File: | Dpkg/Conf.pm |
Coverage: | 75.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 | package Dpkg::Conf; | ||||||
17 | |||||||
18 | 1 1 1 | 2 0 11 | use strict; | ||||
19 | 1 1 1 | 2 1 26 | use warnings; | ||||
20 | |||||||
21 | our $VERSION = '1.04'; | ||||||
22 | |||||||
23 | 1 1 1 | 2 1 18 | use Carp; | ||||
24 | |||||||
25 | 1 1 1 | 116 1 24 | use Dpkg::Gettext; | ||||
26 | 1 1 1 | 118 1 32 | use Dpkg::ErrorHandling; | ||||
27 | |||||||
28 | 1 1 1 | 2 1 2 | use parent qw(Dpkg::Interface::Storable); | ||||
29 | |||||||
30 | use overload | ||||||
31 | 0 | 0 | '@{}' => sub { return [ $_[0]->get_options() ] }, | ||||
32 | 1 1 1 | 34 0 2 | fallback => 1; | ||||
33 | |||||||
34 | =encoding utf8 | ||||||
35 | |||||||
36 - 56 | =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. =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 | 5 | 1 | 7 | my ($this, %opts) = @_; | |||
60 | 5 | 12 | my $class = ref($this) || $this; | ||||
61 | |||||||
62 | 5 | 6 | my $self = { | ||||
63 | options => [], | ||||||
64 | allow_short => 0, | ||||||
65 | }; | ||||||
66 | 5 | 5 | foreach my $opt (keys %opts) { | ||||
67 | 4 | 5 | $self->{$opt} = $opts{$opt}; | ||||
68 | } | ||||||
69 | 5 | 4 | bless $self, $class; | ||||
70 | |||||||
71 | 5 | 9 | 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 | 6 | 1 | 4 | my $self = shift; | |||
84 | |||||||
85 | 6 6 | 4 11 | 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 | 5 | 1 | 6 | my ($self, $fh, $desc) = @_; | |||
158 | 5 | 2 | my $count = 0; | ||||
159 | 5 | 3 | local $_; | ||||
160 | |||||||
161 | 5 | 6 | while (<$fh>) { | ||||
162 | 130 | 68 | chomp; | ||||
163 | 130 | 90 | s/^\s+//; # Strip leading spaces | ||||
164 | 130 | 99 | s/\s+$//; # Strip trailing spaces | ||||
165 | 130 | 83 | s/\s+=\s+/=/; # Remove spaces around the first = | ||||
166 | 130 | 115 | s/\s+/=/ unless m/=/; # First spaces becomes = if no = | ||||
167 | # Skip empty lines and comments | ||||||
168 | 130 | 186 | next if /^#/ or length == 0; | ||||
169 | 75 | 72 | if (/^-[^-]/ and not $self->{allow_short}) { | ||||
170 | 2 | 2 | warning(g_('short option not allowed in %s, line %d'), $desc, $.); | ||||
171 | 2 | 3 | next; | ||||
172 | } | ||||||
173 | 73 | 82 | if (/^([^=]+)(?:=(.*))?$/) { | ||||
174 | 73 | 58 | my ($name, $value) = ($1, $2); | ||||
175 | 73 | 64 | $name = "--$name" unless $name =~ /^-/; | ||||
176 | 73 | 42 | if (defined $value) { | ||||
177 | 64 | 52 | $value =~ s/^"(.*)"$/$1/ or $value =~ s/^'(.*)'$/$1/; | ||||
178 | 64 64 | 41 72 | push @{$self->{options}}, "$name=$value"; | ||||
179 | } else { | ||||||
180 | 9 9 | 5 6 | push @{$self->{options}}, $name; | ||||
181 | } | ||||||
182 | 73 | 58 | $count++; | ||||
183 | } else { | ||||||
184 | 0 | 0 | warning(g_('invalid syntax for option in %s, line %d'), $desc, $.); | ||||
185 | } | ||||||
186 | } | ||||||
187 | 5 | 6 | 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 | 3 | 1 | 3 | my ($self, %opts) = @_; | |||
199 | 3 15 | 6 14 | my $remove = $opts{remove} // sub { 0 }; | ||||
200 | 3 3 | 5 2 | my $keep = $opts{keep} // sub { 1 }; | ||||
201 | |||||||
202 | 3 45 | 7 20 | @{$self->{options}} = grep { not $remove->($_) and $keep->($_) } | ||||
203 | 3 3 | 3 3 | @{$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 | 4 | 1 | 3 | my ($self, $fh) = @_; | |||
219 | 4 | 4 | my $ret = ''; | ||||
220 | 4 | 2 | foreach my $opt ($self->get_options()) { | ||||
221 | 21 | 15 | $opt =~ s/^--//; | ||||
222 | 21 | 38 | $opt =~ s/^([^=]+)=(.*)$/$1 = "$2"/; | ||||
223 | 21 | 12 | $opt .= "\n"; | ||||
224 | 21 0 | 14 0 | print { $fh } $opt if defined $fh; | ||||
225 | 21 | 12 | $ret .= $opt; | ||||
226 | } | ||||||
227 | 4 | 7 | 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; |