[augeas-devel] augeas: master - Debctrl: new lens and test

David Lutterkort lutter at fedoraproject.org
Fri Feb 26 18:39:50 UTC 2010


Gitweb:        http://git.fedorahosted.org/git/augeas.git?p=augeas.git;a=commitdiff;h=c2be07b632607802d09e9fc2acc52c8d536a6812
Commit:        c2be07b632607802d09e9fc2acc52c8d536a6812
Parent:        9b6a3cebca371557992aa71742df07a6fdacb612
Author:        Dominique Dumont <domi.dumont at free.fr>
AuthorDate:    Fri Feb 26 10:10:38 2010 -0800
Committer:     David Lutterkort <lutter at redhat.com>
CommitterDate: Fri Feb 26 10:18:59 2010 -0800

Debctrl: new lens and test

---
 doc/naturaldocs/conf/lenses/Menu.txt |    1 +
 lenses/debctrl.aug                   |  135 ++++++++++++++++++++++
 lenses/tests/test_debctrl.aug        |  207 ++++++++++++++++++++++++++++++++++
 tests/Makefile.am                    |    1 +
 4 files changed, 344 insertions(+), 0 deletions(-)

diff --git a/doc/naturaldocs/conf/lenses/Menu.txt b/doc/naturaldocs/conf/lenses/Menu.txt
index f8a5fbf..bb0a676 100644
--- a/doc/naturaldocs/conf/lenses/Menu.txt
+++ b/doc/naturaldocs/conf/lenses/Menu.txt
@@ -57,6 +57,7 @@ Group: Specific Modules  {
    File: cgconfig  (cgconfig.aug)
    File: cgrules  (cgrules.aug)
    File: Cron  (cron.aug)
+   File: debctrl  (debctrl.aug)
    File: Dpkg  (dpkg.aug)
    File: Exports  (exports.aug)
    File: Iptables  (iptables.aug)
diff --git a/lenses/debctrl.aug b/lenses/debctrl.aug
new file mode 100644
index 0000000..3dd516f
--- /dev/null
+++ b/lenses/debctrl.aug
@@ -0,0 +1,135 @@
+(*
+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")
diff --git a/lenses/tests/test_debctrl.aug b/lenses/tests/test_debctrl.aug
new file mode 100644
index 0000000..f81d1e2
--- /dev/null
+++ b/lenses/tests/test_debctrl.aug
@@ -0,0 +1,207 @@
+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
+"
+
diff --git a/tests/Makefile.am b/tests/Makefile.am
index e577623..1d7856d 100644
--- a/tests/Makefile.am
+++ b/tests/Makefile.am
@@ -21,6 +21,7 @@ lens_tests =			\
   lens-cobblermodules.sh	\
   lens-cron.sh			\
   lens-darkice.sh		\
+  lens-debctrl.sh		\
   lens-dhclient.sh		\
   lens-dnsmasq.sh		\
   lens-dpkg.sh			\




More information about the augeas-devel mailing list