Helix SwarmHelix Swarm
Loading...

pls

  • //
  • guest/
  • marc_gauthier/
  • pls #1
  • View
  • Commits
  • Open Download .zip Download (29 KB) 
  1. #!/bin/sh
  2. #  Not every host installs perl at the same location, handle many locations:
  3. PATH=/usr/xtensa/stools-5.0/bin:/usr/bin:/usr/local/bin:$PATH
  4. exec perl -x -S $0 ${1+"$@"}
  5. exit $?
  6. #!perl -w
  7. #line 8
  8. #  pls -- Perforce 'ls' -- lists combined Perforce and local directories
  9.  
  10. #  Copyright (c) 2000-2006, Tensilica Inc.
  11. #  All rights reserved.
  12. # 
  13. #  Redistribution and use, with or without modification, are permitted provided
  14. #  that the following conditions are met:
  15. # 
  16. #   - Redistributions must retain the above copyright notice, this list of
  17. #     conditions, and the following disclaimer.
  18. # 
  19. #   - Modified software must be plainly marked as such, so as not to be
  20. #     misrepresented as being the original software.
  21. # 
  22. #   - Neither the names of the copyright holders or their contributors, nor
  23. #     any of their trademarks, may be used to endorse or promote products or
  24. #     services derived from this software without specific prior written
  25. #     permission.
  26. # 
  27. #  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
  28. #  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  29. #  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  30. #  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
  31. #  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  32. #  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  33. #  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
  34. #  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
  35. #  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
  36. #  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  37. #  POSSIBILITY OF SUCH DAMAGE.
  38.  
  39. #  See `pls -h` for usage info.
  40. #
  41. #  History:
  42. #  2006-FEB-15	1.6	marc	Recognize alternate login methods
  43. #  2005-APR-12	1.5	marc	Update copyright/license notice.
  44. #  2002-OCT-02	1.4	marc	Handle spaces in pathnames
  45. #  2001-DEC-18	1.3	marc	Improve perl and script path independence
  46. #  2001-OCT-05	1.2	marc	Put p4where() logic in p4lib.pm.
  47. #  2001-???	1.1b	marc	Use p4lib.pm.
  48. #  2001-FEB-23	1.1	marc	Add -p4 option.
  49. #  2000-MAY-23	1.0	marc	Initial version
  50.  
  51. $progvers = "1.6";
  52. $progname = "pls";
  53.  
  54. $p4prog = "p4";
  55.  
  56. my $scriptdir = $0;
  57. $scriptdir =~ s|[/\\][^/\\]+$||;	# strip script name, leaving only dirname
  58. push @INC, $scriptdir;
  59. require p4lib;
  60.  
  61. #  Get arguments:
  62. @args = ();
  63. while( defined($_ = shift) ) {
  64.     if( /^-q$/ ) {		# don't show deleted files
  65. 	$no_del_files = 1;
  66. 	next;
  67.     }
  68.     if( /^-p4$/ ) {		# set p4prog path
  69. 	if( !defined($p4prog = shift) ) {
  70. 	    print STDERR "$progname: missing parameter after '-p4' option\n";
  71. 	    usage();
  72. 	    exit 1;
  73. 	}
  74. 	next;
  75.     }
  76.     if( /^-(h|help|\-h|\-help|\?)$/i ) {
  77. 	usage();
  78. 	exit 0;
  79.     }
  80.     if( /^-/ ) {
  81. 	print STDERR "$progname: unrecognized option '$_'\n";
  82. 	usage();
  83. 	exit 1;
  84.     }
  85.     push(@args, $_);
  86. }
  87.  
  88. #  Only do p4 commands starting here, i.e. after -p4 option processed.
  89.  
  90. #  Verify login:
  91. my $verlogin = `$p4prog login -s`;
  92. chomp($verlogin);
  93. if ($verlogin !~ /ticket expires/
  94.     && $verlogin !~ /not necessary/
  95.     && $verlogin !~ /authenticated by password not ticket/) {
  96.     print STDERR "Perforce account requires login\n";
  97.     #  Try doing a login (requesting password on the spot):
  98.     $vercode = system("$p4prog login");
  99.     if ($vercode != 0) {
  100. 	die "Perforce account still requires login (exit code $vercode)\nStopped";
  101.     }
  102.     my($verlogin) = p4cmdout("login -s");
  103.     chomp($verlogin);
  104.     if ($verlogin !~ /ticket expires/) {
  105. 	die "Perforce account still requires login ($verlogin)\n Stopped";
  106.     }
  107. }
  108.  
  109. #  Get various info:
  110. p4getinfo();
  111.  
  112. #  Execute listing:
  113. if( @args == 0 ) {
  114.     pls("");
  115. } else {
  116.     foreach (@args) {
  117. 	pls($_);
  118.     }
  119. }
  120.  
  121. exit 0;			# done!
  122.  
  123.  
  124.  
  125. sub usage {
  126.     print <<"__END__";
  127. Perforce lister v$progvers  --  Displays contents of a Perforce/local directory
  128.  
  129. Usage:    pls [-q] [dirpath [...]]
  130. Options:
  131.           -q            do not display deleted files (unless opened etc)
  132.           -h            display this help message
  133.           -p4 progname  set path to p4 executable (default 'p4')
  134.  
  135. Caveats:  o  You cannot specify a single file, only a directory
  136.           o  Invokes many p4 commands, so tends to be slow
  137.           o  Does not support //<clientname> requests (does support //)
  138.           o  Does not display date/time or file size
  139.  
  140. Displays the following columns:
  141.  
  142. [_LOCAL__]           HAVE RSLV [______OPENED______] [____DEPOT_____]
  143.  perms     p4 type   rev  rev  change  how others   loc head change  Name
  144. ---------- --------- ---- ---- ------- --- -------- --- ---- ------- ----
  145.  
  146. LOCAL perms:   -rwxrwxrwx as per 'ls -l' if the file/dir is on your disk
  147. p4 type:       p4 file type (text, ktext, DIR, etc) if Perforce knows about it;
  148.                if opened vs depot types are different, parts of the type that
  149.                differ are shown as '*' (eg. text vs ktext is shown as *text)
  150.                (note that DIR is not a p4 type, it is inferred by the script)
  151. HAVE rev:      revision of the file you have on your disk, or "head" if same as
  152.                the head rev in the depot; prefixed with '*' if this rev (or for
  153.                dirs, if any descendant file) includes resolved & unsubmitted revs;
  154.                (NOT same as p4 have's rev if RSLV rev present)
  155. RSLV rev:      revision of the file you last sync'ed, if newer and unresolved;
  156.                "head" if same as head rev in depot; for dirs, displays number
  157.                of descendant unresolved files; these unresolved files are due
  158.                to p4 sync (for unresolved due to p4 integrate, see Name column)
  159. OPENED change: change number (or "default") if you have the file opened;
  160.                for dirs, shows change number for all opened descendant files
  161.                if they all have the same, else the number of opened files
  162. OPENED how:    action used to open file (or set of descendant files for dirs);
  163.                add=new file, int=integrate, del=deleted, bra=branch, edi=edit,
  164.                ...=mixed actions (dirs only); last char replaced with '*' if you
  165.                have locked the file (or for dirs, locked any descendant file)
  166. OPENED others: lists any other users who have opened the file (or for dirs, any
  167.                descendant file), including yourself if you opened it on another
  168.                client; ends with "..." if the list of users is too long to fit
  169.                (generally the case if more than 1 other user);
  170.                ends with '*' if any of these other users has locked the file(s)
  171. DEPOT loc:     "DEP" if file visible in depot but not your client;
  172.                "CLI" if file somehow visible in your client but not depot
  173. DEPOT head:    head rev of file if present in depot
  174.                (shown as !n instead of #n if depot file is deleted)
  175. DEPOT change:  last change number at which file was changed/affected in the depot
  176. Name:          name of the file;
  177.                "-> <symlink contents>" appended if is a symlink on your local disk;
  178.                "<= <pathname>[#rev[,rev]][ (<action>#rev)]" appended for each file
  179.                from which it was integrated but not submitted:
  180.                   #rev[,rev]     indicates unresolved versions;
  181.                   (<action>#rev) indicates resolved versions, where <action> is
  182.                                  copy, igno or merg (there are probably others).
  183.                "<= (<n> unresolved) (<n> resolved)" appended for dirs for which
  184.                any descendant file has been integrated but not submitted
  185. __END__
  186. }   #'
  187.  
  188.  
  189. #  Return list of files within a given Perforce directory path:
  190. #
  191. sub p4flat_files {
  192.     my($path,$what,$subdir_prefix) = @_;
  193.     return () if $path eq "";
  194.     my $subs = defined($subdir_prefix);
  195.     if( $subs ) {
  196. 	$subdir_prefix =~ s|^//depot||;	# prefix is in depot syntax
  197. 	#$subdir_prefix .= "/" unless $subdir_prefix =~ m|/$|;	# append '/'
  198.     }
  199.     $path .= "/".($subs ? "..." : "*");
  200.     my @files = p4files($what,$path);
  201.     my @result = ();
  202.     my %dirs = ();
  203.     foreach my $f ( @files ) {
  204. 	my($fpath,$fname,$fvers,$action,$chgnum,$ftype,$byuser,$bycli,$lock) = @$f;
  205. 	my $chg = "change";
  206. 	$fpath =~ s|^//depot||;
  207. 	#print "Got lock $fname '$lock'\n" if $lock;
  208. 	$chgnum = "\@".$chgnum if $chgnum =~ /^\d+$/;
  209. 	if( !$subs or $fpath eq $subdir_prefix ) {
  210. 	    push(@result, [$fpath,$fname,$fvers,$action,$chg,$chgnum,$ftype,$byuser,$bycli,$lock] );
  211. 	    #printf "%-9s #%-5s \@%-7s $fname  ($fpath)\n", $ftype, $fvers, $chgnum;
  212. 	} elsif( $fpath =~ s|^\Q$subdir_prefix\E/([^/]+)|| ) {
  213. 	    my $subdir = $1;
  214. 	    ${$dirs{$subdir}}[0]++;
  215. 	    ${$dirs{$subdir}}[4] += 0;	# just make sure it's defined
  216. 	    ${$dirs{$subdir}}[5] += 0;	# ditto
  217. 	    if( $byuser eq $p_user and $bycli eq $p_client ) {
  218. 		${${$dirs{$subdir}}[2]}{$action} = 1;
  219. 		${${$dirs{$subdir}}[3]}{$chgnum} = 1;
  220. 		${$dirs{$subdir}}[4]++ if $lock;
  221. 	    } else {
  222. 		${${$dirs{$subdir}}[1]}{$byuser."@".$bycli} = 1;
  223. 		${$dirs{$subdir}}[5]++ if $lock;
  224. 	    }
  225. 	    #push(@result, [$subdir_prefix,$subdir,"-","-",$chg,$chgnum,$ftype,$byuser,$bycli,$lock] );
  226. 	    #printf "Got subdir file:  %-9s #%-5s \@%-7s $fname  ($fpath)\n", $ftype, $fvers, $chgnum;
  227. 	} else {
  228. 	    printf "Got unknown file: %-9s #%-5s \@%-7s $fname  ($fpath)\n", $ftype, $fvers, $chgnum;
  229. 	}
  230.     }
  231.     foreach (keys %dirs) {
  232. 	my $nelems  =        ${$dirs{$_}}[0];
  233. 	my @who     = keys %{${$dirs{$_}}[1]};
  234. 	my @actions = keys %{${$dirs{$_}}[2]};
  235. 	my @changes = keys %{${$dirs{$_}}[3]};
  236. 	my $nlocks  =        ${$dirs{$_}}[4];
  237. 	my $nlockso =        ${$dirs{$_}}[5];
  238. 	my $dirwho = join(",",@who).",";
  239. 	my $diract = (@actions == 1) ? $actions[0] : (@actions == 0) ? "" : "...";
  240. 	my $dirchg = (@changes == 1) ? $changes[0] : (@changes == 0) ? "" : "($nelems)";
  241. 	push(@result, [$subdir_prefix,$_,$nelems,$diract,"-",$dirchg,"DIR",$dirwho,"",$nlocks,$nlockso] );
  242.     }
  243.     return @result;
  244. }
  245.  
  246. #  Return list of files within a given Perforce directory path
  247. #  (parse 'p4 resolved' and 'p4 resolve -n' output):
  248. #
  249. sub p4resfiles {
  250.     my($path,$what,$subdir_prefix,$loc_prefix) = @_;
  251.     return () if $path eq "";
  252.     my $subs = defined($subdir_prefix);
  253.     my $cmdline = "$what ".p4passpath("$path/".($subs ? "..." : "*"));
  254.     ##print "Doing '$cmdline'\n";
  255.     my($info) = p4cmdout($cmdline);
  256.     chomp($info);
  257.     #print STDERR "Got '$info'\n";
  258.     my @result = ();
  259.     my %dirs = ();
  260.     #print "subs $subs\n";
  261.     foreach ( split(/\n/,$info) ) {
  262. 	if( ! m%(/[^#]+/)([^/#]*) - ([^/]+)\s+(//depot[^#]*/)([^/#]*)#([0-9]+)(,#([0-9]+)|)% ) {
  263. 	    print STDERR "$progname: unparsable line from '$p4prog -s $cmdline': $_\n";
  264. 	    next;
  265. 	}
  266. 	my($locpath,$locname,$action,$respath,$resname,$resvers,$resv2,$resv3) = ($1,$2,$3,$4,$5,$6,$7,$8);
  267. 	defined($resv3) or $resv3 = "";
  268. 	my $frompathname;
  269. 	$action = substr($action,0,4);
  270. 	if( $locpath !~ s|^\Q$loc_prefix/|| ) {
  271. 	    print "Couldn't find prefix '$loc_prefix' in '$locpath'\n";
  272. 	    return ();
  273. 	}
  274. 	if( $respath =~ s|^\Q$subdir_prefix/|| ) {
  275. 	    if( $respath !~ s|^\Q$locpath|| ) {
  276. 		foreach ($locpath =~ m|/|g) {
  277. 		    $respath = "../$respath";
  278. 		}
  279. 	    }
  280. 	    if( $locname eq $resname and $respath eq "" ) {
  281. 		$frompathname = "";			# itself
  282. 	    } else {
  283. 		$frompathname = $respath.$resname;
  284. 	    }
  285. 	} else {
  286. 	    $frompathname = $respath.$resname;
  287.  
  288. 	    #  Try to get a shorter version using relative pathname:
  289. 	    my $p1 = $subdir_prefix."/".$locpath.$locname;
  290. 	    my $p2 = $frompathname;
  291. 	    #print "A. p1 = $p1\n   p2 = $p2\n";
  292. 	    while(1) {
  293. 		$p1 =~ m|^([^/]*/)| or last;  $f1 = $1;
  294. 		$p2 =~ m|^([^/]*/)| or last;  $f2 = $1;
  295. 		$f1 eq $f2 or last;
  296. 		$p1 = substr($p1,length($f1));
  297. 		$p2 = substr($p2,length($f1));
  298. 	    }
  299. 	    #print "B. p1 = $p1\n   p2 = $p2\n";
  300. 	    foreach ($p1 =~ m|/|g) {
  301. 		$p2 = "../$p2";
  302. 	    }
  303. 	    $frompathname = $p2 if length($p2) < length($frompathname);
  304.  
  305. 	    #  Try to get a shorter version using branch pathname:
  306. 	    #...(not yet implemented)...
  307. 	}
  308. 	#print "Got $action\[$resvers|$resv2|$resv3] <$locpath>'$locname' from <$frompathname>\n";
  309. 	if( !$subs or $locpath eq "" ) {
  310. 	    push(@result, [$locname,$frompathname,$action,$resvers,$resv3] );
  311. 	} else {
  312. 	    $locpath =~ m|^([^/]*)|;
  313. 	    my $subdir = $1;
  314. 	    ${$dirs{$subdir}}[0] += ($frompathname eq "");
  315. 	    ${$dirs{$subdir}}[1] += ($frompathname ne "");
  316. 	}
  317.     }
  318.     foreach (keys %dirs) {
  319. 	my $nself = ${$dirs{$_}}[0];
  320. 	my $nintg = ${$dirs{$_}}[1];
  321. 	push(@result, [$_," ","","",$nintg] ) if $nintg > 0;
  322. 	push(@result, [$_,"","","","$nself"] ) if $nself > 0;
  323.     }
  324.     #print "\n";
  325.     return @result;
  326. }
  327.  
  328. #  Return list of files within a given Perforce directory path
  329. #  (parse 'p4 have' output):
  330. #
  331. sub p4havefiles {
  332.     my($path) = @_;
  333.     return () if $path eq "";
  334.     my @havelist = p4have("$path/*");
  335.     my @result = ();
  336.     foreach (@havelist) {
  337. 	my($fpath,$fname,$fvers) = @$_;
  338. 	$fpath =~ s|^//depot||;
  339. 	push(@result, [$fpath,$fname,$fvers] );
  340.     }
  341.     return @result;
  342. }
  343.  
  344.  
  345.  
  346. sub pls {
  347.     my ($args) = @_;
  348.     my $p4path = "";	# path to list in Perforce format, ie. prefixed
  349.     			#  with //depot or //<client>
  350.     my $locpath = "";
  351.     my $clipath = "";
  352.  
  353.     defined($args) or $args = "";
  354.  
  355.     #  We have to remove any "." and "..":
  356.     #
  357.     my $roots = 0;
  358.     $roots++ while $args =~ s|^/||;	# count leading slashes
  359.     $args = "/$args/";			# insure it starts and ends in slash
  360.     $args =~ s|//+|/|g;			# collapse repeated slashes
  361.     $args =~ s|/\./|/|g;		# strip out any "."
  362.     #  Strip out any "xxx/..":
  363.     while($args =~ s@/([^/.][^/]*|\.[^/.][^/]*|\.\.[^/]+)/\.\./@/@g) { }
  364.     #  There may be some leading ".." left, should be okay.
  365.     $roots = 2 if $roots > 2;
  366.     $args =~ s|^/||;			# remove added leading '/'
  367.     $args =~ s|^\.\./||g if $roots > 0;	# strip out any .. across root
  368.     my $argstrail = $args;		# save path that has trailing '/'
  369.     $args =~ s|/$||;			# remove added trailing '/'
  370.     if( $roots == 2 ) {
  371. 	if( $args eq "" ) {
  372. 	    #  Empty rooted path ("//").
  373. 	    #  Special case, must list clients and depots:
  374. 	    print "Contents of //:\n";
  375. 	    print "Clients:\n";
  376. 	    my ($allclients) = p4cmdout("clients",0,1,1);
  377. 	    chomp($allclients);
  378. 	    foreach (sort(split(/\n/,$allclients))) {
  379. 		/^Client (\S+) \S+ root ([^\']+) \'\s*(.*?)\s*\'\s*$/ or next;
  380. 		my($cname,$croot,$ccomment) = ($1,$2,$3);
  381. 		$ccomment =~ s|\s+\-?//.*||;	# some people put commented out paths in here
  382. 		printf "//%-20s -> %s (%s)\n", $cname,$croot,$ccomment;
  383. 	    }
  384. 	    print "Depots:\n";
  385. 	    my ($alldepots) = p4cmdout("depots",0,1,1);
  386. 	    chomp($alldepots);
  387. 	    foreach (sort(split(/\n/,$alldepots))) {
  388. 		/^Depot (\S+) \S+ (\S+) subdir [^\']+ \'\s*(.*?)\s*\'\s*$/ or next;
  389. 		my($dname,$dwhat,$dcomment) = ($1,$2,$3);
  390. 		printf "//%-20s %-6s (%s)\n", $dname,$dwhat,$dcomment;
  391. 	    }
  392. 	    return;
  393. 	}
  394. 	$args = "//".$args;
  395. 	$p4path = $args;
  396. 	if( $argstrail =~ m|^depot/| ) {
  397. 	    #				# already in depot format
  398. 	} else {
  399. 	    #  Verify that path is in client format:
  400. 	    #...
  401. 	}
  402.     } else {
  403. 	$args = "/".$args if $roots > 0;
  404. 	$args = "." if $args eq "";
  405. 	$locpath = $args;
  406.     }
  407.     #print STDERR "Got p4path  = '$p4path'\n";
  408.     #print STDERR "Got locpath = '$locpath'\n";
  409.  
  410.     #  Use 'p4 where' to convert native format to Perforce format
  411.     #  (default to //depot syntax):
  412.  
  413.     my ($mapped,$w_p4path,$w_clipath,$w_locpath) = p4where($args);
  414.     ($p4path,$clipath,$locpath) = ($w_p4path,$w_clipath,$w_locpath) if defined($w_p4path);
  415. #    my ($info) = p4cmdout("where ".p4passpath($args));
  416. #    if( $info eq "" ) {			# can't map? try with a sub-element
  417. #	($info) = p4cmdout("where ".p4passpath("$args/--.SoMeFiLe.--"));
  418. #	$info =~ s|/\-\-\.SoMeFiLe\.\-\-||gs;
  419. #    }
  420. #    if( $info eq "" ) {
  421. #	#  The requested pathname couldn't map via the client.
  422. #	#  Show what we can (either depot only or local files only).
  423. #    } else {
  424. #	chomp($info);  $info =~ s|.*\n||s;	# keep all but the last line
  425. #	my $notmapped = ($info =~ s|^\-||);
  426. #	if( $info !~ m|^(//.*) (//.*) (/.*)$| ) {
  427. #	    die "$progname: can't parse output of '$p4prog -s where $args':\n".
  428. #		"$progname: '$info'\n".
  429. #		"$progname: stopped";
  430. #	}
  431. #	$p4path = $1;
  432. #	$clipath = $2;
  433. #	$locpath = $3;
  434. #	#print STDERR "Depot  path is $p4path\n";
  435. #	#print STDERR "Client path is $clipath\n";
  436. #	#print STDERR "Local  path is $locpath\n";
  437. #	print STDERR "$progname: warning: requested directory defined but unmapped by the client\n"
  438. #		if $notmapped;
  439. #    }
  440.  
  441.     $args = ($p4path ne "") ? $p4path : $locpath;
  442.     print "Contents of $args:\n";
  443.  
  444.     #  Get (directory) contents of Perforce directory:
  445.     #
  446.     foreach (p4dirs($p4path))  { $alldirs{$_} |= 1; }	# is in depot
  447.     foreach (p4dirs($clipath)) { $alldirs{$_} |= 2; }	# is in client
  448.  
  449.     #  Get contents of local directory:
  450.     #
  451.     my @locitems = ();
  452.     if( $locpath ne "" ) {
  453. 	if( opendir(DIR, $locpath) ) {
  454. 	    @locitems = readdir(DIR);
  455. 	    closedir DIR;
  456. 	}
  457.     }
  458.     # @locdirs = grep { -d "$locpath/$_" } @locitems;
  459.     foreach (@locitems) {
  460. 	my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
  461.             $atime,$mtime,$ctime,$blksize,$blocks) = lstat("$locpath/$_") or next;
  462. 	$_ eq "." and next;
  463. 	$_ eq ".." and next;
  464. 	my $type;
  465. 	my $symlink = "";
  466. 	if    (-f _) { $type = '-'; }
  467. 	elsif (-d _) { $type = 'd'; }
  468. 	elsif (-c _) { $type = 'c'; }
  469. 	elsif (-b _) { $type = 'b'; }
  470. 	elsif (-p _) { $type = 'p'; }
  471. 	elsif (-S _) { $type = 's'; }
  472. 	else         { $type = 'l'; $symlink = ' -> ' . readlink("$locpath/$_"); }
  473.  
  474. 	if( $type eq 'd' ) {
  475. 	    $alldirs{$_} |= 4;		# is local
  476. 	} else {
  477. 	    #	0 dev      device number of filesystem
  478. 	    #	1 ino      inode number
  479. 	    #	2 mode     file mode  (type and permissions)
  480. 	    #	3 nlink    number of (hard) links to the file
  481. 	    #	4 uid      numeric user ID of file's owner
  482. 	    #	5 gid      numeric group ID of file's owner
  483. 	    #	6 rdev     the device identifier (special files only)
  484. 	    #	7 size     total size of file, in bytes
  485. 	    #	8 atime    last access time since the epoch
  486. 	    #	9 mtime    last modify time since the epoch
  487. 	    #	10 ctime    inode change time (NOT creation time!) since the epoch
  488. 	    #	11 blksize  preferred block size for file system I/O
  489. 	    #	12 blocks   actual number of blocks allocated
  490.  
  491. 	    $allfiles{$_} = 1;
  492. 	}
  493. 	$locfiles{$_} = [$mode,$size,$mtime,$uid,$gid,$type,$symlink];
  494.     }
  495.  
  496.  
  497. #    #  Display directories:
  498. #    #
  499. #    foreach (sort keys %alldirs) {
  500. #	my $where = $alldirs{$_};
  501. #	print "directory ",
  502. #		($where & 1)?"depot":"     ",
  503. #		" ",
  504. #		($where & 2)?"client":"      ",
  505. #		"       $_\n";
  506. #    }
  507.  
  508.     foreach (p4flat_files($p4path ,"files")) {
  509. 	$allfiles{$$_[1]} += ($$_[3] ne "delete");
  510. 	$depfiles{$$_[1]} = $_;
  511.     }
  512.     foreach (p4flat_files($clipath,"files")) {
  513. 	$allfiles{$$_[1]} += ($$_[3] ne "delete");
  514. 	$clifiles{$$_[1]} = $_;
  515.     }
  516.  
  517.     foreach (p4havefiles($p4path )) {
  518. 	$allfiles{$$_[1]} = 1;
  519. 	$dephfiles{$$_[1]} = $$_[2];
  520.     }
  521. #    foreach (p4havefiles($clipath)) {
  522. #	$allfiles{$$_[1]} = 1;
  523. #	$clihfiles{$$_[1]} = $$_[2];
  524. #    }
  525.  
  526.     foreach (p4resfiles($p4path ,"resolve -n",$p4path,$locpath)) {
  527. 	if( $$_[3] eq "" ) {	# directory?
  528. 	    $alldirs{$$_[0]} = 1;
  529. 	} else {
  530. 	    $allfiles{$$_[0]} = 1;
  531. 	}
  532. 	if( $$_[1] eq "" ) {	# self?
  533. 	    $depresons{$$_[0]} = $_;
  534. 	} else {
  535. 	    $$_[5] = 1;		# indicate unresolved
  536. 	    push(@{${$depreso{$$_[0]}}{$$_[1]}}, $_);
  537. 	}
  538.     }
  539.  
  540.     #  Note - order matters (resolved done after resolve -n)
  541.  
  542.     ### BUG!!!  need to p4resfiles() on client, not just depot,
  543.     ### !!!!!!  because some 'resolved' indications are only
  544.     ### !!!!!!  shown for client views (eg. integrate to new file)
  545.     foreach (p4resfiles($p4path ,"resolved",$p4path,$locpath)) {
  546. 	if( $$_[3] eq "" ) {	# directory?
  547. 	    $alldirs{$$_[0]} = 1;
  548. 	} else {
  549. 	    $allfiles{$$_[0]} = 1;
  550. 	}
  551. 	if( $$_[1] eq "" ) {	# self?
  552. 	    $depresods{$$_[0]} = $_;
  553. 	} else {
  554. 	    $$_[5] = 0;		# indicate resolved
  555. 	    push(@{${$depreso{$$_[0]}}{$$_[1]}}, $_);
  556. 	}
  557.     }
  558.  
  559.     #foreach (p4flat_files($p4path ,"opened")) { $allfiles{$$_[1]} = 1; $depofiles{$$_[1]} = $_; }
  560.     #foreach (p4flat_files($clipath,"opened")) { $allfiles{$$_[1]} = 1; $cliofiles{$$_[1]} = $_; }
  561.     foreach (p4flat_files($p4path ,"opened -a",$p4path)) {
  562. 	if( $$_[6] eq "DIR" ) {
  563. 	    $alldirs{$$_[1]} = 1;
  564. 	    $depoafiles{$$_[1]} .= $$_[7];
  565. 	    $depofiles{$$_[1]} = $_;
  566. 	    $filelocked{$$_[1]} += $$_[10];
  567. 	} else {
  568. 	    $allfiles{$$_[1]} = 1;
  569. 	    if( $$_[7] eq $p_user and $$_[8] eq $p_client ) {
  570. 		$depofiles{$$_[1]} = $_;
  571. 	    } else {
  572. 		$depoafiles{$$_[1]} .= $$_[7]."@".$$_[8].",";
  573. 		$filelocked{$$_[1]} += $$_[9];
  574. 	    }
  575. 	}
  576.     }
  577.  
  578. #    foreach (p4flat_files($clipath,"opened -a",$p4path)) {
  579. #	if( $$_[6] eq "DIR" ) {
  580. #	    $alldirs{$$_[1]} = 1;
  581. #	    $clioafiles{$$_[1]} .= $$_[7];
  582. #	    $cliofiles{$$_[1]} = $_;
  583. #	} else {
  584. #	    $allfiles{$$_[1]} = 1;
  585. #	    if( $$_[7] eq $p_user and $$_[8] eq $p_client ) {
  586. #		$cliofiles{$$_[1]} = $_;
  587. #	    } else {
  588. #		$clioafiles{$$_[1]} .= $$_[7]."@".$$_[8].",";
  589. #	    }
  590. #	}
  591. #    }
  592.  
  593.  
  594.     #  If requested, don't list files that are deleted, unopened, and
  595.     #  otherwise non-displayable:
  596.     #
  597.     if( $no_del_files ) {
  598. 	@delfiles = grep {$allfiles{$_} == 0} (keys %allfiles);
  599. 	foreach $f (@delfiles) {
  600. 	    delete $allfiles{$f};
  601. 	}
  602.     }
  603.  
  604.  
  605. #Contents of //depot/dev/rtos/Xtensa/Software/rtos/vxworks/xt1000:
  606.     #  Display in this format:
  607.     print
  608. "[_LOCAL__]                HAVE RSLV [______OPENED______] [____DEPOT_____]\n".
  609. " perms     size p4 type   rev  rev  change  how others   loc head change  Name\n".
  610. "---------- ---- --------- ---- ---- ------- --- -------- --- ---- ------- ----\n";
  611. #-rwxr-xr-x      ktext     head      default bra rutt     cli #1   @20909  Makefile.in -> xxx
  612. #drwxr-xr-x      dir/text  dir       @12345  ...          dep              Tools
  613. #                          #1  +head                          !2           oldfile
  614. #                          #2  +#4   default int              #5   @22476  sysSerial.c.tpp  <+= sysSerialPoll.c.tpp#2
  615. #-rw-r--r--      ktext               default add                           focal  <= ../../blip/target.nr#2 done
  616. #....                      #1   done                          #2   ...
  617. #-rw-r--r--      ktext               default add                           xyz  <= //depot/rel/2_0/Xtensa/...
  618.  
  619.     foreach $f (sort keys %allfiles, keys %alldirs) {
  620. 	#my $where = $allfiles{$f};
  621. 	#print "   '$f'\n";
  622. 	my $fullp4path = $p4path."/".$f;	# full p4 pathname of $f
  623.  
  624. 	my $isdep  = exists($depfiles{$f});   my $dep   = $depfiles{$f}   if $isdep;
  625. 	my $iscli  = exists($clifiles{$f});   my $cli   = $clifiles{$f}   if $iscli;
  626. 	my $isdeph = exists($dephfiles{$f});  my $deph  = $dephfiles{$f}  if $isdeph;
  627. #	my $isclih = exists($clihfiles{$f});  my $clih  = $clihfiles{$f}  if $isclih;
  628. 	my $isdepo = exists($depofiles{$f});  my $depo  = $depofiles{$f}  if $isdepo;
  629. #	my $isclio = exists($cliofiles{$f});  my $clio  = $cliofiles{$f}  if $isclio;
  630. 	my $isdepoa= exists($depoafiles{$f}); my $depoa = $depoafiles{$f} if $isdepoa;
  631. #	my $isclioa= exists($clioafiles{$f}); my $clioa = $clioafiles{$f} if $isclioa;
  632. 	my $isloc  = exists($locfiles{$f});   my $loc   = $locfiles{$f}   if $isloc;
  633. 	my $isdeprn= exists($depreso{$f});    my $deprn = $depreso{$f}    if $isdeprn;
  634. 	my $isdeprs= exists($depresods{$f});  my $deprs = $depresods{$f}  if $isdeprs;
  635. 	my $isdepns= exists($depresons{$f});  my $depns = $depresons{$f}  if $isdepns;
  636.  
  637. 	#  Build display line:
  638.  
  639. 	my $line = "";
  640. 	my $symlink = "";
  641. 	my $filesize = -1;
  642.  
  643. 	#  Local info:
  644. 	if( $isloc ) {
  645. 	    my ($mode,$size,$mtime,$uid,$gid,$type,$symlnk) = @$loc;
  646. 	    $symlink = $symlnk;
  647. 	    #$line .= sprintf("%X",$mode >> 9);
  648. 	    $line .= $type
  649. 		    .(($mode & 0400)?"r":"-")
  650. 		    .(($mode & 0200)?"w":"-")
  651. 		    .(($mode & 0100)?"x":"-")
  652. 		    .(($mode & 0040)?"r":"-")
  653. 		    .(($mode & 0020)?"w":"-")
  654. 		    .(($mode & 0010)?"x":"-")
  655. 		    .(($mode & 0004)?"r":"-")
  656. 		    .(($mode & 0002)?"w":"-")
  657. 		    .(($mode & 0001)?"x":"-")
  658. 		    ." ";
  659. 	    $filesize = $size if $type ne 'd';
  660. 	} else {
  661. 	    $line .= "           ";
  662. 	    #  No filesize for now.
  663. 	}
  664.  
  665. 	if ($filesize >= 0) {
  666. 	    use integer;
  667. 	    my $suffix = 0;
  668. 	    my $decimal = "";
  669. 	    while ($filesize >= 1024) {
  670. 		my $remainder = ($filesize & 1023);
  671. 		$decimal = "." . ($remainder * 10 / 1024);
  672. 		$filesize /= 1024;
  673. 		$suffix++;
  674. 	    }
  675. 	    $decimal = "" if $filesize > 9;
  676. 	    my @suffixes = ("", "k", "M", "G", "T", "P", "E");
  677. 	    $filesize .= $decimal . $suffixes[$suffix];
  678. 	    $line .= substr("   " . $filesize, -4, 4) . " ";
  679. 	} else {
  680. 	    $line .= "     ";
  681. 	}
  682.  
  683. 	#  Type info (start cumulating):
  684. 	my %types = ();
  685.  
  686. 	#  Resolved info (self):
  687. 	$line_resf = ($isdeprs ? "*" : " ");
  688.  
  689. 	#  Have (and unresolved) info:
  690. 	$line_rslv = "     ";
  691. 	if( $isdeph ) {
  692. 	    my $have_ver = $deph;
  693. 	    if( $isdepns ) {
  694. 		#  Unresolved changes from depot version of this file:
  695. 		$have_ver = $$depns[3] - 1;
  696. 		$reso_ver = (($$depns[4] eq "") ? $$depns[3] : $$depns[4]);
  697. 		#  Note: p4's "have" version number ($deph) is ignored
  698. 		#  (generally same as $reso_ver though I think...?)
  699. 		if( $isdep and $$dep[2] == $reso_ver ) {
  700. 		    $line_rslv = "head ";
  701. 		} else {
  702. 		    $line_rslv = sprintf("#%-4u", $reso_ver);
  703. 		}
  704. 	    }
  705. 	    if( $isdep and $$dep[2] == $have_ver ) {
  706. 		$line_have = "head ";
  707. 	    } else {
  708. 		$line_have = sprintf("#%-4u", $have_ver);
  709. 	    }
  710. 	} else {
  711. 	    $line_have = "     ";
  712. 	    
  713. 	    #  Special case for directories:
  714. 	    if( $isdepns ) {
  715. 		$line_rslv = substr("(".$$depns[4].")    ",0,5);
  716. 	    }
  717. 	}
  718.  
  719. 	#  Opened info:
  720. 	if( $isdepo ) {
  721. 	    my($fpath,$fname,$fvers,$action,$chg,$chgnum,$ftype,$x1,$x2,$lock) = @$depo;
  722. 	    $types{$ftype} = 1;
  723. 	#    if( $isdep and $$dep[2] == $fvers ) {
  724. 	#	$line_open = "head ";
  725. 	#    } else {
  726. 	#	$line_open = sprintf("%s%-4u", ($action eq "delete" ? "!":"#"),$fvers);
  727. 	#    }
  728. 	    $action = substr($action,0,2)."*" if $lock;
  729. 	    $line_open = sprintf("%-8s%-3.3s ", $chgnum,$action);
  730. 	} else {
  731. 	    $line_open = "            ";
  732. 	}
  733.  
  734. 	#  Others info:
  735. 	$depoa = "" unless $isdepoa;
  736. 	$depoa =~ s/,$//;
  737. 	my @depoa = split(/,/,$depoa);
  738. 	#my @depoa = grep {$_ ne $p_user."@".$p_client} @depoa;
  739. 	foreach (@depoa) {s/\@.*//;}
  740. 	$depoa = join(',',@depoa);
  741. 	if( @depoa < 1 ) {
  742. 	    $line_others = "";
  743. 	} elsif( @depoa > 1 ) {
  744. 	    $line_others = substr($depoa,0,5)."...";
  745. 	} else {
  746. 	    $line_others = substr($depoa,0,8);
  747. 	}
  748. 	$line_others .= ((exists($filelocked{$f}) and $filelocked{$f}) ? "*" : "");
  749. 	$line_others = substr($line_others."         ",0,9);
  750.  
  751. 	#  Depot info:
  752. 	if( $isdep or $iscli ) {
  753. 	    if( $isdep and !$iscli ) {
  754. 		$line_dep = "DEP ";
  755. 	    } elsif( $iscli and !$isdep ) {
  756. 		$line_dep = "CLI ";
  757. 	    } else {
  758. 		$line_dep = "    ";
  759. 	    }
  760. 	    my $info = $isdep ? $dep : $cli;
  761. 	    my($fpath,$fname,$fvers,$action,$chg,$chgnum,$ftype) = @$info;
  762. 	    $types{$ftype} = 1;
  763. 	    $line_dep .= sprintf("%s%-4u%-8s", ($action eq "delete" ? "!":"#"),$fvers,$chgnum);
  764. 	} else {
  765. 	    $line_dep = "                 ";
  766. 	}
  767.  
  768. 	#  Item type:
  769. 	my $isdir = exists($alldirs{$f});
  770. 	if( exists($types{"DIR"}) ) {
  771. 	    $isdir = 1;
  772. 	    delete $types{"DIR"};
  773. 	}
  774. 	my @types = keys %types;
  775. 	if( $isdir ) {
  776. 	    $line_type = "DIR";
  777. 	    $line_type .= "/" if @types > 0;
  778. 	} else {
  779. 	    $line_type = "";
  780. 	}
  781. 	if( @types == 1 ) {
  782. 	    $line_type .= $types[0];
  783. 	} elsif( @types > 1 ) {
  784. 	    my $first = pop(@types);
  785. 	    my $suffix = $first;
  786. 	    foreach (@types) {
  787. 		while( ! /\Q$suffix\E$/ ) {$suffix = substr($suffix,1);}
  788. 	    }
  789. 	    $first =~ s/\Q$suffix\E$//;
  790. 	    foreach (@types) { s/\Q$suffix\E$//; }
  791. 	    my $prefix = $first;
  792. 	    foreach (@types) {
  793. 		while( ! /^\Q$prefix\E/ ) {$prefix = substr($prefix,0,length($prefix)-1);}
  794. 	    }
  795. 	    $first =~ s/^\Q$prefix\E//;
  796. 	    foreach (@types) { s/^\Q$prefix\E//; }
  797. 	    $line_type .= $prefix."*".$suffix;
  798. 	}
  799. 	$line_type = substr($line_type."          ",0,9);
  800.  
  801. 	#  Print most of the line:
  802. 	#
  803. 	print "$line$line_type$line_resf$line_have$line_rslv$line_open$line_others$line_dep$f$symlink";
  804.  
  805. 	#  Integration/branching information (resolved/unresolved, but not submitted):
  806. 	foreach $intfile (keys %{$deprn}) {
  807. 	    print "  <= ";
  808. 	    if( $intfile eq $fullp4path ) {	# same filename?
  809. 		print "self";			# should never happen
  810. 	    } elsif( $intfile ne " " ) {
  811. 		#  Try to shorten the name if it's similar to the file being integrated to.
  812.  
  813. 		#  Tensilica-specific name compression:  if same in different branch,
  814. 		#  just display the branch name.
  815. 		#  Is $f in a branch?:
  816. 		my $bpath = $fullp4path;
  817. 		if( $bpath =~ s@^//depot/(main|rel/[^/]+|dev/[^/]+|user/[^/]+)/@@ ) {
  818. 		    #my $fbranch = $1;
  819. 		    #  Current file (integrate destination) is in branch $1,
  820. 		    #  and $bpath now contains the branch-relative pathname.
  821. 		    #  Is $intfile same as $f in another branch?:
  822. 		    if( $intfile =~ m@^//depot/(main|rel/[^/]+|dev/[^/]+|user/[^/]+)/\Q$bpath\E$@ ) {
  823. 			my $intbranch = $1;	# branch from which this file was integrated
  824. 			print $intbranch;
  825. 		    } else {
  826. 			print $intfile;
  827. 		    }
  828. 		} else {
  829. 		    print $intfile;
  830. 		}
  831. 	    }
  832. 	    foreach my $rev (@{${$deprn}{$intfile}}) {
  833. 		my($locname,$frompathname,$action,$resvers,$resv3,$unresol) = @$rev;
  834. 		if( $resvers ne "" ) {
  835. 		    #  Normal files:
  836. 		    if( $unresol ) {
  837. 			print "#$resvers";
  838. 			print ",$resv3" if $resv3 ne "";
  839. 		    } else {
  840. 			print " ($action #$resvers";
  841. 			print ",$resv3" if $resv3 ne "";
  842. 			print ")";
  843. 		    }
  844. 		} else {
  845. 		    #  Directories:
  846. 		    if( $unresol ) {
  847. 			print " ($resv3 unresolved)";
  848. 		    } else {
  849. 			print " ($resv3 resolved)";
  850. 		    }
  851. 		}
  852. 	    }
  853. 	}
  854.  
  855. 	print "\n";
  856.     } # foreach item
  857.  
  858.     exit 0;
  859.  
  860.     open(FILES,"$p4prog files $args|") or die "$progname: can't $p4prog files $args: $!, stopped";
  861.     while( <FILES> ) {
  862. 	chomp;
  863. 	if( ! m@//depot([^#]*)/([^/#]*)#(\S*) - (\S+)\s+(\S+)\s+(\S+)\s+\(([^) ]+)\)@ ) {
  864. 	    print "*** unparsable line: $_\n";
  865. 	    next;
  866. 	}
  867. 	my($fpath,$fname,$fvers,$action,$chg,$chgnum,$ftype) = ($1,$2,$3,$4,$5,$6,$7);
  868. 	printf "%-9s #%-5s \@%-7s $fname  ($fpath)\n", $ftype, $fvers, $chgnum;
  869.     }
  870.     close FILES;
  871. }
  872.  
  873.  
# Change User Description Committed
#1 5330 Marc Gauthier Initial checkin of a few useful perl scripts for p4. 19 years ago