1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
package Config::Model::Backend::Dpkg::Autopkgtest;
use strict;
use warnings;
use Mouse;
extends 'Config::Model::Backend::Any';
with 'Config::Model::Backend::DpkgSyntax';
with 'Config::Model::Backend::DpkgStoreRole';
use 5.20.1;
use feature qw/postderef signatures/;
no warnings qw/experimental::postderef experimental::signatures/;
use Carp;
use Config::Model::Exception;
use Log::Log4perl qw(get_logger :levels);
use IO::File;
my $logger = get_logger("Backend::Dpkg::Autopkgtest");
my $user_logger = get_logger('User');
sub read ($self, %args) { ## no critic (ProhibitBuiltinHomonyms)
# args is:
# object => $obj, # Config::Model::Node object
# root => './my_test', # fake root directory, userd for tests
# config_dir => /etc/foo', # absolute path
# file => 'foo.conf', # file name
# file_path => './my_test/etc/foo/foo.conf'
# check => yes|no|skip
my $fp = $args{file_path};
return 0 unless defined $fp and $fp->is_file ;
$self->parse_control_file($fp, $args{object}, $args{check});
return 1;
}
sub parse_control_file ($self, $control_file, $node, $check) {
$logger->info("Parsing $control_file");
# load autopkgtest control file
my $c = $self -> parse_dpkg_file ($control_file, $check, 1 ) ;
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 $section_data = $section->[ $i + 1 ];
if ( my $elt = $test_obj->find_element( $key, case => 'any' ) ) {
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, $section_data);
}
else {
$self->store_section_leaf_element ( $logger, $elt_obj, $check, $section_data);
}
}
else {
$user_logger->warn("Unknown parameter found in $control_file: $key");
}
}
}
return;
}
sub write ($self, %args) { ## no critic (ProhibitBuiltinHomonyms)
# args is:
# object => $obj, # Config::Model::Node object
# root => './my_test', # fake root directory, userd for tests
# config_dir => /etc/foo', # absolute path
# file => 'foo.conf', # file name
# file_path => './my_test/etc/foo/foo.conf'
$self->write_control_file($args{object}, $args{file_path});
return 1;
}
sub write_control_file ($self, $node, $control_file) {
my @sections;
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)) ];
}
my $res = $self->write_dpkg_file(\@sections,", " ) ;
$control_file->spew_utf8($res);
return;
}
1;
__END__
=head1 NAME
Config::Model::Backend::Dpkg::Autopkgtest - Read and write Debian Dpkg Autopkgtest information
=head1 SYNOPSIS
No synopsis. This class is dedicated to configuration class C<Dpkg::Autopkgtest>
=head1 DESCRIPTION
This module is used directly by L<Config::Model> to read or write the
content of Debian C<Autopkgtest> file.
All C<Autopkgtest> files keyword are read in a case-insensitive manner.
=head1 CONSTRUCTOR
=head2 new
Parameters: C<< node => $node_obj, name => 'Dpkg::Autopkgtest' >>
Inherited from L<Config::Model::Backend::Any>. The constructor will be
called by L<Config::Model::AutoRead>.
=head2 read
Read data from Autopkgtest files.
When a file is read, C<read()> returns 1.
=head2 write
Write data to Autopkgtest files.
C<write()> returns 1.
=head1 AUTHOR
Dominique Dumont, (ddumont at cpan dot org)
=head1 SEE ALSO
L<Config::Model>,
L<Config::Model::AutoRead>,
L<Config::Model::Backend::Any>,
=cut
|
