#!/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#7 $
select STDERR; $| = 1; select STDOUT; $| = 1;
use Carp;
$| = 1;
($Myname = $0) =~ s%^.*/%%;
$Usage = <<LIT;
$Myname: usage:
$Myname -cvsdir cvsdir -p4dir p4dir [-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 ($f2 eq "MibObjs.h") { $f1 =~ s/\/[^\/]*$/MibObjs.h/; }
if ((! (-T $f1 && -T $f2)) || $f1 =~ /\.($binary_exts)\$/ || $f1 =~ /mibobs.h$/i)
{
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 = "";
yline: while (<Y>)
{
$y_ = $_;
if ($tstash)
{ $t = $tstash; $tstash = ""; }
else
{ $t = <T>; }
$t_ = $t;
$y_ =~ s/\$(Author|Date|Header|Id|Locker|Log|Name|RCSfile|Revision|Source|State).*\$/\$XXX\$/g;
$t_ =~ s/\$(Author|Date|Header|Id|Locker|Log|Name|RCSfile|Revision|Source|State).*\$/\$XXX\$/g;
if ($y_ ne $t_) { close Y; close T; return 0; }
if ($t =~ /\$Log[^\$]*\$/)
{
<T>;
while ($t_ = <T>)
{
if ($t_ =~ /Revision/ || $t_ =~ /\*\//)
{ $tstash = $t_; next yline; }
}
}
}
$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; }
my($path) = "$dir/$file";
$path =~ s/^\.\///;
my($rpath) = "$p4dir/$path";
if (! -e $rpath)
{
print STDOUT "$Myname: *** Missing: $rpath\n";
$Ndiff++;
}
elsif (! &same("$rpath", "$path"))
{
print STDOUT "$Myname: different: $rpath\n";
$Ndiff++;
}
$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; }
# 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];
$p4dir = "";
$cvsdir =".";
$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; }
$cvsdir = $ARGV[0]; shift; next;
}
elsif ($ARGV[0] eq "-p4dir")
{
shift; if ($ARGV[0] < 0) { &usage; }
$p4dir = $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 (! -d $p4dir) { &usage; }
chdir $p4dir || die "Can't chdir $p4dir: $!";
$p4dir = `/bin/pwd`;
chomp($p4dir);
chdir $Here || die "Can't chdir $Here: $!";
print STDERR "$Myname: starting...\n";
chdir "$cvsdir" || die "Can't chdir $cvsdir: $!";
&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: [email protected], [email protected] |
||
| #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... |