#!/usr/bin/perl
#
# perfbrowse.perl -- CGI browser for PERFORCE
#
# $Id: //guest/matthew_rees/perfbrowse/perfbrowse.pl#3 $

# Updated by Jeff Marshall at Paragon Software, Inc.
# (jam@paragon-software.com)
#
# Revised by Matthew Rees (matthew@marc.com) 6/14/1999
#  - Add FORMS capability
#  - Add a nice way to browse the repository
#  - Many other miscellaneous changes
#  - Tested with Perforce server version 99.1

# Set these according to your system:
$ENV{P4PORT} = "1666";
$ENV{P4CLIENT} = "perfbrowse";

# When using authentication on the web server, REMOTE_USER is set and could
# be used here.  But it wouldn't work for any users that use a password!
#$ENV{P4USER} = $ENV{REMOTE_USER};
$ENV{P4USER} = "p4admin";

# The PATH environment variable needs to be able to pick up the p4 command
$ENV{PATH} .= ":/usr/local/bin"; 

# Set TOPPAGE to something other than this script if you want to use a custom
# static top-level page (link to this is included at the bottom of every page)
# Suggestion: run 'perfbrowse.pl > index.html' and edit to create your top page
#$TOPPAGE = "$myname";
$TOPPAGE = "/index.html";

# These icons are used for the depot browser
# (They may be left undefined, but it looks much better you find icons!)
$UPDIR_ICON = "/icons/hand.up.gif";
$DIR_ICON = "/icons/folder.gif";

# The name of this script
$myname = $ENV{SCRIPT_NAME} || "cgi/perfbrowse.pl";

$BLUE = qq(<font color="#0000FF">);
$RED = qq(<font color="#B00000">);
$END = qq(</font>);

$ADD = $BLUE;
$ADDEND = $END;
$DEL = "<STRIKE>$RED";
$DELEND = "$END</STRIKE>";

$MAXCONTEXT = 30;
$NCONTEXT = 10;

$PRINTEDHEADER = 0;

&ReadParse(\%INPUT);


################################
#
# No arguments. 
#
#	Put up a basic index page
#
################################

if (! defined $INPUT{'cmd'}) {

    print &header("Perforce Web Interface");
    print "<center><h1>Perforce Web Interface</h1></center>\n<hr>\n";
    print "<h2>Browse the depot: Select a starting point </h2>\n<ul>\n",
          "<li><a href=\"$myname\?cmd=browse&spec=//depot\"> \n",
          "//depot </a></ul>\n",
          qq(<form method="send" name="Browse" ), "action=\"$myname\">\n",
          qq(<input type="hidden" name="cmd" value="browse">), "\n",
          "<dl><dd>Or enter a directory to start:\n<dd>",
          qq(<input name="spec" size="50" maxlength="255" value="//depot">),
          "\n", qq(<input type="submit" value="Go"><br>), "\n",
          "<dd><input type=checkbox name=showdeleted>",
          "Show deleted files/directories\n</dl>\n</form>\n\n";
    print "<h2>Query Changes: Select a path to limit the query\n</h2>\n",
          "<ul>\n<li>",
          "<a href=\"$myname\?cmd=changes&spec=//depot/...&limit=1\">",
          "//depot/...</a>\n", "</ul>\n\n",
          qq(<form method="send" name="Query" action=), "\"$myname\">\n",
          qq(<input type="hidden" name="cmd" value="changes">), "\n",
          "<dl>\n<dd>Or enter your own path specification:\n<dd><input ",
          qq(name="spec" size="50" maxlength="255" value="//depot/...">),
          "\n", qq(<input type="submit" value="Go">), "\n<dd>",
          qq(<input type="checkbox" name="limit" checked>), "\n",
          "Limit results to last ", 
          qq(<input name="max" size=5 maxlength=5 value="20">), "\nchanges\n",
          "</dl>\n</form>\n\n";
    print "<dl>\n<dt><h2>Other Queries:</h2>\n",
          "<dd><li><a href=\"$myname\?cmd=clients\"> Clients </a>:\n",
          "See what clients have been defined by any user.\n",
          "<dd><li><a href=\"$myname\?cmd=users\"> Users </a>:\n",
          "See information about the users known to the Perforce server.\n",
          "<dd><li><a href=\"$myname\?cmd=branches\"> Branches </a>:\n",
          "See what branches have been created in the depot.\n",
          "<dd><li><a href=\"$myname\?cmd=labels\"> Labels </a>:\n",
          "See information about labels in the depot.\n",
          "<dd><li><a href=\"$myname\?cmd=jobs\"> Jobs </a>:\n",
          "See information about jobs.\n",
          "</dl>\n";
    print "\n<p><hr>\n";
    print "<center><a href=\"http://www.perforce.com\">Perforce Home Page</a>",
          "</center>\n";
    print "\n</body></html>\n";

    exit 0;
}


################################
#
# Browse the repository ('browse')
#  "spec=path_spec"  - the file/directory specification
#  "showdeleted=b"   - flag to also list deleted files/directories
#
################################

elsif ( $INPUT{'cmd'} eq "browse" ) {
    local ($spec) = $INPUT{'spec'};
    $spec = "//*" if (!$spec || $spec =~ m!^/+$!);
    local ($sdel) = "showdeleted=1" if( $INPUT{'showdeleted'} );

    print &header("Listing of $spec");
    print "<center><h1>Listing of $spec</h1>\n";

    print &formtop("browse"), "<input name=\"spec\" size=50 maxlength=255 ",
          "value=\"$spec\">\n",
          "<input type=\"submit\" value=\"Go\"><br>",
          "<input type=\"checkbox\" name=\"showdeleted\" ";
    print "checked" if $sdel;
    print ">Show deleted files/directories\n</form>";

    local ($head, $tail) = ($spec =~ m!^(.*)/([^/]*)$!);
    local ($getdirs, $getfiles) = (1,1);
    local ($wildcards) = ($spec =~ m![*]|\.\.\.!);
    local ($showpaths) = ($head =~ m![*]|\.\.\.!);
    local ($nfound) = 0;

    if (! $tail) { 
	$getfiles = 0; 
	$spec = $head; 
    } elsif (! $wildcards) {
	&p4open('P4', "dirs ".($sdel ? "-D " : "")."\"$spec\" 2> /dev/null|");
	if(<P4>) { $spec .= "/*"; }
	else { $getdirs = 0; }
	close P4;
    }

    print "</center><hr>\n";
    print "<table cellpadding=0 cellspacing=0>\n";

    #### Print the Directories ####
    if( $getdirs ) {
	if ($tail && !$wildcards) {
	    if($UPDIR_ICON) { print "<tr><td><img src=\"$UPDIR_ICON\"></td>"; }
	    else { print "<tr><td>(dir) </td>"; }
	    print "<td>", &url( "browse", "spec=$head", "$sdel", ".. (UP)" ), 
	          "</td></tr>\n";
	}
	&p4open('P4', "dirs ".($sdel ? "-D " : "")."\"$spec\" 2> /dev/null|");
	local( $dirsymbol ) = ($DIR_ICON ? "<img src=\"$DIR_ICON\">" : 
			       "(dir) ");
	while (<P4>) {
	    local( $d ) = ($showpaths ? $_ : m!^.*/([^/]+)$!);
	    print "<tr><td> $dirsymbol &nbsp;&nbsp;</td>";
	    print "<td>", &url("browse", "spec=$_", "$sdel", $d), "</td>",
	          "</tr>\n";
	    $nfound ++;
	}
	close P4;
	print "</table><p>\n";
    }

    #### Print the Files ###
    # Sample: //depot/main/p4/Jamrules#71 - edit change 42 (text)
    if( $getfiles ) {
	print "<table cellpadding=>\n";
	&p4open( 'P4', "files \"$spec\" 2> /dev/null|" );
	while (<P4>) {
	    if ( local($filepath,$rev,$action,$change,$type)  = 
		 m!^(\S.+)\#(\d+) - (\S+) \S+ (\S+) \((\w+)\)$! ) {
		next if ( !$sdel && $action eq "delete" );
		local($file) = ($showpaths ? $filepath : 
				$filepath =~ m!^.*/(\S.+)!);
		print "<tr><td><li>";
		if ($action eq "delete") { print "$DEL"; }
		print &url( "filelog", "file=$filepath", "$file" );
		if ($action eq "delete") { print "$DELEND"; }
		print "</td><td>",
		"(rev ", &url("print", "file=$filepath", "rev=$rev", "#$rev"),
		", $action \@ change ", 
		&url( "describe", "change=$change", "#$change" ), 
		" ) &lt;$type&gt; </td></tr>\n";
		$nfound ++;
	    }
	}
	close P4;
	print "</table>\n";
    }
    print "No such file or directory<br>\n" if (!$nfound);

    $spec =~ s!(.*)/\*$!$1/\.\.\.! if ($getdirs);
    @OTHER_FOOTERS = (" | ", &url ("changes", "spec=$spec", "limit=1",
				   "Show changes"));
}


################################
#
# p4 users
#
################################

elsif ( $INPUT{'cmd'} eq "users" ) {
    &p4open( 'P4', "users|" );

    print &header("Perforce Users");
    print 
	"<center><h1>Perforce Users</h1>\n</center>",
	"<i>This browser allows you to view information about ",
    	" Perforce users.</i>\n",
	"<hr>";

    print
	"<table cellpadding=1>",
	"<tr align=left><th>User<th>Email<th>Full Name",
	"<th>Last Accessed</tr>\n";

    # Sample:
    # jam <jam@bar.com> (Jeffrey A. Marshall) accessed 1998/07/03

    while( <P4> ) {
	if (local( $user, $email, $fullname, $accessed ) = 
	    /(\S+) <(\S+)> \((.*)\) accessed (\S+)/)
	{
	    print "<tr>",
	    	  "<td>", &url ( "user", "name=$user", "$user"),
		  "<td>", &mailto ( "$email" ),
	    	  "<td>", "$fullname",
		  "<td>", "$accessed",
	       	  "</tr>\n";
	}
    }
    print "</table>\n";
    close P4;
}


################################
#
# p4 user
#  "name=username"  - the user to list  *required*
#
################################

elsif ( $INPUT{'cmd'} eq "user" ) {
    local( $user, $email, $update, $access, $fullname, $jobview );
    $user = $INPUT{'name'};
    &p4open ('P4', "user -o $user|");

    while (<P4>)
    {
	next if (/^User:/);
	next if (/^Email:/ && (( $email ) = /^Email:\s*(.*)$/ ));
	next if (/^Update:/ && (( $update ) = /^Update:\s*(.*)$/ ));
	next if (/^Access:/ && (( $access ) = /^Access:\s*(.*)$/ ));
	next if (/^FullName:/ && (( $fullname ) = /^FullName:\s*(.*)$/ ));
	next if (/^JobView:/ && (( $jobview ) = /^JobView:\s*(.*)$/ ));
	last if (/^Reviews:/);
    }

    print &header("Perforce User Information");
    print 
	"<center><h1>Perforce User Information for $user</h1>\n</center>",
	"<i>This browser allows you to view information about ",
    	" a given Perforce user.</i>\n<hr>",
	"<h3>Full Name</h3><pre>        $fullname</pre>\n",
	"<h3>Email</h3><pre>        ", &mailto ("$email"), "</pre>\n";
    print
	"<h3>Last Update</h3><pre>        $update</pre>\n" if $update;
    print
	"<h3>Last Access</h3><pre>        $access</pre>\n";
    print
	"<h3>JobView</h3><pre>            $jobview</pre>\n" if $jobview;
    print
	"<h3>Reviews</h3>\n<pre>";

    while (<P4>) { print; }
    print "</pre>\n";
    close P4;

    @OTHER_FOOTERS = (" | ",
		      , &url ("opened", "user=$user",
			      "Files Opened by $user"));
}


################################
#
# p4 clients
#
################################

elsif ( $INPUT{'cmd'} eq "clients" ) {
    &p4open( 'P4', "clients|" );

    print &header("Perforce Clients");
    print
	"<center><h1>Perforce Clients</h1>\n</center>",
	"<i>This browser allows you to view information about ",
    	" Perforce clients.</i>\n",
	"<hr>";

    print
	"<table cellpadding=5>",
	"<tr align=left><th>Client<th>Date<th>Root Directory",
	"<th>Description</tr>\n";

    # Sample:
    # Client oak.template 1998/06/25 root /tmp 'OAK client template '

    while( <P4> ) {
	if (local( $client, $date, $root, $descrip ) = 
	    /Client (\S+) (\S+) root (\S+) '(.*)'/)
	{
	    print "<tr>",
	    	  "<td>", &url ( "client", "name=$client", "$client"),
		  "<td>$date",
		  "<td>$root",
		  "<td>$descrip",
	       	  "</tr>\n"
	}
    }
    print "</table>\n";
    close P4;
}


################################
#
# p4 client
#  "name=clientname"  -  the client to list  *required*
#
################################

elsif ( $INPUT{'cmd'} eq "client" ) {
    local( $client, $date, $update, $access, $owner, $root, $opts );
    $client = $INPUT{'name'};
    &p4open ('P4', "client -o $client|");

    while (<P4>)
    {
	next if (/^Client:/);
	next if (/^Date:/ && (( $date ) = /^Date:\s*(.*)$/ ));  # Pre-99.1
	next if (/^Update:/ && (( $update ) = /^Update:\s*(.*)$/ ));
	next if (/^Access:/ && (( $access ) = /^Access:\s*(.*)$/ ));
	next if (/^Owner:/ && (( $owner ) = /^Owner:\s*(\S+)$/ ));
	last if (/^Description:/);
    }

    print &header("Perforce Client Information");
    print
	"<center><h1>Perforce Client Information for $client</h1>\n</center>",
	"<i>This browser allows you to view information about ",
    	" a given Perforce client.</i>\n<hr>";

    unless ($date || $update) {
	print "<h3>Client <i>$client</i> doesn't exist</h3>";
    }
    else
    {
	if($date) {
	    print "<h3>Date</h3><pre>        $date</pre>\n";
	} else {
	    print "<h3>Update</h3><pre>      $update</pre>\n",
       	          "<h3>Access</h3><pre>      $access</pre>\n";
	}
	print       "<h3>User</h3><pre>        ",
	      &url ("user", "name=$owner", "$owner"), "</pre>\n",
	      "<h3>Description</h3><pre>\n";

	while (<P4>)
	{
	   next if (/^$/);
	   last if (/^Root:/ && (( $root ) = /^Root:\s*(.*)$/ ));
	   print;
	}
	while (<P4>)
	{
	   next if (/^Options:/ && (( $opts ) = /^Options:\s*(.*)$/ ));
	   last if (/^View:/);
        }
	print "</pre><h3>Root Directory</h3><pre>        $root</pre>\n",
    	  "<h3>Options</h3><pre>        $opts</pre>\n",
	  "<h3>View</h3><pre>";
	while (<P4>)
	{
	    last if (/^$/);
	    print;
	}
	print "</pre>";
    }
    close P4;
    @OTHER_FOOTERS = (" | ", &url ("files", "spec=\@$client", 
				   "Files in $client"),
		      " | ", &url ("opened", "client=$client",
				   "Files Opened in $client"));
}


################################
#
# p4 jobs
#
################################

elsif ( $INPUT{'cmd'} eq "jobs" ) {
    &p4open( 'P4', "jobs|" );

    print &header("Perforce Jobs");
    print
	"<center><h1>Perforce Jobs</h1>\n</center>",
	"<i>This browser allows you to view information about ",
    	" Perforce Jobs.</i>\n",
	"<hr>";

    print
	"<table cellpadding=1>",
	"<tr align=left><th>Job Name<th>Date<th>User",
	"<th>Status<th>Description</tr>\n";

    # Sample:
    # job000011 on 1998/07/03 by jam *open* 'Another test. '

    while( <P4> ) {
	if (local( $name, $date, $user, $status, $descrip ) = 
	    /^(\S+) on (\S+) by (\S+) \*(\S+)\* '(.*) '$/)
	{
	    print "<tr>",
	    	  "<td>", &url ( "job", "job=$name", "$name"),
		  "<td>$date",
	    	  "<td>", &url ( "user", "name=$user", "$user"),
		  "<td>$status",
		  "<td>$descrip",
	       	  "</tr>\n";
	}
    }
    print "</table>\n";
    close P4;
}


################################
#
# List branches or labels  ('p4 branches' or 'p4 labels')
#
################################

elsif ( $INPUT{'cmd'} eq "branches" || $INPUT{'cmd'} eq "labels" ) {
    local ($type, $viewer, $plural);
    local ($cmd) = $INPUT{'cmd'};

    if ($cmd eq "branches") {
	$type = "Branch";
	$plural = "Branches";
	$viewer = "branch";
      } else {
	$type = "Label";
	$plural = "Labels";
	$viewer = "label";
      }
    &p4open( 'P4', "$cmd|" );

    print &header("Perforce ${plural}");
    print
	"<center><h1>Perforce ${plural}</h1>\n</center>",
	"<i>This browser allows you to view information about ",
    	" Perforce ${plural}.</i>\n",
	"<hr>",
	"<table cellpadding=1>",
	"<tr align=left><th>$type Name<th>Date<th>Description</tr>\n";

    # Sample:
    # Branch test 1998/07/03 'Created by jam. '
    # Label example-label.template 1998/06/26 'Label tempalte for the example '

    while( <P4> ) {
	if (local( $name, $date, $descrip ) = 
	    /^$type (\S+) (\S+) '(.*) '$/)
	{
	    print "<tr>",
	    	  "<td>", &url ( "$viewer", "name=$name", "$name"),
		  "<td>$date",
	    	  "<td>$descrip",
	       	  "</tr>\n";
	}
    }
    print "</table>\n";
    close P4;
}


###############################
#
# p4 branch
#  "name=branchname"  -  the branch name to describe   *required*
#
###############################

elsif ( $INPUT{'cmd'} eq "branch" ) {
    local( $name, $date, $update, $access, $owner );
    $name = $INPUT{'name'};
    &p4open ('P4', "branch -o $name|");
    while (<P4>) {
	next if (/^Date/ && (( $date ) = /^Date:\s*(.*)$/ ));     # Pre-99.1
	next if (/^Update/ && (( $update ) = /^Update:\s*(.*)$/ ));
	next if (/^Access/ && (( $access ) = /^Access:\s*(.*)$/ ));
	next if (/^Owner/ && (( $owner ) = /^Owner:\s*(.*)$/ ));
	last if (/^Description:/);
    }

    print &header("Perforce Branch Information");
    print
	"<center><h1>Perforce Branch Information for $name</h1>\n</center>",
	"<i>This browser allows you to view information about ",
    	" a given Perforce branch.</i>\n<hr>";

    if($owner) {
	if($date) { 
	    print "<h3>Date</h3><pre>        $date</pre>\n" }
	else {
	    print "<h3>Update</h3><pre>      $update</pre>\n",
	          "<h3>Access</h3><pre>      $access</pre>\n";
	}
	print     "<h3>User</h3><pre>        ",
	&url ("user", "name=$owner", "$owner"), "</pre>\n";
	print "<h3>Description</h3><pre>\n";
	while (<P4>) {
	    next if (/^$/);
	    last if (/^View:/);
	    print;
	}
	print "</pre>\n";
        print "<h3>View</h3><pre>\n";
	local (@speclist, $spec);
	while (<P4>) {
	    next if (/^$/);
	    push( @speclist, /^\s*\S+\s+(\S+)$/ );
	    print;
	}
	$spec = join('+', @speclist);
	print "</pre>\n";
	@OTHER_FOOTERS = (" | ", &url ("files", "spec=$spec",
				       "Files in this Branch"));
    }
    else {
	print "<h3>Branch <i>$name</i> doesn't exist</h3>\n";
    }
    close P4;
}

###############################
#
# p4 label
#  "name=labelname"  -  the label name to describe   *required*
#
###############################

elsif ( $INPUT{'cmd'} eq "label" ) {
    local( $name, $date, $update, $owner, $opts );
    $name = $INPUT{'name'};
    &p4open ('P4', "label -o $name|");
    while (<P4>) {
	next if (/^Date/ && (( $date ) = /^Date:\s*(.*)$/ ));     # Pre-99.1
	next if (/^Update/ && (( $update ) = /^Update:\s*(.*)$/ ));
	next if (/^Owner/ && (( $owner ) = /^Owner:\s*(.*)$/ ));
	last if (/^Description:/);
    }

    print &header("Perforce Label Information");
    print
	"<center><h1>Perforce Label Information for $name</h1>\n</center>",
	"<i>This browser allows you to view information about ",
    	" a given Perforce label.</i>\n<hr>";

    if($owner) {
	if($date) { 
	    print "<h3>Date</h3><pre>        $date</pre>\n" }
	else {
	    print "<h3>Last Update</h3><pre>      $update</pre>\n";
	}
	print     "<h3>User</h3><pre>        ",
	&url ("user", "name=$owner", "$owner"), "</pre>\n";
	print "<h3>Description</h3><pre>\n";
	while (<P4>) {
	    next if (/^$/);
	    last if (/^\S+/);
	    print;
	}
	print "</pre>\n";
	if( /^Options/ && (( $opts ) = /^Options:\s*(.*)$/ )) {
	    print "<h3>Options</h3><pre>     $opts</pre>\n";
	}
	while (<P4>) {
	    last if (/^View/);
	}
        print "<h3>View</h3><pre>\n";
	while (<P4>) {
	    next if (/^$/);
	    print;
	}
	print "</pre>\n";
	@OTHER_FOOTERS = (" | ", &url ("files", "spec=\@$name",
				       "Files in this Label"));
    }
    else {
	print "<h3>Label <i>$name</i> doesn't exist</h3>\n";
    }
    close P4;
}


################################
#
# p4 changes
#  "spec=path_spec" -  the file/path specification  *required*
#  "limit=b"        -  flag to limit the number of changes listed
#  "max=n"          -  max # of changes to list (ignored unless 'limit' set)
#
################################

elsif( $INPUT{'cmd'} eq "changes" ) {

    local ($max) = $INPUT{'max'} || 20;

    print &header("Changes for $INPUT{'spec'}");
    print 
	"<center><h1>Changes for $INPUT{'spec'}</h1></center>\n",
	"<i>This form displays the changes for the files you've selected.\n",
	"Click on the change number to see details of a change.  Changes\n",
	"are listed in reverse chronological order, so you see what's\n",
	"most recent first.</i><br>\n";
    print &formtop("changes");
    print "<center><input name=\"spec\" size=50 maxlength=255 ",
          "value=\"$INPUT{'spec'}\">\n",
          "<input type=\"submit\" value=\"Go\"><br>",
          "<input type=\"checkbox\" name=\"limit\" ";
    print "checked" if $INPUT{'limit'};
    print ">Limit results to last ";
    print "<input name=\"max\" size=5 maxlength=5 value=$max>changes\n</form>";
    print "</center><hr><dl>\n";
    &bail("Invalid number entered") unless $max > 0;

    $max = ( $INPUT{'limit'} ? "-m " . $max : "" );

    &p4open( 'P4', "changes -l $max $INPUT{'spec'} |" );

    while (<P4>) {

        s/&/&amp;/g;
        s/\"/&quot;/g;
        s/</&lt;/g;
        s/>/&gt;/g;

	if( local( $change, $on, $user, $client ) = 
	   /^Change (\d+) on (\S+) by (\S+)@(\S+)$/ ) 
	{
	    print 
		"<dt>", &url( "describe", "change=$change", "Change $change" ),
		" on $on by ", &url ("user", "name=$user", "$user"),
		" on client ", &url ("client", "name=$client", "$client"), 
		"<dd>\n";
	} 
	else 
	{
	    chop;
	    print "<tt>$_</tt><br>\n";
	}
    }

    print "</dl>\n";

    close P4;
}

################################
#
# p4 describe
#  "change=c"   -  the change number to list
#
################################

elsif( $INPUT{'cmd'} eq "describe" ) {

    &p4open( 'P4', "describe -s $INPUT{'change'}|" );

    $_ = <P4>;

    ( local($chn, $user, $client, $date, $time) = 
	/^Change (\d+) by (\S*)@(\S*) on (\S*) (\S*)$/ )
	|| &bail( $_ );

    print &header("Change $chn");
    print 
	"<center><h1>Change $chn</h1></center>\n",
	"<i>This form displays the details of a change.  For each of the\n",
	"files affected, you can click on:\n",
	"<ul>\n",
	"<li>Filename -- to see the complete file history\n",
	"<li>Revision Number -- to see the file text\n",
	"<li>Action -- to see the deltas (diffs)\n",
	"</ul></i>",
	"<hr><pre>\n",
	"<strong>Author        </strong>", &url("user", "name=$user", 
						"$user"), "\n",
	"<strong>Client        </strong>", &url ("client", "name=$client", 
						 "$client"), "\n",
	"<strong>Date          </strong>$time $date\n",
	"</pre><hr>\n",
	"<h2>Description</h2>\n",
	"<pre>\n";

    while(<P4>) {
	next if /^\s*$/;
	last if /^Jobs fixed/;
	last if /^Affected files/;
	print $_;
    }

    print
	"</pre>",
	"<hr>\n";

    # display jobs

    if( /^Jobs fixed/ )
    {
	print 
	    "<h2>Jobs Fixed</h2>\n",
	    "<ul>\n";

	while ( <P4> ) {
	    local( $job, $time, $user, $client );

	    while( ( $job, $time, $user, $client ) = 
		/(\S*) fixed on (\S*) by (\S*)@(\S*)/ )
	    {
		print
		    "<li><h3>",
		    &url( "job", "job=$job", $job ),
		    "</h3><pre>\n";

		while(<P4>) {
		    last if /^\S/;
		    print $_;
		}
	    }

	    print "</pre>\n";
	    last if /^Affected files/;
	}

	print 
	    "</dl>",
	    "<hr>\n";
    }

    print
	"<h2>Files</h2>\n",
	"<ul>\n",
	"<table cellpadding=1>",
	"<tr align=left><th>File<th>Rev<th>Action</tr>\n";

    # Sample:
    # ... //depot/main/p4/Jamrules#71 edit

    while(<P4>) {
	if( local( $file, $rev, $act ) = /^\.\.\. (\S*)#(\d*) (\S*)$/ )	{
	   print 
	        "<tr>",
		"<td>", &url( "filelog", "file=$file", "$file" ),
		"<td>", &url( "print", "file=$file", "rev=$rev", "$rev" ),
		"<td>", &url( "diff", "file=$file", "rev=$rev", 
			      "mode=$act", "$act" ),
		"</tr>\n";
	}
    }
    print
	"</table></ul>\n";

    close P4;
}

################################
#
# p4 filelog
#  "file=f"  -  the file to display
#
################################

elsif ($INPUT{'cmd'} eq "filelog") {

    local( $name ) = $INPUT{'file'};

    &p4open( 'P4', "filelog $name|" );

    $name = <P4>;
    chop $name;

    print &header("Filelog $name");
    print 
	"<center><h1>Filelog $name</h1></center>\n",
	"<i>This form shows the history of an individual file across\n",
	"changes.  You can click on the following:\n",
	"<ul>\n",
	"<li>Revision Number -- to see the file text\n",
	"<li>Action -- to see the deltas (diffs)\n",
	"<li>Change -- to see the complete change description, including\n",
	"other files.\n",
	"</ul></i>",
	"<hr>\n";

    print
	"<table cellpadding=3>",
	"<tr align=center><th>Rev</th><th>Action</th><th>Date</th>",
	"<th>User</th><th>client</th><th>Change</th><th>Desc</th></tr>\n";

    # Sample:
    # ... #78 change 1477 edit on 04/18/1996 by user@client (text) 'Fix mkdir'

    while( <P4> ) {
	if (local( $rev, $change, $act, $date, $user, $client, $desc ) =
	    /^\.\.\. \#(\d+) \S+ (\d+) (\S+) on (\S+) by (\S*)@(\S*) \(\S+\) '(.*)'/)
	{
	    if ($act eq 'branch') {
		$_ = <P4>;
		my ($fromname,$fromrev) = /^.*branch from (\S+?)\#(\d+).*/;
		print
		    "<tr align=center>",
		    "<td>", &url( "print", "file=$name", "rev=$rev", "$rev" ),
		    "<td>", &url( "filelog", "file=$fromname", "rev=$fromrev", 
				   $act ),
		    "<td>$date",
		    "<td>", &url ("user", "name=$user", "$user"),
		    "<td>", &url ("client", "name=$client", "$client"),
		    "<td>", &url( "describe", "change=$change", "$change" ),
		    "<td><tt>$desc</tt>",
		    "</tr>\n";
	    }
	    elsif ($act eq 'delete') {
		print
		    "<tr align=center>",
		    "<td>", &url( "print", "file=$name", "rev=$rev", "$rev" ),
		    "<td>$DEL$act$DELEND",
		    "<td>$date",
		    "<td>", &url ("user", "name=$user", "$user"),
		    "<td>", &url ("client", "name=$client", "$client"),
		    "<td>", &url( "describe", "change=$change", "$change" ),
		    "<td><tt>$desc</tt>",
		    "</tr>\n";
	    }
	    else {
		print
		    "<tr align=center>",
		    "<td>", &url( "print", "file=$name", "rev=$rev", "$rev" ),
		    "<td>", &url( "diff", "file=$name", "rev=$rev", 
				  "mode=$act", $act ),
		    "<td>$date",
		    "<td>", &url ("user", "name=$user", "$user"),
		    "<td>", &url ("client", "name=$client", "$client"),
		    "<td>", &url( "describe", "change=$change", "$change" ),
		    "<td><tt>$desc</tt>",
		    "</tr>\n";
	    }
	}
    }

    print "</table>\n";
    close P4;

    # Check if file is opened by any client
    &p4open( 'P4', "opened -a $name 2> /dev/null |" ) if $name;
    if( $name && ($_ = <P4>) ) {
	print "<p>\n<table cellpadding=3 border>\n",
	 "<caption align=top>",
	 "<div align=left>This file is currently opened by:</div></caption>\n",
	 "<tr align=center><th>User</th><th>Client</th>",
	 "<th>Opened<br>for...</th><th>Revision<br>opened</th>",
	 "<th>Pending<br>changelist</th><th>Status</th></tr>\n";

	# Samples: 
	#  //foo/file.java#2 - edit default change (text) by user@client
        #  //foo/file.java#2 - delete change 154 (text) by user@client *locked*
	do {
	    if (local( $rev, $act, $change, $list, $user, $client, $stat ) =
		/^\S+\#(\d+) - (\w+) (\w+) (\w+) \(\w+\) by (\S+)@(\S+)\s?(.*)$/) {

		print 
		 "<tr align=center><td>", &url("user", "name=$user", $user), 
		 "</td><td>", &url("client", "name=$client", $client ), 
		 "</td><td>$act</td><td>$rev</td><td>", 
		 ("$change" eq "default" ? "default" : 
		  &url("describe","change=$list",$list)), "</td>",
		 ($stat ? "<td>$stat</td>" : "<td>\&nbsp;</td>"), "</tr>\n";
	    }
	} while (<P4>);
	print "</table>\n";
    }
    close P4 if $name;
}

################################
#
# p4 files
#  "spec=file_spec"  -  the spec (path) for the file(s)  *required*
#
################################

elsif ($INPUT{'cmd'} eq "files") {
    &p4open( 'P4', "files $INPUT{'spec'}|" );
    print &header("Files for $INPUT{'spec'}");
    print 
	"<center><h1>Files for $INPUT{'spec'}</h1></center>\n",
	"<i>This form displays files in the depot for a given revision.\n",
	"For each of the files, you can click on:\n",
	"<ul>\n",
	"<li>Filename -- to see the complete file history\n",
	"<li>Revision Number -- to see the file text\n",
	"<li>Action -- to see the deltas (diffs)\n",
	"<li>Change -- to see the complete change description, including\n",
	"other files.\n",
	"</ul></i>",
	"<hr>\n";

    print
	"<h3>Files</h3>\n",
	"<ul>\n",
	"<table cellpadding=1>",
	"<tr align=left><th>File<th>Rev<th>Action<th>Change</tr>\n";

    # Sample:
    # //example/find/TypeExpr.java#1 - add change 5 (ktext)

    while(<P4>) {
	if( local( $file, $rev, $act, $change, $type ) =
	    /^(\S+)#(\d*) - (\S+) change (\d*) \((\S+)\)$/ )
	{
	    print 
		"<tr>",
		"<td>", &url( "filelog", "file=$file", "$file" ),
		"<td>", &url( "print", "file=$file", "rev=$rev", "$rev" ),
		"<td>", &url( "diff", "file=$file", "rev=$rev",
			      "mode=$act", "$act" ),
		"<td>", &url( "describe", "change=$change", "$change" ),
		"<td>", "$type",
		"</tr>\n";
	}
    }
    print
	"</table></ul>\n";

    close P4;
}


################################
#
# p4 opened
#  "spec=spec"            -  a file specification (path) to use
#  "client=clientname"    -  a client to be queried
#  "user=username"        -  a user to be queried
#
################################

elsif ($INPUT{'cmd'} eq "opened") {

    local( $openedcmd ) = ( $INPUT{'client'} ? "-c $INPUT{'client'} opened" :
			    "opened -a" );
    &p4open( 'P4', "$openedcmd $INPUT{'spec'} |" );

    local( $title ) = "Opened files for";
    $title .= " $INPUT{'user'}" if $INPUT{'user'};
    $title .= " $INPUT{'client'}" if $INPUT{'client'};
    $title .= " $INPUT{'spec'}" if $INPUT{'spec'};

    print &header("$title");
    print 
	"<center><h1>$title</h1></center>\n",
	"<i>For each of the files, you can click on:\n",
	"<ul>\n",
	"<li>Filename -- to see the complete file history\n",
	"<li>Revision Number -- to see the file text\n",
	"<li>Change List (if not default) -- to see a change description\n",
	"<li>User -- to see the a user description\n",
	"<li>Client -- to see the a client description\n",
	"</ul></i>",
	"<hr>\n";

    print
	"<h3>Files</h3>\n",
	"<ul>\n",
	"<table cellpadding=3>",
	"<tr align=center><th></th><th>Rev</th><th>Action</th>",
	"<th>Change List</th><th>Type</th><th>User</th><th>Client<th></tr>\n";

    # Samples:
    #  //foo/file.java#2 - edit default change (text) by user@client
    #  //foo/file.java#2 - delete change 154 (text) by user@client *locked*
    while(<P4>) {
	if (local($file, $rev, $act, $change, $list, $type, $user, $client, $stat) =
	     /^(\S+)#(\d+) - (\w+) (\w+) (\w+) \((\w+)\) by (\S+)@(\S+)\s?(.*)$/)
	  {
	    next if ( $INPUT{'user'} && $INPUT{'user'} ne $user );
	    print 
		"<tr align=center>",
		"<td align=left>", &url( "filelog", "file=$file", "$file" ), "</td>",
		"<td>", &url( "print", "file=$file", "rev=$rev", "$rev" ), "</td>",
		"<td>$act</td>", 
		"<td>", ("$change" eq "default" ? "default" :
			 &url("describe", "change=$list", $list)), "</td>",
		"<td>$type</td>",
		"<td>", &url( "user", "name=$user", "$user" ), "</td>",
                "<td>", &url( "client", "name=$client", "$client" ), "</td>",
		($stat ? "<td>$stat</td>" : "" ),
		"</tr>\n";
	}
    }
    print
	"</table></ul>\n";

    close P4;
}


################################
#
# p4 print
#  "file=filespec"   - the file to print  *required*
#  "rev=n"           - the file revision to print
#
################################

elsif ($INPUT{'cmd'} eq "print") {

    local($name, $rev) = ($INPUT{'file'}, $INPUT{'rev'});
    $rev = "head" unless $rev;

    &p4open( 'P4', "print $name#$rev|" );

    # Get header line
    # //depot/main/jam/Jamfile#39 - edit change 1749 (text)

    $_ = <P4>;
    local( $name, $rev, $type ) = m!^(\S+)\#(\d+) - \S+ \S+ \S+ \((\w+)\)!;

    local( $ext ) = $name =~ m!^.*\.([^/.]+)$!;
    local( $ctype );
    if( $type =~ /binary/ && ($ext) ) {
	if( $ext =~ /^gif$/i || $ext =~ /^jpg$/i ) { $ctype = "image/$ext"; }
	else { $ctype = "application/$ext"; }
    } elsif ($ext =~ /^html?$/i) {
	$ctype = "text/html";
    }
    if($ctype) {
	print "Content-type: $ctype \n\n" if ($ENV{'GATEWAY_INTERFACE'});
	while(<P4>) { print; }
 	close P4;
	exit;
    }

    print &header("File $name#$rev");
    print 
	"<center><h1>File $name#$rev</h1></center>\n",
	"<i>This form shows you the raw contents of a file, as long as \n",
	"it isn't binary.</i>",
	"<hr>\n";

    if( $type =~ /binary/ )
    {
	print "<h2>$type</h2>\n";
    }
    else
    {
	print "<pre>\n";

	while( <P4> ) {
	    s/&/&amp;/g;
	    s/\"/&quot;/g;
	    s/</&lt;/g;
	    s/>/&gt;/g;
	    print $_;
	}

	print "</pre>\n";
    }

    close P4;
}

################################
#
# p4 diff
#  "file=filename"   -  the name of the file to diff  *required*
#  "rev=n"           -  the revision to diff (with previous version)  *req'd*
#  "mode=mode"       -  needed if this rev is 'add', 'delete', or 'branch'
#
################################

elsif ($INPUT{'cmd'} eq "diff") {

    local( $name,$rev,$mode ) = ($INPUT{'file'},$INPUT{'rev'},$INPUT{'mode'});
    local( $nchunk ) = 0;

    print &header("$name#$rev - $mode");
    print
	"<center><h1>$name#$rev - $mode</h1></center>\n",
	"<i>This form shows you the deltas (diffs) that lead from the\n",
	"previous to the current revision.</i>\n",
	"<hr>\n";

    if ($mode ne 'add' && $mode ne 'delete' && $mode ne 'branch') {

	local($f1) = "$name#" . ($rev - 1);
	local($f2) = "$name#" . ($rev);

	&p4open('P4', "diff2 $f1 $f2|");
	$_ = <P4>; 

	while (<P4>) {

	    local( $dels, $adds );

	    local( $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 ] = ();

	    # deletes

	    while( $dels-- ) {
	    	$_ = <P4>; 	
		s/^. //;
		if (/[&<>]/) {
		    s/&/\&amp;/g;
		    s/</\&lt;/g;
		    s/>/\&gt;/g;
		}
		$lines[ $nchunk ] .= $_;
	    }
	    
	    # separator

	    if ($op eq 'c') {	
		$_ = <P4>; 
	    }

	    # adds

	    while( $adds-- ) {
		$_ = <P4>;
	    }

	    $nchunk++;
	}

	close P4;
    }
   
    # Now walk through the diff chunks, reading the current rev and
    # displaying it as necessary.

    print 
    	"<center><pre>",
    	"$ADD added lines $ADDEND\n",
	"$DEL deleted lines $DELEND\n",
	"</pre></center><hr><pre>\n";

    local( $curlin ) = 1;

    &p4open('P4', "print -q $name#$rev|");

    for( $n = 0; $n < $nchunk; $n++ )
    {
	# print up to this chunk.

	&catchup( 'P4', $start[ $n ] - $curlin );

	# display deleted lines -- we saved these from the diff

	if( $dels[ $n ] )
	{
		print "$DEL";
		print $lines[ $n ];
		print "$DELEND";
	}

	# display added lines -- these are in the file stream.

	if( $adds[ $n ] )
	{
		print "$ADD";
		&display( 'P4', $adds[ $n ] );
		print "$ADDEND";
	}

	$curlin = $start[ $n ] + $adds[ $n ];
    }

    &catchup( 'P4', 999999999 );

    print "</pre>\n";
    close P4;
} 

################################
#
# p4 job
#  "job=n"  -  the job to describe  *required*
#
################################

elsif ($INPUT{'cmd'} eq "job") {

    local( $user, $job, $status, $time, $date );

    &p4open( 'P4', "job -o $INPUT{'job'}|" );

    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 &header("Job $job");
    print 
	"<center><h1>Job $job</h1></center>\n",
	"<i>This form displays the details of a job.  You can click on a\n",
	"change number to see its description.\n",
	"</i>",
	"<hr><pre>\n",
        "<strong>User          </strong>", &url("user", "name=$user", "$user"),
	"\n",
	"<strong>Status        </strong>$status\n",
	"<strong>Date          </strong>$time $date\n",
	"</pre><hr>\n",
	"<h2>Description</h2>\n",
	"<pre>\n";

    while(<P4>) {
	print $_;
    }

    print
	"</pre>",
	"<hr>\n";

    close P4;

    # display fixes

    &p4open( 'P4', "fixes -j $INPUT{'job'}|" );

    $count = 0;

    while( <P4> )
    {
	print
	    "<h2>Fixes</h2>\n",
	    "<ul>\n",
	    "<table cellpadding=1>",
	    "<tr align=left><th>Change<th>Date<th>User\@Client</tr>\n"
		if( !$count++ );

	# jobx fixed by change N on 1997/04/25 by user@host

	if( local( $change, $date, $user, $client ) 
		= /^\S* fixed by change (\S*) on (\S*) by (\S*)@(\S*)/ ) 
	{
	    print 
		"<tr>",
		"<td>", &url( "describe", "change=$change", "$change" ),
		"<td>", $date,
		"<td>", &url ("user", "name=$user", "$user"), "\@",
			&url ("client", "name=$client", "$client"),
		"</tr>\n";
	}
    }

    print "</table></ul>\n"
	if( $count );

    close P4;
}

################################
#
# None of the above.
#
################################

else {
    &bail( "Invalid invocation $INPUT{'cmd'}" );
}

# Trailer

@HTMLFOOTER = (
	"<p align=\"center\">*&nbsp; *&nbsp; *<br>\n",
	"<a HREF=\"$TOPPAGE\">Top</a> | \n",
	&url ("clients", "Clients"), " | \n",
	&url ("users", "Users"), " | \n",
	&url ("branches", "Branches"), " | \n",
	&url ("labels", "Labels"), " | \n",
	&url ("jobs", "Jobs"), "\n",
	@OTHER_FOOTERS, "\n",
	"</body></html>\n");

print   @HTMLFOOTER;

##################################################################
##################################################################
#
# Subroutines.
#
##################################################################
##################################################################

sub header {
    if($PRINTEDHEADER) { return; }
    $PRINTEDHEADER = 1;
    local ($string) = "Content-type: text/html\n\n" 
	if ($ENV{'GATEWAY_INTERFACE'});
    $string .= "<html>\n" .
	"<head><title>@_</title></head>\n" .
	"<body bgcolor=\"#ffffff\">\n";
    return $string;
}

sub url {
    local( @options ) = @_[0 .. $#_-1];
    local ($i) = 0;
    for(; $i<=$#options; $i++) { splice(@options,$i,1) if !$options[$i]; }
    local( $url ) = "$myname?cmd=" . join('&',@options);
    return qq(<a HREF="$url">$_[$#_]</a>);
}

sub formtop {
    local( $action ) = $_[0];
    return "<form method=\"send\" name=\"$action\" action=\"$myname\">\n" .
           "<input type=\"hidden\" name=\"cmd\" value=\"$action\">\n";
}

sub mailto {
    return qq(<a HREF="mailto:@_">@_</a>) ;
}

sub bail {
    print &header("Script Error");
    print @_, "\n</body></html>\n";
    die @_;
}

sub p4open {
    local( $handle, @command ) = @_;
    open( $handle, "p4 @command" ) || &bail( "p4 @command failed" );
}

# Support for processing diff chunks.
#
# skip: skip lines in source file
# display: display lines in source file, handling funny chars 
# catchup: display & skip as necessary
#

sub skip {
    local( $handle, $to ) = @_;
    while( $to > 0 && ( $_ = <$handle> ) ) {
	$to--;
    }
    return $to;
}

sub display {
    local( $handle, $to ) = @_;
    while( $to-- > 0 && ( $_ = <$handle> ) ) {
	if (/[&<>]/) {
	    s/&/\&amp;/g;
	    s/</\&lt;/g;
	    s/>/\&gt;/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><strong>",
	    "$skipped lines skipped",
	    "</strong></center><hr>\n" if( $skipped );
	&display( $handle, $NCONTEXT );
    }
    else
    {
	&display;
    }
}

sub ReadParse {
  local (*hash) = @_ if @_;   # Reference to hash table
  local ($i, $key, $val, $in, @list);

  # Read in text
  if ($ENV{ 'REQUEST_METHOD'} eq "GET" ) {
    $in = $ENV{'QUERY_STRING'};
  } elsif ( $ENV{'REQUEST_METHOD'} eq "POST" ) {
      read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
  } else {
      $in = $ARGV[0];
  }

  # Convert %XX from hex numbers to alphanumeric
  $in =~ s/%(\w\w)/pack("c",hex($1))/ge;

  @list = split(/[&;]/,$in);
  &TranslateOldStyle( \@list );

  foreach $i (0 .. $#list) {
    # Convert plus's to spaces
    $list[$i] =~ s/\+/ /g;

    # Split into key and value (splits on first '=')
    ($key, $val) = split(/=/,$list[$i],2);

    # Associate key and value
    $hash{$key} .= "\0" if defined($hash{$key}); # \0 is the multiple separator
    $hash{$key} .= $val;
  }

  return scalar(@list);
}

sub TranslateOldStyle {
    local (*argv) = @_;  # Reference to argument list

    # If we have the old style, all args are concatenated into the first
    # arg separated by spaces.  The first character is '@' unless there is 
    # only a file spec for 'changes' (In which case I assume the spec begins
    # with '//').

    return unless scalar(@argv) == 1;
    $argv[0] = "\@changes+" . $argv[0] if ( $argv[0] =~ m!^//\w+! );
    return unless $argv[0] =~ /^\@/;
    $argv[0] =~ s/^\@//;
    @argv = split(/\+/,$argv[0]);
    local( $cmd ) = $argv[0];

    if( $cmd eq "changes" ) {
	$argv[1] = "spec=" . $argv[1];
	push( @argv, "limit=1" );
    } 
    elsif( $cmd eq "describe" ) {
	$argv[1] = "change=" . $argv[1];
    } 
    elsif( $cmd eq "job" ) {
	$argv[1] = "job=" . $argv[1];
    } 
    elsif( $cmd eq "diff" ) {
	$argv[1] = "file=" . $argv[1];
	$argv[2] = "rev=" . $argv[2];
	$argv[3] = "mode=" . $argv[3];
    } 
    elsif( $cmd eq "print" ) {
	$argv[1] = "file=" . $argv[1];
	$argv[2] = "rev=" . $argv[2];
    } 
    elsif( $cmd eq "filelog" ) {
	$argv[1] = "file=" . $argv[1];
    } 
    elsif( $cmd eq "files" ) {
	splice( @argv, 1, $#argv, ( "spec=" . join('+', @argv[1..$#argv]) ));
    } 
    elsif( $cmd eq "opened" ) {
	local($mode) = splice( @argv, 1, 1 );
	$argv[1] = ( $mode eq "user" ? "user=" : "client=" ) . $argv[1];
    } 
    elsif( $cmd eq "user"   ||  $cmd eq "client" ||
	   $cmd eq "branch" ||  $cmd eq "label" ) {
	$argv[1] = "name=" . $argv[1];
    }

    $argv[0] = "cmd=" . $cmd;
}