1 # Copyright 2000, International Business Machines Corporation and others.
4 # This software has been released under the terms of the IBM Public
5 # License. For details, see the LICENSE file in the top-level source
6 # directory or online at http://www.openafs.org/dl/license10.html
9 @Functions = ("Substitution", "Insert", "Replace", "EOF");
14 # This subroutine will print a message and exit.
16 # Msg is the message to print
26 # This subroutine will open the given File for reading and
27 # will open a second file with the name File.new for writing.
28 # The subroutine will save these newly-created subroutines in
29 # an associative array for Patch to use.
31 # This subroutine will cause the whole program to exit if it
32 # cannot open either file.
37 my $FH = "${File}_FH";
38 my $FHOUT = "${FH}OUT";
39 my $Error = (defined(&main::ErrorMsg)) ? \&main::ErrorMsg : \&PatchError;
40 open($FH, "$File") || &$Error("Cannot open $File: $!");
41 open($FHOUT, ">$File.new") || &$Error("Cannot open $File.new: $!");
42 $FileHandles{$File} = [$FH, $FHOUT];
48 # This subroutine will cause the subroutine Patch to be in verbose
59 # This subroutine will cause the subroutine Patch to be in verbose
68 # sub Patch(File, ActionArrayReference)
70 # ActionArrayReference = reference to an array of Actions
71 # Actions = (RE, Function, SearchLines, NewLines)
73 # This subroutine will try to patch a given File by following
74 # the given Actions provided in the Actions array passed to it
77 # The Action array reference passed to it contains references to
78 # the actual Actions to be taken.
80 # The Actions are implemented as an array as described above.
81 # RE is a flag to use Regular Expressions or not (1 or 0)
82 # Function is one of Substitution, Insert, Replace or EOF
83 # SearchLines is a newline-separated string of lines to search for.
84 # NewLines is a newline-separated string of lines which will be new
89 # EOF: The function will do nothing and return Success if the New lines are
90 # present anywhere in the file.
91 # Returns 1 on Success, 0 otherwise
95 my ($File, $ActionList) = @_; # the filename and list reference
96 my ($status, $ActionRef, $FH, $tmp, $RE);
98 my ($SearchPatternArrayRef, $NewPatternArrayRef, $ArrayRef);
99 my $ReplacementMatchRef;
100 local ($SearchBufferRef, $NewBufferRef);
101 my ($SearchLines, $NewLines, @SearchArray, @NewArray, $Function);
102 my (%NewIndex, %NewBuffer, %SearchIndex, %SearchBuffer);
103 my (%NewMatch, %NewLinesPrinted, %ReplacementMatch);
104 local ($NewIndexRef, $SearchIndexRef);
105 local $CurrentLine = 0;
112 # Check to see if the Action List is empty
113 if ($#$ActionList == -1) {
114 print "No Actions specified for $File\n";
118 # Check to see if the given file has already been opened with FileOpen
119 if (!exists($FileHandles{$File})) {
120 print "$File has not been previously opened with Patch::FileOpen\n";
124 print "\nAttempting to patch $File...\n" if ($Verbose);
126 $ArrayRef = $FileHandles{$File};
127 ($FH, $NEWFH) = @$ArrayRef;
129 # Initialize the assoc. arrays which will be used to keep track of indices
130 # and the previously found matches
132 foreach $ActionRef (@$ActionList) {
133 my (@SearchPatternArray, @NewPatternArray);
136 $SearchIndex{$Index} = 0;
137 $SearchBuffer{$Index} = [];
138 $NewIndex{$Index} = 0;
139 $NewBuffer{$Index} = [];
140 $NewLinesPrinted{$Index} = 0;
141 &DebugPrint("SearchBuffer[$Index]= $SearchBuffer{$Index}");
142 &DebugPrint("NewBuffer[$Index]= $NewBuffer{$Index}");
144 # recreate the new Action Array as follows:
147 # 2) Reference to SearchPattern array
148 # 3) Reference to NewPattern array
151 # remove the RE flag from the list
152 $RE = shift @$ActionRef;
154 # prepend the Index number to the front of the list
155 unshift(@$ActionRef, $Index);
157 if (!grep(/$$ActionRef[1]/, @Functions)) {
158 Abort("Unknown function: $$ActionRef[1]");
161 if (!$RE && $$ActionRef[1] eq "Substitution") {
162 Abort("The Substitution function requires a Regular Expression");
166 # Since we will be using split with a limit, we need to get rid of the
168 chomp $$ActionRef[2];
170 @SearchArray = split(/\n/, $$ActionRef[2], length($$ActionRef[2]));
171 if ($$ActionRef[1] ne "EOF" && $#SearchArray == -1) {
172 Abort("Cannot have an empty Search parameter");
175 # The Search parameter for Substitution is limited to a single line
176 if ($$ActionRef[1] eq "Substitution" &&
178 Abort("Cannot have a multi-line Search parameter with Substitution:");
179 &PrintArray(\@SearchArray);
182 # delimit each character if we are not expecting regular expressions
183 foreach $tmp (@SearchArray) {
184 $tmp = quotemeta $tmp if (!$RE);
185 push(@SearchPatternArray, $tmp);
187 $$ActionRef[2] = \@SearchPatternArray;
189 chomp $$ActionRef[3];
190 @NewArray = split(/\n/, $$ActionRef[3],length($$ActionRef[3]));
191 if ($#NewArray == -1) {
192 Abort("Cannot have an empty New parameter");
195 # The Replace parameter for Substitution is limited to a single line
196 if ($$ActionRef[1] eq "Substitution" &&
198 Abort("Cannot have a multi-line Replace parameter with Substitution:");
199 &PrintArray(\@NewArray);
202 # delimit each character if we are not expecting regular expressions
203 foreach $tmp (@NewArray) {
204 $tmp = quotemeta $tmp if (!$RE);
205 push(@NewPatternArray, $tmp);
207 splice(@$ActionRef, 3, 0, \@NewPatternArray);
209 # Now we have to create a new string out of the Search and Replace(New)
210 # parameters if the function is Substitution. This new string is used
211 # to determine whether or not we have a file which has successfully
213 if ($$ActionRef[1] eq "Substitution") {
214 my $search = $$ActionRef[2][0];
215 my $replace = $$ActionRef[3][0];
219 # split the search string on the opening '(' if there are any
220 my (@search) = split(/\(/, $search);
221 foreach $tmp (@search) {
222 # Check to see if the '(' was was preceeded by a '\' which indicates
223 # that a match was not being performed.
224 # If so prepend the current string plus the '(', lost during the split
225 # to the next string.
226 if (substr($tmp, -1, 1) eq "\\") {
227 $search[$index+1] = "$search[$index]($search[$index+1]";
230 next if (!$index++); # the first array value is before a match
231 # Now we need to find the occurrence of the final ')' trying not
232 # to match a '\)'. Once this is found we can push the entire string
233 # that was orignally between the '()' into our matches buffer.
235 while (($end = index($tmp, ")", $end)) >= $[) {
236 if (substr($tmp, $end-1, 1) eq "\\") {
238 push(@matches, substr($tmp, 0, $end));
244 # if the sequence "#" is found then the intent was to place a #
245 # character in the replace portion as a comment in the string to
246 # pacify the perl preprocessor. The quotes need to be stripped in the
247 # ReplacementMatch string.
248 $replace =~ s/"#"/#/;
250 # Split the Replace line on the input '.' characters which are used to
251 # show how to combine the replace piece of the s/// function
252 my (@new) = split(/\./, $replace);
254 # We are not expecting to have any $# replacements since there were
255 # no '.' characters in the string. In this case just use the actual
256 # string when trying to look for that new string.
257 $ReplacementMatch{$Index} = shift @new;
259 # Go through the '.'-separated components of the string and replace
260 # any occurrence of $# with the original search pattern.
261 # Otherwise just save the original string.
263 while ($tmp = shift @new) {
264 &DebugPrint("\t\t$tmp");
265 if ($tmp =~ /^\$\d+$/) {
266 &DebugPrint("\tFound a match");
267 $ReplacementMatch{$Index} .= $matches[$index];
270 $ReplacementMatch{$Index} .= $tmp;
273 &DebugPrint("index=$index, matches = $#matches");
274 if ($index != $#matches+1) {
275 &Abort("Substitution does not have matching matches");
282 print "Index = $$ActionRef[0]\n";
283 print "Function = $$ActionRef[1]\n";
285 &PrintArray($$ActionRef[2]);
287 &PrintArray($$ActionRef[3]);
288 print "NewLines = $$ActionRef[4]\n";
289 print "ReplacementMatch = $ReplacementMatch{$Index}\n";
290 print "----------------------------\n";
295 MAINLOOP: while (<$FH>) {
298 $LineReferences{$CurrentLine} = 0;
301 &DebugPrint("$CurrentLine=>$_");
303 chomp; # get rid of newline character
304 # go through each action on this line of the file
305 foreach $ActionRef (@$ActionList) {
306 ($Index, $Function, $SearchPatternArrayRef, $NewPatternArrayRef,
307 $NewLines) = @$ActionRef;
308 # define references to asociative array values for easier use
309 $NewIndexRef = \$NewIndex{$Index};
310 $NewBufferRef = $NewBuffer{$Index};
311 $SearchIndexRef = \$SearchIndex{$Index};
312 $SearchBufferRef = $SearchBuffer{$Index};
313 $NewMatchRef = \$NewMatch{$Index};
315 $NewLinesPrintedRef = \$NewLinesPrinted{$Index};
316 $ReplacementMatchRef = \$ReplacementMatch{$Index};
318 # if the function is a substitution and the current line matches the
319 # Search pattern then try to perform the substitution and flag that
320 # the action as done if successful
321 if ($Function eq "Substitution" &&
322 /$$SearchPatternArrayRef[$$SearchIndexRef]/) {
323 &DebugPrint("\tSubstitution");
324 &VerbosePrint("Substituting line in $File...");
325 $Done{$Index} |= s/$$SearchPatternArrayRef[$$SearchIndexRef]/"$$NewPatternArrayRef[$$NewIndexRef]"/ee;
328 # This is a look-ahead check to see if the "New" lines will be matched
329 $$NewMatchRef = 1 if (($$NewIndexRef <= $#$NewPatternArrayRef) &&
330 /$$NewPatternArrayRef[$$NewIndexRef]/i);
332 # "EOF" function has no use for the Search paramaters
333 # see if the "Search" lines can be found
334 if ($Function ne "EOF" &&
335 ($$SearchIndexRef <= $#$SearchPatternArrayRef) &&
336 /$$SearchPatternArrayRef[$$SearchIndexRef]/) {
337 &DebugPrint("Search");
338 # print the "New" buffer and clear the indices if we were previsouly
339 # tracking the "New" lines and we no longer are
340 &ResetNew(1) if $$NewIndexRef && !$$NewMatchRef;
341 # see if all of the "Search" lines been found
342 if ($$SearchIndexRef == $#$SearchPatternArrayRef) {
343 if ($Function eq "Insert") {
344 # reset the search indices and print the buffer and current line
347 &DebugPrint("\tSearch Printed: $_");
349 # just reset the search indices
352 # now that we are caught up with everything else, print the newlines
353 print $NEWFH "$NewLines\n";
354 &DebugPrint("\tSearch Printed: $NewLines");
355 # mark that the new lines have already been printed
356 $$NewLinesPrintedRef = 1 if ($$NewMatchRef && $Function ne "Insert");
357 $$NewLinesPrintedRef = 1 if ($Function eq "Insert");
358 &VerbosePrint ("Replacing line[s] in $File...");
359 $Done{$Index} = 1; # flag that this Action is done
361 # add this line to the buffer and increment the index to the next
363 &AddToBuffer($SearchBufferRef, $_);
366 # set flag so that we don't check for inconsistencies
369 # check to see if we already determined a "New" match
372 # clean the "Search" buffer if it is partial and the $NextLine was not
373 # set before. If it was set, then search is still active
374 &ResetSearch(1) if ($$SearchIndexRef && !$NextLoop);
375 &DebugPrint("$NextLoop and $$NewLinesPrintedRef");
376 # see if all of the "New" lines have been found
377 if ($$NewIndexRef == $#$NewPatternArrayRef) {
378 # reset the Search indices but do not print the buffer
380 # print the buffered lines aw sell as the current line unless they
381 # were already printed by "Search"; reset the indices
382 if (!$NextLoop && !$$NewLinesPrintedRef) {
385 &DebugPrint("\tNew printed $_");
387 # the lines were previously printed; just reset everything
390 $Done{$Index} = 1; # flag that this Action is done
392 # add the current line to the New buffer unless this line has
393 # already been printed
394 &AddToBuffer($NewBufferRef, $_) if (!$$NewLinesPrintedRef);
397 # set flag so that we don't check for inconsistencies
401 # If the substitution action hasn't already been successful during
402 # this run and the current line matches the replacement line
403 # then mark the action as done
404 if (!$Done{$Index} && $Function eq "Substitution" &&
405 /$$ReplacementMatchRef/) {
406 &DebugPrint("\tFound the ReplacementMatch");
407 $Done{$Index} = 1; # flag that this Action is done
410 # if this point is reached and the NewIndex is not at zero, then some but
411 # not all of the New lines were found.
412 # skip this block if Search or New already succeeded
413 if (!$NextLoop && $$NewIndexRef) {
414 &DebugPrint("New check");
420 # if this point is reached and the SearchIndex is not at zero, then some
421 # but not all of the Search lines were found
422 # skip this block if Search or New already succeeded
423 if (!$NextLoop && $$SearchIndexRef) {
424 &DebugPrint("Search check");
425 &ResetSearch(!$Done{$Index});
430 # print the new lines at the end of the file if the function is "EOF", the
431 # next read on the file will be EOF and the new lines are not already
432 # present at the end of the file
433 if (!$NextLoop && $Function eq "EOF" && eof($FH) && !$Done{$Index}) {
436 print $NEWFH "$NewLines\n";
437 &DebugPrint("\tEOF Printed: $_\n$NewLines");
438 &VerbosePrint("Appending new line[s] to end of $File...");
445 &DebugPrint("\tPrinted: $_");
451 $Errors = grep(/0/, values %Done);
453 $status = system("diff $File $File.new > /dev/null 2>&1");
455 if (!rename($File, "$File.old")) {
456 print "Could not rename $File to $File.old: $!";
458 if (!rename("$File.new", $File)) {
459 print "Could not rename $File.new to $File: $!";
461 &CopyStat("$File.old", $File);
465 &VerbosePrint ("No difference. Leaving the old $File intact");
471 &VerbosePrint("$Errors Action[s] did not succeed.");
478 # AddToBuffer(BufferRef, Line)
480 # This subroutine will add a given line to a buffer
482 # BufferRef is a reference to a buffer
483 # Line is the line to be added
487 my($BufferRef, $line) = @_;
488 push(@$BufferRef, [$CurrentLine, $line]);
489 $LineReferences{$CurrentLine}++;
490 &DebugPrint("Adding to buffer[$BufferRef]=>$CurrentLine, $line");
491 &DebugPrint("References for $CurrentLine is $LineReferences{$CurrentLine}");
497 # This subroutine will reset the Search variables
499 # Print indicates whether or not to print the contents of the SearchBuffer
506 &DebugPrint("ResetSearch");
508 # print the lines that were matched up to this point since they were not
510 foreach $ref (@$SearchBufferRef) {
511 ($lineno, $BufferedLine) = @$ref;
512 &DebugPrint("References for $lineno is $LineReferences{$lineno}");
513 if ($LineReferences{$lineno} == 1) {
514 print $NEWFH "$BufferedLine\n";
515 &DebugPrint("\tResetSearch Printed: $BufferedLine [$SearchBufferRef,$lineno]");
517 &DebugPrint("not printing [$SearchBufferRef]=>$lineno,$BufferedLine\n");
519 $LineReferences{$lineno}--;
522 # reset the Search indices and buffer
523 $$SearchIndexRef = 0;
524 @$SearchBufferRef = ();
530 # This subroutine will reset the New variables
532 # Print indicates whether or not to print the contents of the NewBuffer
539 &DebugPrint("ResetNew");
541 # print the lines that were matched up to this point since they were not
543 foreach $ref (@$NewBufferRef) {
544 ($lineno, $BufferedLine) = @$ref;
545 &DebugPrint("References for $lineno is $LineReferences{$lineno}");
546 if ($LineReferences{$lineno} == 1) {
547 print $NEWFH "$BufferedLine\n";
548 &DebugPrint("\tResetNew Printed: $BufferedLine [$NewBufferRef,$lineno]");
550 &DebugPrint("not printing [$NewBufferRef]=>$lineno,$BufferedLine\n");
552 $LineReferences{$lineno}--;
555 # reset the New indices and buffer
563 # This subroutine will print an abort message
568 print "Aborting, $mesg\n";
574 # This subroutine will print a message if the program is running in verbose
575 # mode set earlier by Verbose()
577 # Msg is the message to print
582 print "\t$mesg\n" if ($Verbose);
588 # This subroutine will print a message if the program is running in Debug
589 # mode set earlier by Debug()
591 # Msg is the message to print
596 print "$mesg\n" if ($Debug);
602 # This subroutine will print out all of the contents of an array.
603 # Primarily used in debugging.
605 # Array is the array to print
610 foreach $element (@$arrayref) {
616 # CopyStat(SrcFile, DstFile)
618 # This subroutine copies the mode, uid and gid from SrcFile to DstFile
621 my ($user, $group, $srcfile, $destfile, $mode, $rc, @statinfo);
623 $destfile = shift @_;
624 @statinfo = stat($srcfile);
625 $mode = $statinfo[2];
626 $user = $statinfo[4];
627 $group = $statinfo[5];
628 &VerbosePrint("Copying owner,group,mode of \"$srcfile\" to \"$destfile\"");
629 $rc = chown $user, $group, $destfile;
630 &VerbosePrint("Could not change mode bits of", $destfile) if (!$rc);
631 $rc = chmod $mode, $destfile;
632 &VerbosePrint("Could not change mode bits of", $destfile) if (!$rc);