File: | Dpkg/Conf.pm |
Coverage: | 74.8% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | # Copyright © 2009-2010 Raphaël Hertzog <hertzog@debian.org> | ||||||
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 <https://www.gnu.org/licenses/>. | ||||||
15 | |||||||
16 | =encoding utf8 | ||||||
17 | |||||||
18 - 27 | =head1 NAME Dpkg::Conf - parse dpkg configuration files =head1 DESCRIPTION The Dpkg::Conf object can be used to read options from a configuration file. It can export an array that can then be parsed exactly like @ARGV. =cut | ||||||
28 | |||||||
29 | package Dpkg::Conf 1.04; | ||||||
30 | |||||||
31 | 3 3 3 | 9 3 54 | use strict; | ||||
32 | 3 3 3 | 6 3 86 | use warnings; | ||||
33 | |||||||
34 | 3 3 3 | 6 3 117 | use Carp; | ||||
35 | |||||||
36 | 3 3 3 | 484 5 162 | use Dpkg::Gettext; | ||||
37 | 3 3 3 | 964 6 160 | use Dpkg::ErrorHandling; | ||||
38 | |||||||
39 | 3 3 3 | 9 2 8 | use parent qw(Dpkg::Interface::Storable); | ||||
40 | |||||||
41 | use overload | ||||||
42 | 0 | 0 | '@{}' => sub { return [ $_[0]->get_options() ] }, | ||||
43 | 3 3 3 | 133 2 10 | fallback => 1; | ||||
44 | |||||||
45 - 56 | =head1 METHODS =over 4 =item $conf = Dpkg::Conf->new(%opts) Create a new Dpkg::Conf object. Some options can be set through %opts: if allow_short evaluates to true (it defaults to false), then short options are allowed in the configuration file, they should be prepended with a single hyphen. =cut | ||||||
57 | |||||||
58 | sub new { | ||||||
59 | 15 | 1 | 34 | my ($this, %opts) = @_; | |||
60 | 15 | 71 | my $class = ref($this) || $this; | ||||
61 | |||||||
62 | 15 | 33 | my $self = { | ||||
63 | options => [], | ||||||
64 | allow_short => 0, | ||||||
65 | }; | ||||||
66 | 15 | 31 | foreach my $opt (keys %opts) { | ||||
67 | 12 | 26 | $self->{$opt} = $opts{$opt}; | ||||
68 | } | ||||||
69 | 15 | 26 | bless $self, $class; | ||||
70 | |||||||
71 | 15 | 44 | return $self; | ||||
72 | } | ||||||
73 | |||||||
74 - 80 | =item @$conf =item @options = $conf->get_options() Returns the list of options that can be parsed like @ARGV. =cut | ||||||
81 | |||||||
82 | sub get_options { | ||||||
83 | 18 | 1 | 18 | my $self = shift; | |||
84 | |||||||
85 | 18 18 | 13 52 | return @{$self->{options}}; | ||||
86 | } | ||||||
87 | |||||||
88 - 98 | =item $conf->load($file) Read options from a file. Return the number of options parsed. =item $conf->load_system_config($file) Read options from a system configuration file. Return the number of options parsed. =cut | ||||||
99 | |||||||
100 | sub load_system_config { | ||||||
101 | 0 | 1 | 0 | my ($self, $file) = @_; | |||
102 | |||||||
103 | 0 | 0 | return 0 unless -e "$Dpkg::CONFDIR/$file"; | ||||
104 | 0 | 0 | return $self->load("$Dpkg::CONFDIR/$file"); | ||||
105 | } | ||||||
106 | |||||||
107 - 114 | =item $conf->load_user_config($file) Read options from a user configuration file. It will try to use the XDG directory, either $XDG_CONFIG_HOME/dpkg/ or $HOME/.config/dpkg/. Return the number of options parsed. =cut | ||||||
115 | |||||||
116 | sub load_user_config { | ||||||
117 | 0 | 1 | 0 | my ($self, $file) = @_; | |||
118 | |||||||
119 | 0 | 0 | my $confdir = $ENV{XDG_CONFIG_HOME}; | ||||
120 | 0 | 0 | $confdir ||= $ENV{HOME} . '/.config' if length $ENV{HOME}; | ||||
121 | |||||||
122 | 0 | 0 | return 0 unless length $confdir; | ||||
123 | 0 | 0 | return 0 unless -e "$confdir/dpkg/$file"; | ||||
124 | 0 | 0 | return $self->load("$confdir/dpkg/$file") if length $confdir; | ||||
125 | 0 | 0 | return 0; | ||||
126 | } | ||||||
127 | |||||||
128 - 134 | =item $conf->load_config($file) Read options from system and user configuration files. Return the number of options parsed. =cut | ||||||
135 | |||||||
136 | sub load_config { | ||||||
137 | 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 - 154 | =item $conf->parse($fh) Parse options from a file handle. When called multiple times, the parsed options are accumulated. Return the number of options parsed. =cut | ||||||
155 | |||||||
156 | sub parse { | ||||||
157 | 15 | 1 | 21 | my ($self, $fh, $desc) = @_; | |||
158 | 15 | 10 | my $count = 0; | ||||
159 | 15 | 8 | local $_; | ||||
160 | |||||||
161 | 15 | 31 | while (<$fh>) { | ||||
162 | 390 | 277 | chomp; | ||||
163 | 390 | 337 | s/^\s+//; # Strip leading spaces | ||||
164 | 390 | 381 | s/\s+$//; # Strip trailing spaces | ||||
165 | 390 | 315 | s/\s+=\s+/=/; # Remove spaces around the first = | ||||
166 | 390 | 441 | s/\s+/=/ unless m/=/; # First spaces becomes = if no = | ||||
167 | # Skip empty lines and comments | ||||||
168 | 390 | 751 | next if /^#/ or length == 0; | ||||
169 | 225 | 274 | if (/^-[^-]/ and not $self->{allow_short}) { | ||||
170 | 6 | 12 | warning(g_('short option not allowed in %s, line %d'), $desc, $.); | ||||
171 | 6 | 11 | next; | ||||
172 | } | ||||||
173 | 219 | 294 | if (/^([^=]+)(?:=(.*))?$/) { | ||||
174 | 219 | 264 | my ($name, $value) = ($1, $2); | ||||
175 | 219 | 225 | $name = "--$name" unless $name =~ /^-/; | ||||
176 | 219 | 136 | if (defined $value) { | ||||
177 | 192 | 221 | $value =~ s/^"(.*)"$/$1/ or $value =~ s/^'(.*)'$/$1/; | ||||
178 | 192 192 | 119 332 | push @{$self->{options}}, "$name=$value"; | ||||
179 | } else { | ||||||
180 | 27 27 | 22 29 | push @{$self->{options}}, $name; | ||||
181 | } | ||||||
182 | 219 | 233 | $count++; | ||||
183 | } else { | ||||||
184 | 0 | 0 | warning(g_('invalid syntax for option in %s, line %d'), $desc, $.); | ||||
185 | } | ||||||
186 | } | ||||||
187 | 15 | 23 | return $count; | ||||
188 | } | ||||||
189 | |||||||
190 - 195 | =item $conf->filter(%opts) Filter the list of options, either removing or keeping all those that return true when $opts{remove}->($option) or $opts{keep}->($option) is called. =cut | ||||||
196 | |||||||
197 | sub filter { | ||||||
198 | 9 | 1 | 17 | my ($self, %opts) = @_; | |||
199 | 9 45 | 22 46 | my $remove = $opts{remove} // sub { 0 }; | ||||
200 | 9 9 | 20 26 | my $keep = $opts{keep} // sub { 1 }; | ||||
201 | |||||||
202 | 9 135 | 31 80 | @{$self->{options}} = grep { not $remove->($_) and $keep->($_) } | ||||
203 | 9 9 | 8 13 | @{$self->{options}}; | ||||
204 | } | ||||||
205 | |||||||
206 - 215 | =item $string = $conf->output([$fh]) Write the options in the given filehandle (if defined) and return a string representation of the content (that would be) written. =item "$conf" Return a string representation of the content. =cut | ||||||
216 | |||||||
217 | sub output { | ||||||
218 | 12 | 1 | 13 | my ($self, $fh) = @_; | |||
219 | 12 | 12 | my $ret = ''; | ||||
220 | 12 | 18 | foreach my $opt ($self->get_options()) { | ||||
221 | 63 | 59 | $opt =~ s/^--//; | ||||
222 | 63 | 152 | $opt =~ s/^([^=]+)=(.*)$/$1 = "$2"/; | ||||
223 | 63 | 54 | $opt .= "\n"; | ||||
224 | 63 0 | 47 0 | print { $fh } $opt if defined $fh; | ||||
225 | 63 | 44 | $ret .= $opt; | ||||
226 | } | ||||||
227 | 12 | 34 | return $ret; | ||||
228 | } | ||||||
229 | |||||||
230 - 267 | =item $conf->save($file) Save the options in a file. =back =head1 CHANGES =head2 Version 1.04 (dpkg 1.20.0) Remove croak: For 'format_argv' in $conf->filter(). Remove methods: $conf->get(), $conf->set(). =head2 Version 1.03 (dpkg 1.18.8) Obsolete option: 'format_argv' in $conf->filter(). Obsolete methods: $conf->get(), $conf->set(). New methods: $conf->load_system_config(), $conf->load_system_user(), $conf->load_config(). =head2 Version 1.02 (dpkg 1.18.5) New option: Accept new option 'format_argv' in $conf->filter(). New methods: $conf->get(), $conf->set(). =head2 Version 1.01 (dpkg 1.15.8) New method: $conf->filter() =head2 Version 1.00 (dpkg 1.15.6) Mark the module as public. =cut | ||||||
268 | |||||||
269 | 1; |