| 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; | ||||||