#!/usr/bin/perl # -*-Fundamental-*- # $Id: //guest/richard_geiger/utils/p4addck#4 $ # # Copyright 1999 Network Appliance, Inc. # # Richard Geiger - rmg@foxcove.com # (Please send bug reports/patches!) # use Carp; use strict norefs; $| = 1; ########## Local Configuration # # my $Myname; ($Myname = $0) =~ s%^.*/%%; # Set up "$P4", the "p4" path we'll use # if (! -d "/u/p4/VERS") { ###### # # Local configuration settings for use outside of NetApp: # # We're out in the big wide world; trust the $PATH, Luke. # $P4 = "p4"; # If your site uses a standard "P4CONFIG" name, and your users # don't all define it in their own environments, you might want # to set it here # $ENV{"P4CONFIG"} = "P4ENV"; # @Exclude_file_re = split(/\n/, <] [-p ] [-r] [-a] [[+|!] ...] [file ...] $Myname help file ... any valid "p4 have arguments" -r consider all files in subtrees of examined directories -a force all output to be absolute pathnames ! supress output for files whose depot path matches + only output files whos client path matches LIT sub usage { print STDERR $Usage; exit 1; } sub help { print STDERR < Specifies user-requested additions to the @Exclude_path_re list (see above). + Specifies a pattern to be matched against all output lines just before the are written; if one or more "+" patterns is given, then *only* lines matching one or more of the patterns will be printed. Thus $Myname +\\.c\$ +\\.h\$ is roughly equivalent to $Myname | egrep '\.c$|\.h$\' (but it uses Perl regular expression matching). LIT exit 1; } ########## General functions # sub dirname { my ($dir) = @_; $dir =~ s%^$%.%; $dir = "$dir/"; if ($dir =~ m%^/[^/]*//*$%) { return "/"; } if ($dir =~ m%^.*[^/]//*[^/][^/]*//*$%) { $dir =~ s%^(.*[^/])//*[^/][^/]*//*$%$1%; { return $dir; } } return "."; } # Potential libraryizers!: this is a nonstandard "traverse()"! # sub traverse { my($dir, $lev, $Dashr, $Client_dir_seen, $onfile, $ondir, $onsymlink) = @_; if ($$Client_dir_seen{$dir}) { return; } $$Client_dir_seen{$dir} = 1; my($dirent); my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks); my($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 (defined(&$onfile)) { &$onfile("$dir", "$dirent"); } last typsw; } ; -d _ && $Dashr && do { if (defined(&$ondir)) { &$ondir("$dir", "$dirent"); } foreach my $re (@Prunes) { if ($dirent =~ /$re/) { last typsw; } } if (! $$Client_dir_seen{"$dir/$dirent"}) { do traverse("$dir/$dirent", $lev+1, $Dashr, $Client_dir_seen, $onfile, $ondir, $onsymlink) if -d _; } last typsw; } ; -l "$dir/$dirent" && do { if (defined(&$onsymlink)) { &$onsymlink("$dir", "$dirent"); } last typsw; } ; } } closedir($dirhandle); } sub argstr { my (@Args) = @_; my $Args = ""; my $arg; foreach $arg (@Args) { if ($Args ne "") { $Args .= " "; } if ($arg =~ /\s/) { $arg =~ s/"/\\"/g; $arg = "\"".$arg."\""; } $arg =~ s/\*/\\*/g; $arg =~ s/\$/\\\$/g; $arg =~ s/\?/\\?/g; $arg =~ s/#/\\#/g; $arg =~ s/\[/\\[/g; $Args .= $arg; } return $Args; } # This is like a "normal" "p4 have", but it translates the output # into client-side cwd-relative pathnames. # sub have_cli { my ($Client_dir, $Depot, @Args) = @_; my $havecmd = "$P4 have 2>&1 ". &argstr(@Args); if (! open(H, "$havecmd |")) { print STDERR "$Myname: open \"$havecmd\" failed: $!.\n"; exit 1; } my $err = 0; while () { if ($_ =~ /^\(b4p4: using /) { next; } chomp; if ($_ =~ m/^([^\s]+) - ([^\s]+)$/) { my($d, $c) = ($1, $2); foreach my $re (@Omit_re) { if ($c =~ /$re/) { next; } } $$Depot{$c} = "have"; $$Client_dir{&dirname($c)} = 1; } else { print STDERR $_."\n"; $err = 1; } } if ($err) { exit 1; } close H; } sub opened_cli { my ($Client_dir, $Depot, @Args) =@_; my $wherecmd = "$P4 opened 2>/dev/null ". &argstr(@Args) ."| sed -e 's/#.*//' | $P4 -x - where 2>/dev/null"; my $openedcmd = "$P4 opened 2>/dev/null ". &argstr(@Args); if (! open(O, "$openedcmd |")) { print STDERR "$Myname: open \"$openedcmd\" failed: $!.\n"; exit 1; } if (! open(W, "$wherecmd |")) { print STDERR "$Myname: open \"$wherecmd\" failed: $!.\n"; exit 1; } while () { chomp; $W_ = ; chomp $W_; $W_ =~ s/^.* //; my ($file, $how) = ($_ =~ /^([^#]+)#[0-9]+ - ([a-z]+)/); $$Depot{$W_} = $how; $$Client_dir{&dirname($W_)} = 1; } close O; close W; return @ret; } ########## "main" begins here # # option switch variables get defaults here... my @Include_re = (); my @Omit_re = (); my $Dashr = 0; my $Relpaths = 1; my @Args; my $Args; while ($#ARGV >= 0) { if ($ARGV[0] =~ /^\+(.*)/) { push(@Include_re, $1); shift; next; } elsif ($ARGV[0] =~ /^\!(.*)/) { push(@Omit_re, $1); shift; next; } elsif ($ARGV[0] eq "-c") { shift; if ($#ARGV < 0) { &usage; }; $ENV{"P4CLIENT"} = $ARGV[0]; shift; next; } elsif ($ARGV[0] eq "-p") { shift; if ($#ARGV < 0) { &usage; }; $ENV{"P4PORT"} = $ARGV[0]; shift; next; } elsif ($ARGV[0] eq "-r") { $Dashr = 1; shift; next; } elsif ($ARGV[0] eq "-a") { $Relpaths = 0; shift; next; } elsif ($ARGV[0] eq "-help") { &help; } elsif ($ARGV[0] =~ /^-/) { &usage; } push(@Args, $ARGV[0]); shift; } foreach my $ex (@Exclude_lit) { $Exclude_lit{$ex} = 1; } $Cdsave=`/bin/pwd`; chop $Cdsave; ($Cdsave_esc = $Cdsave) =~ s/\//\\\//g; my %Depot; my %Client_dir; my %Client; my $cmd; # First, what depot files do we have... # print STDERR "$Myname: load depot list\n"; &have_cli(\%Client_dir, \%Depot, @Args); # Next, what opened depot files do we have... # print STDERR "$Myname: load open depot list\n"; &opened_cli(\%Client_dir, \%Depot, @Args); # Now, all of the files in the tree... # print STDERR "$Myname: load client list\n"; sub onfile { my($dir, $file) = @_; $dir =~ s/^\.\///; my $path; if ($dir eq ".") { $path = "$file"; } else { $path = "$dir/$file"; } my ($relpath) = $path; $relpath =~ s/^$Clientroot\///; # Use these rules where they wipe out large numbers of files # -or- would be predictive of future build output files which # are unlikly to need being checked in to Perforce: # foreach $re (@Exclude_file_re) { if ($file =~ /$re/) { return; } } foreach $re (@Exclude_path_re) { if ($relpath =~ /$re/) { return; } } # User-defined exclusions: # foreach my $o (@Omit_re) { if ($path =~ /$o/) { return; } } if (defined($Exclude_lit{$relpath})) { return; } $Client{"$path"} = 1; } $cmd = "$P4 info 2>/dev/null |"; if (! open(INFO, $cmd)) { print STDERR "$Myname: can't open \"$cmd\": $!."; exit 1; } $Clientroot = ""; $Clientname = ""; while () { chop; if (/^Client name: (.*)$/) { $Clientname = $1; } if (/^Client root: (.*)$/) { $Clientroot = $1; last; } } close INFO; if ($Clientname eq "-" || $Clientroot eq "") { print STDERR "$Myname: can't determine client root.\n"; exit 1; } my %Client_dirs_seen; if ($Dashr) { &traverse($Clientroot, 0, $Dashr, \%Client_dir_seen, "onfile", "printpath", "printpath"); } else { foreach $cd (sort(keys(%Client_dir))) { &traverse($cd, 0, $Dashr, \%Client_dir_seen, "onfile", "printpath", "printpath"); } } @Client = sort(keys(%Client)); my %Potentials; client_path: foreach $c (@Client) { if ($#Include_re >= 0) { foreach my $r (@Include_re) { if ($c =~ /$r/) { goto gotit; } } next client_path; } gotit: if (! defined($Depot{$c})) { $Potentials{$c} = 1; } } @Potentials = sort(keys(%Potentials)); if ($#Potentials < 0) { print STDERR "$Myname: I don't see any potential missed adds.\n"; exit 0; } else { print STDERR "$Myname: potential missed adds:\n"; foreach $p (@Potentials) { if ($Relpaths) { $p =~ s/$Cdsave_esc\///; } print "$p\n"; } } exit 1;