#!/usr/bin/perl # -*-Fundamental-*- @binary_exts = split(/\n/, <<EOFEOFEOF); img tst crt exe a tdt stg mcp opt EOFEOFEOF $binary_exts = join("|", @binary_exts); # $Id: //guest/richard_geiger/utils/cvs2p4/bin/srcdiff#14 $ select STDERR; $| = 1; select STDOUT; $| = 1; use Carp; $| = 1; use File::Basename; ($Myname = $0) =~ s%^.*/%%; $Mydir = dirname($0); $Here = `/bin/pwd`; chomp $Here; chdir $Mydir || die "chdir $Mydir: $!"; $Mydir = `/bin/pwd`; chomp $Mydir; chdir $Here || die "chdir $Here"; $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; sub same { my ($f1, $f2) = @_; if ((! (-T $f1 && -T $f2)) || $f1 =~ /\.($binary_exts)\$/i) { $f1 =~ s/"/\\"/g; $f2 =~ s/"/\\"/g; my $cmd = "/usr/bin/cmp \"$f1\" \"$f2\""; # print STDERR "$Myname: binary compare: $cmd\n"; return ! (system $cmd); } # print STDERR "$Myname: text compare: $f1 $f2\n"; if (! open(Y, "<$f1")) { print STDERR "$Myname: can't open \"$f1\": $!\n"; return 0; } if (! open(T, "<$f2")) { close Y; print STDERR "$Myname: can't open \"$f2\": $!\n"; return 0; } $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; return 0; } if ($t =~ /\$Log\b[^\$]*\$/) { <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_ eq "") { return 1; } else { return 0; } } 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"; 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; } } 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 { printf STDERR "$Myname: %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) = @_; if ($tag eq "-") { $tag = ""; } &insdir($CVSCLI); chdir $CVSCLI || die "chdir $CVSCLI"; 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 p4_checkout { my ($module, $branch, $tag) = @_; if ($tag eq "-") { $tag = ""; } # So, is the server running? # if (! $p4d_up) { if (&dosystem("p4 -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 -p $P4PORT client -d -f $P4CLIENT >/dev/null 2>&1", 1); &dosystem("rm -rf *"); &dosystem("/bin/echo P4PORT=$P4PORT > P4ENV"); &dosystem("/bin/echo P4CLIENT=$P4CLIENT >> P4ENV"); open(CLI_O, "p4 -p $P4PORT client -o $P4CLIENT |") || die "can't open p4 client -o"; open(CLI_I, "| p4 -p $P4PORT client -i") || die "can't open p4 client -o"; 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 { my (@tagsflds) = split(/\s+/, $tagsinfo); if ($#tagsflds == 1) { if ($tagsflds[1] eq "UNMAPPED-NOTFOUND") { push (@branches, "*"); } else { push (@branches, $tagsflds[1]); } } elsif ($#tagsflds == 3) { $tagsflds[2] =~ s/^\[(.*)\]$/$1/; $tagsflds[3] =~ s/^\[(.*)\]$/$1/; push(@branches, $tagsflds[2]); push(@branches, $tagsflds[3]); } } } 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 = ""; foreach my $branch (@branches) { print STDERR "$Myname: \t$overlay//ip/$branch/$module/... //srcdiff/ip/$branches[0]/$module/...\n"; print CLI_I "\t$overlay//ip/$branch/$module/... //srcdiff/ip/$branches[0]/$module/...\n"; $overlay = "+"; } close CLI_I; if ($?) { die "p4 client -i"; } if ($tag) { $spec = "\@$tag"; } else { $spec = "#head"; } &dosystem("p4 -p $P4PORT -c $P4CLIENT sync //...$spec >/dev/null"); return $branches[0]; } # 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) { if (! open(CONFIG, "<$Config")) { print "$Myname: open \"<$Config\" failed: $!.\n"; exit 1; } my $config_pl; { local $/; $config_pl = <CONFIG>; } close CONFIG; my $evret; eval $config_pl; if ($@) { print "eval $Config failed: $@\n"; exit 1; } print "eval'ed $Config ok.\n"; 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_branch = &p4_checkout($module, $branch, $tag); &cvs_checkout($module, $branch, $tag); &dosystem("$Mydir/$Myname -cvsdir $CVSCLI/$module -p4dir $P4CLI/ip/$p4_branch/$module"); } 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; print STDERR "$Myname: done.\n";
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#29 | 5851 | Richard Geiger | now detects x bit mismatches. | ||
#28 | 5761 | Richard Geiger |
return a meaningful exist status, nonzero if any diffs or missing files were found (or missing). 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 |
||
#27 | 5730 | Richard Geiger | Handle a special case that was causing false positives. | ||
#26 | 5712 | Richard Geiger |
Handle Pathhacks in srcdiff & dolabels. Moves sub Pathhacks() into util.pl |
||
#25 | 5688 | Richard Geiger | consistently invoke perl via PATH | ||
#24 | 5644 | Richard Geiger | checkpoint | ||
#23 | 5641 | Richard Geiger | debug cruft removal | ||
#22 | 5640 | Richard Geiger |
Better comments in the config files. Fix an asymtompatic bug in srcdiff. |
||
#21 | 5625 | Richard Geiger | Fixes to srcdiff for handling $ and/or \r in CVS pathnames. | ||
#20 | 5622 | Richard Geiger | Yet another labels fix. | ||
#19 | 5621 | Richard Geiger | Handles getting p4 workspace for "cvs import" branch names. | ||
#18 | 5615 | Richard Geiger | more depot mapping fixes. | ||
#17 | 5588 | Richard Geiger |
checkpoint the latest. This includes a rework of the label-heursitical stuff that seems to work better. |
||
#16 | 5586 | Richard Geiger | fix progress reportage... | ||
#15 | 5583 | Richard Geiger |
Handle "..." in CVS pathnames by changing them to ",,,"s. "Works for me!" |
||
#14 | 5580 | Richard Geiger | Tweaks & debugging fixes from the IP 2006/07/06 trial. | ||
#13 | 5577 | Richard Geiger |
Added the -confg <config> option for auto-running a series of checkout/comparisons. Former usage still gets the same behavior. |
||
#12 | 5563 | Richard Geiger |
Life is a corner case. "UNMAPPED-COLLISION tags in tags.txt now indicate what collided better. Fix srcdiff to handle odd Log expansion corner case that was causing flase positives. |
||
#11 | 5556 | Richard Geiger | Should make it honor the list form the config file! | ||
#10 | 5542 | Richard Geiger | checkpointing progress. | ||
#9 | 5537 | Richard Geiger |
Decruft and tighten the regexps which were observed to have choked to product a spurious "files differ" case. |
||
#8 | 5535 | Richard Geiger | ignore .cvsignore files by default. | ||
#7 | 5533 | Richard Geiger | wack dead code. | ||
#6 | 5531 | Richard Geiger |
A significant checkpoint commit, with new improved handling of import vendor branches, and 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. |
||
#5 | 5292 | Richard Geiger | Fix a couple of misaligned } s. | ||
#4 | 5278 | Richard Geiger |
fix problem with compares of binary files with spaces in the filenames |
||
#3 | 5270 | Richard Geiger | Add some simple usage information, for goodness sake! | ||
#2 | 4930 | Richard Geiger | Oops, make this puppy kxtext. | ||
#1 | 4929 | Richard Geiger |
For comparing pre- and post- conversion trees. Needs a oince-over before I release it as part of cvs2p4... |