File Coverage

blib/lib/App/IniDiff/IniFile.pm
Criterion Covered Total %
statement 59 470 12.5
branch 0 196 0.0
condition 0 48 0.0
subroutine 20 52 38.4
pod 0 1 0.0
total 79 767 10.3


line stmt bran cond sub pod time code
1             package App::IniDiff::IniFile;
2            
3 1     1   165898 use 5.006;
  1         4  
4            
5 1     1   6 use strict;
  1         3  
  1         22  
6 1     1   5 use Carp;
  1         3  
  1         64  
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.17
15            
16             =cut
17            
18 1     1   6 use vars qw($VERSION);
  1         1  
  1         85  
19             $VERSION = '0.17';
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   7 use vars qw(&new &write &findKey &keys &removekey &addKey);
  1         4  
  1         86  
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         66  
95            
96             {
97            
98             package App::IniDiff::IniFile::Field;
99            
100 1     1   7 use strict;
  1         2  
  1         30  
101 1     1   5 use Carp;
  1         6  
  1         67  
102            
103 1         93 use vars qw(&new &name &canonName &value &deleted &annotation
104 1     1   7 &setFrom &write &canonicalize );
  1         3  
105 1     1   9 use vars qw($eol);
  1         2  
  1         623  
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   8 use strict;
  1         2  
  1         29  
211 1     1   6 use Carp;
  1         2  
  1         50  
212 1     1   486 use IO::File;
  1         8511  
  1         139  
213            
214 1         149 use vars qw(&new &name &canonName &orderId &deleted &annotation &fields
215             &canonicalize &findField &addField &appendField &removeField
216             &write
217 1     1   8 );
  1         2  
218 1     1   7 use vars qw($eol);
  1         2  
  1         2317  
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   13 use strict;
  1         2  
  1         24  
647 1     1   11 use Carp;
  1         3  
  1         58  
648 1     1   9 use IO::File;
  1         3  
  1         153  
649            
650 1     1   9 use vars qw(&new &readConf &filter &export);
  1         3  
  1         61  
651 1     1   7 use vars qw($errorString);
  1         6  
  1         1888  
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