scripts/Dpkg/Conf.pm

   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 =head1 NAME
  19
  20 Dpkg::Conf - parse dpkg configuration files
  21
  22 =head1 DESCRIPTION
  23
  24 The Dpkg::Conf object can be used to read options from a configuration
  25 file. It can export an array that can then be parsed exactly like @ARGV.
  26
  27 =cut
  28
  29 package Dpkg::Conf 1.04;
  30
  31 use strict;
  32 use warnings;
  33
  34 use Carp;
  35
  36 use Dpkg::Gettext;
  37 use Dpkg::ErrorHandling;
  38
  39 use parent qw(Dpkg::Interface::Storable);
  40
  41 use overload
  42     '@{}' => sub { return [ $_[0]->get_options() ] },
  43     fallback => 1;
  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     my ($this, %opts) = @_;
  60     my $class = ref($this) || $this;
  61
  62     my $self = {
  63         options => [],
  64         allow_short => 0,
  65     };
  66     foreach my $opt (keys %opts) {
  67         $self->{$opt} = $opts{$opt};
  68     }
  69     bless $self, $class;
  70
  71     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     my $self = shift;
  84
  85     return @{$self->{options}};
  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     my ($self, $file) = @_;
 102
 103     return 0 unless -e "$Dpkg::CONFDIR/$file";
 104     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     my ($self, $file) = @_;
 118
 119     my $confdir = $ENV{XDG_CONFIG_HOME};
 120     $confdir ||= $ENV{HOME} . '/.config' if length $ENV{HOME};
 121
 122     return 0 unless length $confdir;
 123     return 0 unless -e "$confdir/dpkg/$file";
 124     return $self->load("$confdir/dpkg/$file") if length $confdir;
 125     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     my ($self, $file) = @_;
 138
 139     my $nopts = 0;
 140
 141     $nopts += $self->load_system_config($file);
 142     $nopts += $self->load_user_config($file);
 143
 144     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     my ($self, $fh, $desc) = @_;
 158     my $count = 0;
 159     local $_;
 160
 161     while (<$fh>) {
 162         chomp;
 163         s/^\s+//;             # Strip leading spaces
 164         s/\s+$//;             # Strip trailing spaces
 165         s/\s+=\s+/=/;         # Remove spaces around the first =
 166         s/\s+/=/ unless m/=/; # First spaces becomes = if no =
 167         # Skip empty lines and comments
 168         next if /^#/ or length == 0;
 169         if (/^-[^-]/ and not $self->{allow_short}) {
 170             warning(g_('short option not allowed in %s, line %d'), $desc, $.);
 171             next;
 172         }
 173         if (/^([^=]+)(?:=(.*))?$/) {
 174             my ($name, $value) = ($1, $2);
 175             $name = "--$name" unless $name =~ /^-/;
 176             if (defined $value) {
 177                 $value =~ s/^"(.*)"$/$1/ or $value =~ s/^'(.*)'$/$1/;
 178                 push @{$self->{options}}, "$name=$value";
 179             } else {
 180                 push @{$self->{options}}, $name;
 181             }
 182             $count++;
 183         } else {
 184             warning(g_('invalid syntax for option in %s, line %d'), $desc, $.);
 185         }
 186     }
 187     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     my ($self, %opts) = @_;
 199     my $remove = $opts{remove} // sub { 0 };
 200     my $keep = $opts{keep} // sub { 1 };
 201
 202     @{$self->{options}} = grep { not $remove->($_) and $keep->($_) }
 203                                @{$self->{options}};
 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     my ($self, $fh) = @_;
 219     my $ret = '';
 220     foreach my $opt ($self->get_options()) {
 221         $opt =~ s/^--//;
 222         $opt =~ s/^([^=]+)=(.*)$/$1 = "$2"/;
 223         $opt .= "\n";
 224         print { $fh } $opt if defined $fh;
 225         $ret .= $opt;
 226     }
 227     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;