mdw@git.distorted.org.uk Git - dpkg/blob - 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 package Dpkg::Conf;
  17
  18 use strict;
  19 use warnings;
  20
  21 our $VERSION = '1.03';
  22
  23 use Carp;
  24
  25 use Dpkg::Gettext;
  26 use Dpkg::ErrorHandling;
  27
  28 use parent qw(Dpkg::Interface::Storable);
  29
  30 use overload
  31     '@{}' => sub { return [ $_[0]->get_options() ] },
  32     fallback => 1;
  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     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 get()
  89
  90 =item set()
  91
  92 Obsolete functions, use get_options() instead. They will croak.
  93
  94 =cut
  95
  96 sub get {
  97     croak 'obsolete function, use get_options instead';
  98 }
  99
 100 sub set {
 101     croak 'obsolete function, use get_options instead';
 102 }
 103
 104 =item $conf->load($file)
 105
 106 Read options from a file. Return the number of options parsed.
 107
 108 =item $conf->load_system_config($file)
 109
 110 Read options from a system configuration file.
 111
 112 Return the number of options parsed.
 113
 114 =cut
 115
 116 sub load_system_config {
 117     my ($self, $file) = @_;
 118
 119     return 0 unless -e "$Dpkg::CONFDIR/$file";
 120     return $self->load("$Dpkg::CONFDIR/$file");
 121 }
 122
 123 =item $conf->load_user_config($file)
 124
 125 Read options from a user configuration file. It will try to use the XDG
 126 directory, either $XDG_CONFIG_HOME/dpkg/ or $HOME/.config/dpkg/.
 127
 128 Return the number of options parsed.
 129
 130 =cut
 131
 132 sub load_user_config {
 133     my ($self, $file) = @_;
 134
 135     my $confdir = $ENV{XDG_CONFIG_HOME};
 136     $confdir ||= $ENV{HOME} . '/.config' if length $ENV{HOME};
 137
 138     return 0 unless length $confdir;
 139     return 0 unless -e "$confdir/dpkg/$file";
 140     return $self->load("$confdir/dpkg/$file") if length $confdir;
 141     return 0;
 142 }
 143
 144 =item $conf->load_config($file)
 145
 146 Read options from system and user configuration files.
 147
 148 Return the number of options parsed.
 149
 150 =cut
 151
 152 sub load_config {
 153     my ($self, $file) = @_;
 154
 155     my $nopts = 0;
 156
 157     $nopts += $self->load_system_config($file);
 158     $nopts += $self->load_user_config($file);
 159
 160     return $nopts;
 161 }
 162
 163 =item $conf->parse($fh)
 164
 165 Parse options from a file handle. When called multiple times, the parsed
 166 options are accumulated.
 167
 168 Return the number of options parsed.
 169
 170 =cut
 171
 172 sub parse {
 173     my ($self, $fh, $desc) = @_;
 174     my $count = 0;
 175     local $_;
 176
 177     while (<$fh>) {
 178         chomp;
 179         s/^\s+//;             # Strip leading spaces
 180         s/\s+$//;             # Strip trailing spaces
 181         s/\s+=\s+/=/;         # Remove spaces around the first =
 182         s/\s+/=/ unless m/=/; # First spaces becomes = if no =
 183         # Skip empty lines and comments
 184         next if /^#/ or length == 0;
 185         if (/^-[^-]/ and not $self->{allow_short}) {
 186             warning(g_('short option not allowed in %s, line %d'), $desc, $.);
 187             next;
 188         }
 189         if (/^([^=]+)(?:=(.*))?$/) {
 190             my ($name, $value) = ($1, $2);
 191             $name = "--$name" unless $name =~ /^-/;
 192             if (defined $value) {
 193                 $value =~ s/^"(.*)"$/$1/ or $value =~ s/^'(.*)'$/$1/;
 194                 push @{$self->{options}}, "$name=$value";
 195             } else {
 196                 push @{$self->{options}}, $name;
 197             }
 198             $count++;
 199         } else {
 200             warning(g_('invalid syntax for option in %s, line %d'), $desc, $.);
 201         }
 202     }
 203     return $count;
 204 }
 205
 206 =item $conf->filter(%opts)
 207
 208 Filter the list of options, either removing or keeping all those that
 209 return true when $opts{remove}->($option) or $opts{keep}->($option) is called.
 210
 211 =cut
 212
 213 sub filter {
 214     my ($self, %opts) = @_;
 215     my $remove = $opts{remove} // sub { 0 };
 216     my $keep = $opts{keep} // sub { 1 };
 217
 218     croak 'obsolete option format_argv' if exists $opts{format_argv};
 219
 220     @{$self->{options}} = grep { not $remove->($_) and $keep->($_) }
 221                                @{$self->{options}};
 222 }
 223
 224 =item $string = $conf->output($fh)
 225
 226 Write the options in the given filehandle (if defined) and return a string
 227 representation of the content (that would be) written.
 228
 229 =item "$conf"
 230
 231 Return a string representation of the content.
 232
 233 =item $conf->save($file)
 234
 235 Save the options in a file.
 236
 237 =cut
 238
 239 sub output {
 240     my ($self, $fh) = @_;
 241     my $ret = '';
 242     foreach my $opt ($self->get_options()) {
 243         $opt =~ s/^--//;
 244         $opt =~ s/^([^=]+)=(.*)$/$1 = "$2"/;
 245         $opt .= "\n";
 246         print { $fh } $opt if defined $fh;
 247         $ret .= $opt;
 248     }
 249     return $ret;
 250 }
 251
 252 =back
 253
 254 =head1 CHANGES
 255
 256 =head2 Version 1.03 (dpkg 1.18.8)
 257
 258 Obsolete option: 'format_argv' in $conf->filter().
 259
 260 Obsolete methods: $conf->get(), $conf->set().
 261
 262 New methods: $conf->load_system_config(), $conf->load_system_user(),
 263 $conf->load_config().
 264
 265 =head2 Version 1.02 (dpkg 1.18.5)
 266
 267 New option: Accept new option 'format_argv' in $conf->filter().
 268
 269 New methods: $conf->get(), $conf->set().
 270
 271 =head2 Version 1.01 (dpkg 1.15.8)
 272
 273 New method: $conf->filter()
 274
 275 =head2 Version 1.00 (dpkg 1.15.6)
 276
 277 Mark the module as public.
 278
 279 =cut
 280
 281 1;