#!/usr/local/bin/perl -w
#
# This script maps files that have been integrated into their destinations.
# It is primarily useful for finding files that have been renamed.
#
# This tool works as follows:
# 1. Expand the argument filespecs into files.
# 2. For each file, find everywhere it has been branched into.
# 3. Iteratively follow branches from those files, until leaves are
# reached.
# 4. Filter that list (including the original file) for not being deleted,
# and being in the same tree as the current directory.
#
# Script assumes Perforce is already set up.
$Usage = <<EOD
Usage: $0 [-a] [-d] [-v] filespec...
-a Print all files, not just those in the current directory tree
-d Print deleted files as well
-v Print debugging output
This tool finds files that (may) have been moved and reports everywhere in
the current directory tree that they have been integrated into. The original
file will also be reported if it still exists.
The files are specified as Perforce filespecs, which can be simple filenames,
either absolute or relative, or can include "..." and "*".
This tool is ideal for use in a change branch, but can take a long time to
run in the masters.
EOD
;
# Parse command line
@Filespecs = ();
$PrintDeleted = $PrintAll = $Verbose = 0;
foreach $arg (@ARGV) {
if($arg =~ /^-(.)$/) {
$flag = $1;
if($flag eq 'd') {
$PrintDeleted = 1;
} elsif($flag eq 'a') {
$PrintAll = 1;
} elsif($flag eq 'v') {
$Verbose = 1;
} else {
&error("Unrecognized flag '$flag'");
}
} else {
push @Filespecs, $arg;
}
}
if(!@Filespecs) {
&error("No filespecs specfied. Please give at least one.");
}
$Root = qx/p4 where . | tail -1 | cut -f1 -d" "/;
chomp $Root;
die "Can't find root" if(!defined($Root) || $Root eq '');
&inform("Root = $Root");
@InputFiles = ();
foreach $filespec (@Filespecs) {
push @InputFiles, &expandFilespec($filespec);
}
if(!@InputFiles) {
&error("Filespecs expanded to no files.");
}
foreach $file (@InputFiles) {
# Iterate the queue of descendents
&inform("Checking for descendents of $file");
@outputFiles = ();
@candidates = ($file); # queue
%checkedFiles = ($file => 1); # Prevent loops
while($f = shift @candidates) {
if(($PrintDeleted || &stillExists($f)) &&
($PrintAll || $f =~ m{^$Root})) {
&inform(" Result: $f");
push @outputFiles, $f;
}
foreach $child (&findChildren($f)) {
if(!defined($checkedFiles{$child})) {
&inform(" Found child $child");
push @candidates, $child;
$checkedFiles{$child} = 1
}
}
}
print "$file -> ", join(" ", sort @outputFiles), "\n";
}
sub findChildren {
my ($file) = @_;
my @results = ();
open P4, "p4 filelog $file | grep '^\.\.\. \.\.\. branch into' | cut -f5 -d' ' | cut -f1 -d# |" ||
die "Can't call p4 filelog $file";
while(<P4>) {
chomp;
push @results, $_;
}
close P4;
return @results;
}
sub stillExists {
my ($file) = @_;
my $status = qx/p4 files $file/;
return $status !~ / - delete /;
}
sub expandFilespec {
my($filespec) = @_;
my @results;
open P4, "p4 files $filespec | cut -f1 -d# |" ||
die "Can't call p4 files $filespec";
while(<P4>) {
chomp;
push @results, $_;
}
close P4;
return @results;
}
sub error {
my($message) = @_;
print STDERR "ERROR: $message\n\n$Usage";
exit 1;
}
sub inform {
my($message) = @_;
if($Verbose) {
print STDERR "> $message\n";
}
}