File Coverage

blib/lib/Dpkg/Conf.pm
Criterion Covered Total %
statement 73 91 80.2
branch 16 28 57.1
condition 11 16 68.7
subroutine 14 18 77.7
pod 8 8 100.0
total 122 161 75.7


line stmt bran cond sub pod time code
1             # Copyright © 2009-2010 Raphaël Hertzog
2             #
3             # This program is free software; you can redistribute it and/or modify
4             # it under the terms of the GNU General Public License as published by
5             # the Free Software Foundation; either version 2 of the License, or
6             # (at your option) any later version.
7             #
8             # This program is distributed in the hope that it will be useful,
9             # but WITHOUT ANY WARRANTY; without even the implied warranty of
10             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11             # GNU General Public License for more details.
12             #
13             # You should have received a copy of the GNU General Public License
14             # along with this program. If not, see .
15              
16             package Dpkg::Conf;
17              
18 1     1   910 use strict;
  1         3  
  1         30  
19 1     1   5 use warnings;
  1         3  
  1         39  
20              
21             our $VERSION = '1.04';
22              
23 1     1   5 use Carp;
  1         2  
  1         51  
24              
25 1     1   432 use Dpkg::Gettext;
  1         3  
  1         62  
26 1     1   408 use Dpkg::ErrorHandling;
  1         3  
  1         80  
27              
28 1     1   483 use parent qw(Dpkg::Interface::Storable);
  1         313  
  1         5  
29              
30             use overload
31 0     0   0 '@{}' => sub { return [ $_[0]->get_options() ] },
32 1     1   72 fallback => 1;
  1         2  
  1         6  
33              
34             =encoding utf8
35              
36             =head1 NAME
37              
38             Dpkg::Conf - parse dpkg configuration files
39              
40             =head1 DESCRIPTION
41              
42             The Dpkg::Conf object can be used to read options from a configuration
43             file. It can export an array that can then be parsed exactly like @ARGV.
44              
45             =head1 METHODS
46              
47             =over 4
48              
49             =item $conf = Dpkg::Conf->new(%opts)
50              
51             Create a new Dpkg::Conf object. Some options can be set through %opts:
52             if allow_short evaluates to true (it defaults to false), then short
53             options are allowed in the configuration file, they should be prepended
54             with a single hyphen.
55              
56             =cut
57              
58             sub new {
59 5     5 1 753 my ($this, %opts) = @_;
60 5   33     24 my $class = ref($this) || $this;
61              
62 5         47 my $self = {
63             options => [],
64             allow_short => 0,
65             };
66 5         17 foreach my $opt (keys %opts) {
67 4         11 $self->{$opt} = $opts{$opt};
68             }
69 5         12 bless $self, $class;
70              
71 5         26 return $self;
72             }
73              
74             =item @$conf
75              
76             =item @options = $conf->get_options()
77              
78             Returns the list of options that can be parsed like @ARGV.
79              
80             =cut
81              
82             sub get_options {
83 6     6 1 1453 my $self = shift;
84              
85 6         11 return @{$self->{options}};
  6         29  
86             }
87              
88             =item $conf->load($file)
89              
90             Read options from a file. Return the number of options parsed.
91              
92             =item $conf->load_system_config($file)
93              
94             Read options from a system configuration file.
95              
96             Return the number of options parsed.
97              
98             =cut
99              
100             sub load_system_config {
101 0     0 1 0 my ($self, $file) = @_;
102              
103 0 0       0 return 0 unless -e "$Dpkg::CONFDIR/$file";
104 0         0 return $self->load("$Dpkg::CONFDIR/$file");
105             }
106              
107             =item $conf->load_user_config($file)
108              
109             Read options from a user configuration file. It will try to use the XDG
110             directory, either $XDG_CONFIG_HOME/dpkg/ or $HOME/.config/dpkg/.
111              
112             Return the number of options parsed.
113              
114             =cut
115              
116             sub load_user_config {
117 0     0 1 0 my ($self, $file) = @_;
118              
119 0         0 my $confdir = $ENV{XDG_CONFIG_HOME};
120 0 0 0     0 $confdir ||= $ENV{HOME} . '/.config' if length $ENV{HOME};
121              
122 0 0       0 return 0 unless length $confdir;
123 0 0       0 return 0 unless -e "$confdir/dpkg/$file";
124 0 0       0 return $self->load("$confdir/dpkg/$file") if length $confdir;
125 0         0 return 0;
126             }
127              
128             =item $conf->load_config($file)
129              
130             Read options from system and user configuration files.
131              
132             Return the number of options parsed.
133              
134             =cut
135              
136             sub load_config {
137 0     0 1 0 my ($self, $file) = @_;
138              
139 0         0 my $nopts = 0;
140              
141 0         0 $nopts += $self->load_system_config($file);
142 0         0 $nopts += $self->load_user_config($file);
143              
144 0         0 return $nopts;
145             }
146              
147             =item $conf->parse($fh)
148              
149             Parse options from a file handle. When called multiple times, the parsed
150             options are accumulated.
151              
152             Return the number of options parsed.
153              
154             =cut
155              
156             sub parse {
157 5     5 1 15 my ($self, $fh, $desc) = @_;
158 5         8 my $count = 0;
159 5         7 local $_;
160              
161 5         19 while (<$fh>) {
162 130         3118 chomp;
163 130         238 s/^\s+//; # Strip leading spaces
164 130         276 s/\s+$//; # Strip trailing spaces
165 130         216 s/\s+=\s+/=/; # Remove spaces around the first =
166 130 100       307 s/\s+/=/ unless m/=/; # First spaces becomes = if no =
167             # Skip empty lines and comments
168 130 100 100     472 next if /^#/ or length == 0;
169 75 100 100     170 if (/^-[^-]/ and not $self->{allow_short}) {
170 2         10 warning(g_('short option not allowed in %s, line %d'), $desc, $.);
171 2         12 next;
172             }
173 73 50       241 if (/^([^=]+)(?:=(.*))?$/) {
174 73         191 my ($name, $value) = ($1, $2);
175 73 100       173 $name = "--$name" unless $name =~ /^-/;
176 73 100       124 if (defined $value) {
177 64 100       148 $value =~ s/^"(.*)"$/$1/ or $value =~ s/^'(.*)'$/$1/;
178 64         80 push @{$self->{options}}, "$name=$value";
  64         240  
179             } else {
180 9         10 push @{$self->{options}}, $name;
  9         21  
181             }
182 73         202 $count++;
183             } else {
184 0         0 warning(g_('invalid syntax for option in %s, line %d'), $desc, $.);
185             }
186             }
187 5         180 return $count;
188             }
189              
190             =item $conf->filter(%opts)
191              
192             Filter the list of options, either removing or keeping all those that
193             return true when $opts{remove}->($option) or $opts{keep}->($option) is called.
194              
195             =cut
196              
197             sub filter {
198 3     3 1 36 my ($self, %opts) = @_;
199 3   100 15   13 my $remove = $opts{remove} // sub { 0 };
  15         30  
200 3   100 3   12 my $keep = $opts{keep} // sub { 1 };
  3         15  
201              
202 3 100       25 @{$self->{options}} = grep { not $remove->($_) and $keep->($_) }
  45         187  
203 3         5 @{$self->{options}};
  3         8  
204             }
205              
206             =item $string = $conf->output([$fh])
207              
208             Write the options in the given filehandle (if defined) and return a string
209             representation of the content (that would be) written.
210              
211             =item "$conf"
212              
213             Return a string representation of the content.
214              
215             =cut
216              
217             sub output {
218 4     4 1 691 my ($self, $fh) = @_;
219 4         8 my $ret = '';
220 4         9 foreach my $opt ($self->get_options()) {
221 21         49 $opt =~ s/^--//;
222 21         101 $opt =~ s/^([^=]+)=(.*)$/$1 = "$2"/;
223 21         34 $opt .= "\n";
224 21 50       38 print { $fh } $opt if defined $fh;
  0         0  
225 21         33 $ret .= $opt;
226             }
227 4         23 return $ret;
228             }
229              
230             =item $conf->save($file)
231              
232             Save the options in a file.
233              
234             =back
235              
236             =head1 CHANGES
237              
238             =head2 Version 1.04 (dpkg 1.20.0)
239              
240             Remove croak: For 'format_argv' in $conf->filter().
241              
242             Remove methods: $conf->get(), $conf->set().
243              
244             =head2 Version 1.03 (dpkg 1.18.8)
245              
246             Obsolete option: 'format_argv' in $conf->filter().
247              
248             Obsolete methods: $conf->get(), $conf->set().
249              
250             New methods: $conf->load_system_config(), $conf->load_system_user(),
251             $conf->load_config().
252              
253             =head2 Version 1.02 (dpkg 1.18.5)
254              
255             New option: Accept new option 'format_argv' in $conf->filter().
256              
257             New methods: $conf->get(), $conf->set().
258              
259             =head2 Version 1.01 (dpkg 1.15.8)
260              
261             New method: $conf->filter()
262              
263             =head2 Version 1.00 (dpkg 1.15.6)
264              
265             Mark the module as public.
266              
267             =cut
268              
269             1;