#!/bin/sh
# Not every host installs perl at the same location, handle many locations:
PATH=/usr/xtensa/stools-5.0/bin:/usr/bin:/usr/local/bin:$PATH
exec perl -x -S $0 ${1+"$@"}
exit $?
#!perl -w
#line 8
# pls -- Perforce 'ls' -- lists combined Perforce and local directories
# Copyright (c) 2000-2006, Tensilica Inc.
# All rights reserved.
#
# Redistribution and use, with or without modification, are permitted provided
# that the following conditions are met:
#
# - Redistributions must retain the above copyright notice, this list of
# conditions, and the following disclaimer.
#
# - Modified software must be plainly marked as such, so as not to be
# misrepresented as being the original software.
#
# - Neither the names of the copyright holders or their contributors, nor
# any of their trademarks, may be used to endorse or promote products or
# services derived from this software without specific prior written
# permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
# See `pls -h` for usage info.
#
# History:
# 2006-FEB-15 1.6 marc Recognize alternate login methods
# 2005-APR-12 1.5 marc Update copyright/license notice.
# 2002-OCT-02 1.4 marc Handle spaces in pathnames
# 2001-DEC-18 1.3 marc Improve perl and script path independence
# 2001-OCT-05 1.2 marc Put p4where() logic in p4lib.pm.
# 2001-??? 1.1b marc Use p4lib.pm.
# 2001-FEB-23 1.1 marc Add -p4 option.
# 2000-MAY-23 1.0 marc Initial version
$progvers = "1.6";
$progname = "pls";
$p4prog = "p4";
my $scriptdir = $0;
$scriptdir =~ s|[/\\][^/\\]+$||; # strip script name, leaving only dirname
push @INC, $scriptdir;
require p4lib;
# Get arguments:
@args = ();
while( defined($_ = shift) ) {
if( /^-q$/ ) { # don't show deleted files
$no_del_files = 1;
next;
}
if( /^-p4$/ ) { # set p4prog path
if( !defined($p4prog = shift) ) {
print STDERR "$progname: missing parameter after '-p4' option\n";
usage();
exit 1;
}
next;
}
if( /^-(h|help|\-h|\-help|\?)$/i ) {
usage();
exit 0;
}
if( /^-/ ) {
print STDERR "$progname: unrecognized option '$_'\n";
usage();
exit 1;
}
push(@args, $_);
}
# Only do p4 commands starting here, i.e. after -p4 option processed.
# Verify login:
my $verlogin = `$p4prog login -s`;
chomp($verlogin);
if ($verlogin !~ /ticket expires/
&& $verlogin !~ /not necessary/
&& $verlogin !~ /authenticated by password not ticket/) {
print STDERR "Perforce account requires login\n";
# Try doing a login (requesting password on the spot):
$vercode = system("$p4prog login");
if ($vercode != 0) {
die "Perforce account still requires login (exit code $vercode)\nStopped";
}
my($verlogin) = p4cmdout("login -s");
chomp($verlogin);
if ($verlogin !~ /ticket expires/) {
die "Perforce account still requires login ($verlogin)\n Stopped";
}
}
# Get various info:
p4getinfo();
# Execute listing:
if( @args == 0 ) {
pls("");
} else {
foreach (@args) {
pls($_);
}
}
exit 0; # done!
sub usage {
print <<"__END__";
Perforce lister v$progvers -- Displays contents of a Perforce/local directory
Usage: pls [-q] [dirpath [...]]
Options:
-q do not display deleted files (unless opened etc)
-h display this help message
-p4 progname set path to p4 executable (default 'p4')
Caveats: o You cannot specify a single file, only a directory
o Invokes many p4 commands, so tends to be slow
o Does not support //<clientname> requests (does support //)
o Does not display date/time or file size
Displays the following columns:
[_LOCAL__] HAVE RSLV [______OPENED______] [____DEPOT_____]
perms p4 type rev rev change how others loc head change Name
---------- --------- ---- ---- ------- --- -------- --- ---- ------- ----
LOCAL perms: -rwxrwxrwx as per 'ls -l' if the file/dir is on your disk
p4 type: p4 file type (text, ktext, DIR, etc) if Perforce knows about it;
if opened vs depot types are different, parts of the type that
differ are shown as '*' (eg. text vs ktext is shown as *text)
(note that DIR is not a p4 type, it is inferred by the script)
HAVE rev: revision of the file you have on your disk, or "head" if same as
the head rev in the depot; prefixed with '*' if this rev (or for
dirs, if any descendant file) includes resolved & unsubmitted revs;
(NOT same as p4 have's rev if RSLV rev present)
RSLV rev: revision of the file you last sync'ed, if newer and unresolved;
"head" if same as head rev in depot; for dirs, displays number
of descendant unresolved files; these unresolved files are due
to p4 sync (for unresolved due to p4 integrate, see Name column)
OPENED change: change number (or "default") if you have the file opened;
for dirs, shows change number for all opened descendant files
if they all have the same, else the number of opened files
OPENED how: action used to open file (or set of descendant files for dirs);
add=new file, int=integrate, del=deleted, bra=branch, edi=edit,
...=mixed actions (dirs only); last char replaced with '*' if you
have locked the file (or for dirs, locked any descendant file)
OPENED others: lists any other users who have opened the file (or for dirs, any
descendant file), including yourself if you opened it on another
client; ends with "..." if the list of users is too long to fit
(generally the case if more than 1 other user);
ends with '*' if any of these other users has locked the file(s)
DEPOT loc: "DEP" if file visible in depot but not your client;
"CLI" if file somehow visible in your client but not depot
DEPOT head: head rev of file if present in depot
(shown as !n instead of #n if depot file is deleted)
DEPOT change: last change number at which file was changed/affected in the depot
Name: name of the file;
"-> <symlink contents>" appended if is a symlink on your local disk;
"<= <pathname>[#rev[,rev]][ (<action>#rev)]" appended for each file
from which it was integrated but not submitted:
#rev[,rev] indicates unresolved versions;
(<action>#rev) indicates resolved versions, where <action> is
copy, igno or merg (there are probably others).
"<= (<n> unresolved) (<n> resolved)" appended for dirs for which
any descendant file has been integrated but not submitted
__END__
} #'
# Return list of files within a given Perforce directory path:
#
sub p4flat_files {
my($path,$what,$subdir_prefix) = @_;
return () if $path eq "";
my $subs = defined($subdir_prefix);
if( $subs ) {
$subdir_prefix =~ s|^//depot||; # prefix is in depot syntax
#$subdir_prefix .= "/" unless $subdir_prefix =~ m|/$|; # append '/'
}
$path .= "/".($subs ? "..." : "*");
my @files = p4files($what,$path);
my @result = ();
my %dirs = ();
foreach my $f ( @files ) {
my($fpath,$fname,$fvers,$action,$chgnum,$ftype,$byuser,$bycli,$lock) = @$f;
my $chg = "change";
$fpath =~ s|^//depot||;
#print "Got lock $fname '$lock'\n" if $lock;
$chgnum = "\@".$chgnum if $chgnum =~ /^\d+$/;
if( !$subs or $fpath eq $subdir_prefix ) {
push(@result, [$fpath,$fname,$fvers,$action,$chg,$chgnum,$ftype,$byuser,$bycli,$lock] );
#printf "%-9s #%-5s \@%-7s $fname ($fpath)\n", $ftype, $fvers, $chgnum;
} elsif( $fpath =~ s|^\Q$subdir_prefix\E/([^/]+)|| ) {
my $subdir = $1;
${$dirs{$subdir}}[0]++;
${$dirs{$subdir}}[4] += 0; # just make sure it's defined
${$dirs{$subdir}}[5] += 0; # ditto
if( $byuser eq $p_user and $bycli eq $p_client ) {
${${$dirs{$subdir}}[2]}{$action} = 1;
${${$dirs{$subdir}}[3]}{$chgnum} = 1;
${$dirs{$subdir}}[4]++ if $lock;
} else {
${${$dirs{$subdir}}[1]}{$byuser."@".$bycli} = 1;
${$dirs{$subdir}}[5]++ if $lock;
}
#push(@result, [$subdir_prefix,$subdir,"-","-",$chg,$chgnum,$ftype,$byuser,$bycli,$lock] );
#printf "Got subdir file: %-9s #%-5s \@%-7s $fname ($fpath)\n", $ftype, $fvers, $chgnum;
} else {
printf "Got unknown file: %-9s #%-5s \@%-7s $fname ($fpath)\n", $ftype, $fvers, $chgnum;
}
}
foreach (keys %dirs) {
my $nelems = ${$dirs{$_}}[0];
my @who = keys %{${$dirs{$_}}[1]};
my @actions = keys %{${$dirs{$_}}[2]};
my @changes = keys %{${$dirs{$_}}[3]};
my $nlocks = ${$dirs{$_}}[4];
my $nlockso = ${$dirs{$_}}[5];
my $dirwho = join(",",@who).",";
my $diract = (@actions == 1) ? $actions[0] : (@actions == 0) ? "" : "...";
my $dirchg = (@changes == 1) ? $changes[0] : (@changes == 0) ? "" : "($nelems)";
push(@result, [$subdir_prefix,$_,$nelems,$diract,"-",$dirchg,"DIR",$dirwho,"",$nlocks,$nlockso] );
}
return @result;
}
# Return list of files within a given Perforce directory path
# (parse 'p4 resolved' and 'p4 resolve -n' output):
#
sub p4resfiles {
my($path,$what,$subdir_prefix,$loc_prefix) = @_;
return () if $path eq "";
my $subs = defined($subdir_prefix);
my $cmdline = "$what ".p4passpath("$path/".($subs ? "..." : "*"));
##print "Doing '$cmdline'\n";
my($info) = p4cmdout($cmdline);
chomp($info);
#print STDERR "Got '$info'\n";
my @result = ();
my %dirs = ();
#print "subs $subs\n";
foreach ( split(/\n/,$info) ) {
if( ! m%(/[^#]+/)([^/#]*) - ([^/]+)\s+(//depot[^#]*/)([^/#]*)#([0-9]+)(,#([0-9]+)|)% ) {
print STDERR "$progname: unparsable line from '$p4prog -s $cmdline': $_\n";
next;
}
my($locpath,$locname,$action,$respath,$resname,$resvers,$resv2,$resv3) = ($1,$2,$3,$4,$5,$6,$7,$8);
defined($resv3) or $resv3 = "";
my $frompathname;
$action = substr($action,0,4);
if( $locpath !~ s|^\Q$loc_prefix/|| ) {
print "Couldn't find prefix '$loc_prefix' in '$locpath'\n";
return ();
}
if( $respath =~ s|^\Q$subdir_prefix/|| ) {
if( $respath !~ s|^\Q$locpath|| ) {
foreach ($locpath =~ m|/|g) {
$respath = "../$respath";
}
}
if( $locname eq $resname and $respath eq "" ) {
$frompathname = ""; # itself
} else {
$frompathname = $respath.$resname;
}
} else {
$frompathname = $respath.$resname;
# Try to get a shorter version using relative pathname:
my $p1 = $subdir_prefix."/".$locpath.$locname;
my $p2 = $frompathname;
#print "A. p1 = $p1\n p2 = $p2\n";
while(1) {
$p1 =~ m|^([^/]*/)| or last; $f1 = $1;
$p2 =~ m|^([^/]*/)| or last; $f2 = $1;
$f1 eq $f2 or last;
$p1 = substr($p1,length($f1));
$p2 = substr($p2,length($f1));
}
#print "B. p1 = $p1\n p2 = $p2\n";
foreach ($p1 =~ m|/|g) {
$p2 = "../$p2";
}
$frompathname = $p2 if length($p2) < length($frompathname);
# Try to get a shorter version using branch pathname:
#...(not yet implemented)...
}
#print "Got $action\[$resvers|$resv2|$resv3] <$locpath>'$locname' from <$frompathname>\n";
if( !$subs or $locpath eq "" ) {
push(@result, [$locname,$frompathname,$action,$resvers,$resv3] );
} else {
$locpath =~ m|^([^/]*)|;
my $subdir = $1;
${$dirs{$subdir}}[0] += ($frompathname eq "");
${$dirs{$subdir}}[1] += ($frompathname ne "");
}
}
foreach (keys %dirs) {
my $nself = ${$dirs{$_}}[0];
my $nintg = ${$dirs{$_}}[1];
push(@result, [$_," ","","",$nintg] ) if $nintg > 0;
push(@result, [$_,"","","","$nself"] ) if $nself > 0;
}
#print "\n";
return @result;
}
# Return list of files within a given Perforce directory path
# (parse 'p4 have' output):
#
sub p4havefiles {
my($path) = @_;
return () if $path eq "";
my @havelist = p4have("$path/*");
my @result = ();
foreach (@havelist) {
my($fpath,$fname,$fvers) = @$_;
$fpath =~ s|^//depot||;
push(@result, [$fpath,$fname,$fvers] );
}
return @result;
}
sub pls {
my ($args) = @_;
my $p4path = ""; # path to list in Perforce format, ie. prefixed
# with //depot or //<client>
my $locpath = "";
my $clipath = "";
defined($args) or $args = "";
# We have to remove any "." and "..":
#
my $roots = 0;
$roots++ while $args =~ s|^/||; # count leading slashes
$args = "/$args/"; # insure it starts and ends in slash
$args =~ s|//+|/|g; # collapse repeated slashes
$args =~ s|/\./|/|g; # strip out any "."
# Strip out any "xxx/..":
while($args =~ s@/([^/.][^/]*|\.[^/.][^/]*|\.\.[^/]+)/\.\./@/@g) { }
# There may be some leading ".." left, should be okay.
$roots = 2 if $roots > 2;
$args =~ s|^/||; # remove added leading '/'
$args =~ s|^\.\./||g if $roots > 0; # strip out any .. across root
my $argstrail = $args; # save path that has trailing '/'
$args =~ s|/$||; # remove added trailing '/'
if( $roots == 2 ) {
if( $args eq "" ) {
# Empty rooted path ("//").
# Special case, must list clients and depots:
print "Contents of //:\n";
print "Clients:\n";
my ($allclients) = p4cmdout("clients",0,1,1);
chomp($allclients);
foreach (sort(split(/\n/,$allclients))) {
/^Client (\S+) \S+ root ([^\']+) \'\s*(.*?)\s*\'\s*$/ or next;
my($cname,$croot,$ccomment) = ($1,$2,$3);
$ccomment =~ s|\s+\-?//.*||; # some people put commented out paths in here
printf "//%-20s -> %s (%s)\n", $cname,$croot,$ccomment;
}
print "Depots:\n";
my ($alldepots) = p4cmdout("depots",0,1,1);
chomp($alldepots);
foreach (sort(split(/\n/,$alldepots))) {
/^Depot (\S+) \S+ (\S+) subdir [^\']+ \'\s*(.*?)\s*\'\s*$/ or next;
my($dname,$dwhat,$dcomment) = ($1,$2,$3);
printf "//%-20s %-6s (%s)\n", $dname,$dwhat,$dcomment;
}
return;
}
$args = "//".$args;
$p4path = $args;
if( $argstrail =~ m|^depot/| ) {
# # already in depot format
} else {
# Verify that path is in client format:
#...
}
} else {
$args = "/".$args if $roots > 0;
$args = "." if $args eq "";
$locpath = $args;
}
#print STDERR "Got p4path = '$p4path'\n";
#print STDERR "Got locpath = '$locpath'\n";
# Use 'p4 where' to convert native format to Perforce format
# (default to //depot syntax):
my ($mapped,$w_p4path,$w_clipath,$w_locpath) = p4where($args);
($p4path,$clipath,$locpath) = ($w_p4path,$w_clipath,$w_locpath) if defined($w_p4path);
# my ($info) = p4cmdout("where ".p4passpath($args));
# if( $info eq "" ) { # can't map? try with a sub-element
# ($info) = p4cmdout("where ".p4passpath("$args/--.SoMeFiLe.--"));
# $info =~ s|/\-\-\.SoMeFiLe\.\-\-||gs;
# }
# if( $info eq "" ) {
# # The requested pathname couldn't map via the client.
# # Show what we can (either depot only or local files only).
# } else {
# chomp($info); $info =~ s|.*\n||s; # keep all but the last line
# my $notmapped = ($info =~ s|^\-||);
# if( $info !~ m|^(//.*) (//.*) (/.*)$| ) {
# die "$progname: can't parse output of '$p4prog -s where $args':\n".
# "$progname: '$info'\n".
# "$progname: stopped";
# }
# $p4path = $1;
# $clipath = $2;
# $locpath = $3;
# #print STDERR "Depot path is $p4path\n";
# #print STDERR "Client path is $clipath\n";
# #print STDERR "Local path is $locpath\n";
# print STDERR "$progname: warning: requested directory defined but unmapped by the client\n"
# if $notmapped;
# }
$args = ($p4path ne "") ? $p4path : $locpath;
print "Contents of $args:\n";
# Get (directory) contents of Perforce directory:
#
foreach (p4dirs($p4path)) { $alldirs{$_} |= 1; } # is in depot
foreach (p4dirs($clipath)) { $alldirs{$_} |= 2; } # is in client
# Get contents of local directory:
#
my @locitems = ();
if( $locpath ne "" ) {
if( opendir(DIR, $locpath) ) {
@locitems = readdir(DIR);
closedir DIR;
}
}
# @locdirs = grep { -d "$locpath/$_" } @locitems;
foreach (@locitems) {
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks) = lstat("$locpath/$_") or next;
$_ eq "." and next;
$_ eq ".." and next;
my $type;
my $symlink = "";
if (-f _) { $type = '-'; }
elsif (-d _) { $type = 'd'; }
elsif (-c _) { $type = 'c'; }
elsif (-b _) { $type = 'b'; }
elsif (-p _) { $type = 'p'; }
elsif (-S _) { $type = 's'; }
else { $type = 'l'; $symlink = ' -> ' . readlink("$locpath/$_"); }
if( $type eq 'd' ) {
$alldirs{$_} |= 4; # is local
} else {
# 0 dev device number of filesystem
# 1 ino inode number
# 2 mode file mode (type and permissions)
# 3 nlink number of (hard) links to the file
# 4 uid numeric user ID of file's owner
# 5 gid numeric group ID of file's owner
# 6 rdev the device identifier (special files only)
# 7 size total size of file, in bytes
# 8 atime last access time since the epoch
# 9 mtime last modify time since the epoch
# 10 ctime inode change time (NOT creation time!) since the epoch
# 11 blksize preferred block size for file system I/O
# 12 blocks actual number of blocks allocated
$allfiles{$_} = 1;
}
$locfiles{$_} = [$mode,$size,$mtime,$uid,$gid,$type,$symlink];
}
# # Display directories:
# #
# foreach (sort keys %alldirs) {
# my $where = $alldirs{$_};
# print "directory ",
# ($where & 1)?"depot":" ",
# " ",
# ($where & 2)?"client":" ",
# " $_\n";
# }
foreach (p4flat_files($p4path ,"files")) {
$allfiles{$$_[1]} += ($$_[3] ne "delete");
$depfiles{$$_[1]} = $_;
}
foreach (p4flat_files($clipath,"files")) {
$allfiles{$$_[1]} += ($$_[3] ne "delete");
$clifiles{$$_[1]} = $_;
}
foreach (p4havefiles($p4path )) {
$allfiles{$$_[1]} = 1;
$dephfiles{$$_[1]} = $$_[2];
}
# foreach (p4havefiles($clipath)) {
# $allfiles{$$_[1]} = 1;
# $clihfiles{$$_[1]} = $$_[2];
# }
foreach (p4resfiles($p4path ,"resolve -n",$p4path,$locpath)) {
if( $$_[3] eq "" ) { # directory?
$alldirs{$$_[0]} = 1;
} else {
$allfiles{$$_[0]} = 1;
}
if( $$_[1] eq "" ) { # self?
$depresons{$$_[0]} = $_;
} else {
$$_[5] = 1; # indicate unresolved
push(@{${$depreso{$$_[0]}}{$$_[1]}}, $_);
}
}
# Note - order matters (resolved done after resolve -n)
### BUG!!! need to p4resfiles() on client, not just depot,
### !!!!!! because some 'resolved' indications are only
### !!!!!! shown for client views (eg. integrate to new file)
foreach (p4resfiles($p4path ,"resolved",$p4path,$locpath)) {
if( $$_[3] eq "" ) { # directory?
$alldirs{$$_[0]} = 1;
} else {
$allfiles{$$_[0]} = 1;
}
if( $$_[1] eq "" ) { # self?
$depresods{$$_[0]} = $_;
} else {
$$_[5] = 0; # indicate resolved
push(@{${$depreso{$$_[0]}}{$$_[1]}}, $_);
}
}
#foreach (p4flat_files($p4path ,"opened")) { $allfiles{$$_[1]} = 1; $depofiles{$$_[1]} = $_; }
#foreach (p4flat_files($clipath,"opened")) { $allfiles{$$_[1]} = 1; $cliofiles{$$_[1]} = $_; }
foreach (p4flat_files($p4path ,"opened -a",$p4path)) {
if( $$_[6] eq "DIR" ) {
$alldirs{$$_[1]} = 1;
$depoafiles{$$_[1]} .= $$_[7];
$depofiles{$$_[1]} = $_;
$filelocked{$$_[1]} += $$_[10];
} else {
$allfiles{$$_[1]} = 1;
if( $$_[7] eq $p_user and $$_[8] eq $p_client ) {
$depofiles{$$_[1]} = $_;
} else {
$depoafiles{$$_[1]} .= $$_[7]."@".$$_[8].",";
$filelocked{$$_[1]} += $$_[9];
}
}
}
# foreach (p4flat_files($clipath,"opened -a",$p4path)) {
# if( $$_[6] eq "DIR" ) {
# $alldirs{$$_[1]} = 1;
# $clioafiles{$$_[1]} .= $$_[7];
# $cliofiles{$$_[1]} = $_;
# } else {
# $allfiles{$$_[1]} = 1;
# if( $$_[7] eq $p_user and $$_[8] eq $p_client ) {
# $cliofiles{$$_[1]} = $_;
# } else {
# $clioafiles{$$_[1]} .= $$_[7]."@".$$_[8].",";
# }
# }
# }
# If requested, don't list files that are deleted, unopened, and
# otherwise non-displayable:
#
if( $no_del_files ) {
@delfiles = grep {$allfiles{$_} == 0} (keys %allfiles);
foreach $f (@delfiles) {
delete $allfiles{$f};
}
}
#Contents of //depot/dev/rtos/Xtensa/Software/rtos/vxworks/xt1000:
# Display in this format:
print
"[_LOCAL__] HAVE RSLV [______OPENED______] [____DEPOT_____]\n".
" perms size p4 type rev rev change how others loc head change Name\n".
"---------- ---- --------- ---- ---- ------- --- -------- --- ---- ------- ----\n";
#-rwxr-xr-x ktext head default bra rutt cli #1 @20909 Makefile.in -> xxx
#drwxr-xr-x dir/text dir @12345 ... dep Tools
# #1 +head !2 oldfile
# #2 +#4 default int #5 @22476 sysSerial.c.tpp <+= sysSerialPoll.c.tpp#2
#-rw-r--r-- ktext default add focal <= ../../blip/target.nr#2 done
#.... #1 done #2 ...
#-rw-r--r-- ktext default add xyz <= //depot/rel/2_0/Xtensa/...
foreach $f (sort keys %allfiles, keys %alldirs) {
#my $where = $allfiles{$f};
#print " '$f'\n";
my $fullp4path = $p4path."/".$f; # full p4 pathname of $f
my $isdep = exists($depfiles{$f}); my $dep = $depfiles{$f} if $isdep;
my $iscli = exists($clifiles{$f}); my $cli = $clifiles{$f} if $iscli;
my $isdeph = exists($dephfiles{$f}); my $deph = $dephfiles{$f} if $isdeph;
# my $isclih = exists($clihfiles{$f}); my $clih = $clihfiles{$f} if $isclih;
my $isdepo = exists($depofiles{$f}); my $depo = $depofiles{$f} if $isdepo;
# my $isclio = exists($cliofiles{$f}); my $clio = $cliofiles{$f} if $isclio;
my $isdepoa= exists($depoafiles{$f}); my $depoa = $depoafiles{$f} if $isdepoa;
# my $isclioa= exists($clioafiles{$f}); my $clioa = $clioafiles{$f} if $isclioa;
my $isloc = exists($locfiles{$f}); my $loc = $locfiles{$f} if $isloc;
my $isdeprn= exists($depreso{$f}); my $deprn = $depreso{$f} if $isdeprn;
my $isdeprs= exists($depresods{$f}); my $deprs = $depresods{$f} if $isdeprs;
my $isdepns= exists($depresons{$f}); my $depns = $depresons{$f} if $isdepns;
# Build display line:
my $line = "";
my $symlink = "";
my $filesize = -1;
# Local info:
if( $isloc ) {
my ($mode,$size,$mtime,$uid,$gid,$type,$symlnk) = @$loc;
$symlink = $symlnk;
#$line .= sprintf("%X",$mode >> 9);
$line .= $type
.(($mode & 0400)?"r":"-")
.(($mode & 0200)?"w":"-")
.(($mode & 0100)?"x":"-")
.(($mode & 0040)?"r":"-")
.(($mode & 0020)?"w":"-")
.(($mode & 0010)?"x":"-")
.(($mode & 0004)?"r":"-")
.(($mode & 0002)?"w":"-")
.(($mode & 0001)?"x":"-")
." ";
$filesize = $size if $type ne 'd';
} else {
$line .= " ";
# No filesize for now.
}
if ($filesize >= 0) {
use integer;
my $suffix = 0;
my $decimal = "";
while ($filesize >= 1024) {
my $remainder = ($filesize & 1023);
$decimal = "." . ($remainder * 10 / 1024);
$filesize /= 1024;
$suffix++;
}
$decimal = "" if $filesize > 9;
my @suffixes = ("", "k", "M", "G", "T", "P", "E");
$filesize .= $decimal . $suffixes[$suffix];
$line .= substr(" " . $filesize, -4, 4) . " ";
} else {
$line .= " ";
}
# Type info (start cumulating):
my %types = ();
# Resolved info (self):
$line_resf = ($isdeprs ? "*" : " ");
# Have (and unresolved) info:
$line_rslv = " ";
if( $isdeph ) {
my $have_ver = $deph;
if( $isdepns ) {
# Unresolved changes from depot version of this file:
$have_ver = $$depns[3] - 1;
$reso_ver = (($$depns[4] eq "") ? $$depns[3] : $$depns[4]);
# Note: p4's "have" version number ($deph) is ignored
# (generally same as $reso_ver though I think...?)
if( $isdep and $$dep[2] == $reso_ver ) {
$line_rslv = "head ";
} else {
$line_rslv = sprintf("#%-4u", $reso_ver);
}
}
if( $isdep and $$dep[2] == $have_ver ) {
$line_have = "head ";
} else {
$line_have = sprintf("#%-4u", $have_ver);
}
} else {
$line_have = " ";
# Special case for directories:
if( $isdepns ) {
$line_rslv = substr("(".$$depns[4].") ",0,5);
}
}
# Opened info:
if( $isdepo ) {
my($fpath,$fname,$fvers,$action,$chg,$chgnum,$ftype,$x1,$x2,$lock) = @$depo;
$types{$ftype} = 1;
# if( $isdep and $$dep[2] == $fvers ) {
# $line_open = "head ";
# } else {
# $line_open = sprintf("%s%-4u", ($action eq "delete" ? "!":"#"),$fvers);
# }
$action = substr($action,0,2)."*" if $lock;
$line_open = sprintf("%-8s%-3.3s ", $chgnum,$action);
} else {
$line_open = " ";
}
# Others info:
$depoa = "" unless $isdepoa;
$depoa =~ s/,$//;
my @depoa = split(/,/,$depoa);
#my @depoa = grep {$_ ne $p_user."@".$p_client} @depoa;
foreach (@depoa) {s/\@.*//;}
$depoa = join(',',@depoa);
if( @depoa < 1 ) {
$line_others = "";
} elsif( @depoa > 1 ) {
$line_others = substr($depoa,0,5)."...";
} else {
$line_others = substr($depoa,0,8);
}
$line_others .= ((exists($filelocked{$f}) and $filelocked{$f}) ? "*" : "");
$line_others = substr($line_others." ",0,9);
# Depot info:
if( $isdep or $iscli ) {
if( $isdep and !$iscli ) {
$line_dep = "DEP ";
} elsif( $iscli and !$isdep ) {
$line_dep = "CLI ";
} else {
$line_dep = " ";
}
my $info = $isdep ? $dep : $cli;
my($fpath,$fname,$fvers,$action,$chg,$chgnum,$ftype) = @$info;
$types{$ftype} = 1;
$line_dep .= sprintf("%s%-4u%-8s", ($action eq "delete" ? "!":"#"),$fvers,$chgnum);
} else {
$line_dep = " ";
}
# Item type:
my $isdir = exists($alldirs{$f});
if( exists($types{"DIR"}) ) {
$isdir = 1;
delete $types{"DIR"};
}
my @types = keys %types;
if( $isdir ) {
$line_type = "DIR";
$line_type .= "/" if @types > 0;
} else {
$line_type = "";
}
if( @types == 1 ) {
$line_type .= $types[0];
} elsif( @types > 1 ) {
my $first = pop(@types);
my $suffix = $first;
foreach (@types) {
while( ! /\Q$suffix\E$/ ) {$suffix = substr($suffix,1);}
}
$first =~ s/\Q$suffix\E$//;
foreach (@types) { s/\Q$suffix\E$//; }
my $prefix = $first;
foreach (@types) {
while( ! /^\Q$prefix\E/ ) {$prefix = substr($prefix,0,length($prefix)-1);}
}
$first =~ s/^\Q$prefix\E//;
foreach (@types) { s/^\Q$prefix\E//; }
$line_type .= $prefix."*".$suffix;
}
$line_type = substr($line_type." ",0,9);
# Print most of the line:
#
print "$line$line_type$line_resf$line_have$line_rslv$line_open$line_others$line_dep$f$symlink";
# Integration/branching information (resolved/unresolved, but not submitted):
foreach $intfile (keys %{$deprn}) {
print " <= ";
if( $intfile eq $fullp4path ) { # same filename?
print "self"; # should never happen
} elsif( $intfile ne " " ) {
# Try to shorten the name if it's similar to the file being integrated to.
# Tensilica-specific name compression: if same in different branch,
# just display the branch name.
# Is $f in a branch?:
my $bpath = $fullp4path;
if( $bpath =~ s@^//depot/(main|rel/[^/]+|dev/[^/]+|user/[^/]+)/@@ ) {
#my $fbranch = $1;
# Current file (integrate destination) is in branch $1,
# and $bpath now contains the branch-relative pathname.
# Is $intfile same as $f in another branch?:
if( $intfile =~ m@^//depot/(main|rel/[^/]+|dev/[^/]+|user/[^/]+)/\Q$bpath\E$@ ) {
my $intbranch = $1; # branch from which this file was integrated
print $intbranch;
} else {
print $intfile;
}
} else {
print $intfile;
}
}
foreach my $rev (@{${$deprn}{$intfile}}) {
my($locname,$frompathname,$action,$resvers,$resv3,$unresol) = @$rev;
if( $resvers ne "" ) {
# Normal files:
if( $unresol ) {
print "#$resvers";
print ",$resv3" if $resv3 ne "";
} else {
print " ($action #$resvers";
print ",$resv3" if $resv3 ne "";
print ")";
}
} else {
# Directories:
if( $unresol ) {
print " ($resv3 unresolved)";
} else {
print " ($resv3 resolved)";
}
}
}
}
print "\n";
} # foreach item
exit 0;
open(FILES,"$p4prog files $args|") or die "$progname: can't $p4prog files $args: $!, stopped";
while( <FILES> ) {
chomp;
if( ! m@//depot([^#]*)/([^/#]*)#(\S*) - (\S+)\s+(\S+)\s+(\S+)\s+\(([^) ]+)\)@ ) {
print "*** unparsable line: $_\n";
next;
}
my($fpath,$fname,$fvers,$action,$chg,$chgnum,$ftype) = ($1,$2,$3,$4,$5,$6,$7);
printf "%-9s #%-5s \@%-7s $fname ($fpath)\n", $ftype, $fvers, $chgnum;
}
close FILES;
}