Generated: Sat Oct 12 17:23:15 2013 from patchit.pl 2012/03/28 46.6 KB. text copy
#!/usr/bin/perl -w # NAME: patchit.pl # AIM: 24/03/2012 Accept a patch file as input, and apply the patches # This was NOT written as a replacement of the 'patch' tool, which does a # very good job, but to better # understand the unified diff notation, and # how to apply it. # UGH: With MSVC10 must deal with BOM (Byte Order Mark), like # UTF-8 EF BB BF 239 187 191 # ======================================================================= use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use Cwd; my $os = $^O; my $perl_dir = '/home/geoff/bin'; my $PATH_SEP = '/'; my $temp_dir = '/tmp'; if ($os =~ /win/i) { $perl_dir = 'C:\GTools\perl'; $temp_dir = $perl_dir; $PATH_SEP = "\\"; } unshift(@INC, $perl_dir); require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl' Check paths in \@INC...\n"; # log file stuff our ($LF); my $pgmname = $0; if ($pgmname =~ /(\\|\/)/) { my @tmpsp = split(/(\\|\/)/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $temp_dir.$PATH_SEP."temp.$pgmname.txt"; open_log($outfile); # user variables my $VERS = "0.0.1 2012-03-24"; my $load_log = 0; my $in_file = ''; my $verbosity = 0; my $debug_on = 0; my $def_file = 'def_file'; my $out_xml = ''; my $work_dir = ''; # directory where the patches are to be applied my $strip_count = 0; # strip this count off the path my $files_reversed = 0; # reverse new and old in patch my $strip_bom_utf8 = 1; ### program variables my @warnings = (); my $cwd = cwd(); my @new_files = (); ### DEBUG my $dbg_01 = 0; # show ALL lines my $dbg_02 = 0; # show loaded diff file lines my $dbg_03 = 0; # show lines from file to be patched my $dbg_04 = 0; # show the bumping of $cpl_cnt for DEBUG ONLY my $dbg_05 = 0; # show stored/skipped lines my $dbg_06 = 0; # show lines from old file my $dbg_07 = 0; # show lines from patch input file my $dbg_08 = 0; # show lines when merging my $dbg_09 = 0; # show all patched file lines my $dbg_10 = 0; # show patch file lines my $dbg_11 = 0; # show OLDFILE lines my $dbg_14 = 0; # show check MORE on line difference # setup a 'function' to call # like $new_hash{'function'} = \&foo; # call the a function like $stg = $func->(); my ($path_function); $path_function = \&path_d2u; if ($os =~ /win/i) { $path_function = \&path_u2d; } sub VERB1() { return $verbosity >= 1; } sub VERB2() { return $verbosity >= 2; } sub VERB5() { return $verbosity >= 5; } sub VERB9() { return $verbosity >= 9; } sub show_warnings($) { my ($val) = @_; if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS...\n" ); foreach my $itm (@warnings) { prt("$itm\n"); } prt("\n"); } else { prt( "\nNo warnings issued.\n\n" ) if (VERB9()); } } sub pgm_exit($$) { my ($val,$msg) = @_; if (length($msg)) { $msg .= "\n" if (!($msg =~ /\n$/)); prt($msg); } show_warnings($val); close_log($outfile,$load_log); exit($val); } sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } # get_counts($lcnts,\$off1,\$len1,\$off2,\$len2); # Normally @@ -57,10 +57,16 # Also must resolve @@ -1 +1 @@ and @@ -0,0 +1 @@ # UGH and '-1 +0,0', '-1,2 +1', '-1 +0,0' sub get_counts($$$$$) { my ($lcnts,$roff1,$rlen1,$roff2,$rlen2) = @_; ${$roff1} = -9999; ${$rlen1} = -9999; ${$roff2} = -9999; ${$rlen2} = -9999; my ($cnt,$old,$new,$msg,$i); my @arr = split(/\s+/,$lcnts); $cnt = scalar @arr; if ($cnt != 2) { $msg = "WARNING:1: CNTS [$lcnts] did NOT split in 2 on space! Got $cnt?"; for ($i = 0; $i < $cnt; $i++) { $msg .= " $arr[$i]"; } prtw("$msg\n"); return 1; } $old = $arr[0]; $new = $arr[1]; if ( !($old =~ /^-/) || !($new =~ /^\+/)) { prtw("WARNING:2: CNTS [$lcnts] did NOT resolve with - or + [$old] [$new]!\n"); return 2; } $old = substr($old,1); @arr = split(",",$old); $cnt = scalar @arr; if ($cnt == 1) { ${$roff1} = $arr[0]; ${$rlen1} = $arr[0]; } elsif ($cnt == 2) { ${$roff1} = $arr[0]; ${$rlen1} = $arr[1]; } else { prtw("WARNING:3: CNTS [$lcnts] OLD did NOT resolve [$old] [$new]!\n"); return 3; } $new = substr($new,1); @arr = split(",",$new); $cnt = scalar @arr; if ($cnt == 1) { ${$roff2} = $arr[0]; ${$rlen2} = $arr[0]; } elsif ($cnt == 2) { ${$roff2} = $arr[0]; ${$rlen2} = $arr[1]; } else { prtw("WARNING:4: CNTS [$lcnts] OLD did NOT resolve [$old] [$new]!\n"); return 4; } return 0; } sub get_counts_FAILED_ON_SOME($$$$$) { my ($lcnts,$roff1,$rlen1,$roff2,$rlen2) = @_; ${$roff1} = -9999; ${$rlen1} = -9999; ${$roff2} = -9999; ${$rlen2} = -9999; my $len = length($lcnts); my ($i,$ch,$tag,$cnt); $cnt = 0; $tag = ''; for ($i = 0; $i < $len; $i++) { $ch = substr($lcnts,$i,1); if (length($tag) == 0) { if ($ch =~ /\s/) { next; } elsif (($ch eq '-')||($ch eq '+')||($ch =~ /\d/)) { $tag .= $ch; # start the tag } } elsif ($ch =~ /\d/) { if ( (length($tag) == 1) && (($tag eq '+')||($tag eq '-')) ) { $tag = ''; # REMOVE '-' and '+' indicators } $tag .= $ch; } else { # is NOT '-' or '+' or a digit - assume END if ($cnt == 0) { ${$roff1} = $tag; } elsif ($cnt == 1) { ${$rlen1} = $tag; } elsif ($cnt == 2) { ${$roff2} = $tag; } elsif ($cnt == 3) { ${$rlen2} = $tag; } $cnt++; # bump counter $tag = ''; # and CLEAR tag } } if (length($tag) && ($cnt == 3)) { ${$rlen2} = $tag; $cnt++; } if ($cnt != 4) { prtw("WARNING: CNTS [$lcnts] did NOT resolve (-${$roff1},${$rlen1} +${$roff2},${$rlen2})!\n"); } } sub get_diff_files($$$) { my ($lin,$rfil1,$rfil2) = @_; #my @arr = split(/s+/,$lin); my @arr = space_split($lin); if (scalar @arr < 2) { pgm_exit(1,"ERROR: Line [$lin] did NOT split correctly!\n"); } my ($fil,$cnt); $cnt = 0; foreach $fil (@arr) { next if ($fil =~ /^-/); if ($cnt == 0) { ${$rfil1} = $fil; $cnt++; } elsif ($cnt == 1) { ${$rfil2} = $fil; $cnt++; } } return $cnt; } sub strip_file_path($) { my $file = shift; return $file if ($strip_count == 0); $file = $path_function->($file); my $len = length($file); my $cnt = 0; my ($i,$ch); for ($i = 0; $i < $len; $i++) { $ch = substr($file,$i,1); if ($ch eq $PATH_SEP) { $cnt++; if ($cnt == $strip_count) { return substr($file,($i+1)); } } } return $file; } sub line_has_utf8_bom($) { my $line = shift; my $len = length($line); my ($ch,$val1,$val2,$val3); # UTF-8 EF BB BF 239 187 191 if ($len > 3) { $ch = substr($line,0,1); $val1 = ord($ch); $ch = substr($line,1,1); $val2 = ord($ch); $ch = substr($line,2,1); $val3 = ord($ch); if (($val1 == 239)&&($val2 == 187)&&($val3 == 191)) { return 1; } } return 0; } sub remove_utf8_bom_from_line($) { my $line = shift; if (line_has_utf8_bom($line)) { $line = substr($line,3); } return $line; } sub remove_utf_bom($$) { my ($ff,$ra) = @_; my $line = ${$ra}[0]; # get first line my $nline = remove_utf8_bom_from_line($line); if ($line ne $nline) { prt("NOTE: File [$ff] is UTF-8 encoding. BOM removed.\n"); ${$ra}[0] = $nline; } } # if (get_diff_file_lines($ff,\@oldlines)) { sub get_diff_file_lines($$) { my ($ff,$ra) = @_; my $lncnt = 0; if (open INF, "<$ff") { @{$ra} = <INF>; close INF; $lncnt = scalar @{$ra}; remove_utf_bom($ff,$ra) if ($strip_bom_utf8); } return $lncnt; } # if (lines_match($plline,$dline)) { sub lines_match($$) { my ($pl,$dl) = @_; return 1 if ($pl eq $dl); return 0; } sub write_patched_file($$) { my ($rh,$ff) = @_; my $dnlist = 0; my ($dcnt,$i,$dline,$plline,$msg2,$len,$tlen); my $mcnt = 0; my $errcnt = 0; my $failed = ''; if (defined ${$rh}{$ff}) { my $rhh = ${$rh}{$ff}; my $rpla = ${$rhh}{'PATCHED_LINES'}; my $len1 = scalar @{$rpla}; $msg2 = ''; if ((defined ${$rhh}{'NEW_LINES'})&&(defined ${$rhh}{'NEW_FILE'})) { my $rnla = ${$rhh}{'NEW_LINES'}; my $ffnew = ${$rhh}{'NEW_FILE'}; my $len2 = scalar @{$rnla}; $len = ($len1 < $len2) ? $len1 : $len2; #if ($len1 == $len2) { if ($len) { prt("\n") if (VERB9() || $dbg_09); prt("Display of patched $len1 lines, file [$ff], compared to $len2 lines, file [$ffnew]\n"); $dcnt = 0; for ($i = 0; $i < $len; $i++) { $dline = ${$rpla}[$i]; $plline = ${$rnla}[$i]; chomp $plline; if (lines_match($dline,$plline)) { $msg2 = "ok"; $mcnt++; } else { $msg2 = "NM [$plline]"; if (line_has_utf8_bom($dline)) { $msg2 .= " due UTF-8 BOM"; } $errcnt++; if (VERB9() || $dbg_14) { # hmmm, check more on difference my ($tlen1,$tlen2,$j,$ch,$val); $tlen1 = length($dline); $tlen2 = length($plline); $tlen = ($tlen1 < $tlen2) ? $tlen1 : $tlen2; for ($j = 0; $j < $tlen; $j++) { $ch = substr($dline,$j,1); if ($ch ne substr($plline,$j,1) ) { $val = ord($ch); $failed .= "<- here offset $j [$ch]$val ne "; $ch = substr($plline,$j,1); $val = ord($ch); $failed .= "[$ch]$val"; if (line_has_utf8_bom($dline)) { $failed .= " due UTF-8 BOM"; } $j++; last; } $failed .= $ch; } $failed .= "\n"; $failed .= "old [$dline]$tlen1\n"; $failed .= "new [$plline]$tlen2\n"; } } $dcnt++; prt("$dcnt: [$dline] $msg2\n") if (VERB9() || $dbg_09); } if ($i < $len1) { prt("Balance ".($len1 - $i)." in patched file.\n"); for ( ; $i < $len1; $i++) { $dline = ${$rpla}[$i]; $dcnt++; prt("$dcnt: [$dline]\n") if (VERB9() || $dbg_09);; $errcnt++; } } elsif ($i < $len2) { prt("Balance ".($len2 - $i)." in NEW file.\n"); for ( ; $i < $len2; $i++) { $plline = ${$rnla}[$i]; chomp $plline; $dcnt++; prt("$dcnt: [$plline]\n") if (VERB9() || $dbg_09);; $errcnt++; } } $dnlist = 1; if ($mcnt == $dcnt) { prt("A perfect match $dcnt of $mcnt.\n"); } else { prt("Match FAILED on $errcnt lines, matched $mcnt!\n"); prt("$failed\n") if (length($failed)); } } else { $msg2 .= " lengths $len1 and $len2 different!"; } } else { $msg2 .= " 'NEW_LINES' or 'NEW_FILE' NOT defined!"; } if (!$dnlist) { $dcnt = 0; prt("\n") if (VERB9() || $dbg_09); prt("Display of patched file $ff with new lines... $msg2\n"); foreach $dline (@{$rpla}) { $dcnt++; prt("$dcnt: [$dline]\n") if (VERB9() || $dbg_09); } } } } sub show_patch_lines($$$$) { my ($rh,$rdifflines,$rpatchlines,$rcnt_stack) = @_; my $maxplcnt = scalar @{$rpatchlines}; my $maxstack = scalar @{$rcnt_stack}; my $oldlncnt = scalar @{$rdifflines}; my $dcnt = 0; my ($rpla,$pltype,$plline,$i,$off); my ($rca,$off1,$len1,$off2,$len2,$endp1,$endp2,$icnt); my ($poff1,$plen1,$poff2,$plen2,$jcnt,$roff); $off = 0; if ($off < $maxstack) { $rca = ${$rcnt_stack}[$off]; $off1 = ${$rca}[0]; $len1 = ${$rca}[1]; $off2 = ${$rca}[2]; $len2 = ${$rca}[3]; $endp1 = $off1 + $len1; $endp2 = $off2 + $len2; $off++; } else { pgm_exit(1,"ERROR:show_patch_lines: No counts available! Aborting...\n"); } prt("\n") if (VERB9() || $dbg_10); prt("List of $maxplcnt patch lines from [$in_file]. old file has $oldlncnt lines.\n"); prt("Counts $maxstack (-$off1,$len1 +$off2,$len2)\n"); $icnt = 0; $jcnt = 0; $roff = 0; for ($i = 0; $i < $maxplcnt; $i++) { $rpla = ${$rpatchlines}[$i]; $pltype = ${$rpla}[0]; # get TYPE of line 'S', '+', '-'... $plline = ${$rpla}[1]; # and the line $dcnt++; $icnt++ if ($pltype ne '-'); if ($pltype ne '+') { # count of current file lines $jcnt++; $roff++; } prt("$roff:$dcnt:$icnt:$jcnt: $pltype [$plline]\n") if (VERB9() || $dbg_10); if ($icnt == $len2) { if ($off < $maxstack) { $rca = ${$rcnt_stack}[$off]; $poff1 = $off1; $plen1 = $len1; $poff2 = $off2; $plen2 = $len2; $off1 = ${$rca}[0]; $len1 = ${$rca}[1]; $off2 = ${$rca}[2]; $len2 = ${$rca}[3]; $endp1 = $off1 - $roff - 1; # get old file lines to SKIP $roff = $off1 - 1; # set the new OLD file offset prt("Next counts (-$off1,$len1 +$off2,$len2) SKIP $endp1\n"); $endp1 = $off1 + $len1; $endp2 = $off2 + $len2; $off++; } $icnt = 0; $jcnt = 0; } } $endp1 = $oldlncnt - $roff; if ($roff == $oldlncnt) { prt("Calculated actual line count $roff equals old line count $oldlncnt.\n"); } else { prt("Calculated actual line count $roff, plus $endp1 lines to equal old line count $oldlncnt.\n"); } } sub merge_file_lines($$$$$$) { my ($ff,$rpatchedlines,$rpatches,$rnewlines,$bgnpatch,$rroff) = @_; my $oflcnt = scalar @{$rpatchedlines}; my $pflcnt = scalar @{$rpatches}; prt("\n") if (VERB9() || $dbg_08); prt("Merge $oflcnt old file lines with $pflcnt patch line...\n"); my $cof = 0; my $cpf = 0; my $errcnt = 0; my ($msg2,$oline); my ($rpla,$pltype,$plline); for ($cpf = 0; $cpf < $pflcnt; $cpf++) { $rpla = ${$rpatches}[$cpf]; $pltype = ${$rpla}[0]; # get TYPE of line 'S', '+', '-'... $plline = ${$rpla}[1]; # and the line $msg2 = $pltype; if ($pltype eq 'S') { if ($cof < $oflcnt) { $oline = ${$rpatchedlines}[$cof]; $cof++; if (lines_match($oline,$plline)) { $msg2 .= ' matched1'; } else { $msg2 .= " NM1 [$plline]"; $errcnt++; } push(@{$rnewlines},$oline); ${$rroff}++; prt("${$rroff}:$bgnpatch: [$oline] stored $msg2\n") if (VERB9() || $dbg_08); $bgnpatch++; } else { pgm_exit(1,"ERROR:1: Ran out of lines $pltype [$plline]\n"); } } elsif ($pltype eq '+') { push(@{$rnewlines},$plline); prt("${$rroff}:$bgnpatch:$cpf: [$plline] added $msg2\n") if (VERB9() || $dbg_08); $bgnpatch++; } elsif ($pltype eq '-') { if ($cof < $oflcnt) { $oline = ${$rpatchedlines}[$cof]; $cof++; if (lines_match($oline,$plline)) { $msg2 .= ' matched1'; } else { $msg2 .= " NM1 [$plline]"; $errcnt++; } prt("$bgnpatch: [$oline] dropped $msg2\n") if (VERB9() || $dbg_08); $bgnpatch++; } else { pgm_exit(1,"ERROR:2: Ran out of lines\n"); } } else { pgm_exit(1,"ERROR: Uncased TYPE [$pltype]!\n"); } } return $errcnt; } sub test_patch_lines($$$$$) { my ($rh,$ff,$rcnt_stack,$rdifflines,$rpatchlines) = @_; my ($dcnt,$dline,$msg); my ($rca,$off1,$len1,$off2,$len2,$off,$endp2); my ($inpatch,$rpla,$pltype,$plline,$cpl_cnt,$prevline); my ($pladd,$pltot,$plsub,$msg2,$pstart); my ($i,$i2,$icnt,$bgnpatch,$endp1); my ($poff1,$plen1,$poff2,$plen2,$skcnt); my $rcnt = scalar @{$rcnt_stack}; my $maxplcnt = scalar @{$rpatchlines}; my $diffcnt = scalar @{$rdifflines}; $dcnt = 0; $inpatch = 0; $cpl_cnt = 0; # start at zero to maxplcnt $prevline = ''; $pladd = 0; $pltot = 0; $plsub = 0; $pstart = 0; my $revind = 0; my $roff = 0; # calculate REAL offset in OLDFILE my $jcnt = 0; $cpl_cnt = 0; # run a test my @newlines = (); my @patchedlines = (); my @patches = (); $i = 0; if (defined ${$rh}{$ff}) { my $rhh = ${$rh}{$ff}; ${$rhh}{'PATCHED_LINES'} = \@newlines; } else { pgm_exit(1,"ERROR: [$ff] NOT defined in ref hash!\n"); } # get FIRST set of lengths and offsets # ------------------------------------ $off = 0; if ($off < $rcnt) { $rca = ${$rcnt_stack}[$off]; $off1 = ${$rca}[0]; $len1 = ${$rca}[1]; $off2 = ${$rca}[2]; $len2 = ${$rca}[3]; $endp1 = $off1 + $len1; $endp2 = $off2 + $len2; $off++; } else { pgm_exit(1,"ERROR: No counts available! Aborting...\n"); } prt("\n") if (VERB9() || $dbg_05); prt("Test patch to [$ff] $diffcnt lines... $rcnt chunks, $maxplcnt lines...\n"); if ( ($off1 == 0) && ($len1 == 0) ) { prt("Patch CNTS (-$off1,$len1 +$off2,$len2) $endp1 of $diffcnt, $endp2 NEW FILE\n"); @patches = (); $dcnt = 0; prt("Storing length $len2 of $maxplcnt patch lines from [$in_file], begin at $cpl_cnt\n") if ($cpl_cnt < $maxplcnt); for ( ; $cpl_cnt < $maxplcnt; $cpl_cnt++) { $rpla = ${$rpatchlines}[$cpl_cnt]; $pltype = ${$rpla}[0]; # get TYPE of line 'S', '+', '-'... $plline = ${$rpla}[1]; # and the line $dcnt++; prt("$dcnt: $pltype [$plline]\n") if (VERB9() || $dbg_05); push(@patches,[$pltype,$plline]); last if ($dcnt == $len2); } merge_file_lines($ff,\@patchedlines,\@patches,\@newlines,$bgnpatch,\$roff); ### write_patched_file($rh,$ff); return $revind; } $skcnt = $off1; $skcnt -= 1 if ($skcnt); prt("Patch CNTS$off: (-$off1,$len1 +$off2,$len2) SKIP $skcnt\n"); while ( $i < $diffcnt ) { # prt("Patch CNTS (-$off1,$len1 +$off2,$len2) $endp1 of $diffcnt, $endp2\n"); #if ($off1 > 1) { if ($skcnt) { #prt("Skipping ".($off1-1)." lines in old file [$ff]\n"); prt("Skipping $skcnt lines in old file [$ff]\n"); $jcnt = 0; for ( ; $i < $diffcnt; $i++) { $dline = ${$rdifflines}[$i]; chomp $dline; $i2 = $i + 1; #last if ($i2 == $endp1); #last if ($jcnt == $endp1); push(@newlines,$dline); $roff++; # bump calc offset in OLDFILE $msg = "$roff:$i2: [$dline] stored as is and skipped"; prt("$msg\n") if (VERB9() || $dbg_05); $jcnt++; if ($jcnt == $skcnt) { $i++; # bump last; # and exit } } } else { prt("No lines ($len1,$off1 $len2,$off2) to skip in old file [$ff]\n"); } @patchedlines = (); prt("Storing length $len1 lines from old file [$ff], from $i of $diffcnt\n") if ($i < $diffcnt); $bgnpatch = $i + 1; $icnt = 0; for ( ;$i < $diffcnt ; $i++) { $dline = ${$rdifflines}[$i]; chomp $dline; $i2 = $i + 1; $icnt++; $msg = "$i2:$icnt: [$dline] "; prt("$msg\n") if (VERB9() || $dbg_06); push(@patchedlines,$dline); # last if ($icnt == $len1); if ($icnt == $len1) { $i++; last; } } @patches = (); $dcnt = 0; prt("Storing length $len2 of $maxplcnt patch lines from [$in_file], begin at $cpl_cnt\n") if ($cpl_cnt < $maxplcnt); for ( ; $cpl_cnt < $maxplcnt; $cpl_cnt++) { $rpla = ${$rpatchlines}[$cpl_cnt]; $pltype = ${$rpla}[0]; # get TYPE of line 'S', '+', '-'... $plline = ${$rpla}[1]; # and the line $dcnt++ if ($pltype ne '-'); prt("$dcnt: $pltype [$plline]\n") if (VERB9() || $dbg_07); push(@patches,[$pltype,$plline]); # last if ($dcnt == $len2); if ($dcnt == $len2) { $cpl_cnt++; last; } } if ($icnt || $dcnt) { merge_file_lines($ff,\@patchedlines,\@patches,\@newlines,$bgnpatch,\$roff); prt("Done merge "); if ($off < $rcnt) { prt("- continue to next..."); } elsif ($i < $diffcnt) { prt("- store balance next..."); } else { prt("- end."); } prt("\n"); } #if ($revind) { # prt("Appears this patch already applied!\n"); #} # get NEXT chunk to process if ($off < $rcnt) { $rca = ${$rcnt_stack}[$off]; $poff1 = $off1; $plen1 = $len1; $poff2 = $off2; $plen2 = $len2; $off1 = ${$rca}[0]; $len1 = ${$rca}[1]; $off2 = ${$rca}[2]; $len2 = ${$rca}[3]; $endp1 = $off1 + $len1; $endp2 = $off2 + $len2; $off++; $skcnt = $off1 - ($poff1 + $plen1); prt("Patch CNTS$off: (-$off1,$len1 +$off2,$len2) SKIP $skcnt\n"); } else { if ( $i < $diffcnt ) { prt("Store balance ".($diffcnt - $i)." lines from old file [$ff]\n"); for ( ; $i < $diffcnt; $i++) { $dline = ${$rdifflines}[$i]; chomp $dline; $i2 = $i + 1; push(@newlines,$dline); $msg = "$i2: [$dline] stored in new"; prt("$msg\n") if (VERB9() || $dbg_07); } } } } ### write_patched_file($rh,$ff); ### pgm_exit(1,"TEMP EXIT"); return $revind; } sub show_oldfile_lines($$$) { my ($rh,$ff,$rdifflines) = @_; my $oldlncnt = scalar @{$rdifflines}; if ($oldlncnt && (VERB9() || $dbg_03)) { # show the FILE LINE my ($msg); prt("\n") if (VERB9() || $dbg_11); prt("List $oldlncnt lines in [$ff] loaded for patching...\n"); $oldlncnt = 0; foreach $msg (@{$rdifflines}) { $oldlncnt++; chomp $msg; prt("$oldlncnt: [$msg]\n") if (VERB9() || $dbg_11); } } } # deal_with_patches($ff,\@cnt_stack,\@oldlines); sub deal_with_patches($$$$$) { my ($rh,$ff,$rcnt_stack,$rdifflines,$rpatchlines) = @_; my ($dcnt,$dline,$msg); my ($rca,$off1,$len1,$off2,$len2,$off,$endp); my ($inpatch,$rpla,$pltype,$plline,$cpl_cnt,$prevline); my ($pladd,$pltot,$plsub,$msg2,$pstart); my ($i,$i2,$rhh,$ffnew); my $rcnt = scalar @{$rcnt_stack}; my $maxplcnt = scalar @{$rpatchlines}; my $diffcnt = scalar @{$rdifflines}; if (defined ${$rh}{$ff}) { $rhh = ${$rh}{$ff}; if (defined ${$rhh}{'NEW_FILE'}) { $ffnew = ${$rhh}{'NEW_FILE'}; } else { pgm_exit(1,"ERROR: New file name to patch NOT in hash!\n"); } } else { pgm_exit(1,"ERROR: New file name to patch NOT in hash!\n"); } if (VERB9() || $dbg_02) { show_oldfile_lines($rh,$ff,$rdifflines); show_patch_lines($rh,$rdifflines,$rpatchlines,$rcnt_stack); } if ($diffcnt) { # was a NEW file loaded to patch # run the patching test_patch_lines($rh,$ff,$rcnt_stack,$rdifflines,$rpatchlines); write_patched_file($rh,$ff); } else { prt("No file [$ffnew] found to patch! Perhaps adjust --strip <num> (-p) paramter.\n"); } } sub process_in_file($) { my ($inf) = @_; if (! open INF, "<$inf") { pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); } my @lines = <INF>; close INF; my $lncnt = scalar @lines; prt("Processing $lncnt lines, from [$inf]...\n"); my ($line,$inc,$lnn,$ofiles,$lcnts,$aline,$mline,$sline,$pfile,$mfile); my ($indiff,$gotnums,$lnncnt,$plncnt,$mlncnt,$cntlnn,$tmp,$extra); my ($innums,$off1,$len1,$off2,$len2,$ccnt,$ncnt,$msg,$islast); my ($file1,$file2,$targd,$spfile,$smfile,$spfile2,$smfile2,@arr); my ($poff1,$plen1,$poff2,$plen2,$skcnt); my @oldlines = (); my @newlines = (); my ($newlncnt, $oldlncnt); my @cnt_stack = (); my @patchlines = (); my ($dline,$dcnt,$chunk_cnt,$newfile,$file_count); my $ffold = ''; # preceeded by '---' my $ffnew = ''; # preceeded by '+++' my %hash = (); my $rh = \%hash; $targd = $work_dir; if (length($targd)) { $targd .= $PATH_SEP if ( !($targd =~ /(\\|\/)$/) ); $targd = $path_function->($targd); } $indiff = 0; $gotnums = 0; $lnncnt = 0; $plncnt = 0; $mlncnt = 0; $innums = 0; $islast = 0; $lnn = 0; $cntlnn = 0; $lcnts = ''; $file1 = ''; $file2 = ''; $oldlncnt = 0; $newlncnt = 0; $chunk_cnt = 0; $newfile = 0; $file_count = 0; $off1 = $len1 = $off2 = $len2 = 0; foreach $line (@lines) { chomp $line; $lnn++; # assumption either a line begin # diff [options] file1 file2 # being with '@@...' the line counts # examples # @@ -1,4 +1,17 @@ and @@ -0,0 +1,138 @@ # begin with ' ', '+' or '-' = diff block # else ignore if ($line =~ /^diff\s+(.+)$/) { $ofiles = $1; $file1 = ''; $file2 = ''; get_diff_files($ofiles,\$file1,\$file2); if ($lnncnt || $plncnt || $mlncnt) { $ccnt = $lnncnt + $mlncnt; $ncnt = $lnncnt + $plncnt; #prt("$cntlnn: Prev CNTS ".($lnncnt + $mlncnt)." ".($lnncnt + $plncnt)." [$lcnts] ($off1,$len1 $off2,$len2)\n"); $msg = "$cntlnn: Prev CNT1 [$lcnts] ($off1,$len1 $off2,$len2) -$ccnt +$ncnt"; if (($ccnt == $len1) && ($ncnt == $len2)) { $msg .= " ok"; } elsif (($ncnt == $len1) && ($ccnt == $len2)) { $msg .= " okR"; } else { $msg .= " CHECK COUNTS!"; } $msg .= " -$oldlncnt -$newlncnt" if ($oldlncnt || $newlncnt); prt("$msg\n"); ### if ($oldlncnt) { my %h = (); my @a = @oldlines; $h{'OLD_LINES'} = \@a; $h{'OLD_FILE'} = $ffold; my @b = @newlines; $h{'NEW_LINES'} = \@b; $h{'NEW_FILE'} = $ffnew; $h{'PATCH_LINES'} = [ @patchlines ]; $h{'PATCH_FILE'} = $inf; my @c = @cnt_stack; $h{'COUNT_STACK'} = \@c; ${$rh}{$ffold} = \%h; deal_with_patches($rh,$ffold,\@cnt_stack,\@oldlines,\@patchlines); ###} else { ### prt("NO lines from [$ffold]\n") if (VERB9() || $dbg_02); ###} } # ok, start a NEW diff # ==================== $oldlncnt = 0; $file_count++; # this should ALWAYS be in the order 'oldFile' 'newFile' # the patch is intended to update the 'oldFile' to equal the 'newFile' # Such a patch applied can be 'reversed' - taken out - by -R $msg = "\n$lnn:$file_count: DIFF [$ofiles]"; if (length($file1) && length($file2)) { # note GNU patch IGNORES this 'diff ...' line #$spfile = strip_file_path($file1); #$ff .= $spfile; #if (-f $ff) { # @oldlines = (); # if (get_diff_file_lines($ff,\@oldlines)) { # $oldlncnt = scalar @oldlines; # $msg .= " found [$ff] $oldlncnt lines"; # } else { # $msg .= " found [$ff] but LOAD FAILED"; # } #} else { # $msg .= " [$ff] NOT FOUND!" #} } else { prtw("WARNING:$lnn: CHECK ME\nLine [$line] did NOT yield 2 files!\nGot 1 [$file1] 2 [$file2]\n"); } $msg .= " PATCH CNTS cleared"; prt("$msg\n"); $lnncnt = 0; $plncnt = 0; $mlncnt = 0; $lcnts = ''; $innums = 0; $islast = 0; $chunk_cnt = 0; @cnt_stack = (); # clear the COUNT stack $newfile = 0; # set when counts done @patchlines = (); } elsif ($line =~ /^\s{1}(.*)$/) { # SAME LINE $sline = $1; $lnncnt++; push(@patchlines,["S",$sline]); $ccnt = $lnncnt + $mlncnt; $ncnt = $lnncnt + $plncnt; $msg = "$lnn:$ccnt:$ncnt: S [$sline]"; if (($ccnt == $len1) && ($ncnt == $len2)) { $msg .= " last"; $islast = 1; } elsif (($ncnt == $len1) && ($ccnt == $len2)) { $msg .= " Rlast"; $islast = 1; } prt("$msg\n") if (VERB9() || $dbg_01); } elsif ($line =~ /^\+\+\+\s+(.*)$/) { # +++ NEW FILES $pfile = $1; $msg = "$lnn: PF [$pfile]"; @arr = space_split($pfile); $pfile = strip_quotes($arr[0]); if (length($pfile)) { $ffnew = $targd; $smfile2 = strip_file_path($pfile); $ffnew .= $smfile2; if (-f $ffnew) { @newlines = (); if (get_diff_file_lines($ffnew,\@newlines)) { $newlncnt = scalar @newlines; $msg .= " found [$ffnew] $newlncnt lines"; } else { $msg .= " found [$ffnew] but LOAD FAILED"; } } else { $msg .= " [$ffnew] NOT FOUND!" } } prt("$msg\n"); } elsif ($line =~ /^\+(.*)$/) { # ADDED LINE $aline = $1; $plncnt++; push(@patchlines,["+",$aline]); $ccnt = $lnncnt + $mlncnt; $ncnt = $lnncnt + $plncnt; prt("$lnn:$ccnt:$ncnt: + [$aline]\n") if (VERB9() || $dbg_01); } elsif ($line =~ /^---\s+(.+)\s*$/) { # --- OLD FILE $mfile = $1; $msg = "$lnn: MF [$mfile]"; @arr = space_split($mfile); $mfile = strip_quotes($arr[0]); if (length($mfile)) { $ffold = $targd; $smfile2 = strip_file_path($mfile); $ffold .= $smfile2; if (-f $ffold) { @oldlines = (); if (get_diff_file_lines($ffold,\@oldlines)) { $oldlncnt = scalar @oldlines; $msg .= " found [$ffold] $oldlncnt lines"; } else { $msg .= " found [$ffold] but LOAD FAILED"; } } else { $msg .= " [$ffold] NOT FOUND!" } } prt("$msg\n"); } elsif ($line =~ /^-(.*)$/) { # DELETE LINE $mline = $1; $mlncnt++; push(@patchlines,["-",$mline]); $ccnt = $lnncnt + $mlncnt; $ncnt = $lnncnt + $plncnt; prt("$lnn:$ccnt:$ncnt: - [$mline]\n") if (VERB9() || $dbg_01); } elsif ($line =~ /^\@\@\s+(.+)\s+\@\@\s*(.*)$/) { $tmp = $1; $extra = $2; # git puts this after the numbers - is actually the next line!!! # BUT is NOT included in the count!? if ($lnncnt || $plncnt || $mlncnt) { $ccnt = $lnncnt + $mlncnt; $ncnt = $lnncnt + $plncnt; #prt("$cntlnn: Prev CNT2 ".($lnncnt + $plncnt)." ".($lnncnt + $mlncnt)." [$lcnts] ($off1,$len1 $off2,$len2)\n"); $msg = "$cntlnn: Prev CNT2 [$lcnts] ($off1,$len1 $off2,$len2) -$ccnt +$ncnt"; if (($ccnt == $len1) && ($ncnt == $len2)) { $msg .= " ok"; } elsif (($ncnt == $len1) && ($ccnt == $len2)) { $msg .= " okR"; } else { $msg .= " CHECK COUNTS!"; } $msg .= " -$oldlncnt -$newlncnt" if ($oldlncnt || $newlncnt); prt("$msg\n"); } $lcnts = $tmp; $poff1 = $off1; $plen1 = $len1; $poff2 = $off2; $plen2 = $len2; get_counts($lcnts,\$off1,\$len1,\$off2,\$len2); $chunk_cnt++; # count another chunk $msg = "$lnn:$chunk_cnt: D\@CNTS [$lcnts] ($off1,$len1 $off2,$len2)"; $skcnt = $off1 - ($poff1 + $plen1); $skcnt -= 1 if ($skcnt && !@cnt_stack); if ( ($off1 == 0) && ($len1 == 0) ) { $newfile = 1; $msg .= " NEW file, so should be NOT FOUND!"; push(@new_files,$ffold); } else { $msg .= " skip $skcnt"; } prt("$msg\n"); push(@cnt_stack, [ $off1, $len1, $off2, $len2 ]); # add counts to patch line - to separate chunks # push(@patchlines,["N", "$off1, $len1, $off2, $len2"]); $lnncnt = 0; $plncnt = 0; $mlncnt = 0; $cntlnn = $lnn; $innums = 1; prt("$lnn: s [$extra] (but NOT in count)\n") if ( $extra && length($extra) ) } elsif ($line =~ /^index\s+/) { # git ' index ...' line } elsif ($line =~ /^\\\s+/) { prt("$lnn: DC [$line]\n"); } else { prt("$lnn: ??? [$line] CHECK THIS\n"); } } # END OF PATCH FILE - deal with last diff found if ($lnncnt || $plncnt || $mlncnt) { $ccnt = $lnncnt + $mlncnt; $ncnt = $lnncnt + $plncnt; #prt("$cntlnn: Prev CNTS ".($lnncnt + $mlncnt)." ".($lnncnt + $plncnt)." [$lcnts] ($off1,$len1 $off2,$len2)\n"); $msg = "$cntlnn: Prev CNTE [$lcnts] ($off1,$len1 $off2,$len2) -$ccnt +$ncnt"; if (($ccnt == $len1) && ($ncnt == $len2)) { $msg .= " ok"; } elsif (($ncnt == $len1) && ($ccnt == $len2)) { $msg .= " okR"; } else { $msg .= " CHECK COUNTS!"; } $msg .= " -$oldlncnt -$newlncnt" if ($oldlncnt || $newlncnt); prt("$msg\n"); if (!$oldlncnt) { prt("NO lines from [$ffold]\n") if (VERB9() || $dbg_02); } my %h = (); my @a = @oldlines; $h{'OLD_LINES'} = \@a; $h{'OLD_FILE'} = $ffold; my @b = @newlines; $h{'NEW_LINES'} = \@b; $h{'NEW_FILE'} = $ffnew; $h{'PATCH_LINES'} = [ @patchlines ]; $h{'PATCH_FILE'} = $inf; my @c = @cnt_stack; $h{'COUNT_STACK'} = \@c; ${$rh}{$ffold} = \%h; deal_with_patches($rh,$ffold,\@cnt_stack,\@oldlines,\@patchlines); } # SHOW any NEW files found in the 'patch' file - like '@@ -0,0 +n,n @@' ${$rh}{'NEW_FILES_IN_PATCH'} = \@new_files; return $rh; } sub show_ref_hoh($$) { my ($inf,$rh) = @_; # SHOW any NEW files found in the 'patch' file - like '@@ -0,0 +n,n @@' my ($ra,$ncnt,$ffold,$type,$val); my %done = (); $ncnt = scalar keys($rh); prt("\nRef has contains $ncnt keys...\n"); if ( defined ${$rh}{'NEW_FILES_IN_PATCH'} ) { $ra = ${$rh}{'NEW_FILES_IN_PATCH'}; $ncnt = scalar @{$ra}; if ($ncnt) { prt("Patch file [$inf] lists $ncnt NEW files...\n"); $ncnt = 0; foreach $ffold (sort @{$ra}) { $ncnt++; prt("$ncnt: [$ffold]\n"); $done{$ffold} = 1; } } } my @diff_list = (); foreach $ffold (keys %{$rh}) { $val = ${$rh}{$ffold}; $type = ref $val; if ($type eq 'HASH') { if ( ! defined $done{$ffold} ) { $done{$ffold} = 1; push(@diff_list,$ffold); } } } $ncnt = scalar @diff_list; prt("\nPatch file [$inf] lists $ncnt DIFF files...\n"); $ncnt = 0; foreach $ffold (sort @diff_list) { $ncnt++; prt("$ncnt: [$ffold]\n"); } } ######################################### ### MAIN ### parse_args(@ARGV); my $ref_hoh = process_in_file($in_file); show_ref_hoh($in_file,$ref_hoh); pgm_exit(0,""); ######################################## sub need_arg { my ($arg,@av) = @_; pgm_exit(1,"ERROR: [$arg] must have a following argument!\n") if (!@av); } sub parse_args { my (@av) = @_; my ($arg,$sarg); while (@av) { $arg = $av[0]; if ($arg =~ /^-/) { $sarg = substr($arg,1); $sarg = substr($sarg,1) while ($sarg =~ /^-/); if (($sarg =~ /^h/i)||($sarg eq '?')) { give_help(); pgm_exit(0,"Help exit(0)"); } elsif ($sarg =~ /^v/) { if ($sarg =~ /^v.*(\d+)$/) { $verbosity = $1; } else { while ($sarg =~ /^v/) { $verbosity++; $sarg = substr($sarg,1); } } prt("Verbosity = $verbosity\n") if (VERB1()); } elsif ($sarg =~ /^l/) { $load_log = 1; prt("Set to load log at end.\n") if (VERB1()); } elsif ($sarg =~ /^d/) { need_arg(@av); shift @av; $sarg = $av[0]; $work_dir = $sarg; prt("Set work directory to [$work_dir].\n") if (VERB1()); pgm_exit(1,"ERROR: Work directory [$work_dir] DOES NOT EXIST!\n") if (! -d $work_dir); } elsif (($sarg =~ /^p/)||($sarg eq 'strip')) { need_arg(@av); shift @av; $sarg = $av[0]; if ($sarg =~ /^\d+$/) { $strip_count = $sarg; } else { pgm_exit(1,"ERROR: Argument $arg MUST be followed by an integer NUMBER! (not $sarg)\n"); } #} elsif (($sarg eq 'reverse')||($sarg eq 'R')) { # $files_reversed = 1; # prt("Set to reverse new old files.\n"); } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { $in_file = $arg; prt("Set input to [$in_file]\n") if (VERB1()); } shift @av; } if ((length($in_file) == 0) && $debug_on) { $in_file = $def_file; prt("Set DEFAULT input to [$in_file]\n"); } if (length($in_file) == 0) { pgm_exit(1,"ERROR: No input files found in command!\n"); } if (! -f $in_file) { pgm_exit(1,"ERROR: Unable to find in file [$in_file]! Check name, location...\n"); } } sub patch_help { my $txt = <<EOF; patch is used on a 'context diff' or 'unified diff' (unidiffs), so \$ diff -u oldFile newFile > mods.diff \$ patch < mods.diff # apply the patches This will modify the 'oldFile' to match the 'newFile' The mods.diff file will start with diff -u oldFile newFile --- oldFile date time +++ newFile date time New lines will be added, and removed lines deleted and modified lines exchanged After patch 'oldFile' and 'newFile' will be the SAME A patch can be reversed using -R, in which case the effects of the patch will be reversed - taken out C:\\FGCVS>patch --help Usage: patch [OPTION]... [ORIGFILE [PATCHFILE]] Input options: -p NUM --strip=NUM Strip NUM leading components from file names. -F LINES --fuzz LINES Set the fuzz factor to LINES for inexact matching. -l --ignore-whitespace Ignore white space changes between patch and input. -c --context Interpret the patch as a context difference. -e --ed Interpret the patch as an ed script. -n --normal Interpret the patch as a normal difference. -u --unified Interpret the patch as a unified difference. -N --forward Ignore patches that appear to be reversed or already applied. -R --reverse Assume patches were created with old and new files swapped. -i PATCHFILE --input=PATCHFILE Read patch from PATCHFILE instead of stdin. Output options: -o FILE --output=FILE Output patched files to FILE. -r FILE --reject-file=FILE Output rejects to FILE. -D NAME --ifdef=NAME Make merged if-then-else output using NAME. -E --remove-empty-files Remove output files that are empty after patching. -Z --set-utc Set times of patched files, assuming diff uses UTC (GMT). -T --set-time Likewise, assuming local time. --quoting-style=WORD output file names using quoting style WORD. Valid WORDs are: literal, shell, shell-always, c, escape. Default is taken from QUOTING_STYLE env variable, or 'shell' if unset. Backup and version control options: -b --backup Back up the original contents of each file. --backup-if-mismatch Back up if the patch does not match exactly. --no-backup-if-mismatch Back up mismatches only if otherwise requested. -V STYLE --version-control=STYLE Use STYLE version control. STYLE is either 'simple', 'numbered', or 'existing'. -B PREFIX --prefix=PREFIX Prepend PREFIX to backup file names. -Y PREFIX --basename-prefix=PREFIX Prepend PREFIX to backup file basenames. -z SUFFIX --suffix=SUFFIX Append SUFFIX to backup file names. -g NUM --get=NUM Get files from RCS etc. if positive; ask if negative. Miscellaneous options: -t --batch Ask no questions; skip bad-Prereq patches; assume reversed. -f --force Like -t, but ignore bad-Prereq patches, and assume unreversed. -s --quiet --silent Work silently unless an error occurs. --verbose Output extra information about the work being done. --dry-run Do not actually change any files; just print what would happen. --posix Conform to the POSIX standard. --unified-reject-files Create unified reject files. --global-reject-file=file Put all rejects into one file. -d DIR --directory=DIR Change the working directory to DIR first. --binary Read and write data in binary mode (no effect on this platform). -v --version Output version info. --help Output this help. Report bugs to <bug-patch\@gnu.org>. Report bugs of this Windows port to <reports\@geoffair.info>. EOF return $txt; } sub give_help { prt("$pgmname: version $VERS\n"); prt("Usage: $pgmname [options] in-file\n"); prt("Options:\n"); prt(" --help (-h or -?) = This help, and exit 0.\n"); prt(" --dir <dir> (-d) = Set WORK directory.\n"); # prt(" --reverse (-R) = Assume patch created with old and new reversed.\n"); prt(" --strip <num> (-p) = Strip leading path count.\n"); prt(" --verb[n] (-v) = Bump [or set] verbosity. def=$verbosity\n"); prt(" --load (-l) = Load LOG at end. ($outfile)\n"); #prt(" --out <file> (-o) = Write output to this file.\n"); } # BOM Representations of byte order marks by encoding # UTF-8 EF BB BF 239 187 191 # UTF-16 (BE) FE FF 254 255 # UTF-16 (LE) FF FE 255 254 # UTF-32 (BE) 00 00 FE FF 0 0 254 255 # UTF-32 (LE) FF FE 00 00 255 254 0 0 # UTF-7 2B 2F 76 38 2B 2F 76 39 2B 2F 76 2B 2B 2F 76 2F # UTF-1 F7 64 4C 247 100 76 # UTF-EBCDIC DD 73 66 73 221 115 102 115 # SCSU 0E FE FF 14 254 255 # BOCU-1 FB EE 28 251 238 40 # GB-18030 84 31 95 33 132 49 149 51 # eof - patchit.pl