[libconfig-model-dpkg-perl] 03/05: fix Autopkgtest to handle several stanzas
dod at debian.org
dod at debian.org
Wed Nov 22 19:16:53 UTC 2017
This is an automated email from the git hooks/post-receive script.
dod pushed a commit to annotated tag debian/2.104
in repository libconfig-model-dpkg-perl.
commit 83ac3eff6d286a29bce6fd2ed1db5fec534287d1
Author: Dominique Dumont <dod at debian.org>
Date: Wed Nov 22 20:08:48 2017 +0100
fix Autopkgtest to handle several stanzas
---
lib/Config/Model/Backend/Dpkg/Autopkgtest.pm | 65 ++++++++++++---------------
lib/Config/Model/models/Dpkg.pl | 4 +-
lib/Config/Model/models/Dpkg/Tests.pl | 24 ++++++++++
lib/Config/Model/models/Dpkg/Tests/Control.pl | 10 +----
4 files changed, 57 insertions(+), 46 deletions(-)
diff --git a/lib/Config/Model/Backend/Dpkg/Autopkgtest.pm b/lib/Config/Model/Backend/Dpkg/Autopkgtest.pm
index a570127..a8331cb 100644
--- a/lib/Config/Model/Backend/Dpkg/Autopkgtest.pm
+++ b/lib/Config/Model/Backend/Dpkg/Autopkgtest.pm
@@ -36,42 +36,40 @@ sub read {
# io_handle => $io # IO::File object
# check => yes|no|skip
- # io_handle is not defined as no file is specified in model
-
return 0 unless defined $args{io_handle} ;
$logger->info("Parsing $args{file_path}");
# load autopkgtest control file
my $c = $self -> parse_dpkg_file ($args{file_path}, $args{io_handle}, $args{check}, 1 ) ;
- Config::Model::Exception::Syntax->throw(
- message => "More than 1 section in $args{file_path}",
- parsed_file => $args{file_path},
- )
- if @$c > 2; # $c contains [ line_nb, section_ref ]
-
- my ( $section_line, $section ) = @$c;
my $node = $args{object};
my $check = $args{check};
-
- foreach ( my $i = 0 ; $i < $#$section ; $i += 2 ) {
- my $key = $section->[$i];
- my $v_ref = $section->[ $i + 1 ];
- if ( my $found = $node->find_element( $key, case => 'any' ) ) {
- my $elt = $found ;
- my $to_store = $v_ref;
-
- my $elt_obj = $node->fetch_element($elt);
- if ($node->element_type($elt) eq 'list') {
- $self->store_section_list_element ( $logger, $elt_obj, $check, $to_store);
+ my $test_list = $node->fetch_element('control');
+ my $test_nb = 0;
+
+ while (@$c ) {
+ my ($section_line,$section) = splice @$c,0,2 ;
+ my $test_obj = $test_list->fetch_with_id($test_nb++);
+
+ foreach ( my $i = 0 ; $i < $#$section ; $i += 2 ) {
+ my $key = $section->[$i];
+ my $v_ref = $section->[ $i + 1 ];
+ if ( my $found = $test_obj->find_element( $key, case => 'any' ) ) {
+ my $elt = $found ;
+ my $to_store = $v_ref;
+
+ my $elt_obj = $test_obj->fetch_element($elt);
+ if ($test_obj->element_type($elt) eq 'list') {
+ $self->store_section_list_element ( $logger, $elt_obj, $check, $to_store);
+ }
+ else {
+ $self->store_section_leaf_element ( $logger, $elt_obj, $check, $to_store);
+ }
}
else {
- $self->store_section_leaf_element ( $logger, $elt_obj, $check, $to_store);
+ warn "Unknown parameter found in $args{file_path}: $key";
}
}
- else {
- warn "Unknown parameter found in $args{file_path}: $key";
- }
}
return 1;
@@ -89,23 +87,18 @@ sub write {
# file_path => './my_test/etc/foo/foo.conf'
# io_handle => $io # IO::File object
- # io_handle is not defined as no file is specified in model
-
- croak "Undefined file handle to write"
- unless defined $args{io_handle} ;
+ croak "Undefined file handle to write" unless defined $args{io_handle} ;
my $node = $args{object} ;
- my $io = $args{io_handle} ;
-
- # write all parameters
- foreach my $elt ( $node -> get_element_name ) {
- my $v = $node->fetch_element($elt)->fetch;
+ my $ioh = $args{io_handle} ;
- next unless defined $v;
+ my @sections;
- $io->print("$elt: ");
- $self->write_dpkg_text($io,$v) ;
+ my $test_list = $node->fetch_element('control');
+ foreach my $test_nb ( $test_list -> fetch_all_indexes ) {
+ push @sections, [ $self->node_to_section($test_list->fetch_with_id($test_nb)) ];
}
+ $self->write_dpkg_file($ioh, \@sections,", " ) ;
return 1;
}
diff --git a/lib/Config/Model/models/Dpkg.pl b/lib/Config/Model/models/Dpkg.pl
index 732743c..bec5855 100644
--- a/lib/Config/Model/models/Dpkg.pl
+++ b/lib/Config/Model/models/Dpkg.pl
@@ -222,9 +222,9 @@ By default, it will include all existing files in the top-level source directory
'type' => 'leaf',
'value_type' => 'string'
},
- 'test-control',
+ 'tests',
{
- 'config_class_name' => 'Dpkg::Tests::Control',
+ 'config_class_name' => 'Dpkg::Tests',
'level' => 'hidden',
'type' => 'warped_node',
'warp' => {
diff --git a/lib/Config/Model/models/Dpkg/Tests.pl b/lib/Config/Model/models/Dpkg/Tests.pl
new file mode 100644
index 0000000..cf9a0d2
--- /dev/null
+++ b/lib/Config/Model/models/Dpkg/Tests.pl
@@ -0,0 +1,24 @@
+[
+ {
+ 'element' => [
+ 'control',
+ {
+ 'cargo' => {
+ 'config_class_name' => 'Dpkg::Tests::Control',
+ 'type' => 'node'
+ },
+ 'type' => 'list'
+ }
+ ],
+ 'name' => 'Dpkg::Tests',
+ 'rw_config' => {
+ 'auto_create' => '1',
+ 'auto_delete' => '1',
+ 'backend' => 'Dpkg::Autopkgtest',
+ 'config_dir' => 'debian/tests',
+ 'file' => 'control'
+ }
+ }
+]
+;
+
diff --git a/lib/Config/Model/models/Dpkg/Tests/Control.pl b/lib/Config/Model/models/Dpkg/Tests/Control.pl
index 43200a4..ea0a1c2 100644
--- a/lib/Config/Model/models/Dpkg/Tests/Control.pl
+++ b/lib/Config/Model/models/Dpkg/Tests/Control.pl
@@ -91,14 +91,8 @@ This is purely an informational field for autopkgtest itself and will be ignored
'value_type' => 'uniline'
}
],
- 'name' => 'Dpkg::Tests::Control',
- 'rw_config' => {
- 'auto_create' => '1',
- 'auto_delete' => '1',
- 'backend' => 'Dpkg::Autopkgtest',
- 'config_dir' => 'debian/tests',
- 'file' => 'control'
- }
+ 'gist' => '{Tests:0}{Test-Command}',
+ 'name' => 'Dpkg::Tests::Control'
}
]
;
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libconfig-model-dpkg-perl.git
More information about the Pkg-perl-cvs-commits
mailing list