- eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
- & eval 'exec perl -S $0 $argv:q'
- if 0;
- # THE PRECEEDING STUFF EXECS perl via $PATH
- # -*-Fundamental-*-
- # $Id: //guest/richard_geiger/utils/cvs2p4/bin/srcdiff#29 $
- select STDERR; $| = 1; select STDOUT; $| = 1;
- require 5.000;
- require "timelocal.pl";
- use Carp; # ...or flounder. (This will fail unless 'perl' is a perl5!)
- #use bytes;
- use File::Basename;
- ($Myname = $0) =~ s%^.*/%%;
- $Mydir = dirname($0);
- $Here = `/bin/pwd`; chomp $Here;
- if ($Mydir ne ".") { chdir "$Mydir" || die "$Myname: can't chdir \"$Mydir\": $!"; }
- chdir ".." || die "$Myname: can't chdir \"..\": $!";
- $Mydir = `/bin/pwd`; chop $Mydir;
- chdir $Here || die "$Myname: can't chdir \"$Here\": $!";
- my $revpat;
- require "$Mydir/lib/util.pl";
- # A default EXT list; will be overlayed with the list in in the "config" file,
- # if present.
- #
- $EXT = <<EXTS;
- a
- bin
- bmp
- class
- coff
- com
- crt
- dll
- doc
- dvi
- dwarf
- exe
- fm
- gif
- gz
- ico
- img
- jar
- jpg
- lib
- mcp
- o
- obj
- opt
- ps
- rsrc
- stg
- tar
- tdt
- xbm
- xls
- zip
- z
- EXTS
- @EXT = split(/\n/, $EXT); foreach my $ext (@EXT) { $EXT{$ext} = 1; }
- $Usage = <<LIT;
- $Myname: usage:
- $Myname -cvsdir cvsdir -p4dir p4dir [-tracelev n] [-repint n]
- $Myname -config <file> [-tracelev n] [-repint n]
- $Myname -help
- LIT
- sub usage
- {
- print STDERR $Usage;
- exit 1;
- }
- sub help
- {
- print STDERR <<LIT;
- $Usage
- "repint" is the reporting interval - print a progress report after
- comparing every n files.
- LIT
- exit 1;
- }
- $First = ".";
- $Go = 1;
- $ren_hack = "_reTUrn_";
- sub same
- {
- my ($f1, $f2) = @_;
- my ($f1_ext) = ($f1 =~ /\.([^\.]+)$/);
- $f1_ext =~ tr/A-Z/a-z/;
- if ((! (-T $f1 && -T $f2)) || defined($EXTS{$f1_ext}) || defined($NOKEYEXP_PATHNAME{$f1}))
- {
- $f1 =~ s/"/\\"/g;
- $f2 =~ s/"/\\"/g;
- # This awful hack is because I can't get the perl open function to
- # open a file with a \r in the filename! I'm sorry!
- #
- $f2nam = $f2;
- if ($f2 =~ m/\r/)
- {
- $f2nam =~ s/\r/$ren_hack/g;
- rename($f2, $f2nam) || die "rename \$f2, \$f2nam";
- }
- my $cmd = "/usr/bin/cmp \"$f1\" \"$f2nam\"";
- # Alas, the fall foul of the shell!:
- #
- $cmd =~ s/\$/\\\$/g;
- #print STDERR "$Myname: binary compare: $cmd\n";
- my $sts = (! (system "$cmd"));
- if ( (-x $f1) ^ (-x $f2nam))
- {
- print STDOUT "$Myname: different x modes: <$f1> <$f2nam>\n";
- return 0;
- }
- # Flip the name back, after the compare/stat:
- #
- if ($f2nam =~ /$ren_hack/o)
- { rename($f2nam, $f2) || die "rename \$f2nam, \$f2"; }
- return $sts;
- }
- #print STDERR "$Myname: text compare: $f1 $f2\n";
- if (! open(Y, "<$f1"))
- { print STDERR "$Myname: can't open \"$f1\": $!\n"; exit 1; return 0; }
- # This awful hack is because I can't get the perl open function to
- # open a file with a \r in the filename! I'm sorry!
- #
- $f2nam = $f2;
- if ($f2 =~ m/\r/)
- {
- $f2nam =~ s/\r/$ren_hack/g;
- rename($f2, $f2nam) || die "rename \$f2, \$f2nam";
- }
- if (! open(T, "<$f2nam"))
- { close Y; print STDERR "$Myname: can't open \"$f2nam\": $!\n"; exit 1; return 0; }
- my $sts = 1;
- if ( (-x $f1) ^ (-x $f2nam))
- {
- print STDOUT "$Myname: different x modes: <$f1> <$f2nam>\n";
- $sts = 0;
- }
- # Flip the name back, after the open/stat:
- #
- if ($f2nam =~ /$ren_hack/o)
- { rename($f2nam, $f2) || die "rename \$f2nam, \$f2"; }
- $tstash = "";
- line: while (<Y>)
- {
- $y_ = $_;
- if ($tstash)
- { $t = $tstash; $tstash = ""; }
- else
- { $t = <T>; }
- $t_ = $t;
- # This is to handle a special case noticed in IronPort's
- # cvsroot/doug/ata/freebsd/sys/contrib/dev/oltr (Perhaps from
- # using Log in a file checked in from Windows?) Anyway, I'm
- # pretty confident this will detect and correctly handle this
- # case, without perturbing the "normal" cases.
- #
- if ($y_ =~ /\r$/ && $t_ !~ /\r$/)
- { $use_cr = 1; }
- else
- { $use_cr = 0; }
- $y_ =~ s/\$(Author|Date|Header|Id|Locker|Log|Name|RCSfile|Revision|Source|State)\b[^\$]*\$\r?/\$XXX\$/g;
- $t_ =~ s/\$(Author|Date|Header|Id|Locker|Log|Name|RCSfile|Revision|Source|State)\b[^\$]*\$\r?/\$XXX\$/g;
- # Similar to the special case noted above...
- # We only do this if we see $XXX$ (likely from the replacement above),
- # so that we'll still catch any other line-end mismatches.
- #
- # $t_ =~ s/\$XXX\$\r$/\$XXX\$/;
- # $t_ =~ s/\$XXX\$\r/\$XXX\$/;
- if ($y_ ne $t_)
- {
- close Y;
- close T;
- print STDOUT "$Myname: compare mismatch <$f1> vs <$f2>\n";
- $sts = 0;
- last line;
- }
- if ($t =~ /\$Log\b[^\$]*\$/ && $t !~ /\\\$Log\\\$/)
- {
- <T>;
- while ($t_ = <T>)
- {
- $last = 0;
- if ($use_cr)
- { if ($t_ =~ /\*\r/) { next line; } } # Drop the *\r in this case!
- elsif ($t_ =~ /Revision/ || $t_ =~ /\*[\/]/)
- { $tstash = $t_; next line; }
- }
- }
- }
- $t_ = <T>;
- close Y; close T;
- if ($t_ ne "")
- {
- print STDOUT "$Myname: compare mismatch <$f1> vs <$f2>\n";
- $sts = 0;
- }
- return $sts;
- }
- sub traverse
- {
- local($dir, $lev, $onfile, $ondir, $onsymlink) = @_;
- local($dirent);
- local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
- $atime,$mtime,$ctime,$blksize,$blocks);
- local($dirhandle) = "dh$lev";
- opendir($dirhandle, $dir);
- while (($dirent = readdir($dirhandle)))
- {
- if ($dirent eq "." || $dirent eq "..") { next; }
- ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
- $atime,$mtime,$ctime,$blksize,$blocks) = lstat("$dir/$dirent");
- typsw:
- {
- -f _ && do
- {
- if ($Go && defined(&$onfile)) { &$onfile("$dir", "$dirent", $lev); }
- last typsw;
- } ;
- -d _ && do
- {
- if (defined(&$ondir)) { &$ondir("$dir", "$dirent", $lev); }
- if ($lev == 0 && $dirent =~ /$First/) { $Go = 1; }
- if ($Go) { do traverse("$dir/$dirent", $lev+1, $onfile, $ondir, $onsymlink) if -d _; }
- last typsw;
- } ;
- -l "$dir/$dirent" && do
- {
- if ($Go && defined(&$onsymlink)) { &$onsymlink("$dir", "$dirent", $lev); }
- last typsw;
- } ;
- }
- }
- closedir($dirhandle);
- }
- $Ndiff = 0;
- $Nchecked = 0;
- sub dir
- {
- my($dir, $file, $lev) = @_;
- if ($file eq "CVS") { return; }
- my($path) = "$dir/$file";
- $path =~ s/^\.\///;
- my($rpath) = "$Here/$path";
- if ($lev < $Tracelev) { printf STDERR "$Myname: checking in $path\n"; }
- }
- sub check
- {
- my($dir, $file, $lev) = @_;
- my $dirbase;
- ($dirbase = $dir) =~ s%^.*/%%;
- if ($dirbase eq "CVS") { return; }
- if ($file =~ /\.o$/) { return; }
- if ($file eq ".cvsignore") { return; }
- if ($file =~ /\.cvsignore$/) { return; }
- my($path) = "$dir/$file";
- $path =~ s/^\.\///;
- my($rpath) = "$P4CLI/$path";
- # Handle special pathname cases...
- #
- $rpath =~ s/\r/%0d/g;
- $rpath =~ s/\.\.\./,,,/g;
- $rpath = &p4_esc($rpath, 1);
- if (! -e $rpath)
- {
- print STDOUT "$Myname: *** Missing: $rpath\n";
- $Ndiff++;
- }
- elsif (! &same("$rpath", "$path"))
- {
- print STDOUT "$Myname: different: $rpath\n";
- $Ndiff++;
- }
- # else
- # { print STDOUT "$Myname: OK: $rpath\n"; }
- $Nchecked++;
- if (($Nchecked % $Repint) == 0) { &report("progress"); }
- }
- sub ts
- {
- my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
- return sprintf("%04d/%02d/%02d_%02d:%02d:%02d", $year+1900, $mon+1, $mday, $hour, $min, $sec); }
- sub report
- {
- my ($status) = @_;
- if ($status) { $status .= " "; }
- printf STDERR "$Myname: $status: %s checked $Nchecked files; found $Ndiff diffs.\n", &ts;
- }
- sub mkd
- {
- my($dir, $mode) = @_;
- mkdir($dir, $mode) || &fail("can't mkdir \"$dir\": $!\n");
- printf(STDERR "> mkdir %s, %04o\n", $dir, $mode);
- }
- # insure that the directory(s) required to store path "$dir" exist.
- # if $dir" or any require parent in the $dir pathname do not exist,
- # created them with the specified mode.
- #
- sub insdir
- {
- my($dir, $insmode) = @_;
- if (! $insmode) { $insmode = 0775; }
- if (! -e $dir)
- {
- &insdir(&dirname($dir), $insmode);
- &mkd($dir, $insmode);
- return;
- }
- # So, it already exists, is it a dir?
- if (! -d $dir) { die("existing \"$dir\" is not a directory\n"); }
- if (! $insmode) { return; }
- # Last thing to insure is the mode...
- my(@stat) = stat($dir) || die("can't stat \"$dir\": $!\n");
- if (($stat[2] & 0777) == $insmode) { return; }
- chmod $insmode, $dir || die("can't chmod \"$dir\": $!\n");
- }
- sub dosystem
- {
- my ($cmd, $cont) = @_;
- my $sts;
- print "$Myname> $cmd\n";
- if ($sts = system($cmd))
- {
- if (! $cont) { die "$Myname: dosystem(): command <$cmd> returned nonzero"; }
- }
- return $sts;
- }
- sub cvs_checkout
- {
- my ($module, $branch, $tag) = @_;
- $branch =~ s/^import\///;
- if ($tag eq "-") { $tag = ""; }
- &insdir($CVSCLI);
- chdir $CVSCLI || die "chdir $CVSCLI";
- $cotag = "";
- if ($tag)
- { $cotag = " -r$tag"; }
- elsif ($branch && $branch ne "main")
- { $cotag = " -r$branch"; }
- &dosystem("/bin/rm -rf *");
- &dosystem("CVSROOT=$CVSROOT cvs checkout$cotag $module >/dev/null 2>&1");
- }
- my $p4d_up;
- sub depot_for
- {
- my ($module) = @_;
- my $depot = $P4_DEPOT;
- if (defined($Depotmap{$module}))
- { $depot = $Depotmap{$module}; }
- $depot =~ s/^\/\///;
- return $depot;
- }
- $IS_IMPORT_BRANCH{"BEST_PRACTICAL"} = 1;
- sub p4_checkout
- {
- my ($module, $branch, $tag) = @_;
- my $ret;
- if ($tag eq "-") { $tag = ""; }
- # So, is the server running?
- #
- if (! $p4d_up)
- {
- if (&dosystem("p4 -u $P4USER -p $P4PORT info >/dev/null 2>&1", 1))
- {
- chdir($P4ROOT) || die "chdir $P4ROOT";
- &dosystem("p4d -p $P4PORT -d -q -L log -J journal");
- print STDERR "Started Perforce server.\n";
- }
- $p4d_up = 1;
- }
- &insdir($P4CLI);
- chdir $P4CLI || die "chdir $CVSCLI";
- &dosystem("p4 -u $P4USER -p $P4PORT client -d -f $P4CLIENT >/dev/null 2>&1", 1);
- &dosystem("/bin/rm -rf *");
- &dosystem("/bin/echo P4PORT=$P4PORT > P4ENV");
- &dosystem("/bin/echo P4CLIENT=$P4CLIENT >> P4ENV");
- &dosystem("/bin/echo P4USER=$P4USER >> P4ENV");
- open(CLI_O, "p4 -u $P4USER -p $P4PORT client -o $P4CLIENT |") || die "can't open p4 client -o";
- open(CLI_I, "| p4 -u $P4USER -p $P4PORT client -i") || die "can't open p4 client -i";
- my @branches;
- # This gotta learn to love tags!:
- #
- if ($tag)
- {
- my $tagsinfo = `/usr/bin/grep ^$tag $TAGS 2>&1`;
- chomp $tagsinfo;
- if (! $tagsinfo)
- {
- print STDERR "$Myname: WARNING: tag \"$tag\" not found in $TAGS.\n".
- "$Myname: all branches will be mapped in the client.\n";
- push(@branches, "*");
- }
- else
- {
- print "TAGSINFO $tagsinfo\n";
- my (@tagsflds) = split(/\s+/, $tagsinfo);
- my @tbranches = split(/\001/, $tagsflds[1]);
- #print "\$#tbranches = $#tbranches\n";
- #foreach my $b (@tbranches)
- #{ print " b = $b\n"; }
- #die;
- if ($#tbranches == 0 && $tbranches[0] eq "UNMAPPED")
- { push(@branches, "*"); }
- else
- {
- foreach my $branch (@tbranches)
- {
- if ($branch ne "UNMAPPED") { push(@branches, $branch); }
- }
- }
- }
- }
- else
- { push(@branches, $branch); }
- while (<CLI_O>)
- {
- if (/^Root:/) { print CLI_I "Root: $P4CLI\n"; next; }
- if (/^View:/) { last; }
- print CLI_I;
- }
- close CLI_O;
- print CLI_I "View:\n";
- print STDERR "$Myname: View:\n";
- my $overlay = "";
- my $rhs_path;
- foreach my $branch (@branches)
- {
- print "DEBUG LOOP branch <$branch>\n";
- #srcdiff: View:
- #DEBUG LOOP branch <main>
- #srcdiff: //user/doug/main/... //srcdiff/user/doug/main/...
- #DEBUG LOOP branch <BEST_PRACTICAL>
- #srcdiff: +//import/doug/... //srcdiff/user/doug/...
- #Client srcdiff saved.
- my $depot;
- if ($IS_IMPORT_BRANCH{$branch})
- {
- $depot = "import";
- $pbranch = $branch;
- $pmodule = "";
- $mslash = "";
- }
- else
- {
- $depot = &depot_for($module);
- $pbranch = $branch;
- $pmodule = $module;
- $mslash = "/";
- }
- if (! $rhs_path) { $rhs_path = "$depot/$branch"; }
- if ($depot eq $module)
- {
- $pmodule = "";
- $mslash = "";
- }
- if ($depot eq "user")
- {
- # This makes me dizzy
- $rhs_path = "$depot/$module";
- my $tmp = $branch;
- $pbranch = $module;
- $pmodule = $branch
- }
- my $lpmodule = "$pmodule";
- if ($depot eq "import") { $lpmodule = "main/"; }
- print STDERR "$Myname: \t$overlay//$depot/$pbranch/$pmodule$mslash... //srcdiff/$rhs_path/$lpmodule$mslash...\n";
- print CLI_I "\t$overlay//$depot/$pbranch/$pmodule$mslash... //srcdiff/$rhs_path/$lpmodule$mslash...\n";
- if (! $ret) { $ret = "$rhs_path/$lpmodule"; }
- $overlay = "+";
- }
- close CLI_I;
- if ($?) { die "p4 client -i"; }
- if ($tag)
- { $spec = "\@$tag"; }
- else
- { $spec = "#head"; }
- &dosystem("p4 -u $P4USER -p $P4PORT -c $P4CLIENT sync //...$spec >/dev/null");
- # my $ret = "$rhs_path";
- # if ($module) { $ret .= "/$module"; }
- return $ret;
- }
- # option switch variables get defaults here...
- (@pwent) = getpwuid($<);
- if ($#pwent < 7)
- {
- print STDERR "$Myname: can't get your passwd file entry.\n";
- exit 1;
- }
- $Username = $pwent[0];
- $P4CLI = "";
- $CVSCLI =".";
- $Repint = 1000;
- $Tracelev = 0;
- while ($#ARGV >= 0)
- {
- if ($ARGV[0] eq "-boolopt") { $Boolopt = 1; shift; next; }
- elsif ($ARGV[0] eq "-repint")
- {
- shift; if ($ARGV[0] < 0) { &usage; }
- $Repint = $ARGV[0]; shift; next;
- }
- elsif ($ARGV[0] eq "-tracelev")
- {
- shift; if ($ARGV[0] < 0) { &usage; }
- $Tracelev = $ARGV[0]; shift; next;
- }
- elsif ($ARGV[0] eq "-cvsdir")
- {
- shift; if ($ARGV[0] < 0) { &usage; }
- $CVSCLI = $ARGV[0]; shift; next;
- }
- elsif ($ARGV[0] eq "-p4dir")
- {
- shift; if ($ARGV[0] < 0) { &usage; }
- $P4CLI = $ARGV[0]; shift; next;
- }
- elsif ($ARGV[0] eq "-config")
- {
- shift; if ($ARGV[0] < 0) { &usage; }
- $Config = $ARGV[0]; shift; next;
- }
- elsif ($ARGV[0] eq "-help")
- { &help; }
- elsif ($ARGV[0] =~ /^-/) { &usage; }
- if ($Args ne "") { $Args .= " "; }
- push(@Args, $ARGV[0]);
- shift;
- }
- $Here = `/bin/pwd`; chop $Here;
- if ($Config)
- {
- my $Configdir = &dirname($Config);
- require "$Configdir/config";
- require "$Config";
- foreach $_ (@Cases)
- {
- chomp $case;
- if (/^\s*#/ || /^\s*$/) { next; }
- my ($module, $branch, $tag) = split(/\s+/, $_);
- print STDERR "\n$Myname: ===== module $module ===== branch $branch ===== tag $tag =====\n";
- my $p4_path = &p4_checkout($module, $branch, $tag);
- &cvs_checkout($module, $branch, $tag);
- &dosystem("$Mydir/bin/$Myname -cvsdir $CVSCLI/$module -p4dir $P4CLI/$p4_path");
- }
- exit 0;
- }
- if (! -d $P4CLI) { print "No directory <$P4CLI>\n"; &usage; }
- chdir $P4CLI || die "Can't chdir $P4CLI: $!";
- $P4CLI = `/bin/pwd`;
- chomp($P4CLI);
- chdir $Here || die "Can't chdir $Here: $!";
- print STDERR "$Myname: starting...\n";
- chdir "$CVSCLI" || die "Can't chdir $CVSCLI: $!";
- &traverse(".", 0, "check", "dir", undef);
- &report(" summary");
- print STDERR "$Myname: done.\n";
- exit ($Ndiff > 0);
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#29 | 5851 | Richard Geiger | now detects x bit mismatches. | 18 years ago | |
#28 | 5761 | Richard Geiger | return a meaningful exist status, nonzero if any diffs or missing files were found (or mi...ssing). Hey John, I'm considring srcdiff to be part of the cvs2p4 tools, so I maintain it here on the Perforce Public Depot. Since the Public Depot is running basically the same p4notifyd we are using here (I wrote it), I can say "cc:", see!?: cc: jshuping@ironport.com, rmg@ironport.com « |
18 years ago | |
#27 | 5730 | Richard Geiger | Handle a special case that was causing false positives. | 18 years ago | |
#26 | 5712 | Richard Geiger |
Handle Pathhacks in srcdiff & dolabels. Moves sub Pathhacks() into util.pl |
18 years ago | |
#25 | 5688 | Richard Geiger | consistently invoke perl via PATH | 18 years ago | |
#24 | 5644 | Richard Geiger | checkpoint | 19 years ago | |
#23 | 5641 | Richard Geiger | debug cruft removal | 19 years ago | |
#22 | 5640 | Richard Geiger |
Better comments in the config files. Fix an asymtompatic bug in srcdiff. |
19 years ago | |
#21 | 5625 | Richard Geiger | Fixes to srcdiff for handling $ and/or \r in CVS pathnames. | 19 years ago | |
#20 | 5622 | Richard Geiger | Yet another labels fix. | 19 years ago | |
#19 | 5621 | Richard Geiger | Handles getting p4 workspace for "cvs import" branch names. | 19 years ago | |
#18 | 5615 | Richard Geiger | more depot mapping fixes. | 19 years ago | |
#17 | 5588 | Richard Geiger | checkpoint the latest. This includes a rework of the label-heursitical stuff that seems t...o work better. « |
19 years ago | |
#16 | 5586 | Richard Geiger | fix progress reportage... | 19 years ago | |
#15 | 5583 | Richard Geiger |
Handle "..." in CVS pathnames by changing them to ",,,"s. "Works for me!" |
19 years ago | |
#14 | 5580 | Richard Geiger | Tweaks & debugging fixes from the IP 2006/07/06 trial. | 19 years ago | |
#13 | 5577 | Richard Geiger | Added the -confg <config> option for auto-running a series of checkout/comparisons.... Former usage still gets the same behavior. « |
19 years ago | |
#12 | 5563 | Richard Geiger | Life is a corner case. "UNMAPPED-COLLISION tags in tags.txt now indicate what collided bet...ter. Fix srcdiff to handle odd Log expansion corner case that was causing flase positives. « |
19 years ago | |
#11 | 5556 | Richard Geiger | Should make it honor the list form the config file! | 19 years ago | |
#10 | 5542 | Richard Geiger | checkpointing progress. | 19 years ago | |
#9 | 5537 | Richard Geiger | Decruft and tighten the regexps which were observed to have choked to product a spurious... "files differ" case. « |
19 years ago | |
#8 | 5535 | Richard Geiger | ignore .cvsignore files by default. | 19 years ago | |
#7 | 5533 | Richard Geiger | wack dead code. | 19 years ago | |
#6 | 5531 | Richard Geiger | A significant checkpoint commit, with new improved handling of import vendor branches, an...d revisions present in main by virtue of multiple vendor drops to a file with no local mods. test/runtest works, with new refernece results pretty well scrutinized. « |
19 years ago | |
#5 | 5292 | Richard Geiger | Fix a couple of misaligned } s. | 19 years ago | |
#4 | 5278 | Richard Geiger |
fix problem with compares of binary files with spaces in the filenames |
19 years ago | |
#3 | 5270 | Richard Geiger | Add some simple usage information, for goodness sake! | 19 years ago | |
#2 | 4930 | Richard Geiger | Oops, make this puppy kxtext. | 20 years ago | |
#1 | 4929 | Richard Geiger | For comparing pre- and post- conversion trees. Needs a oince-over before I release it as... part of cvs2p4... « |
20 years ago |