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 |