OLD | NEW |
(Empty) | |
| 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.01'; |
| 22 |
| 23 use Dpkg::Gettext; |
| 24 use Dpkg::ErrorHandling; |
| 25 |
| 26 use parent qw(Dpkg::Interface::Storable); |
| 27 |
| 28 use overload |
| 29 '@{}' => sub { return [ $_[0]->get_options() ] }, |
| 30 fallback => 1; |
| 31 |
| 32 =encoding utf8 |
| 33 |
| 34 =head1 NAME |
| 35 |
| 36 Dpkg::Conf - parse dpkg configuration files |
| 37 |
| 38 =head1 DESCRIPTION |
| 39 |
| 40 The Dpkg::Conf object can be used to read options from a configuration |
| 41 file. It can exports an array that can then be parsed exactly like @ARGV. |
| 42 |
| 43 =head1 FUNCTIONS |
| 44 |
| 45 =over 4 |
| 46 |
| 47 =item my $conf = Dpkg::Conf->new(%opts) |
| 48 |
| 49 Create a new Dpkg::Conf object. Some options can be set through %opts: |
| 50 if allow_short evaluates to true (it defaults to false), then short |
| 51 options are allowed in the configuration file, they should be prepended |
| 52 with a single hyphen. |
| 53 |
| 54 =cut |
| 55 |
| 56 sub new { |
| 57 my ($this, %opts) = @_; |
| 58 my $class = ref($this) || $this; |
| 59 |
| 60 my $self = { |
| 61 options => [], |
| 62 allow_short => 0, |
| 63 }; |
| 64 foreach my $opt (keys %opts) { |
| 65 $self->{$opt} = $opts{$opt}; |
| 66 } |
| 67 bless $self, $class; |
| 68 |
| 69 return $self; |
| 70 } |
| 71 |
| 72 =item @$conf |
| 73 |
| 74 =item @options = $conf->get_options() |
| 75 |
| 76 Returns the list of options that can be parsed like @ARGV. |
| 77 |
| 78 =cut |
| 79 |
| 80 sub get_options { |
| 81 my ($self) = @_; |
| 82 return @{$self->{options}}; |
| 83 } |
| 84 |
| 85 =item $conf->load($file) |
| 86 |
| 87 Read options from a file. Return the number of options parsed. |
| 88 |
| 89 =item $conf->parse($fh) |
| 90 |
| 91 Parse options from a file handle. Return the number of options parsed. |
| 92 |
| 93 =cut |
| 94 |
| 95 sub parse { |
| 96 my ($self, $fh, $desc) = @_; |
| 97 my $count = 0; |
| 98 while (<$fh>) { |
| 99 chomp; |
| 100 s/^\s+//; s/\s+$//; # Strip leading/trailing spaces |
| 101 s/\s+=\s+/=/; # Remove spaces around the first = |
| 102 s/\s+/=/ unless m/=/; # First spaces becomes = if no = |
| 103 next if /^#/ or /^$/; # Skip empty lines and comments |
| 104 if (/^-[^-]/ and not $self->{allow_short}) { |
| 105 warning(_g('short option not allowed in %s, line %d'), $desc, $.); |
| 106 next; |
| 107 } |
| 108 if (/^([^=]+)(?:=(.*))?$/) { |
| 109 my ($name, $value) = ($1, $2); |
| 110 $name = "--$name" unless $name =~ /^-/; |
| 111 if (defined $value) { |
| 112 $value =~ s/^"(.*)"$/$1/ or $value =~ s/^'(.*)'$/$1/; |
| 113 push @{$self->{options}}, "$name=$value"; |
| 114 } else { |
| 115 push @{$self->{options}}, $name; |
| 116 } |
| 117 $count++; |
| 118 } else { |
| 119 warning(_g('invalid syntax for option in %s, line %d'), $desc, $.); |
| 120 } |
| 121 } |
| 122 return $count; |
| 123 } |
| 124 |
| 125 =item $conf->filter(remove => $rmfunc) |
| 126 |
| 127 =item $conf->filter(keep => $keepfunc) |
| 128 |
| 129 Filter the list of options, either removing or keeping all those that |
| 130 return true when &$rmfunc($option) or &keepfunc($option) is called. |
| 131 |
| 132 =cut |
| 133 |
| 134 sub filter { |
| 135 my ($self, %opts) = @_; |
| 136 if (defined($opts{remove})) { |
| 137 @{$self->{options}} = grep { not &{$opts{remove}}($_) } |
| 138 @{$self->{options}}; |
| 139 } |
| 140 if (defined($opts{keep})) { |
| 141 @{$self->{options}} = grep { &{$opts{keep}}($_) } |
| 142 @{$self->{options}}; |
| 143 } |
| 144 } |
| 145 |
| 146 =item $string = $conf->output($fh) |
| 147 |
| 148 Write the options in the given filehandle (if defined) and return a string |
| 149 representation of the content (that would be) written. |
| 150 |
| 151 =item "$conf" |
| 152 |
| 153 Return a string representation of the content. |
| 154 |
| 155 =item $conf->save($file) |
| 156 |
| 157 Save the options in a file. |
| 158 |
| 159 =cut |
| 160 |
| 161 sub output { |
| 162 my ($self, $fh) = @_; |
| 163 my $ret = ''; |
| 164 foreach my $opt ($self->get_options()) { |
| 165 $opt =~ s/^--//; |
| 166 if ($opt =~ s/^([^=]+)=/$1 = "/) { |
| 167 $opt .= '"'; |
| 168 } |
| 169 $opt .= "\n"; |
| 170 print { $fh } $opt if defined $fh; |
| 171 $ret .= $opt; |
| 172 } |
| 173 return $ret; |
| 174 } |
| 175 |
| 176 =back |
| 177 |
| 178 =head1 AUTHOR |
| 179 |
| 180 Raphaël Hertzog <hertzog@debian.org>. |
| 181 |
| 182 =cut |
| 183 |
| 184 1; |
OLD | NEW |