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