[augeas-devel] Augeas lens for Debian control file

Dominique Dumont domi.dumont at free.fr
Wed Feb 24 14:18:35 UTC 2010


Hello

Ahem, I've written this lens a while ago and then I somewhat forgot it ... 
(oops)

Anyway, better late than never, and here's the lens I created while writing 
the "writing a lens from bottom to top" tutorial [1]

This lens applies to Debian control file used for Debian package creation. 
Since this is a user's configuration file, not to a system configuration file, 
augtool '-r' option *must* be used to set up the root directory used by 
Augeas.

All the best

Dominique
--
http://config-model.wiki.sourceforge.net/ -o- http://search.cpan.org/~ddumont/
http://www.ohloh.net/accounts/ddumont
-------------- next part --------------
(*
Module: debctrl
  Parses ./debian/control

Author: 
        Dominique Dumont domi.dumont at free.fr or dominique.dumont at hp.com

About: Reference
  http://augeas.net/page/Create_a_lens_from_bottom_to_top
  http://www.debian.org/doc/debian-policy/ch-controlfields.html

About: License
  This file is licensed under the LGPL v2+.

About: Lens Usage
  Since control file is not a system configuration file, you will have
  to use augtool -r option to point to 'debian' directory.

  Run augtool:
  $ augtool -r debian

  Sample usage of this lens in augtool:

    * Get the value stored in control file
      > print /files/control
      ...

  Saving your file:

      > save


*)

module Debctrl =
  autoload xfm

let eol = Util.eol
let del_ws_spc = del /[\t ]*/ " "
let hardeol = del /\n/ "\n"
let del_opt_ws = del /[\t ]*/ ""
let colon = del /:[ \t]*/ ": "

let simple_entry (k:regexp) =
   let value =  store /[^ \t][^\n]+/ in
   [ key k . colon . value . hardeol ]

let cont_line = del /\n[ \t]+/ "\n "
let comma     = del  /,[ \t]*/  ", "

let sep_comma_with_nl = del /[ \t\n]*,[ \t\n]*/ ",\n "
 (*= del_opt_ws . cont_line* . comma . cont_line**)

let email =  store ( /([A-Za-z]+ )+<[^\n>]+>/ |  /[^\n,\t<> ]+/ )

let multi_line_array_entry (k:regexp) (v:lens) =
    [ key k . colon . [ counter "array" . seq "array" .  v ] . 
      [ seq "array" . sep_comma_with_nl . v ]* . hardeol ]

(* dependency stuff *)

let version_depends = 
    [ label "version"  
     . [   del / *\( */ " ( " . label "relation" . store /[<>=]+/ ]
     . [   del_ws_spc . label "number" . store /[a-zA-Z0-9_\.\-]+/ 
         . del / *\)/ " )" ] 
    ]
    
let arch_depends = 
    [ label "arch" 
    . [  del / *\[ */ " [ " . label "prefix" . store /!?/ ]
    . [ label "name" . store /[a-zA-Z0-9_\.\-]+/ . del / *\]/ " ]" ] ]
    

let package_depends 
  =  [ key ( /[a-zA-Z0-9_\-]+/ | /\$\{[a-zA-Z0-9:]+\}/ ) 
        . ( version_depends | arch_depends ) * ]
    

let dependency = [ label "or" . package_depends ]
               . [ label "or" . del / *\| */ " | "
                   . package_depends ] *

let dependency_list (field:regexp) = 
    [ key field . colon . [ label "and" .  dependency ]
      . [ label "and" . sep_comma_with_nl . dependency ]*
      . eol ]

(* source package *)
let uploaders  =
    multi_line_array_entry /Uploaders/ email

let simple_src_keyword = "Source" | "Section" | "Priority" 
    | "Standards\-Version" | "Homepage" | /Vcs\-Svn/ | /Vcs\-Browser/
    | "Maintainer"
let depend_src_keywords = /Build\-Depends/ | /Build\-Depends\-Indep/

let src_entries = (   simple_entry simple_src_keyword 
                    | uploaders 
                    | dependency_list depend_src_keywords ) *


(* package paragraph *)

let simple_bin_keyword = "Package" | "Architecture" |  "Section"
    | "Priority" | "Essential" | "Homepage" 

let simple_bin_entry = simple_entry simple_bin_keyword 

let multi_line_entry (k:string) =
     let line = /[^\n]+/ in
      [ label k .  del /^ / " " .  store line . hardeol ] *  


let description 
  = [ key "Description" . colon 
     . [ label "summary" . store /[a-zA-Z][^\n]+/ . hardeol ]
     . multi_line_entry "text" ]


(* binary package *)
let simple_bin_keywords = "Package" | "Architecture" 
let depend_bin_keywords = "Depends" | "Recommends" | "Suggests"

let bin_entries = ( simple_entry simple_bin_keywords
                  | dependency_list depend_bin_keywords
                  ) + . description

(* The whole stuff *)
let lns =  [ label "srcpkg" .  src_entries  ] 
        .  [ label "binpkg" . hardeol+ . bin_entries ]+
        . eol*

(* lens must be used with AUG_ROOT set to debian package source directory *)
let xfm = transform lns (incl "/control")
-------------- next part --------------
module Test_debctrl =

 let source = "Source: libtest-distmanifest-perl\n"
 let source_result =   { "Source" = "libtest-distmanifest-perl" }

 test (Debctrl.simple_entry Debctrl.simple_src_keyword ) get source =
    source_result

 test (Debctrl.simple_entry Debctrl.simple_src_keyword ) get 
  "Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>\n"
   = {  "Maintainer" = "Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>"
     }

 let uploaders 
   = "Uploaders: foo at bar, Dominique Dumont <dominique.dumont at xx.yyy>,\n"
   . "  gregor herrmann <gregoa at xxx.yy>\n"

 let uploaders_result =
    { "Uploaders"
       { "1" = "foo at bar"}
       { "2" = "Dominique Dumont <dominique.dumont at xx.yyy>" }
       { "3" = "gregor herrmann <gregoa at xxx.yy>" } }

 test Debctrl.uploaders get uploaders = uploaders_result

(* test package dependencies *)
test Debctrl.version_depends get "( >= 5.8.8-12 )" = 
   { "version" { "relation"  = ">=" } { "number"  = "5.8.8-12" } }

test Debctrl.arch_depends get "[ !hurd-i386]" = 
   { "arch" { "prefix"  = "!" } { "name"  = "hurd-i386" } }

test Debctrl.arch_depends get "[ hurd-i386]" = 
   { "arch" { "prefix"  = "" } { "name"  = "hurd-i386" } }

let p_depends_test = "perl ( >= 5.8.8-12 ) [ !hurd-i386]"

test Debctrl.package_depends get p_depends_test =
   { "perl"
       { "version"
                   { "relation"  = ">=" }
                   { "number"  = "5.8.8-12" } }
       { "arch" { "prefix"  = "!" } { "name"  = "hurd-i386" } } }

let dependency_test = "perl-modules (>= 5.10) | libmodule-build-perl"

test Debctrl.dependency get dependency_test = 
   { "or" { "perl-modules" 
                { "version" { "relation"  = ">=" } 
                            { "number"  = "5.10" } } } }
   { "or" { "libmodule-build-perl" } }

test (Debctrl.dependency_list "Build-Depends-Indep") get 
  "Build-Depends-Indep: perl (>= 5.8.8-12) [ !hurd-i386], \n"
  . "   perl-modules (>= 5.10) | libmodule-build-perl,\n"
  . "   libcarp-assert-more-perl,\n"
  . "   libconfig-tiny-perl\n"
  = { "Build-Depends-Indep"
       { "and" { "or" { "perl" 
                        { "version"
                          { "relation"  = ">=" }
                          { "number"  = "5.8.8-12" } }
                        { "arch" 
                          { "prefix"  = "!" } 
                          { "name"  = "hurd-i386" } } } } }
       { "and" { "or" { "perl-modules" 
                        { "version" { "relation"  = ">=" }  
                                    { "number"  = "5.10" } } } }
               { "or" { "libmodule-build-perl" } } }
       { "and" { "or" { "libcarp-assert-more-perl" } } }
       { "and" { "or" { "libconfig-tiny-perl" } } } }

test (Debctrl.dependency_list "Depends") get 
  "Depends: ${perl:Depends}, ${misc:Depends},\n"
  ." libparse-recdescent-perl (>= 1.90.0)\n"
  = { "Depends"
       {  "and" { "or" { "${perl:Depends}" }} }
       {  "and" { "or" { "${misc:Depends}" }} }
       {  "and" { "or" { "libparse-recdescent-perl"  
                         { "version"
                           { "relation"  = ">=" }
                           { "number"  = "1.90.0" } } } } }
    } 

 let description = "Description: describe and edit configuration data\n"
 ." Config::Model enables [...] must:\n"
 ."    - if the configuration data\n"
 ." .\n"
 ." With the elements above, (...) on ReadLine.\n"

 test Debctrl.description get description = 
  { "Description" 
    { "summary" = "describe and edit configuration data" }
    { "text" = "Config::Model enables [...] must:" }
    { "text" = "   - if the configuration data" }
    { "text" = "." }            
    { "text" = "With the elements above, (...) on ReadLine."} }
 

 let simple_bin_pkg1 = "Package: libconfig-model-perl\n"
     . "Architecture: all\n"
     . "Description: dummy1\n"
     . " dummy text 1\n"

 let simple_bin_pkg2 = "Package: libconfig-model2-perl\n"
     . "Architecture: all\n"
     . "Description: dummy2\n"
     . " dummy text 2\n"

 test Debctrl.src_entries get source.uploaders 
 =  { "Source" = "libtest-distmanifest-perl" }
                { "Uploaders"
                  { "1" = "foo at bar"}
                  { "2" = "Dominique Dumont <dominique.dumont at xx.yyy>" }
                  { "3" = "gregor herrmann <gregoa at xxx.yy>" } }

 test Debctrl.bin_entries get simple_bin_pkg1 = 
  { "Package" = "libconfig-model-perl" }
  { "Architecture" = "all" } 
  { "Description" { "summary" = "dummy1" } {"text" = "dummy text 1" } }

 
 let paragraph_simple = source . uploaders ."\n" 
       . simple_bin_pkg1 . "\n" 
       . simple_bin_pkg2 

 test Debctrl.lns get paragraph_simple =
   { "srcpkg"   { "Source" = "libtest-distmanifest-perl" }
                { "Uploaders"
                  { "1" = "foo at bar"}
                  { "2" = "Dominique Dumont <dominique.dumont at xx.yyy>" }
                  { "3" = "gregor herrmann <gregoa at xxx.yy>" } } }
   { "binpkg" { "Package" = "libconfig-model-perl" }
                    { "Architecture" = "all" } 
                    { "Description" { "summary" = "dummy1" } 
                                    { "text" = "dummy text 1" } } }
   { "binpkg" { "Package" = "libconfig-model2-perl" }
                    { "Architecture" = "all" } 
		    { "Description" { "summary" = "dummy2" } 
                                    { "text" = "dummy text 2" } } } 


(* PUT TESTS *)

test Debctrl.src_entries
     put uploaders  
     after set "/Uploaders/1" "foo at bar"
   =  uploaders

test Debctrl.src_entries
     put uploaders  
  after set "/Uploaders/1" "bar at bar" 
 =  "Uploaders: bar at bar, Dominique Dumont <dominique.dumont at xx.yyy>,\n"
   . "  gregor herrmann <gregoa at xxx.yy>\n"

test Debctrl.src_entries
     put uploaders  
     after set "/Uploaders/4" "baz at bar"
   =  "Uploaders: foo at bar, Dominique Dumont <dominique.dumont at xx.yyy>,\n"
   . "  gregor herrmann <gregoa at xxx.yy>,\n"
   . " baz at bar\n"

test Debctrl.lns put (source."\nPackage: test\nDescription: foobar\n")
  after
  set "/srcpkg/Uploaders/1" "foo at bar" ;
  set "/srcpkg/Uploaders/2" "Dominique Dumont <dominique.dumont at xx.yyy>" ;
  set "/srcpkg/Uploaders/3" "gregor herrmann <gregoa at xxx.yy>" ;
  set "/srcpkg/Build-Depends-Indep/and[1]/or/perl/version/relation" ">=" ;
  set "/srcpkg/Build-Depends-Indep/and[1]/or/perl/version/number" "5.8.8-12" ;
  set "/srcpkg/Build-Depends-Indep/and[1]/or/perl/arch/prefix" "!" ;
  set "/srcpkg/Build-Depends-Indep/and[1]/or/perl/arch/name" "hurd-i386" ;
  set "/srcpkg/Build-Depends-Indep/and[2]/or[1]/perl-modules/version/relation" ">=" ;
  set "/srcpkg/Build-Depends-Indep/and[2]/or[1]/perl-modules/version/number" "5.10" ;
  set "/srcpkg/Build-Depends-Indep/and[2]/or[2]/libmodule-build-perl" "";
  set "/srcpkg/Build-Depends-Indep/and[3]/or/libcarp-assert-more-perl" "" ;
  set "/srcpkg/Build-Depends-Indep/and[4]/or/libconfig-tiny-perl" "" ;
  set "/binpkg[1]/Package" "libconfig-model-perl"  ; 
  (* must remove description because set cannot insert Archi before description *)
  rm  "/binpkg[1]/Description" ;
  set "/binpkg/Architecture" "all"  ;
  set "/binpkg[1]/Description/summary" "dummy1" ;
  set "/binpkg[1]/Description/text" "dummy text 1" ;
  set "/binpkg[2]/Package" "libconfig-model2-perl" ;
  set "/binpkg[2]/Architecture" "all" ;
  set "/binpkg[2]/Description/summary" "dummy2" ;
  set "/binpkg[2]/Description/text" "dummy text 2" 
  =  
"Source: libtest-distmanifest-perl
Uploaders: foo at bar,
 Dominique Dumont <dominique.dumont at xx.yyy>,
 gregor herrmann <gregoa at xxx.yy>
Build-Depends-Indep: perl ( >= 5.8.8-12 ) [ !hurd-i386 ],
 perl-modules ( >= 5.10 ) | libmodule-build-perl,
 libcarp-assert-more-perl,
 libconfig-tiny-perl

Package: libconfig-model-perl
Architecture: all
Description: dummy1
 dummy text 1

Package: libconfig-model2-perl
Architecture: all
Description: dummy2
 dummy text 2
"



More information about the augeas-devel mailing list