here's a nicer looking version of the depot browser (doh!)
ChristianLudloffuser.perforce.maillist at sandpile.org
ChristianLudloffuser.perforce.maillist at sandpile.org
Sat Jun 13 14:39:33 PDT 1998
[Doh! A partial version of this message went out by accident. I am sorry.]
The following three files provide you with a better looking depot browser.
The HTML file will divide the screen into two parts. In the upper one, the
p4browser.cgi script allows to see the depot structure, while in the lower
one the p4details.cgi script provides the changelist, changes, jobs...
When files are displayed, then text files just appear in the browser while
binary files are offered for downloading them. (Although the scripts force
a filename, my Netscape does ignore it when it opens the "Save As" window.
Anyone has an idea why?)
You will have to
- play with the P4BINARY (what a hack of an auto-detection via uname!),
- provide a user with access to the entire depot at the top of the CGIs,
- provide a company name in sub mailto in p4details.cgi for mailing,
- provide a backlink in the @HTMLFOOTER in both CGIs,
- provide your links to the scripts in the HTML file,
and
- do probably a lot more, if you plan to run this on a Windows server,
because it hasn't been tested on one.
Enjoy!
- ---------- p4depot.htm ----------
<html>
<head>
<title>Perforce Depot Browser & Details</title>
</head>
<frameset rows="50%,50%" border=10 frameborder=10 framespacing=10>
<frame name="browser" src="./p4browser.cgi">
<frame name="details" src="./p4details.cgi?@changes">
</frameset>
</html>
- ---------- p4browser.cgi ----------
#!/usr/local/bin/perl
# Perforce Depot Browser (based on freeware scripts from www.perforce.com)
open(OS,"uname -s |") or die "can't run uname";
while (<OS>) {
chop;
$platform = $_;
}
$myname = "p4browser.cgi";
$mymode = "both"; # can be "min", "both", or "max"
if ($platform eq "SunOS") {$ENV{P4BINARY} = "./p4-sparc"}
if ($platform eq "Linux") {$ENV{P4BINARY} = "./p4-linux"}
$ENV{P4PORT} = "perforce:1666";
$ENV{P4USER} = "some_user";
$ENV{P4CLIENT} = $myname;
@HTMLHEADER = (
"Content-type: text/html\n",
"\n",
"<html>\n",
"<head>\n",
"<title>Perforce Directories</title>\n",
"</head>\n",
"<body text=\"#000000\" bgcolor=\"#FFFFFF\" link=\"#004080\" vlink=\"#008080\" alink=\"#804040\">\n",
"<a name=\"top\">\n",
"<center><h1>Perforce Depot Browser</h1></center>\n",
"<hr>\n",
"<pre>"
);
@HTMLFOOTER = (
"</pre>\n",
"<hr>\n",
"<center><a href=\"$myname\">Top</a> | <a href=\"$myname?\@about\">About</a> | <a href=\"http://www.perforce.com/\" target=\"_blank\">Perforce Website</a> | <a href=\"./\" target=\"_top\">Done</a></center>\n",
"</body>\n",
"</html>\n"
);
if(!scalar(@ARGV)) {
push(@ARGV,"\@dirs");
}
if ($ARGV[0] eq "\@dirs") {
if($ARGV[1] eq "") {
push(@ARGV,"//depot/...");
}
open(P4,"$ENV{P4BINARY} files $ARGV[1] |") or die "can't run p4";
while(<P4>) {
m@^(.*)/[^#/]+#@;
$dir{$1}=1;
}
print @HTMLHEADER;
if ($mymode eq "min") { &dirs_min; } # mimimum display mode
elsif ($mymode eq "max") { &dirs_max; } # maximum display mode
else { # both display modes
&dirs_min;
print "\n<hr>\n";
&dirs_max;
}
print @HTMLFOOTER;
close P4;
}
elsif ($ARGV[0] eq "\@files") {
if($ARGV[1] eq "") {
push(@ARGV,"//depot/...");
}
open(P4,"$ENV{P4BINARY} files $ARGV[1] |") or die "can't run p4";
print @HTMLHEADER;
print "<li><b><a href=\"$myname?\@dirs+//depot/...\">//depot/...</a></b></li>\n";
unless ($ARGV[0] eq "//depot/...") {
print "<li><b><a href=\"$myname?\@dirs+$ARGV[1]\">$ARGV[1]</a></b></li>\n";
}
print "<br>\n";
print "<hr>\n";
while(<P4>) {
chop($_);
($path,$rev,$action,$change,$type) = m!^(\S.+)\#(\d+) - (\S+) \S+ (\S+) \((\w+)\)!;
($file) = ($path =~ m!^.*/(\S.+)!);
($name) = ($path =~ m!^.*/(\S.+)\..*$!); if ($name eq "") { ($name) = ($path =~ m!^.*/(\S.+)!); }
($ext) = ($path =~ m!^.+\.(\S.+)$!);
# print "$path\n"; # path+filename+extension
# print "$file\n"; # filename+extension
# print "$name\n"; # filename
# print "$ext\n"; # extension
# print "$rev\n"; # revision (1, 2, etc.)
# print "$action\n"; # action (add, edit, etc.)
# print "$change\n"; # change (1, 2, etc.)
# print "$type\n"; # type (text, binary, etc.)
if ($type eq "binary" | $type eq "xbinary") {
print "<li>";
if ($action eq "delete") { print "<strike>"; }
print "<b><a href=\"$myname?\@print+application/$ext+$file+$_\">$path</a></b> (rev #$rev, $action #$change, $type)";
if ($action eq "delete") { print "</strike>"; }
print "</li>\n";
} else {
print "<li>";
if ($action eq "delete") { print "<strike>"; }
print "<b><a href=\"$myname?\@print+text/html+$file+$_\">$path</a></b> (rev #$rev, $action #$change, $type)";
if ($action eq "delete") { print "</strike>"; }
print "</li>\n";
}
}
print @HTMLFOOTER;
close P4;
}
elsif ($ARGV[0] eq "\@print") {
if($ARGV[1] eq "") {
push(@ARGV,"//depot/");
}
if ($ARGV[1] eq "text/html") {
open(P4,"$ENV{P4BINARY} print $ARGV[3] |") or die "can't run p4";
print @HTMLHEADER;
print "<li><b><a href=\"$myname?\@dirs+//depot/...\">//depot/...</a></b></li>\n";
$counter = 0;
while(<P4>) {
chop($_);
if ($counter == 0) {
$updir = $_;
$updir =~ s|^(.*)/[^/]*#.*$|$1/...|;
print "<li><b><a href=\"$myname?\@files+$updir\">$updir</a></b></li>\n";
print "<br>\n";
print "<hr>\n";
print "<li><b>$_</b></li>\n";
print "<br>\n";
print "<hr>\n";
}
if ($counter > 0) {
# Any <...> is treated as an HTML tag, and if browsers doesn't support
# a tag, then it is not displayed. Therefore, change '<' into '<'.
s/</</g;
print "$_\n";
}
$counter = $counter + 1;
}
print @HTMLFOOTER;
} else {
open(P4,"$ENV{P4BINARY} print -q $ARGV[3] |") or die "can't run p4";
print "Content-type: $ARGV[1]; name=\"$ARGV[2]\"\n";
print "\n";
while(<P4>) { print "$_"; }
}
}
else {
print @HTMLHEADER;
print "<b>$myname currently supports the following invocations:</b>\n";
print "\n";
print " - print a list of directories $myname \@dirs //depot/... (this is the default)\n";
print " - print a list of files $myname \@files //depot/...\n";
print " - print a file\'s contents $myname \@print MIME-type filename.ext file\n";
print "\n";
print "<b>$myname currently has the following known bugs:</b>\n";
print "\n";
print " - filenames with whitespaces are not handled correctly\n";
print "\n";
print "<b>$myname currently uses this Perforce depot server:</b>\n";
print "\n";
open(P4,"$ENV{P4BINARY} info |") or die "can't run p4";
while(<P4>) {
if (($variable,$value) = /^Server (.*): (.*)$/) {
print " - server $variable = $value\n";
$is_up = 1;
}
}
print " - server status = ";
if ($is_up != 1) {
print "<font color=\"#FF0000\">not</font> ";
}
print "up and running\n";
close P4;
print "\n";
print "<b>$myname currently invokes $ENV{P4BINARY} ($platform).</b>\n";
print "</pre>\n";
print @HTMLFOOTER;
}
sub count_slashes {
local($string) = @_;
$count = 0;
$pos = -1;
while (($pos = index($string,"/",$pos)) > -1) {
$pos++;
$count++;
}
return $count;
}
sub dirs_updir {
print "<li><b><a href=\"$myname?\@dirs+//depot/...\">//depot/...</a></b> (<a href=\"$myname?\@files+//depot/...\">files</a>)</li>\n";
if ($ARGV[1] ne "//depot/...") {
$updir = $ARGV[1];
$updir =~ s#^(.*)/.*/\.\.\.#$1/...#;
if ($updir ne "//depot/...") {
print "<li><b><a href=\"$myname?\@dirs+$updir\">$updir</a></b> (<a href=\"$myname?\@files+$updir\">files</a>)</li>\n";
} else {
print "<li><b><a href=\"$myname?\@dirs+$ARGV[1]\">$ARGV[1]</a></b> (<a href=\"$myname?\@files+$ARGV[1]\">files</a>)</li>\n";
}
}
}
sub dirs_one {
print "<li><b><a href=\"$myname?\@dirs+$_/...\">$_/...</a></b> (<a href=\"$myname?\@files+$_/...\">files</a>)</li>\n";
}
sub dirs_min {
print "<b>minimum browsing mode for $ARGV[1]</b>\n";
print "<br>\n";
print "<hr>\n";
&dirs_updir;
%printed = ();
for (sort keys(%dir)) {
$slashes_arg = &count_slashes($ARGV[1]);
$slashes_now = &count_slashes($_);
while ($slashes_arg < $slashes_now) {
($keep) = /^(\S*)\/.*$/;
$slashes_now = &count_slashes($keep);
$_ = $keep;
}
if ($printed{$_} != 1) {
&dirs_one;
$printed{$_} = 1;
}
}
}
sub dirs_max {
print "<b>maximum browsing mode for $ARGV[1]</b>\n";
print "<br>\n";
print "<hr>\n";
&dirs_updir;
%printed = ();
for (sort keys(%dir)) {
if ($printed{$_} != 1) {
&dirs_one;
$printed{$_} = 1;
}
}
}
- ---------- p4details.cgi ----------
#!/usr/local/bin/perl
# Perforce Depot Details (based on freeware scripts from www.perforce.com)
open(OS,"uname -s |") or die "can't run uname";
while (<OS>) {
chop;
$platform = $_;
}
$myname = "p4details.cgi";
if ($platform eq "SunOS") {$ENV{P4BINARY} = "./p4-sparc"}
if ($platform eq "Linux") {$ENV{P4BINARY} = "./p4-linux"}
$ENV{P4PORT} = "perforce:1666";
$ENV{P4USER} = "some_user";
$ENV{P4CLIENT} = $myname;
$BLUE = qq(<font color="#004080">);
$GREEN = qq(<font color="#008080">);
$RED = qq(<font color="#804040">);
$END = qq(</font>);
$ADD = $BLUE;
$ADDEND = $END;
$DEL = "<STRIKE>$RED";
$DELEND = "$END</STRIKE>";
$MAXCONTEXT = 30;
$NCONTEXT = 10;
@HTMLHEADER = (
"Content-type: text/html\n",
"\n",
"<html>\n",
"<title>Perforce Depot Details</title>\n",
"<head>\n",
"<body text=\"#000000\" bgcolor=\"#FFFFFF\" link=\"#004080\" vlink=\"#008080\" alink=\"#804040\">\n",
"<a name=\"top\">\n",
"<center><h1>Perforce Depot Details</h1></center>\n",
"<hr>\n"
);
@HTMLFOOTER = (
"<hr>\n",
"<center><a href=\"$myname\">Top</a> | <a href=\"$myname?\@about\">About</a> | <a href=\"http://www.perforce.com/\" target=\"_blank\">Perforce Website</a> | <a href=\"./\" target=\"_top\">Done</a></center>\n",
"</body>\n",
"</html>\n"
);
if(!scalar(@ARGV)) {
push(@ARGV,"\@changes");
}
if( $ARGV[0] eq "\@changes" ) {
if($ARGV[1] eq "") {
push(@ARGV,"//depot/...");
}
open(P4,"$ENV{P4BINARY} changes -l $ARGV[1] |") or die "can't run p4";
print @HTMLHEADER;
print "<pre>\n";
print "<b>changes for $ARGV[1]</b>\n";
print "<br>\n";
print "<hr>";
while (<P4>) {
# Any <...> is treated as an HTML tag, and if browsers doesn't support
# a tag, then it is not displayed. Therefore, change '<' into '<'.
s/</</g;
if (($change,$date,$user) = /^Change (\d+) on (.*) by (.*)\@.*$/) {
print "\n";
print "<li>",&url("\@describe+$change","change $change")," on $date by ",&mailto("$user","$user"),"\n";
} else {
chop;
unless ($_ eq "") {
print "$_\n";
}
}
}
print "</pre>\n";
print @HTMLFOOTER;
close P4;
}
elsif( $ARGV[0] eq "\@describe" ) {
if($ARGV[1] eq "") {
push(@ARGV,"1");
}
open(P4,"$ENV{P4BINARY} describe -s $ARGV[1] |") or die "can't run p4";
$_ = <P4>;
($change,$user,$client,$date,$time) = /^Change (\d+) by (\S*)@(\S*) on (\S*) (\S*)$/;
print @HTMLHEADER;
print "<pre>\n";
print "<b>description for change $change</b>\n";
print "<br>\n";
print "<hr>";
print "<br>\n";
print "<b>author:</b> ",&mailto("$user","$user"),"\n";
print "<b>client:</b> $client\n";
print "<b>date: </b> $time on $date\n";
print "<br>\n";
print "<b>description:</b>\n";
while(<P4>) {
next if /^\s*$/;
last if /^Jobs fixed/;
last if /^Affected files/;
print $_;
}
if (/^Jobs fixed/) {
print "\n";
print "<b>fixed job(s):</b>\n";
while(<P4>) {
local($job,$time,$user,$client);
while (($job,$time,$user,$client) = /(\S*) fixed on (\S*) by (\S*)@(\S*)/) {
print " ",&url("\@job+$job",$job),"\n";
while (<P4>) {
chop;
last if /^\S/;
unless ($_ eq "") {
print "$_\n";
}
}
}
last if /^Affected files/;
}
}
print "</pre>\n";
print "<table border=0 cellspacing=0 cellpadding=0>\n";
print " <tr align=left>\n";
print " <th><tt>filename(s):</tt></th>\n";
print " <td width=25> </td>\n";
print " <th><tt>rev</tt></th>\n";
print " <td width=25> </td>\n";
print " <th><tt>action</tt></th>\n";
print " </tr>\n";
while(<P4>) {
if(($filename,$rev,$action) = /^\.\.\. (\S*)#(\d*) (\S*)$/ ) {
print " <tr align=left>\n";
print " <td><tt> ",&url("\@filelog+$filename","$filename"),"</tt></td>\n";
print " <td width=25> </td>\n";
print " <td><tt>",&url("\@print+$filename+$rev","$rev"),"</tt></td>\n";
print " <td width=25> </td>\n";
print " <td><tt>",&url("\@diff+$filename+$rev+$action","$action"),"</tt></td>\n";
print " </tr>\n";
}
}
print "</table>\n";
print "<br>\n";
print @HTMLFOOTER;
close P4;
}
elsif( $ARGV[0] eq "\@filelog" ) {
if($ARGV[1] eq "") {
push(@ARGV,"//depot/");
}
open(P4,"$ENV{P4BINARY} filelog $ARGV[1] |") or die "can't run p4";
$name = <P4>;
chop $name;
print @HTMLHEADER;
print "<pre>\n";
print "<b>filelog for file $name</b>\n";
print "</pre>\n";
print "<hr>";
print "<br>";
print "<table border=0 cellspacing=0 cellpadding=0>\n";
print " <tr align=left>\n";
print " <th><tt>rev</tt></th>\n";
print " <td width=25> </td>\n";
print " <th><tt>action</tt></th>\n";
print " <td width=25> </td>\n";
print " <th><tt>date</tt></th>\n";
print " <td width=25> </td>\n";
print " <th><tt>user</tt></th>\n";
print " <td width=25> </td>\n";
print " <th><tt>client</tt></th>\n";
print " <td width=25> </td>\n";
print " <th><tt>change</tt></th>\n";
print " <td width=25> </td>\n";
print " <th><tt>abbreviated desciption</tt></th>\n";
print " </tr>\n";
while(<P4>) {
if(($rev,$change,$action,$date,$user,$client,$description) = /^\.\.\. \#(\d+) \S+ (\d+) (\S+) on (\S+) by (\S*)@(\S*) '(.*)'/) {
if ($action eq 'branch') {
$_ = <P4>;
my($fromname,$fromrev) = /^.*branch from (\S+?)\#(\d+).*/;
print " <tr align=left>\n";
print " <td><tt>",&url("\@print+$name+$rev","$rev"),"</tt></td>\n";
print " <td width=25> </td>\n";
print " <td><tt>",&url("\@filelog+$fromname+$fromrev","$action"),"</tt></td>\n";
print " <td width=25> </td>\n";
print " <td><tt>$date</tt></td>\n";
print " <td width=25> </td>\n";
print " <td><tt>",&mailto("$user","$user"),"</tt></td>\n";
print " <td width=25> </td>\n";
print " <td><tt>$client</tt></td>\n";
print " <td width=25> </td>\n";
print " <td><tt>",&url("\@describe+$change","$change"),"</tt></td>\n";
print " <td width=25> </td>\n";
print " <td><tt>$description</tt></td>\n";
print " </tr>\n";
} elsif ($act eq 'delete') {
print " <tr align=left>\n";
print " <td><tt>",&url("\@print+$name+$rev","$rev"),"</tt></td>\n";
print " <td width=25> </td>\n";
print " <td><tt>$DEL$action$DELEND</tt></td>\n";
print " <td width=25> </td>\n";
print " <td><tt>$date</tt></td>\n";
print " <td width=25> </td>\n";
print " <td><tt>",&mailto("$user","$user"),"</tt></td>\n";
print " <td width=25> </td>\n";
print " <td><tt>$client</tt></td>\n";
print " <td width=25> </td>\n";
print " <td><tt>",&url("\@describe+$change","$change"),"</tt></td>\n";
print " <td width=25> </td>\n";
print " <td><tt>$description</tt></td>\n";
print " </tr>\n";
} else {
print " <tr align=left>\n";
print " <td><tt>",&url("\@print+$name+$rev","$rev"),"</tt></td>\n";
print " <td width=25> </td>\n";
print " <td><tt>",&url("\@diff+$name+$rev+$action","$action"),"</tt></td>\n";
print " <td width=25> </td>\n";
print " <td><tt>$date</tt></td>\n";
print " <td width=25> </td>\n";
print " <td><tt>",&mailto("$user","$user"),"</tt></td>\n";
print " <td width=25> </td>\n";
print " <td><tt>$client</tt></td>\n";
print " <td width=25> </td>\n";
print " <td><tt>",&url("\@describe+$change","$change"),"</tt></td>\n";
print " <td width=25> </td>\n";
print " <td><tt>$description</tt></td>\n";
print " </tr>\n";
}
}
}
print "</table>\n";
print "<br>\n";
print @HTMLFOOTER;
close P4;
}
elsif ($ARGV[0] eq "\@print") {
if($ARGV[1] eq "") {
push(@ARGV,"//depot/");
}
if($ARGV[2] eq "") {
push(@ARGV,"1");
}
open(P4,"$ENV{P4BINARY} print $ARGV[1]#$ARGV[2] |") or die "can't run p4";
$_ = <P4>;
($name,$rev,$type) = m!^(\S+)\#(\d+) - \S+ \S+ \S+ \((\w+)\)!;
if ($type eq "binary" || $type eq "xbinary") {
($file_name) = ($name =~ m!^.*/(\S+)!);
($just_name) = ($name =~ m!^.*/(\S+)\..*$!); if ($just_name eq "") { ($just_name) = ($name =~ m!^.*/(\S+)!); }
($just_ext) = ($name =~ m!^.+\.(\S+)$!);
# print "$name\n"; # path+filename+extension
# print "$file_name\n"; # filename+extension
# print "$just_name\n"; # filename
# print "$just_ext\n"; # extension
close P4;
open(P4,"$ENV{P4BINARY} print -q $ARGV[1]#$ARGV[2] |") or die "can't run p4";
print "Content-type: application/$just_ext; name=\"$file_name\"\n";
print "\n";
while(<P4>) { print "$_"; }
} else {
print @HTMLHEADER;
print "<pre>\n";
print "<b>file $name (rev $rev)</b>\n";
print "<br>\n";
print "<hr>";
print "<br>\n";
while (<P4>) {
# Any <...> is treated as an HTML tag, and if browsers doesn't support
# a tag, then it is not displayed. Therefore, change '<' into '<'.
s/</</g;
print $_;
}
print "</pre>\n";
print @HTMLFOOTER;
}
close P4;
}
elsif ($ARGV[0] eq "\@diff") {
if($ARGV[1] eq "") {
push(@ARGV,"//depot/");
}
if($ARGV[2] eq "") {
push(@ARGV,"1");
}
if($ARGV[3] eq "") {
push(@ARGV,"unknown");
}
$nchunk = 0;
print @HTMLHEADER;
print "<pre>\n";
print "<b>diffs for file $ARGV[1] (rev $ARGV[2], $ARGV[3])</b>\n";
print "<br>\n";
print "<hr>";
if ($ARGV[3] ne 'add' && $ARGV[3] ne 'delete' && $ARGV[3] ne 'branch') {
$f1 = "$ARGV[1]#" . ($ARGV[2] - 1);
$f2 = "$ARGV[1]#" . ($ARGV[2]);
open(P4,"$ENV{P4BINARY} diff2 $f1 $f2 |") or die "can't run p4";
$_ = <P4>;
while (<P4>) {
($la,$lb,$op,$ra,$rb) = /(\d+),?(\d*)([acd])(\d+),?(\d*)/;
next unless $ra;
if (!$lb) { $lb = $op ne 'a' ? $la : $la - 1; }
if (!$rb) { $rb = $op ne 'd' ? $ra : $ra - 1; }
$start[$nchunk] = $op ne 'd' ? $ra : $ra + 1;
$dels[$nchunk] = $dels = $lb - $la + 1;
$adds[$nchunk] = $adds = $rb - $ra + 1;
@lines[$nchunk] = ();
while ($dels--) {
$_ = <P4>;
s/^. //;
if (/[&<>]/) {
# Any <...> is treated as an HTML tag, and if browsers doesn't support
# a tag, then it is not displayed. Therefore, change '<' into '<'.
s/</\</g;
}
@lines[$nchunk] .= $_;
}
if ($op eq 'c') { $_ = <P4>; }
while ($adds--) { $_ = <P4>; }
$nchunk++;
}
close P4;
}
print "<center>\n";
print "$ADD added lines $ADDEND\n";
print "$DEL deleted lines $DELEND\n";
print "</center>\n";
print "<hr>\n";
$curlin = 1;
open(P4,"$ENV{P4BINARY} print -q $ARGV[1]#$ARGV[2] |") or die "can't run p4";
for ($n = 0; $n < $nchunk; $n++) {
&catchup('P4',$start[$n] - $curlin);
if ($dels[$n]) {
print "$DEL";
print @lines[$n];
print "$DELEND";
}
if ($adds[$n]) {
print "$ADD";
&display('P4',$adds[$n]);
print "$ADDEND";
}
$curlin = $start[$n] + $adds[$n];
}
&catchup('P4',999999999);
print "<br>\n";
print "<hr>\n";
print "<center><b>$GREEN end of file $END</b></center>";
print "</pre>\n";
print @HTMLFOOTER;
close P4;
}
#
# job job
#
elsif ($ARGV[0] eq "\@job") {
open(P4,"$ENV{P4BINARY} job -o $ARGV[1] |") or die "can't run p4";
while (<P4>) {
next if (/^Job/ && (($job) = /^Job:\s(\S*)/));
next if (/^User/ && (($user) = /^User:\s*(\S*)/));
next if (/^Status/ && (($status) = /^Status:\s*(\S*)/));
next if (/^Date/ && (($date,$time) = /^Date:\s*(\S*) (\S*)/));
last if (/^Description/);
}
print @HTMLHEADER;
print "<pre>\n";
print "<b>description for job $job</b>\n";
print "<br>\n";
print "<hr>";
print "<br>\n";
print "<b>user: </b> ",&mailto("$user","$user"),"\n";
print "<b>status:</b> $status\n";
print "<b>date: </b> $time on $date\n";
print "<br>\n";
print "<b>description:</b>\n";
while(<P4>) {
chop;
unless ($_ eq "") {
print "$_\n";
}
}
close P4;
print "</pre>\n";
open(P4,"$ENV{P4BINARY} fixes -j $ARGV[1] |") or die "can't run p4";
$count = 0;
while(<P4>) {
if (!$count++) {
print "<table border=0 cellspacing=0 cellpadding=0>\n";
print " <tr align=left>\n";
print " <th colspan=7><tt>fixes:</tt></th>\n";
print " </tr>\n";
print " <tr align=left>\n";
print " <th><tt> change</tt></th>\n";
print " <td width=25> </td>\n";
print " <th><tt>date</tt></th>\n";
print " <td width=25> </td>\n";
print " <th><tt>user</tt></th>\n";
print " <td width=25> </td>\n";
print " <th><tt>client</tt></th>\n";
print " </tr>\n";
}
if(($change,$date,$user,$client) = /^\S* fixed by change (\S*) on (\S*) by (\S*)@(\S*)/) {
print " <tr align=left>\n";
print " <td><tt> ",&url("\@describe+$change","$change"),"</tt></td>\n";
print " <td width=25> </td>\n";
print " <td><tt>$date</tt></td>\n";
print " <td width=25> </td>\n";
print " <td><tt>",&mailto("$user","$user"),"</tt></td>\n";
print " <td width=25> </td>\n";
print " <td><tt>$client</tt></td>\n";
print " </tr>\n";
}
}
if ($count) {
print "</table>\n";
print "<br>\n";
}
print @HTMLFOOTER;
close P4;
}
else {
print @HTMLHEADER;
print "<pre>\n";
print "<b>$myname currently supports the following invocations:</b>\n";
print "\n";
print " - print a list of changes $myname \@changes //depot/... (this is the default)\n";
print " - print a change description $myname \@describe change#\n";
print " - print a file\'s history $myname \@filelog file\n";
print " - print a file\'s contents $myname \@print file rev#\n";
print " - print a list of diffs $myname \@diff file rev# action\n";
print " - print a job description $myname \@job job#\n";
print "\n";
print "<b>$myname currently has the following known bugs:</b>\n";
print "\n";
print " - filenames with whitespaces are not handled correctly\n";
print "\n";
print "<b>$myname currently uses this Perforce depot server:</b>\n";
print "\n";
open(P4,"$ENV{P4BINARY} info |") or die "can't run p4";
while(<P4>) {
if (($variable,$value) = /^Server (.*): (.*)$/) {
print " - server $variable = $value\n";
$is_up = 1;
}
}
print " - server status = ";
if ($is_up != 1) {
print "<font color=\"#FF0000\">not</font> ";
}
print "up and running\n";
close P4;
print "\n";
print "<b>$myname currently invokes $ENV{P4BINARY} ($platform).</b>\n";
print "</pre>\n";
print @HTMLFOOTER;
}
###############################################################################
sub url {
local($url,$name) = @_;
return qq(<a href="$ENV{P4CLIENT}?$url">$name</a>);
}
sub mailto {
local($mail,$name) = @_;
return qq(<a href="mailto:$mail\@some_company.com">$name</a>);
}
sub skip {
local ($handle,$to) = @_;
while ($to > 0 && ($_ = <$handle>)) { $to--; }
return $to;
}
sub display {
local ($handle,$to) = @_;
while ($to-- > 0 && ($_ = <$handle>)) {
if (/[&<>]/) {
# Any <...> is treated as an HTML tag, and if browsers doesn't support
# a tag, then it is not displayed. Therefore, change '<' into '<'.
s/</\</g;
}
print $_;
}
}
sub catchup {
local ($handle,$to) = @_;
if ($to > $MAXCONTEXT) {
local($skipped) = $to - $NCONTEXT * 2;
&display($handle,$NCONTEXT);
$skipped -= &skip($handle,$skipped);
print "<hr><center><b>$skipped lines skipped</b></center><hr>\n" if( $skipped );
&display($handle,$NCONTEXT);
}
else { &display; }
}
- ---------- end ----------
- --
Christian Ludloff http://www.sandpile.org/ Interested in x86 chips?
ludloff at sandpile.org ftp://ftp.sandpile.org/ Go and visit my website!
Speaking for myself. Trademarks are property of their respective owners.
More information about the perforce-user
mailing list