line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package App::IniDiff::IniFile; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
167093
|
use 5.006; |
|
1
|
|
|
|
|
3
|
|
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
19
|
|
6
|
1
|
|
|
1
|
|
5
|
use Carp; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
55
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=head1 NAME |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
App::IniDiff::IniFile - perl module to diff and patch .ini files |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 VERSION |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
Version 0.19 |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=cut |
17
|
|
|
|
|
|
|
|
18
|
1
|
|
|
1
|
|
7
|
use vars qw($VERSION); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
63
|
|
19
|
|
|
|
|
|
|
$VERSION = '0.19'; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head1 DESCRIPTION |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
IniFile.pm - perl module to diff and patch .ini files |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head1 SYNOPSIS |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
This file contains the following: |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=over 4 |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=item * package App::IniDiff::IniFile; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
=item * package App::IniDiff::IniFile::Field; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=item * package App::IniDiff::IniFile::Key; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=item * package App::IniDiff::IniFile::Filter; |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=back |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
Creates the following data structure: |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
{ |
44
|
|
|
|
|
|
|
'nextOrderId' => some-number, |
45
|
|
|
|
|
|
|
'keys' => { |
46
|
|
|
|
|
|
|
{ |
47
|
|
|
|
|
|
|
'name' => "...", |
48
|
|
|
|
|
|
|
'orderId' => some number, |
49
|
|
|
|
|
|
|
'fields' => [ |
50
|
|
|
|
|
|
|
{ |
51
|
|
|
|
|
|
|
'name' => "..." |
52
|
|
|
|
|
|
|
'value' => "...", |
53
|
|
|
|
|
|
|
'deleted' => 0 or 1, |
54
|
|
|
|
|
|
|
'annotation' => "...", |
55
|
|
|
|
|
|
|
}, |
56
|
|
|
|
|
|
|
... |
57
|
|
|
|
|
|
|
], |
58
|
|
|
|
|
|
|
'deleted' => 0 or 1, |
59
|
|
|
|
|
|
|
'annotation' => "...", |
60
|
|
|
|
|
|
|
}, |
61
|
|
|
|
|
|
|
... |
62
|
|
|
|
|
|
|
}, |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=over 4 |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=item * 'orderId' is used to preserve the order in which keys appear in a file. |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=item * 'annotation' is used to decorate inidiff output. |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=item * 'deleted' is used when generating, writing, reading, and applying patch files. |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=back |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
Some terms used differ from what is normally used in WinINI file-speak |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=over 4 |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=item * 'key' is INI 'section' |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=item * 'field' is INI 'entry' |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=item * 'field name' is INI 'key' |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=item * 'field value' is INI 'value' |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=back |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=cut |
90
|
|
|
|
|
|
|
|
91
|
1
|
|
|
1
|
|
6
|
use vars qw(&new &write &findKey &keys &removekey &addKey); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
87
|
|
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# added eol to support old end of line \r\n |
94
|
1
|
|
|
1
|
|
7
|
use vars qw($errorString $eol $commentchars); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
110
|
|
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
{ |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
package App::IniDiff::IniFile::Field; |
99
|
|
|
|
|
|
|
|
100
|
1
|
|
|
1
|
|
8
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
21
|
|
101
|
1
|
|
|
1
|
|
5
|
use Carp; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
68
|
|
102
|
|
|
|
|
|
|
|
103
|
1
|
|
|
|
|
104
|
use vars qw(&new &name &canonName &value &deleted &annotation |
104
|
1
|
|
|
1
|
|
7
|
&setFrom &write &canonicalize ); |
|
1
|
|
|
|
|
2
|
|
105
|
1
|
|
|
1
|
|
10
|
use vars qw($eol); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
705
|
|
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
# end of line character - eol |
108
|
|
|
|
|
|
|
$eol = "\n"; |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
sub new |
111
|
|
|
|
|
|
|
{ |
112
|
0
|
|
|
0
|
|
|
my $proto = shift; |
113
|
0
|
0
|
|
|
|
|
confess "new App::IniDiff::IniFile::Field takes 4 arguments" if @_ != 4; |
114
|
0
|
|
|
|
|
|
my ($name, $value, $del, $annotation) = @_; |
115
|
|
|
|
|
|
|
|
116
|
0
|
|
|
|
|
|
my $field = { |
117
|
|
|
|
|
|
|
'name' => $name, |
118
|
|
|
|
|
|
|
'canonName' => canonicalize($name), |
119
|
|
|
|
|
|
|
'value' => $value, |
120
|
|
|
|
|
|
|
'deleted' => $del, |
121
|
|
|
|
|
|
|
'annotation' => $annotation, |
122
|
|
|
|
|
|
|
}; |
123
|
|
|
|
|
|
|
|
124
|
0
|
|
0
|
|
|
|
bless $field, (ref($proto) || $proto); |
125
|
0
|
|
|
|
|
|
return $field; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
sub name { |
129
|
0
|
|
|
0
|
|
|
my $field = shift; |
130
|
0
|
0
|
|
|
|
|
if (@_) { $field->{'name'} = shift } |
|
0
|
|
|
|
|
|
|
131
|
0
|
|
|
|
|
|
return $field->{'name'}; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub canonName { |
135
|
0
|
|
|
0
|
|
|
my $field = shift; |
136
|
0
|
0
|
|
|
|
|
if (@_) { $field->{'canonName'} = shift } |
|
0
|
|
|
|
|
|
|
137
|
0
|
|
|
|
|
|
return $field->{'canonName'}; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub value { |
141
|
0
|
|
|
0
|
|
|
my $field = shift; |
142
|
0
|
0
|
|
|
|
|
if (@_) { $field->{'value'} = shift } |
|
0
|
|
|
|
|
|
|
143
|
0
|
|
|
|
|
|
return $field->{'value'}; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub deleted { |
147
|
0
|
|
|
0
|
|
|
my $field = shift; |
148
|
0
|
0
|
|
|
|
|
if (@_) { $field->{'deleted'} = shift } |
|
0
|
|
|
|
|
|
|
149
|
0
|
|
|
|
|
|
return $field->{'deleted'}; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub annotation { |
153
|
0
|
|
|
0
|
|
|
my $field = shift; |
154
|
0
|
0
|
|
|
|
|
if (@_) { $field->{'annotation'} = shift } |
|
0
|
|
|
|
|
|
|
155
|
0
|
|
|
|
|
|
return $field->{'annotation'}; |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
sub setFrom |
159
|
|
|
|
|
|
|
{ |
160
|
0
|
|
|
0
|
|
|
my $field = shift; |
161
|
0
|
|
|
|
|
|
my $from = shift; |
162
|
0
|
|
|
|
|
|
$field->name($from->name); |
163
|
0
|
|
|
|
|
|
$field->value($from->value); |
164
|
0
|
|
|
|
|
|
$field->deleted($from->deleted); |
165
|
0
|
|
|
|
|
|
$field->annotation($from->annotation); |
166
|
0
|
|
|
|
|
|
return $field; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
sub canonicalize |
170
|
|
|
|
|
|
|
{ |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
# Called as object method |
173
|
0
|
0
|
0
|
0
|
|
|
if (@_ > 0 && ref $_[0]) { |
174
|
0
|
0
|
|
|
|
|
return ${$_[0]}->canonName if (@_ == 1); |
|
0
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
# Called as object or class method with argument |
178
|
0
|
0
|
|
|
|
|
if (@_ == 2) { |
|
|
0
|
|
|
|
|
|
179
|
0
|
|
|
|
|
|
shift; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
elsif (@_ != 1) { |
182
|
0
|
0
|
|
|
|
|
confess "wrong number of args" if (@_ != 0); |
183
|
|
|
|
|
|
|
} |
184
|
0
|
|
|
|
|
|
my $name = $_[0]; |
185
|
0
|
|
|
|
|
|
$name =~ tr/A-Z/a-z/; |
186
|
0
|
|
|
|
|
|
return $name; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub write |
190
|
|
|
|
|
|
|
{ |
191
|
0
|
|
|
0
|
|
|
my ($field, $fileHandle) = @_; |
192
|
|
|
|
|
|
|
|
193
|
0
|
0
|
|
|
|
|
print $fileHandle "; ", $field->annotation, $eol |
194
|
|
|
|
|
|
|
if defined $field->annotation; |
195
|
0
|
|
|
|
|
|
print $fileHandle $field->name; |
196
|
0
|
0
|
|
|
|
|
if ($field->deleted) { |
|
|
0
|
|
|
|
|
|
197
|
0
|
|
|
|
|
|
print $fileHandle "-"; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
elsif (defined $field->value) { |
200
|
0
|
|
|
|
|
|
print $fileHandle "=", $field->value; |
201
|
|
|
|
|
|
|
} |
202
|
0
|
|
|
|
|
|
print $fileHandle $eol; |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
} # End package App::IniDiff::IniFile::Field; |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
{ |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
package App::IniDiff::IniFile::Key; |
209
|
|
|
|
|
|
|
|
210
|
1
|
|
|
1
|
|
9
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
21
|
|
211
|
1
|
|
|
1
|
|
6
|
use Carp; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
62
|
|
212
|
1
|
|
|
1
|
|
516
|
use IO::File; |
|
1
|
|
|
|
|
9007
|
|
|
1
|
|
|
|
|
133
|
|
213
|
|
|
|
|
|
|
|
214
|
1
|
|
|
|
|
131
|
use vars qw(&new &name &canonName &orderId &deleted &annotation &fields |
215
|
|
|
|
|
|
|
&canonicalize &findField &addField &appendField &removeField |
216
|
|
|
|
|
|
|
&write |
217
|
1
|
|
|
1
|
|
8
|
); |
|
1
|
|
|
|
|
3
|
|
218
|
1
|
|
|
1
|
|
7
|
use vars qw($eol); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
2296
|
|
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
# end of line character - eol |
221
|
|
|
|
|
|
|
$eol = "\n"; |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
sub new |
224
|
|
|
|
|
|
|
{ |
225
|
0
|
|
|
0
|
|
|
my $proto = shift; |
226
|
0
|
0
|
|
|
|
|
confess "new App::IniDiff::IniFile::Key takes 3 arguments" if @_ != 3; |
227
|
0
|
|
|
|
|
|
my ($name, $del, $annotation) = @_; |
228
|
|
|
|
|
|
|
|
229
|
0
|
|
|
|
|
|
my $key = { |
230
|
|
|
|
|
|
|
'name' => $name, |
231
|
|
|
|
|
|
|
'canonName' => canonicalize($name), |
232
|
|
|
|
|
|
|
'orderId' => undef, |
233
|
|
|
|
|
|
|
'deleted' => $del, |
234
|
|
|
|
|
|
|
'annotation' => $annotation, |
235
|
|
|
|
|
|
|
'fields' => [], |
236
|
|
|
|
|
|
|
}; |
237
|
|
|
|
|
|
|
|
238
|
0
|
|
0
|
|
|
|
bless $key, (ref($proto) || $proto); |
239
|
0
|
|
|
|
|
|
return $key; |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
sub name { |
243
|
0
|
|
|
0
|
|
|
my $key = shift; |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
# Do not change canonName (see kludge in App::IniDiff::IniFile::new regarding patches) |
246
|
0
|
0
|
|
|
|
|
if (@_) { $key->{'name'} = shift } |
|
0
|
|
|
|
|
|
|
247
|
0
|
|
|
|
|
|
return $key->{'name'}; |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
sub canonName { |
251
|
0
|
|
|
0
|
|
|
my $key = shift; |
252
|
0
|
0
|
|
|
|
|
if (@_) { $key->{'canonName'} = shift } |
|
0
|
|
|
|
|
|
|
253
|
0
|
|
|
|
|
|
return $key->{'canonName'}; |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
sub orderId { |
257
|
0
|
|
|
0
|
|
|
my $key = shift; |
258
|
0
|
0
|
|
|
|
|
if (@_) { $key->{'orderId'} = shift } |
|
0
|
|
|
|
|
|
|
259
|
0
|
|
|
|
|
|
return $key->{'orderId'}; |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
sub deleted { |
263
|
0
|
|
|
0
|
|
|
my $key = shift; |
264
|
0
|
0
|
|
|
|
|
if (@_) { $key->{'deleted'} = shift } |
|
0
|
|
|
|
|
|
|
265
|
0
|
|
|
|
|
|
return $key->{'deleted'}; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
sub annotation { |
269
|
0
|
|
|
0
|
|
|
my $key = shift; |
270
|
0
|
0
|
|
|
|
|
if (@_) { $key->{'annotation'} = shift } |
|
0
|
|
|
|
|
|
|
271
|
0
|
|
|
|
|
|
return $key->{'annotation'}; |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
sub fields { |
275
|
0
|
|
|
0
|
|
|
my $key = shift; |
276
|
0
|
0
|
|
|
|
|
confess "too many args" if @_ > 0; |
277
|
0
|
|
|
|
|
|
return $key->{'fields'}; |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
sub canonicalize |
281
|
|
|
|
|
|
|
{ |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
# Called as object method |
284
|
0
|
0
|
0
|
0
|
|
|
if (@_ > 0 && ref $_[0]) { |
285
|
0
|
0
|
|
|
|
|
return ${$_[0]}->canonName if (@_ == 1); |
|
0
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
# Called as object or class method with argument |
289
|
0
|
0
|
|
|
|
|
if (@_ == 2) { |
|
|
0
|
|
|
|
|
|
290
|
0
|
|
|
|
|
|
shift; |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
elsif (@_ != 1) { |
293
|
0
|
0
|
|
|
|
|
confess "wrong number of args" if (@_ != 0); |
294
|
|
|
|
|
|
|
} |
295
|
0
|
|
|
|
|
|
my $name = $_[0]; |
296
|
0
|
|
|
|
|
|
$name =~ tr/A-Z/a-z/; |
297
|
0
|
|
|
|
|
|
return $name; |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
# Note: only finds first field... |
301
|
|
|
|
|
|
|
sub findField |
302
|
|
|
|
|
|
|
{ |
303
|
0
|
|
|
0
|
|
|
my ($key, $fieldName) = @_; |
304
|
0
|
|
|
|
|
|
$fieldName = App::IniDiff::IniFile::Field->canonicalize($fieldName); |
305
|
|
|
|
|
|
|
|
306
|
0
|
|
|
|
|
|
my ($field); |
307
|
0
|
|
|
|
|
|
foreach $field (@{$key->fields}) { |
|
0
|
|
|
|
|
|
|
308
|
0
|
0
|
|
|
|
|
return $field if ($field->canonName eq $fieldName); |
309
|
|
|
|
|
|
|
} |
310
|
0
|
|
|
|
|
|
return undef; |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
sub addField |
314
|
|
|
|
|
|
|
{ |
315
|
0
|
|
|
0
|
|
|
my $key = shift; |
316
|
0
|
|
|
|
|
|
my $field = shift; |
317
|
|
|
|
|
|
|
|
318
|
0
|
|
|
|
|
|
my $xfield = $key->findField($field->name); |
319
|
0
|
0
|
|
|
|
|
if (defined $xfield) { |
320
|
0
|
|
|
|
|
|
$xfield->setFrom($field); |
321
|
0
|
|
|
|
|
|
return $xfield; |
322
|
|
|
|
|
|
|
} |
323
|
0
|
|
|
|
|
|
return $key->appendField($field); |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
sub appendField |
327
|
|
|
|
|
|
|
{ |
328
|
0
|
|
|
0
|
|
|
my $key = shift; |
329
|
0
|
|
|
|
|
|
my $field = shift; |
330
|
|
|
|
|
|
|
|
331
|
0
|
|
|
|
|
|
push(@{$key->fields}, $field); |
|
0
|
|
|
|
|
|
|
332
|
0
|
|
|
|
|
|
return $field; |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
# |
336
|
|
|
|
|
|
|
# Remove a field, either by name or by reference |
337
|
|
|
|
|
|
|
# |
338
|
|
|
|
|
|
|
sub removeField |
339
|
|
|
|
|
|
|
{ |
340
|
0
|
|
|
0
|
|
|
my $found = 0; |
341
|
0
|
|
|
|
|
|
my ($key, $arg) = @_; |
342
|
|
|
|
|
|
|
|
343
|
0
|
0
|
|
|
|
|
if (ref $arg) { |
344
|
0
|
|
|
|
|
|
my $fieldToast = $arg; |
345
|
0
|
|
|
|
|
|
for (my $i = 0 ; $i < @{$key->fields} ; $i++) { |
|
0
|
|
|
|
|
|
|
346
|
0
|
|
|
|
|
|
my $field = ${$key->fields}[$i]; |
|
0
|
|
|
|
|
|
|
347
|
0
|
0
|
|
|
|
|
if ($field eq $fieldToast) { |
348
|
0
|
|
|
|
|
|
splice(@{$key->fields}, $i, 1); |
|
0
|
|
|
|
|
|
|
349
|
0
|
|
|
|
|
|
$i--; |
350
|
0
|
|
|
|
|
|
$found++; |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
else { |
355
|
0
|
|
|
|
|
|
my $fieldName = App::IniDiff::IniFile::Field->canonicalize($arg); |
356
|
0
|
|
|
|
|
|
for (my $i = 0 ; $i < @{$key->fields} ; $i++) { |
|
0
|
|
|
|
|
|
|
357
|
0
|
|
|
|
|
|
my $field = ${$key->fields}[$i]; |
|
0
|
|
|
|
|
|
|
358
|
0
|
0
|
|
|
|
|
if ($field->canonName eq $fieldName) { |
359
|
0
|
|
|
|
|
|
splice(@{$key->fields}, $i, 1); |
|
0
|
|
|
|
|
|
|
360
|
0
|
|
|
|
|
|
$i--; |
361
|
0
|
|
|
|
|
|
$found++; |
362
|
|
|
|
|
|
|
} |
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
} |
365
|
0
|
|
|
|
|
|
return $found; |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
sub write |
369
|
|
|
|
|
|
|
{ |
370
|
0
|
|
|
0
|
|
|
my ($key, $fileHandle) = @_; |
371
|
0
|
0
|
|
|
|
|
my ($del) = $key->deleted ? '-' : ''; |
372
|
|
|
|
|
|
|
|
373
|
0
|
0
|
|
|
|
|
print $fileHandle "; ", $key->annotation, $eol |
374
|
|
|
|
|
|
|
if defined $key->annotation; |
375
|
0
|
|
|
|
|
|
print $fileHandle "[", $key->name, "]", $del, $eol; |
376
|
0
|
0
|
|
|
|
|
if (!$key->deleted) { |
377
|
0
|
|
|
|
|
|
my $field; |
378
|
0
|
|
|
|
|
|
foreach $field (@{$key->fields}) { |
|
0
|
|
|
|
|
|
|
379
|
0
|
|
|
|
|
|
$field->write($fileHandle); |
380
|
|
|
|
|
|
|
} |
381
|
|
|
|
|
|
|
} |
382
|
0
|
|
|
|
|
|
print $fileHandle $eol; |
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
} # End package App::IniDiff::IniFile::Key; |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
# $IniFile package Globals |
387
|
|
|
|
|
|
|
$errorString = undef; |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
# end of line character - eol |
390
|
|
|
|
|
|
|
$eol = "\n"; |
391
|
|
|
|
|
|
|
$commentchars = ';#'; # Allow DOS and Unix style comment. |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
sub new |
394
|
|
|
|
|
|
|
{ |
395
|
0
|
|
|
0
|
|
|
my $proto = shift; |
396
|
|
|
|
|
|
|
|
397
|
0
|
|
|
|
|
|
my $ini = { |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
# Used to generate monotonically increasing key ids - used |
400
|
|
|
|
|
|
|
# to reserve order of ini file. |
401
|
|
|
|
|
|
|
'nextOrderId' => 0, |
402
|
|
|
|
|
|
|
'keys' => {}, |
403
|
|
|
|
|
|
|
}; |
404
|
|
|
|
|
|
|
|
405
|
0
|
|
0
|
|
|
|
bless $ini, (ref($proto) || $proto); |
406
|
|
|
|
|
|
|
|
407
|
0
|
0
|
|
|
|
|
return $ini if (@_ == 0); |
408
|
0
|
0
|
|
|
|
|
confess "new called with too many arguments" if (@_ > 4); |
409
|
|
|
|
|
|
|
|
410
|
0
|
|
|
|
|
|
my ($fileHandle, $isPatch, $addM, $stripComments) = |
411
|
|
|
|
|
|
|
@_; # Patches: allow duplicate key names |
412
|
0
|
|
|
|
|
|
my ($key); |
413
|
0
|
|
|
|
|
|
my $ok = 1; |
414
|
|
|
|
|
|
|
|
415
|
0
|
0
|
|
|
|
|
$isPatch = 0 if !defined $isPatch; |
416
|
0
|
0
|
|
|
|
|
$addM = 0 if !defined $addM; # add ^M if pre-NT |
417
|
0
|
0
|
|
|
|
|
$stripComments = 0 if ! defined $stripComments; |
418
|
|
|
|
|
|
|
# strip out trailing inline comments having semicolon |
419
|
|
|
|
|
|
|
# comment out stripComments if isPatch |
420
|
|
|
|
|
|
|
# - this may be a problem |
421
|
|
|
|
|
|
|
# - leave them in unless specifically asked |
422
|
|
|
|
|
|
|
# $stripComments = 1 if $isPatch; # always strip out comments from patches |
423
|
0
|
0
|
|
|
|
|
if ($addM == 1) { |
424
|
0
|
|
|
|
|
|
$eol = "\r\n"; |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
# set the children's eol members to this value as well ... |
427
|
|
|
|
|
|
|
# not using set() methods - oh dear |
428
|
0
|
|
|
|
|
|
$App::IniDiff::IniFile::Key::eol = "\r\n"; |
429
|
0
|
|
|
|
|
|
$App::IniDiff::IniFile::Field::eol = "\r\n"; |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
|
432
|
0
|
|
|
|
|
|
while (<$fileHandle>) { |
433
|
0
|
|
|
|
|
|
chomp; |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
# |
436
|
|
|
|
|
|
|
# Strip comments - not in key names ([...]) and not in strings.. |
437
|
|
|
|
|
|
|
# |
438
|
|
|
|
|
|
|
# if a [key] section |
439
|
0
|
0
|
0
|
|
|
|
if (/^\s*(\[[^]]+])(.*)$/) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
440
|
0
|
|
|
|
|
|
my ($key, $rest) = ($1, $2); |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
# do care if it strips comments after [key] section |
443
|
0
|
0
|
|
|
|
|
if ($stripComments) { |
444
|
0
|
|
|
|
|
|
$rest =~ s/[$commentchars].*//; |
445
|
|
|
|
|
|
|
} |
446
|
0
|
|
|
|
|
|
$_ = $key . $rest; |
447
|
|
|
|
|
|
|
} |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
# not a comment starting with ; and has a " in it |
450
|
|
|
|
|
|
|
elsif (!/^\s*[$commentchars]/ && /"/) { |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
# Slow, but perl won't go exponential... |
453
|
0
|
|
|
|
|
|
my $line = ''; |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
# walk through non comments and matched quoted strings |
456
|
|
|
|
|
|
|
# from left to right |
457
|
|
|
|
|
|
|
# until we hit a comment character or a non matched quote |
458
|
0
|
|
|
|
|
|
while (/^([^"$commentchars]*"[^"]*")(.*)/) { |
459
|
0
|
|
|
|
|
|
$line .= $1; |
460
|
0
|
|
|
|
|
|
$_ = $2; |
461
|
|
|
|
|
|
|
} |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
# Some (burnt) ini files have unmatched quotes... rather |
464
|
|
|
|
|
|
|
# than toast these, we assume they have no comments. |
465
|
0
|
0
|
|
|
|
|
if (!/"/) { |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
# do not strip comments unless requested |
468
|
0
|
0
|
|
|
|
|
if ($stripComments) { |
469
|
0
|
|
|
|
|
|
s/[$commentchars].*//; |
470
|
|
|
|
|
|
|
} |
471
|
|
|
|
|
|
|
} |
472
|
0
|
|
|
|
|
|
$_ = $line . $_; |
473
|
|
|
|
|
|
|
} |
474
|
|
|
|
|
|
|
elsif ($stripComments) { |
475
|
0
|
|
|
|
|
|
s/[$commentchars].*//; |
476
|
|
|
|
|
|
|
} |
477
|
0
|
|
|
|
|
|
s/\s*$//; # remove trailing space includes \r... |
478
|
|
|
|
|
|
|
# not skipping blank lines at this point results in errors when diffing |
479
|
0
|
0
|
|
|
|
|
next if /^$/; # skip blank lines |
480
|
0
|
0
|
|
|
|
|
if (/^\s*\[([^]]+)](-?)$/) { |
481
|
0
|
|
|
|
|
|
my ($name, $del) = ($1, $2); |
482
|
0
|
0
|
|
|
|
|
if ($isPatch) { |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
# Patches are a bit strange as there can be duplicate |
485
|
|
|
|
|
|
|
# key names - to deal with this, the canonName (hash index) |
486
|
|
|
|
|
|
|
# is a generated (unique) thing and we fix up the real name |
487
|
|
|
|
|
|
|
# after the key is created. |
488
|
0
|
|
|
|
|
|
$key = $ini->addKey( |
489
|
|
|
|
|
|
|
new App::IniDiff::IniFile::Key( |
490
|
|
|
|
|
|
|
"[$ini->{'nextOrderId'}]", |
491
|
|
|
|
|
|
|
$del eq '-', undef)); |
492
|
0
|
|
|
|
|
|
$key->name($name); |
493
|
|
|
|
|
|
|
} |
494
|
|
|
|
|
|
|
else { |
495
|
0
|
0
|
|
|
|
|
if ($del eq '-') { |
496
|
0
|
|
|
|
|
|
$errorString = "$.: non-patch file has deleted key"; |
497
|
0
|
|
|
|
|
|
$ok = 0; |
498
|
0
|
|
|
|
|
|
last; |
499
|
|
|
|
|
|
|
} |
500
|
0
|
0
|
|
|
|
|
if ($ini->findKey($name)) { |
501
|
0
|
|
|
|
|
|
$errorString = "$.: duplicate key: $name"; |
502
|
0
|
|
|
|
|
|
$ok = 0; |
503
|
0
|
|
|
|
|
|
last; |
504
|
|
|
|
|
|
|
} |
505
|
|
|
|
|
|
|
$key = |
506
|
0
|
|
|
|
|
|
$ini->addKey(new App::IniDiff::IniFile::Key($name, $del eq '-', undef)); |
507
|
|
|
|
|
|
|
} |
508
|
0
|
|
|
|
|
|
next; |
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
# passed through, this is not a key, so it is something else |
512
|
0
|
|
|
|
|
|
my ($name, $value); |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
# fix quotes |
515
|
0
|
0
|
|
|
|
|
if (/"/) { |
|
|
0
|
|
|
|
|
|
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
# Slow, but perl won't go exponential... |
518
|
0
|
|
|
|
|
|
my $line = ''; |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
# cycle through matched pairs of quotes in LHS $name |
521
|
|
|
|
|
|
|
# accepts = between pair of quotes in LHS |
522
|
0
|
|
|
|
|
|
while (/^([^"=]*"[^"]*")(.*)$/) { |
523
|
0
|
|
|
|
|
|
$line .= $1; |
524
|
0
|
|
|
|
|
|
$_ = $2; |
525
|
|
|
|
|
|
|
} |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
# no remaining quotes in LHS |
528
|
|
|
|
|
|
|
# allows unmatched quote in RHS |
529
|
0
|
0
|
|
|
|
|
if (/^([^"]*)=(.*)$/) { |
|
|
0
|
|
|
|
|
|
530
|
0
|
|
|
|
|
|
$name = $line . $1; |
531
|
0
|
|
|
|
|
|
$value = $2; |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
elsif (/"/) { |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
# Wonder if this will be a problem... |
536
|
0
|
|
|
|
|
|
$errorString = "$.: unmatched quote (no preceeding =)"; |
537
|
0
|
|
|
|
|
|
$ok = 0; |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
# quits here ... maybe we shouldn't quit parsing |
540
|
0
|
|
|
|
|
|
last; |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
else { |
543
|
0
|
|
|
|
|
|
$name = $line . $_; |
544
|
0
|
|
|
|
|
|
$value = undef; |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
} |
547
|
|
|
|
|
|
|
elsif (/^([^=]+)=(.*)$/) { |
548
|
0
|
|
|
|
|
|
$name = $1; |
549
|
0
|
|
|
|
|
|
$value = $2; |
550
|
|
|
|
|
|
|
} |
551
|
|
|
|
|
|
|
else { |
552
|
0
|
|
|
|
|
|
$name = $_; |
553
|
0
|
|
|
|
|
|
$value = undef; |
554
|
|
|
|
|
|
|
} |
555
|
0
|
|
|
|
|
|
my $del = 0; |
556
|
0
|
0
|
0
|
|
|
|
if (!defined $value && $name =~ /-$/) { |
557
|
0
|
0
|
|
|
|
|
if (!$isPatch) { |
558
|
0
|
|
|
|
|
|
$errorString = "$.: non-patch file has deleted field"; |
559
|
0
|
|
|
|
|
|
$ok = 0; |
560
|
0
|
|
|
|
|
|
last; |
561
|
|
|
|
|
|
|
} |
562
|
0
|
|
|
|
|
|
$del = 1; |
563
|
0
|
|
|
|
|
|
chop $name; |
564
|
|
|
|
|
|
|
} |
565
|
0
|
0
|
|
|
|
|
if (!defined $key) { |
566
|
0
|
|
|
|
|
|
$errorString = "$.: field outside of key\n"; |
567
|
0
|
|
|
|
|
|
$ok = 0; |
568
|
0
|
|
|
|
|
|
last; |
569
|
|
|
|
|
|
|
} |
570
|
0
|
0
|
|
|
|
|
if ($key->deleted) { |
571
|
0
|
|
|
|
|
|
$errorString = "$.: deleted key has field\n"; |
572
|
0
|
|
|
|
|
|
$ok = 0; |
573
|
0
|
|
|
|
|
|
last; |
574
|
|
|
|
|
|
|
} |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
# when a comment precedes a new key (section), |
577
|
|
|
|
|
|
|
# it gets stuck with the previous one |
578
|
|
|
|
|
|
|
# because the blank line at the end of a key section |
579
|
|
|
|
|
|
|
# must get eaten for inidiff to work |
580
|
0
|
|
|
|
|
|
$key->appendField(new App::IniDiff::IniFile::Field($name, $value, $del, undef)); |
581
|
|
|
|
|
|
|
} |
582
|
0
|
0
|
|
|
|
|
return undef if !$ok; |
583
|
0
|
|
|
|
|
|
return $ini; |
584
|
|
|
|
|
|
|
} |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
sub write |
587
|
|
|
|
|
|
|
{ |
588
|
0
|
|
|
0
|
|
|
my ($ini, $fileHandle) = @_; |
589
|
0
|
|
|
|
|
|
my ($key); |
590
|
|
|
|
|
|
|
|
591
|
0
|
|
|
|
|
|
foreach $key (@{$ini->keys}) { |
|
0
|
|
|
|
|
|
|
592
|
0
|
|
|
|
|
|
$key->write($fileHandle); |
593
|
|
|
|
|
|
|
} |
594
|
|
|
|
|
|
|
} |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
sub findKey |
597
|
|
|
|
|
|
|
{ |
598
|
0
|
|
|
0
|
|
|
my ($ini, $keyName) = @_; |
599
|
0
|
|
|
|
|
|
return $ini->{'keys'}->{App::IniDiff::IniFile::Key->canonicalize($keyName)}; |
600
|
|
|
|
|
|
|
} |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
sub keys |
603
|
|
|
|
|
|
|
{ |
604
|
0
|
|
|
0
|
|
|
my ($ini) = @_; |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
return [ |
607
|
0
|
|
|
|
|
|
sort { $a->orderId <=> $b->orderId } |
608
|
0
|
|
|
|
|
|
values(%{$ini->{'keys'}}) ]; |
|
0
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
} |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
# |
612
|
|
|
|
|
|
|
# Remove a key, either by name or by reference |
613
|
|
|
|
|
|
|
# |
614
|
|
|
|
|
|
|
sub removeKey |
615
|
|
|
|
|
|
|
{ |
616
|
0
|
|
|
0
|
0
|
|
my ($ini, $arg) = @_; |
617
|
|
|
|
|
|
|
|
618
|
0
|
0
|
|
|
|
|
if (ref $arg) { |
619
|
0
|
|
|
|
|
|
my $keyToast = $arg; |
620
|
0
|
|
|
|
|
|
my ($name, $key); |
621
|
0
|
|
|
|
|
|
while (($name, $key) = each %{$ini->{'keys'}}) { |
|
0
|
|
|
|
|
|
|
622
|
0
|
0
|
|
|
|
|
if ($key eq $keyToast) { |
623
|
0
|
|
|
|
|
|
delete $ini->{'keys'}->{$name}; |
624
|
|
|
|
|
|
|
} |
625
|
|
|
|
|
|
|
} |
626
|
|
|
|
|
|
|
} |
627
|
|
|
|
|
|
|
else { |
628
|
0
|
|
|
|
|
|
my $keyName = $arg; |
629
|
0
|
|
|
|
|
|
return delete $ini->{'keys'}->{App::IniDiff::IniFile::Key->canonicalize($keyName)}; |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
} |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
sub addKey |
634
|
|
|
|
|
|
|
{ |
635
|
0
|
|
|
0
|
|
|
my ($ini, $key) = @_; |
636
|
|
|
|
|
|
|
|
637
|
0
|
|
|
|
|
|
$ini->{'keys'}->{$key->canonName} = $key; |
638
|
0
|
|
|
|
|
|
$key->orderId($ini->{'nextOrderId'}++); |
639
|
0
|
|
|
|
|
|
return $key; |
640
|
|
|
|
|
|
|
} |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
{ |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
package App::IniDiff::IniFile::Filter; |
645
|
|
|
|
|
|
|
|
646
|
1
|
|
|
1
|
|
16
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
23
|
|
647
|
1
|
|
|
1
|
|
6
|
use Carp; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
67
|
|
648
|
1
|
|
|
1
|
|
8
|
use IO::File; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
119
|
|
649
|
|
|
|
|
|
|
|
650
|
1
|
|
|
1
|
|
6
|
use vars qw(&new &readConf &filter &export); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
71
|
|
651
|
1
|
|
|
1
|
|
7
|
use vars qw($errorString); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1901
|
|
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
sub new |
654
|
|
|
|
|
|
|
{ |
655
|
0
|
|
|
0
|
|
|
my $proto = shift; |
656
|
0
|
0
|
|
|
|
|
confess "new App::IniDiff::IniFile::Filter takes no arguments" if @_ != 0; |
657
|
|
|
|
|
|
|
|
658
|
0
|
|
|
|
|
|
my $field = { |
659
|
|
|
|
|
|
|
'keyFilters' => [] |
660
|
|
|
|
|
|
|
}; |
661
|
|
|
|
|
|
|
|
662
|
0
|
|
0
|
|
|
|
bless $field, (ref($proto) || $proto); |
663
|
0
|
|
|
|
|
|
return $field; |
664
|
|
|
|
|
|
|
} |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
sub readConf |
667
|
|
|
|
|
|
|
{ |
668
|
0
|
|
|
0
|
|
|
my ($filter, $file) = @_; |
669
|
|
|
|
|
|
|
|
670
|
0
|
|
|
|
|
|
my $in = new IO::File $file, "r"; |
671
|
0
|
0
|
|
|
|
|
if (!defined $in) { |
672
|
0
|
|
|
|
|
|
$errorString = "can't open $file - $!"; |
673
|
0
|
|
|
|
|
|
return 0; |
674
|
|
|
|
|
|
|
} |
675
|
|
|
|
|
|
|
|
676
|
0
|
|
|
|
|
|
my ($keyActions) = undef; |
677
|
0
|
|
|
|
|
|
my ($entryActions) = undef; |
678
|
|
|
|
|
|
|
|
679
|
0
|
|
|
|
|
|
while (<$in>) { |
680
|
0
|
0
|
|
|
|
|
next if (/^\s*(#|$)/); |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
# Trim whitespace |
683
|
0
|
|
|
|
|
|
s/^\s+//; |
684
|
0
|
|
|
|
|
|
s/\s+$//; |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
# include another filter file? |
687
|
0
|
0
|
|
|
|
|
if (/^\s*include\s+"([^"]*)"\s*$/) { |
688
|
0
|
|
|
|
|
|
my ($ifile) = $1; |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
# End the previous key (with error checking) |
691
|
|
|
|
|
|
|
# added {} around keyActions |
692
|
0
|
0
|
0
|
|
|
|
if (defined $keyActions && !@{$keyActions}) { |
|
0
|
0
|
0
|
|
|
|
|
693
|
0
|
|
|
|
|
|
$errorString = "$file:$.: previous key has no actions"; |
694
|
0
|
|
|
|
|
|
$in->close; |
695
|
0
|
|
|
|
|
|
return 0; |
696
|
|
|
|
|
|
|
} |
697
|
|
|
|
|
|
|
# added {} around entryActions |
698
|
0
|
|
|
|
|
|
elsif (defined $entryActions && !@{$entryActions}) { |
699
|
0
|
|
|
|
|
|
$errorString = |
700
|
|
|
|
|
|
|
"$file:$.: previous name/value pattern has no actions"; |
701
|
0
|
|
|
|
|
|
$in->close; |
702
|
0
|
|
|
|
|
|
return 0; |
703
|
|
|
|
|
|
|
} |
704
|
0
|
|
|
|
|
|
$keyActions = $entryActions = undef; |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
# If not an absolute path, try relative to this file first. |
707
|
0
|
|
|
|
|
|
my ($mypath) = $file; |
708
|
0
|
|
|
|
|
|
$mypath =~ s:/+[^/]*$::; |
709
|
0
|
0
|
0
|
|
|
|
if ($ifile !~ /^\// |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
710
|
|
|
|
|
|
|
&& $mypath ne '' |
711
|
|
|
|
|
|
|
&& $mypath ne $file |
712
|
|
|
|
|
|
|
&& -e $mypath."/".$ifile) |
713
|
|
|
|
|
|
|
{ |
714
|
0
|
0
|
|
|
|
|
return 0 if (!$filter->readConf($mypath."/".$ifile)); |
715
|
|
|
|
|
|
|
} |
716
|
|
|
|
|
|
|
else { |
717
|
0
|
0
|
|
|
|
|
return 0 if (!$filter->readConf($ifile)); |
718
|
|
|
|
|
|
|
} |
719
|
0
|
|
|
|
|
|
next; |
720
|
|
|
|
|
|
|
} |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
# A new key? |
723
|
0
|
0
|
|
|
|
|
if (/^\[(.+)](|\s*-)$/) { |
724
|
0
|
0
|
|
|
|
|
my ($keyPat, $isDel) = ($1, $2 eq '' ? 0 : 1); |
725
|
|
|
|
|
|
|
|
726
|
0
|
0
|
0
|
|
|
|
if (defined $keyActions && !@{$keyActions}) { # added {} |
|
0
|
0
|
0
|
|
|
|
|
727
|
0
|
|
|
|
|
|
$errorString = "$file:$.: previous key has no actions"; |
728
|
0
|
|
|
|
|
|
$in->close; |
729
|
0
|
|
|
|
|
|
return 0; |
730
|
|
|
|
|
|
|
} |
731
|
0
|
|
|
|
|
|
elsif (defined $entryActions && !@{$entryActions}) { # added {} |
732
|
0
|
|
|
|
|
|
$errorString = |
733
|
|
|
|
|
|
|
"$file:$.: previous name/value pattern has no actions"; |
734
|
0
|
|
|
|
|
|
$in->close; |
735
|
0
|
|
|
|
|
|
return 0; |
736
|
|
|
|
|
|
|
} |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
push( |
739
|
0
|
|
|
|
|
|
@{$filter->{'keyFilters'}}, |
|
0
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
{ |
741
|
|
|
|
|
|
|
'keyPat' => $1, |
742
|
|
|
|
|
|
|
'deleteAll' => $isDel, |
743
|
|
|
|
|
|
|
'keyActions' => [] |
744
|
|
|
|
|
|
|
}); |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
# ${$filter} is not an array |
747
|
|
|
|
|
|
|
# $keyActions = $isDel ? undef : |
748
|
|
|
|
|
|
|
# ${$filter}[$#$filter]->{'keyActions'}; |
749
|
0
|
|
|
|
|
|
my @filterHashes = @{$filter->{'keyFilters'}}; |
|
0
|
|
|
|
|
|
|
750
|
0
|
|
|
|
|
|
my $numHashes = $#filterHashes; |
751
|
|
|
|
|
|
|
$keyActions = |
752
|
0
|
0
|
|
|
|
|
$isDel ? undef : $filterHashes[$numHashes]->{'keyActions'}; |
753
|
0
|
|
|
|
|
|
next; |
754
|
|
|
|
|
|
|
} |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
# A new entry match operator? |
757
|
0
|
0
|
|
|
|
|
if (/^\s*(name|value)\s+(\S.*)$/) { |
758
|
0
|
|
|
|
|
|
my ($matchOn, $matchPat) = ($1, $2); |
759
|
0
|
0
|
|
|
|
|
if (!defined $keyActions) { |
760
|
0
|
|
|
|
|
|
$errorString = |
761
|
|
|
|
|
|
|
"$file:$.: name/value pattern found outside key"; |
762
|
0
|
|
|
|
|
|
$in->close; |
763
|
0
|
|
|
|
|
|
return 0; |
764
|
|
|
|
|
|
|
} |
765
|
0
|
0
|
0
|
|
|
|
if (defined $entryActions && !@{$entryActions}) { # added {} |
|
0
|
|
|
|
|
|
|
766
|
0
|
|
|
|
|
|
$errorString = |
767
|
|
|
|
|
|
|
"$file:$.: previous name/value pattern has no actions"; |
768
|
0
|
|
|
|
|
|
$in->close; |
769
|
0
|
|
|
|
|
|
return 0; |
770
|
|
|
|
|
|
|
} |
771
|
0
|
|
|
|
|
|
$entryActions = []; |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
# added {} to keyActions |
774
|
|
|
|
|
|
|
push( |
775
|
0
|
|
|
|
|
|
@{$keyActions}, |
|
0
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
{ 'matchOn' => $matchOn, |
777
|
|
|
|
|
|
|
'matchPat' => $matchPat, |
778
|
|
|
|
|
|
|
'entryActions' => $entryActions, |
779
|
|
|
|
|
|
|
}); |
780
|
0
|
|
|
|
|
|
next; |
781
|
|
|
|
|
|
|
} |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
# A entry substitution |
784
|
0
|
0
|
|
|
|
|
if (/^\s*subst\s+(name|value)\s+(\S.*)$/) { |
785
|
0
|
|
|
|
|
|
my ($action, $subst) = ($1, $2); |
786
|
0
|
0
|
|
|
|
|
if (!defined $keyActions) { |
787
|
0
|
|
|
|
|
|
$errorString = "$file:$.: substitution found outside key"; |
788
|
0
|
|
|
|
|
|
$in->close; |
789
|
0
|
|
|
|
|
|
return 0; |
790
|
|
|
|
|
|
|
} |
791
|
0
|
0
|
|
|
|
|
if (!defined $entryActions) { |
792
|
0
|
|
|
|
|
|
$errorString = |
793
|
|
|
|
|
|
|
"$file:$.: substitution found outside entry/key pattern"; |
794
|
0
|
|
|
|
|
|
$in->close; |
795
|
0
|
|
|
|
|
|
return 0; |
796
|
|
|
|
|
|
|
} |
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
# added {} to entryActions |
799
|
|
|
|
|
|
|
push( |
800
|
0
|
|
|
|
|
|
@{$entryActions}, |
|
0
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
{ 'action' => "subst\u$action", |
802
|
|
|
|
|
|
|
'subst' => $subst, |
803
|
|
|
|
|
|
|
}); |
804
|
0
|
|
|
|
|
|
next; |
805
|
|
|
|
|
|
|
} |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
# An entry deletion |
808
|
0
|
0
|
|
|
|
|
if (/^\s*delete$/) { |
809
|
0
|
0
|
|
|
|
|
if (!defined $keyActions) { |
810
|
0
|
|
|
|
|
|
$errorString = "$file:$.: delete entry found outside key"; |
811
|
0
|
|
|
|
|
|
$in->close; |
812
|
0
|
|
|
|
|
|
return 0; |
813
|
|
|
|
|
|
|
} |
814
|
0
|
0
|
|
|
|
|
if (!defined $entryActions) { |
815
|
0
|
|
|
|
|
|
$errorString = |
816
|
|
|
|
|
|
|
"$file:$.: delete entry found outside entry/key pattern"; |
817
|
0
|
|
|
|
|
|
$in->close; |
818
|
0
|
|
|
|
|
|
return 0; |
819
|
|
|
|
|
|
|
} |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
# added {} to entryActions |
822
|
|
|
|
|
|
|
push( |
823
|
0
|
|
|
|
|
|
@{$entryActions}, |
|
0
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
{ 'action' => 'delete', |
825
|
|
|
|
|
|
|
'subst' => undef, |
826
|
|
|
|
|
|
|
}); |
827
|
0
|
|
|
|
|
|
next; |
828
|
|
|
|
|
|
|
} |
829
|
0
|
|
|
|
|
|
$errorString = "$file:$.: unexpected line"; |
830
|
0
|
|
|
|
|
|
$in->close; |
831
|
0
|
|
|
|
|
|
return 0; |
832
|
|
|
|
|
|
|
} |
833
|
0
|
|
|
|
|
|
$in->close; |
834
|
0
|
|
|
|
|
|
return 1; |
835
|
|
|
|
|
|
|
} |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
# |
838
|
|
|
|
|
|
|
# Given a ini object, modify it by applying the filtering commands |
839
|
|
|
|
|
|
|
# (deletions and substitutions) contained in the filter object. |
840
|
|
|
|
|
|
|
# Returns true iff there are no problems. |
841
|
|
|
|
|
|
|
# |
842
|
|
|
|
|
|
|
sub filter |
843
|
|
|
|
|
|
|
{ |
844
|
0
|
|
|
0
|
|
|
my ($filter, $ini) = @_; |
845
|
|
|
|
|
|
|
|
846
|
0
|
|
|
|
|
|
my $key; |
847
|
0
|
|
|
|
|
|
foreach $key (@{$ini->keys}) { # was unblessed references |
|
0
|
|
|
|
|
|
|
848
|
0
|
|
|
|
|
|
my $keyFilt; |
849
|
0
|
|
|
|
|
|
foreach $keyFilt (@{$filter->{'keyFilters'}}) { |
|
0
|
|
|
|
|
|
|
850
|
0
|
0
|
|
|
|
|
next if ($key->name !~ /^$keyFilt->{'keyPat'}$/i); |
851
|
0
|
0
|
|
|
|
|
if ($keyFilt->{'deleteAll'}) { |
852
|
0
|
|
|
|
|
|
$ini->removeKey($key); |
853
|
0
|
|
|
|
|
|
next; # no point in going on... |
854
|
|
|
|
|
|
|
} |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
# remove end block here $keyFilt was not defined |
857
|
|
|
|
|
|
|
# Must be entry substituions/deletions |
858
|
0
|
|
|
|
|
|
my $keyAction; |
859
|
0
|
|
|
|
|
|
foreach $keyAction (@{$keyFilt->{'keyActions'}}) { |
|
0
|
|
|
|
|
|
|
860
|
0
|
|
|
|
|
|
my $field; |
861
|
0
|
|
|
|
|
|
foreach $field (@{$key->fields}) { |
|
0
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
my $target = |
863
|
0
|
0
|
|
|
|
|
$keyAction->{'matchOn'} eq 'name' |
864
|
|
|
|
|
|
|
? $field->name |
865
|
|
|
|
|
|
|
: $field->value; |
866
|
0
|
0
|
|
|
|
|
next if ($target !~ /^$keyAction->{'matchPat'}$/i); |
867
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
# |
869
|
|
|
|
|
|
|
# Have a match - carry out entry actions |
870
|
|
|
|
|
|
|
# |
871
|
0
|
|
|
|
|
|
my $entryAction; |
872
|
0
|
|
|
|
|
|
foreach $entryAction (@{$keyAction->{'entryActions'}}) { |
|
0
|
|
|
|
|
|
|
873
|
0
|
0
|
|
|
|
|
if ($entryAction->{'action'} eq 'substName') { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
874
|
0
|
|
|
|
|
|
my $name = $field->name; |
875
|
0
|
|
|
|
|
|
eval "\$name =~ $entryAction->{'subst'}"; |
876
|
0
|
0
|
|
|
|
|
if ($@ ne '') { |
877
|
0
|
|
|
|
|
|
$errorString = "error substituting " . |
878
|
|
|
|
|
|
|
"$target using $keyAction->{'subst'}"; |
879
|
0
|
|
|
|
|
|
return undef; |
880
|
|
|
|
|
|
|
} |
881
|
0
|
|
|
|
|
|
$field->name($name); |
882
|
|
|
|
|
|
|
} |
883
|
|
|
|
|
|
|
elsif ($entryAction->{'action'} eq 'substValue') { |
884
|
0
|
|
|
|
|
|
my $value = $field->value; |
885
|
0
|
|
|
|
|
|
eval "\$value =~ $entryAction->{'subst'}"; |
886
|
0
|
0
|
|
|
|
|
if ($@ ne '') { |
887
|
0
|
|
|
|
|
|
$errorString = "error substituting " . |
888
|
|
|
|
|
|
|
"$target using $keyAction->{'subst'}"; |
889
|
0
|
|
|
|
|
|
return undef; |
890
|
|
|
|
|
|
|
} |
891
|
0
|
|
|
|
|
|
$field->value($value); |
892
|
|
|
|
|
|
|
} |
893
|
|
|
|
|
|
|
elsif ($entryAction->{'action'} eq 'delete') { |
894
|
0
|
|
|
|
|
|
$key->removeField($field); |
895
|
0
|
|
|
|
|
|
last; |
896
|
|
|
|
|
|
|
} |
897
|
|
|
|
|
|
|
else { |
898
|
0
|
|
|
|
|
|
$errorString = "inifilter::filter: internal " . |
899
|
|
|
|
|
|
|
"error - unknown entry action: " . |
900
|
|
|
|
|
|
|
"$entryAction->{'action'}"; |
901
|
0
|
|
|
|
|
|
return undef; |
902
|
|
|
|
|
|
|
} |
903
|
|
|
|
|
|
|
} |
904
|
|
|
|
|
|
|
} |
905
|
|
|
|
|
|
|
} |
906
|
|
|
|
|
|
|
} |
907
|
|
|
|
|
|
|
} |
908
|
|
|
|
|
|
|
|
909
|
0
|
|
|
|
|
|
return 1; |
910
|
|
|
|
|
|
|
} # End Sub Filter |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
# |
913
|
|
|
|
|
|
|
# Export all filtering commands to the command line (mainly for DEBUG) |
914
|
|
|
|
|
|
|
# (deletions and substitutions) contained in the filter object. |
915
|
|
|
|
|
|
|
# Returns true iff there are no problems. |
916
|
|
|
|
|
|
|
# |
917
|
|
|
|
|
|
|
sub export |
918
|
|
|
|
|
|
|
{ |
919
|
0
|
|
|
0
|
|
|
my ($filter) = @_; |
920
|
|
|
|
|
|
|
|
921
|
0
|
|
|
|
|
|
my $keyFilt; |
922
|
0
|
|
|
|
|
|
foreach $keyFilt (@{$filter->{'keyFilters'}}) { |
|
0
|
|
|
|
|
|
|
923
|
0
|
|
|
|
|
|
print "keyPat = " . $keyFilt->{'keyPat'} . "\n"; |
924
|
0
|
0
|
|
|
|
|
if ($keyFilt->{'deleteAll'}) { |
925
|
0
|
|
|
|
|
|
print "deleteAll = " . $keyFilt->{'deleteAll'} . "\n"; |
926
|
|
|
|
|
|
|
} |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
# remove end block here $keyFilt was not defined |
929
|
|
|
|
|
|
|
# Must be entry substituions/deletions |
930
|
0
|
|
|
|
|
|
my $keyAction; |
931
|
0
|
|
|
|
|
|
foreach $keyAction (@{$keyFilt->{'keyActions'}}) { |
|
0
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
|
933
|
0
|
|
|
|
|
|
print "matchOn = " . $keyAction->{'matchOn'} . "\n"; |
934
|
0
|
|
|
|
|
|
print "matchPat = " . $keyAction->{'matchPat'} . "\n"; |
935
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
# |
937
|
|
|
|
|
|
|
# Have a match - carry out entry actions |
938
|
|
|
|
|
|
|
# |
939
|
0
|
|
|
|
|
|
my $entryAction; |
940
|
0
|
|
|
|
|
|
foreach $entryAction (@{$keyAction->{'entryActions'}}) { |
|
0
|
|
|
|
|
|
|
941
|
0
|
|
|
|
|
|
print "entryAction = " . $entryAction->{'action'} . "\n"; |
942
|
0
|
0
|
|
|
|
|
if ($entryAction->{'action'} eq 'substName') { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
943
|
0
|
|
|
|
|
|
print "subst name = " . $entryAction->{'subst'} . "\n"; |
944
|
|
|
|
|
|
|
} |
945
|
|
|
|
|
|
|
elsif ($entryAction->{'action'} eq 'substValue') { |
946
|
0
|
|
|
|
|
|
print "subst value = " . $entryAction->{'subst'} . "\n"; |
947
|
|
|
|
|
|
|
} |
948
|
|
|
|
|
|
|
elsif ($entryAction->{'action'} eq 'delete') { |
949
|
0
|
|
|
|
|
|
print "delete = " . $entryAction->{'subst'} . "\n"; |
950
|
0
|
|
|
|
|
|
last; |
951
|
|
|
|
|
|
|
} |
952
|
|
|
|
|
|
|
else { |
953
|
0
|
|
|
|
|
|
$errorString = "inifilter::export: internal error " . |
954
|
|
|
|
|
|
|
"- unknown entry action: $entryAction->{'action'}"; |
955
|
0
|
|
|
|
|
|
return undef; |
956
|
|
|
|
|
|
|
} |
957
|
|
|
|
|
|
|
} |
958
|
|
|
|
|
|
|
} |
959
|
|
|
|
|
|
|
} |
960
|
|
|
|
|
|
|
|
961
|
0
|
|
|
|
|
|
return 1; |
962
|
|
|
|
|
|
|
} # End Sub Export |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
} # End package App::IniDiff::IniFile::Filter |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
=pod |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
=head1 AUTHOR |
969
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
Michael Rendell, Memorial University of Newfoundland |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
=head1 MAINTAINERS |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
Jeremy Squires |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
=head1 SOURCE |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
=over 4 |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
=item * The source for this package is available here: |
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
L |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
=back |
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
987
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
Michael Rendell, Memorial University of Newfoundland |
989
|
|
|
|
|
|
|
produced the first version of the Regutils package from which |
990
|
|
|
|
|
|
|
this package was derived. |
991
|
|
|
|
|
|
|
|
992
|
|
|
|
|
|
|
=over 4 |
993
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
=item * It is still available from: |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
L |
997
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
=back |
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
=head1 BUGS |
1001
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
Please report any bugs or feature requests to |
1003
|
|
|
|
|
|
|
C, or through |
1004
|
|
|
|
|
|
|
the web interface at L. I will be notified, and then you'll |
1005
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes. |
1006
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
=head1 SUPPORT |
1008
|
|
|
|
|
|
|
|
1009
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
1010
|
|
|
|
|
|
|
|
1011
|
|
|
|
|
|
|
perldoc App::IniDiff::IniFile |
1012
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
You can also look for information at: |
1014
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
=over 4 |
1016
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here) |
1018
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
L |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
L |
1024
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
=item * CPAN Ratings |
1026
|
|
|
|
|
|
|
|
1027
|
|
|
|
|
|
|
L |
1028
|
|
|
|
|
|
|
|
1029
|
|
|
|
|
|
|
=item * Search CPAN |
1030
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
L |
1032
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
=back |
1034
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
1036
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
This software is Copyright (c) 1998 Memorial University of Newfoundland |
1038
|
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
This is free software, licensed under: |
1040
|
|
|
|
|
|
|
|
1041
|
|
|
|
|
|
|
The GNU General Public License, Version 3, July 2007 |
1042
|
|
|
|
|
|
|
|
1043
|
|
|
|
|
|
|
See F |
1044
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
=cut |
1046
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
1; # End of App::IniDiff::IniFile |
1048
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
|