#!/usr/bin/perl -w
use strict ;
#
# p4b4.perl -- CGI browser for PERFORCE
#
#    This script is based on the cgi script provided by Perforce. Most of the code
#    in that script is still in this script.
# 
#       * Added -w and "use strict" (my personal religion, sorry about that)
#       * Fixed all the consequences from -w and "use strict"
#       * Added some error handling
#       * Handles '<','>' and '&' in more places than before
#       * Changed the way parameters are passed to make it easier to use forms
#       * First parameter to "changes" can now handle labels as well as file name
#       * Smarter way to display files
#       * Added a lot of stuff......
#                         Fredric Fredricson, MYDATA automation AB, fredric@mydata.se
#
#  Known bugs:
#       * A serious case of feature bloat
#
#################################################################
#     BASIC CONFIGURATION INFORMATION
# 
# How to configure:
# 
# 1. Set first line of script to point to perl. Usually /usr/bin/perl 
#    or /usr/bin/perl. Don't forget the -w switch
#
# 2. If You are not using the standard host/port, set it here
#$ENV{P4PORT} = "p4:1666";

# 3. A user and a client must be specfied. The user must have write access (at least
#    if You want to view jobs (at least using p4 97.2.....) I have honstly no idea why
#    this is the case but the physical universe is pretty persuasive here......)
$ENV{USER}     = "trenoll";
$ENV{P4CLIENT} = "trenoll_slussen";
$ENV{USER}     = "fredric";
$ENV{P4CLIENT} = "fredric_at_home";

# 4. Set up complete path to p4 program
my $P4PGM = "/usr/local/bin/p4"; 

# 5. Set up path to standard configuration file
$ENV{CODELINES} = "./CODELINES" ;

# 6. Set up a path to temporary data files that might be used. 
#    (NOTE! the cgi must have write access to this directory)
$ENV{TMPDIR} = "/tmp" ;

#
# 7. Set up script name (leave commented out for apache)
#
#$ENV{SCRIPT_NAME} = $0 ;

#
#   END OF BASIC CONFIGURATION  (well, this is perl, the whole script could be
#                               viewed as "basic configuration")
#################################################################
#
#   Some more opportunities for configuration:
#

# Standard background color
my $bgcolor = "#FFFFD0"; # Sort of bright yellow

# A slightly darker background color
my $bgcolor_dark = "#C0D0C0"; # Sort of dark

# A slightly brighter background color
my $bgcolor_bright = "white"; # Sort of bright

# Some definitions for text colors
my $BLUE_TXT  = qq(<font color=blue>);
my $GREEN_TXT = qq(<font color=green>);
my $RED_TXT   = qq(<font color=red>);
my $END       = qq(</font>);

# Some more definitions for text colors/styles
my $ADD    = $BLUE_TXT;
my $ADDEND = $END;
my $DEL    = "<STRIKE>$RED_TXT";
my $DELEND = "$END</STRIKE>";

# Constants for the file diff display
my $MAXCONTEXT = 30;
my $NCONTEXT   = 10;

#
#  OK, that was the configuration parts, the rest is not *intended*
#  as configuration part
#
#################################################################

my $myname = defined $ENV{SCRIPT_NAME} ? $ENV{SCRIPT_NAME} : $0 ;
# Set up script name

# File handle must be declared somwhere (use strict!)
local *P4 ; 

# Variable to contain parameter values by names
my %args ;
#  CMD      -> current command name
#  CH       -> change number
#  FSPC     -> file specification (for changes and files)
#  CHK_FSPC -> check file spec to make sure file exists
#  REV      -> file revision 
#  ACT      -> file action
#  FROMCH   -> display only changes later than this change
#  EXLAB    -> exclude changes that affects this label 
#  VERBOSE  -> if "YES" will be more verbose (for beginners)

#
# Get arguments from command line or browser (This works with apache version???, I 
# don't know if it will work with any other browser)
#
my $qstring = $ENV{QUERY_STRING} ;
if(defined $qstring) {
                                   ### Convert %nn's in QUERY_STRING
    $qstring =~ s/%/\\x/g ;	   # (method: change to \xnn and eval)
    $qstring =~ s/@/\\@/g ;
    $qstring = eval("return \"$qstring\"") ;
}
else {
    $qstring = join('&',@ARGV) ;
}

#
# Stuff arguments from browsed into args hash
#
my $arg ;
foreach $arg (split(/&/, $qstring)) {
    my ($command,$value) = split /=/,$arg ;
    $args{$command}=$value ;
}

#
# Set verbose variables 
#
my $verbose = $args{"VERBOSE"} ;
$verbose = "NO" unless defined $verbose ;
$verbose = undef unless $verbose eq "YES" ;
my $verbose_string = (defined $verbose) ? "YES" : "NO" ;
my $verbose_arg    = (defined $verbose) ? "&VERBOSE=YES" : "" ;

#
# Get help texts
# 
my %helpTexts ;
my $currHelpText ;
if(defined $verbose) {
    while(<DATA>) {
	/HELPTEXT=(\S+)/ && 
	    do { $currHelpText = $1 ; $helpTexts{$currHelpText} = "" ; next ; } ;
	$helpTexts{$currHelpText} .= $_ ;
    }
}

#
#  Common part of header
#
$| = 1 ; # turn output buffering of (wonderful perl syntax, isn't it!)
print 
    "Content-type: text/html\n",
    "\n",
    "<html>\n" ;

#
# Check that we have contact with p4 server
#
&p4open(*P4,"changes -m 1|") ;
$_ = <P4> ;
/Change (\d+)/ or &bail("No contact with P4 server") ;
my $currentChangeLevel=$1 ;

#
# Parse arguments(s)
#
if(!defined $args{"CMD"}) {
    &introScreen() ;
} 
else {
    my $command=$args{"CMD"} ;

    "changes" eq $command and 
	do { my ($filespec, $exlab, $fromChange) =
		 ($args{"FSPC"} or &bail("Argument error: Missing file specification"),
		  $args{"EXLAB"},
		  $args{"FROMCH"}) ;
	     &showChanges($filespec, $exlab, $fromChange) ;
	 } ;     
    "searchdepot" eq $command and
	do { my ($filespec) =
		 ($args{"FSPC"} or &bail("Argument error: Missing file specification")) ;
	     &searchDepot($filespec) ;	
	 } ;
    "describe" eq $command and 
	do { my $change=$args{"CH"} or &bail("Argument error: Missing change number");
	     &describeChange($change) ;
	 } ;
    "filelog" eq $command and
	do { my ($filespec) =
		 ($args{"FSPC"} or &bail("Argument error: Missing file specification")) ;
	     &filelog($filespec) ;
	 } ;
    "print" eq $command and
	do { my $fname = $args{"FSPC"} or &bail("Argument error: Missing file spec") ;
	     my $frev  = $args{"REV"} or &bail("Argument error: Missing file revision") ;
	     &printFile($fname,$frev) ;
	 } ;
    "diff" eq $command and
	do { my $name = $args{"FSPC"} or &bail("Argument error: Missing file spec") ;
	     my $rev  = $args{"REV"}  or &bail("Argument error: Missing file revision") ;
	     my $mode = $args{"ACT"}  or &bail("Argument error: Missing file action") ;
	     my $rev2 = $args{"REV2"} ;
	     my $name2 = $args{"FSPC2"} ;
	     &printDiff($name,$rev,$mode,$rev2,$name2) ;
	 } ;
    "jobs" eq $command and
	do { 
	    &listJobs($args{"JOBSTAT"}) ;
	} ;
    "job" eq $command and
	do { 
	    $args{"JOB"} or &bail("Argument error: Missing job spec") ;	    
	    &descJob($args{"JOB"}) ;  
	} ;	
    "label" eq $command and
	do { 
	    $args{"LABEL"} or &bail("Argument error: Missing label spec") ;	    
	    &descLabel($args{"LABEL"}) ;  
	} ;	
    "labeldiff" eq $command and
	do { 
	    $args{"LABEL"} or &bail("Argument error: Missing label spec") ;	    
	    $args{"LABEL2"} or &bail("Argument error: Missing label spec") ;	    
	    &labelDiff($args{"LABEL"},$args{"LABEL2"},
		       $args{"SHOWSAME"},
		       $args{"SHOWNOTSAME"},
		       $args{"SHOWDIFF"}) ;  
	} ;	
    
}

# Common trailer

print
    "<hr><small><i>Comments: <a href=\"mailto:fredric\@mydata.se\">fredric\@mydata.se",
    "</a></small></body></html>\n";


################################
#
# Put up the introductory screen.
#
################################ 
				# "local" subroutine that creates an entry
				# on intro screen (made a subroutine to facilitate
				# modifications
sub introScreenSection($$$@ ) 
{
    # arg 1 : title
    # arg 2 : an anchor name for anchor and help texts
    # arg 3 : Help text
    # arg 4..n : body of selection
  #  print "---". join("\n---",@_)."\n" ;
    my $title  = shift @_ or die("Internal error") ;
    my $anchor = shift @_ or die("Internal error") ;
    my $helpText = shift @_ ;  #or die("Internal error for $anchor") ;
    my @body   = @_ ;
    print 
	"",&anchor($anchor),"\n",
	"<h3>$title</h3>" ,
	(defined $verbose) ? $helpText : "",
	join("\n",
	     &table("",
		    row("",
			(cell("bgcolor=\"$bgcolor_dark\"",
			      @body),
			 (!defined $verbose) ? 
			 (cell("",
			       (&url("VERBOSE=YES",
				     "$GREEN_TXT Click for help $END",$anchor))))
			 : ("")
			 )
			)
		    )
	     ) ;
} ;

sub introScreen( )
{
    &printHeader("Perforce Depot Browser") ;

    print 
	"<center>",
	&gotoAnchor("SELECT_PREDEF","Changes for predefined pattern"),"|",
	&gotoAnchor("SELECT_PATTERN","Changes for file"),"|",
	&gotoAnchor("SELECT_SEARCH","Search for file"),"|",
	&gotoAnchor("SELECT_LABEL","View label"),"|",
	&gotoAnchor("SELECT_LABEL_CHANGES","View changes for label"),"|",
	&gotoAnchor("SELECT_LABEL_DIFF","View diff between labels"),"|",
	&gotoAnchor("SELECT_JOBS","View jobs"),
	"</center>" ;
    print 
	"",
	(defined $verbose) ? 
	    &helpText("GENERAL") : &url("VERBOSE=YES",
					"<P ALIGN=Right><small>Click here for".
					" help</small>"),
					    "<hr>\n";
    

    # Default codelines data is just a simple list of everything.
    # If $CODELINES is set in the environment, the codelines comes
    # from that.  The format is:
    #
    #	description1
    #	//path1[+//path2...]
    #	description2
    #	//path2

my @CODELINES = ("Full Depot Source\n",
		 "//...\n" );

    if (defined $ENV{CODELINES} and -r $ENV{CODELINES}) {
	open(P4, "$ENV{CODELINES}" ) || &bail("Can not open codelines file".
					      " \"$ENV{CODELINES}\"" );
	@CODELINES = <P4>;
	close P4 ;
    }

    my $tmp="" ;
    foreach ( @CODELINES )
    {
	chop;	
	if( m:^/: )
	{
	    my $t ;
	    ($t = $_) =~ s/\+/ AND /g ;
	    $tmp .= "<dd><li>". &url( "CMD=changes&FSPC=$_", $t ). "\n";
	}
	elsif( !/^\s*$/ )
	{
	    $tmp .= "<dt><b>$_</b>\n";
	}
    }
    &introScreenSection
	("View changes for predeined view",
	 "SELECT_PREDEF",
	 &helpText("SELECT_PREDEF"),
	 $tmp) ;

    &introScreenSection
	("View changes for selected patterm",
	 "SELECT_PATTERN",
	 &helpText("SELECT_PATTERN"),
	 "<form action=\"$myname\" method=\"GET\">\n" ,
	 "   <input type=\"hidden\" name=\"CMD\" value=\"changes\">\n" ,
	 "   <input type=\"text\" name=\"FSPC\" size=\"60\" maxlength=\"80\">\n" ,
	 "</form>\n") ;

    &introScreenSection
	("Search for file pattern",
	 "SELECT_SEARCH",
	 &helpText("SELECT_SEARCH"),
	 "<form action=\"$myname\" method=\"GET\">\n" .
	 "   <input type=\"hidden\" name=\"CMD\" value=\"searchdepot\">\n" .
	 "   <input type=\"text\" name=\"FSPC\" size=\"60\" maxlength=\"80\">\n".
	 "</form>\n") ;

				# Get labels
    &p4open( *P4, "labels |" );
    my @labels ;
    while(<P4>) {
	/^Label (\S+)/ ;
	$1 =~ /^test/i && do { next ; } ;
	push @labels,$1 ;
    }
    close P4 ;
				# Create label <option>-data
				# Labels are grouped (HTML 4.0) by first part of name
				# (first part is defined as the part before the '-' sign)
    my $labelSelectOptions = "" ;
    my $grp="";
    my $l ;
    foreach $l (sort @labels) {
	my ($g,$n) = ("","") ;
	($g,$n) = split /-/,$l ;
	if($g ne $grp) {
	    if(defined $grp) {  
		$labelSelectOptions .= "</optgroup>\n" ;
	    } ;
	    $grp = $g ;
	    $labelSelectOptions .= "<optgroup label=$grp>\n" ;
	}
	$labelSelectOptions .= "<option value=\"\@$l\" label=\"$n\">$l\n" ;
    } ;

    

				# Label
    &introScreenSection
	("View label",
	 "SELECT_LABEL",
	 &helpText("SELECT_LABEL"),
	 &table("bgcolor=$bgcolor_bright",
		&row("",
		     &cell("",
			   "<form method=\"GET\" action=\"$myname\">\n" ,
			   "<input type=\"hidden\" name=\"CMD\" value=\"label\">" ,
			   "<select name=LABEL>\n" ,
			   "$labelSelectOptions\n" ,
			   "</select>\n"),
		     &cell("",
			   "<input type=\"submit\" value=\"View label\"></th>\n" ,
			   "</form>\n")
		     )
		)
	 ) ;
				# Changes for label
    &introScreenSection
	("Changes for label",
	 "SELECT_LABEL_CHANGES",
	 &helpText("SELECT_LABEL_CHANGES"),
	 "<form method=\"GET\" action=\"$myname\">\n" ,
	 "<input type=\"hidden\" name=\"CMD\" value=\"changes\">\n" ,
	 &table("",
		row("valign=center",
		    cell("align=right",
			 "Label:"),
		    cell("bgcolor=$bgcolor_bright",
			 "<select name=FSPC>\n" ,
			 "$labelSelectOptions" ,
			 "</select>\n"),
		    cell("align=center rowspan=2",
			 "<input type=\"submit\" value=\"View changes\">\n")),
		row("valign=center",
		    cell("align=right",
			 "(optionally)<br>Exclude changes for label:"),
		    cell("bgcolor=$bgcolor_bright",
			 "<select name=EXLAB>\n" ,
			 "<option value=\"-\" label=\"-\">(None)\n",
			 "$labelSelectOptions" ,
			 "</select>\n"))
		),
	 "</form>\n") ;


				# Diffs between labels
    &introScreenSection
	("View diff between two labels",
	 "SELECT_LABEL_DIFF",
	 &helpText("SELECT_LABEL_DIFF"),
	 "<form method=\"GET\" action=\"$myname\">\n" ,
	 "<input type=\"hidden\" name=\"CMD\" value=\"labeldiff\">\n" ,
	 &table("",
		&row("valign=center",
		     &cell("aligh=right",
			   "Label 1:"),
		     &cell("bgcolor=$bgcolor_bright",
			   "<select name=LABEL>\n" ,
			   "$labelSelectOptions" ,
			   "</select>\n"),
		     &cell("align=center rowspan=2",
			   &table("",
				  row("",
				      &cell("bgcolor=$bgcolor_bright",
					    "<b>Select:</b><br>",
					    "<input type=\"checkbox\" "
					    . "name=\"SHOWSAME\" value=\"Y\" >"
					    . "Files with same rev.<br>",
					    "<input type=\"checkbox\" "
					    . "name=\"SHOWNOTSAME\" value=\"Y\" CHECKED>"
					    . "Files that differ<br>",
					    "<input type=\"checkbox\" "
					    . "name=\"SHOWDIFF\" value=\"Y\" CHECKED>"
					    . "Files only in one of the labels"),
				      &cell("bgcolor=$bgcolor_bright",
					    "<input type=\"submit\" "
					    . "value=\"View diff\">\n")
				      )),
		     ),
		&row("valign=center",
		     &cell("aligh=right",
			   "Label 2:"),
		     &cell("bgcolor=$bgcolor_bright",
			   "<select name=LABEL2>\n",
			   "$labelSelectOptions\n",
			   "</select>")
		     )
		     )
		),
	 "</form>\n") ;
				# View jobs
    &introScreenSection
	("View jobs",
	 "SELECT_JOBS",
	 &helpText("SELECT_JOBS"),
	 "<ul>" ,
	 "<li>" , &url("CMD=jobs&JOBSTAT=open","Open jobs") , "\n" ,
	 "<li>" , &url("CMD=jobs&JOBSTAT=suspended","Suspended jobs") , "\n".
	 "<li>" , &url("CMD=jobs&JOBSTAT=closed","Closed jobs") , "\n".
	 "<li>" , &url("CMD=jobs","All jobs"),
	 "</ul>\n") ;

}

################################
#
#  show changes for a path
#
################################
sub showChanges($$$ )
# arg1: file spec (mandatory)
# arg2: if defined, files to exclude (typically a label)
# arg3: if defined, exclude
{
    my $filespec   = shift @_ ; 
    my $exlab      = shift @_ ; 
    my $fromChange = shift @_ ; 

				# Assume filespec is a file spec, set title 
    my $title = "Changes for $filespec" ;
				# Fix if filespec is multiple filespecs delimited by +
    $title =~ s/\+(\/\/)/ and $1/g ;
    $filespec =~ s/\+(\/\/)/ $1/g ;
				# Check if filespec is a label (starting with '@')
    if($filespec =~ s/^\@//) {	#  (set title and filespec if this is true
	$title="Changes for label <code>$filespec</code>";
	$filespec = "//...\@$filespec" ;
    }
				# Add //... to start of filespec if not there
    my $depotAdded ;
    if($filespec !~ /^\/\//) {
	$filespec = "//.../$filespec" ;
	$depotAdded = "y" ;
    }

    my @exclude;
    # List of changes to exclude
    
    $args{"EXLAB"} = "-" unless defined $args{"EXLAB"} ;
    $exlab= ($args{"EXLAB"} eq "-") ? undef : $args{"EXLAB"} ;
    if(defined $exlab) {
	&p4open( *P4, "changes //.../*$exlab|" );
	($title .= " <br>excluding changes in label <code>$exlab</code>") =~ s/\@//g ;
	while(<P4>) {
	    /^Change (\d+)/ ;
	    push @exclude,$1 ;
	}
	close P4 ;	
    }
    push @exclude,0 ;
				# Check if there is a a 'from' parameter
    $fromChange = $args{"FROMCH"} or $fromChange = 0 ;
				# Check if the 'from' parameter is a label
    if($fromChange =~ s/^\@//) {
	$title .= " after label $fromChange";
    }
        
    &p4open( *P4, "changes -l $filespec|" );

    &printHeader($title) ;
    print
	"<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>\n",
	"<hr><dl>\n";

    my $nextToExclude = shift @exclude ;
    if(!defined $nextToExclude) { $nextToExclude = 0 ; } ;
    my ( $change, $misc ) ;
    my $skipped=0 ;
    my $skip;
    while (<P4>) {
	&fixSpecChar() ;
	if(/^Change (\d+) (.*)$/) 
	{
	    $skip="no" ;
	    ( $change, $misc ) = ($1,$2) ;
	    while($nextToExclude > $change) {
		if($skipped>0) {
		    print 
			"<dt><font color=green><hr>\n",
			"$skipped change(s) common to both labels<hr></font>\n";
		};
		$skipped=0 ;
		print
		    "<dt>",
		    &url("CMD=describe&CH=$nextToExclude",
			 "<font color=red>Change $nextToExclude only in label $exlab</font>"),
		    "<dd>  ";
		$nextToExclude = shift @exclude ;
	    }
	    if ($change == $nextToExclude) {
		$nextToExclude = shift @exclude ;
		$skip="yes" ;
		$skipped++ ;
		next ;
	    }
	    last if ($fromChange != 0) and ($change <= $fromChange)  ;
	    if($skipped>0) {
		print 
		    "<dt><font color=green><hr>\n",
		    "$skipped change(s) common to both labels<hr></font>\n";
	    }
	    $skipped=0 ;
	    print 
		"<dt>", &url( "CMD=describe&CH=$change", "Change $change" ), 
		" $misc<dd>\n";
	} 
	else 
	{
	    next if $skip eq "yes";
	    chop;
	    print "<tt>$_</tt><br>\n";
	}
    }

    print "</dl>\n";

    close P4;
}

################################
#
#  search depot for a file
#
################################
sub searchDepot($ )
# arg1: file spec (mandatory)
{
    my $filespec   = shift @_ ; 	
				# Add //... if not there
    if($filespec !~ /^\/\//) {
	$filespec = "//.../$filespec" ;
    }				
				# Check if file exists
    &p4open( *P4, "files $filespec|" );
    my @matches ;
    while(<P4>) {
	push @matches,$_ ;
    }
    close P4 ;

    &printHeader("Search result for <br><code>$args{FSPC}</code>" ) ;
    print
	"<i>This form displays a list of files that matches the pattern \n",
	"you've selected.\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",
	"<table cellpadding=1>",
	"<tr align=left><th>File</th><th>Rev</th><th>Action</th><th>Change</th></tr>\n";

    if(scalar(@matches) == 0) {
	print  "<font color=red>No files found matching $filespec</font>/n" ;
    }
    else {
	my $f ;
	foreach $f (@matches) {
	    $f =~ /([^\#]+)\#(\d+) - (\w+) change (\d+)/ ;
	    my ($name,$rev,$act,$change)=($1,$2,$3,$4) ;
	    print
		"<tr><td>",
		&url( "CMD=filelog&FSPC=$name", "$name" ),
		"</td><td>",
		&url( "CMD=print&FSPC=$name&REV=$rev", "$rev" ),
		"</td><td>",
		&url( "CMD=diff&FSPC=$name&REV=$rev&ACT=$act", "$act" ),
		"</td><td>",
		&url( "CMD=describe&CH=$change", "$change" ),
		"</td></tr>\n",
	    }  ;
	print "</table><hr>\n" ;
	print 
	    "<form method=\"GET\" action=\"$myname\">\n",
	    "<input type=\"hidden\" name=\"CMD\" value=\"diff\">",
	    "<input type=\"hidden\" name=\"ACT\" value=\"edit\">",
	    "File 1:<select name=FSPC>\n";

	foreach $f (@matches) {
	    $f =~ /([^\#]+)\#(\d+) - (\w+) change (\d+)/ ;
	    my ($name,$rev,$act,$change)=($1,$2,$3,$4) ;
	    if($act ne "delete"){
		print "<option value=\"$name&REV=$rev\" label=\"$name\">$name\#$rev\n";
	    }
	} ;
	print 
	    "</select><br>\n",
	    "File 2:<select name=FSPC2>\n";
	foreach $f (@matches) {
	    $f =~ /([^\#]+)\#(\d+) - (\w+) change (\d+)/ ;
	    my ($name,$rev,$act,$change)=($1,$2,$3,$4) ;
	    if($act ne "delete"){
		print "<option value=\"$name&REV2=$rev\" label=\"$name\">$name\#$rev\n";
	    }
	} ;
	print 
	    "</select><br>\n",
	    "<input type=\"submit\" value=\"View diff between file 1 and file 2\">\n",
	    "</form>\n" ;	
    }
}

################################
#
#	describe a change
#
################################
sub describeChange($ )
{
    
    my $change=shift @_ ;

    &p4open( *P4, "describe -s $change|" );

    $_ = <P4>;

    &fixSpecChar() ;
    
    /^Change (\d+) by (\S*)@(\S*) on (\S*) (\S*)$/ || &bail( $_ );
    my ($chn, $user, $client, $date, $time) = ($1,$2,$3,$4,$5) ;

    &printHeader("Change $chn") ;
    print
	"<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>$user\n",
	"<strong>Client        </strong>$client\n",
	"<strong>Date          </strong>$time $date\n",
	"</pre><hr>\n",
	"<h2>Description</h2>\n",
	"<pre>\n";

    while(<P4>) {
	&fixSpecChar() ;
	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> ) {
	    &fixSpecChar() ;
	    my( $job, $time, $user, $client );

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

		while(<P4>) {
		    &fixSpecChar() ;
		    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><th>Rev</th><th>Action</th></tr>\n";

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

    while(<P4>) {
	&fixSpecChar() ;
	if(/^\.\.\. (\S*)#(\d*) (\S*)$/)
	{
	    my( $file, $rev, $act ) = ($1,$2,$3) ;
	    print 
		"<tr>",
		"<td>", &url( "CMD=filelog&FSPC=$file", "$file" ), "</td>",
		"<td>", &url( "CMD=print&FSPC=$file&REV=$rev", "$rev" ),"</td>",
		"<td>", &url( "CMD=diff&FSPC=$file&REV=$rev&ACT=$act", "$act" ),"</td>",
		"</tr>\n";
	}
    }
    print
	"</table></ul>\n";

    close P4;
}

################################
#
# show filelog of the file
#
################################
sub filelog($ ) 
{
    my $name = shift @_ ;

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

    $name = <P4>;
    chop $name;

    &printHeader("Filelog $name") ;
    print
	"<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><br>",
	&url("CMD=changes&FSPC=$name","Changes for $name"),
	"<hr>\n";

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

    # Sample:
    # ... #78 change 1477 edit on 04/18/1996 by user@client 'Fix NT mkdi'

    while( <P4> ) {
	&fixSpecChar() ;	
	if(/^\.\.\. \#(\d+) \S+ (\d+) (\S+) on (\S+) by (\S*)@(\S*) '(.*)'/ )
	{
	    my ($rev,$change,$act,$date,$user,$client,$desc) =($1,$2,$3,$4,$5,$6,$7) ;
	    if ($act eq 'branch') {
		$_ = <P4>;
		my ($fromname,$fromrev) = /^.*branch from (\S+?)\#(\d+).*/;
		print
		    "<tr>",
		    "<td>", &url( "CMD=print&FSPC=$name&REV=$rev", "$rev" ),
		    "<td>", &url( "CMD=filelog&FSPC=$fromname&REV=$fromrev", $act ),
		    "<td>$date",
		    "<td>$user\@$client",
		    "<td>", &url( "CMD=describe&CH=$change", "$change" ),
		    "<td><tt>$desc</tt>",
		    "</tr>\n";
	    }
	    elsif ($act eq 'delete') {
		print
		    "<tr>",
		    "<td>", &url( "CMD=print&FSPC=$name&REV=$rev", "$rev" ),
		    "<td>$DEL$act$DELEND",
		    "<td>$date",
		    "<td>$user\@$client",
		    "<td>", &url( "CMD=describe&CH=$change", "$change" ),
		    "<td><tt>$desc</tt>",
		    "</tr>\n";
	    }
	    else {
		print
		    "<tr>",
		    "<td>", &url( "CMD=print&FSPC=$name&REV=$rev", "$rev" ),
		    "<td>", &url( "CMD=diff&FSPC=$name&REV=$rev&ACT=$act", $act ),
		    "<td>$date",
		    "<td>$user\@$client",
		    "<td>", &url( "CMD=describe&CH=$change", "$change" ),
		    "<td><tt>$desc</tt>",
		    "</tr>\n";
	    }
	}
    }

    print "</table>\n";

    close P4;
}

################################
#
# print file text
#
################################
sub printFile($$ )
# arg1: file spec
# arg2: revision info
{
    my $fname = shift @_ ;
    my $frev  = shift @_ ;
				# Find out if p4br.perl is available, if true set smart
    my $smart;
    my ( $name, $rev, $type ) ;
    if(-x "p4pr.perl") {
	open(*P4,"./p4pr.perl $fname#$frev |") or &bail("Can't start p4pr!!!!. too bad!") ;
	$smart="Yes";
	# Get header line
	#  line   author/branch change  rev //depot/main/jam/Jamfile#39 - edit change 1749 (text)
 	$_ = <P4>;	
	/^\s+\S+\s+\S+\s+\S+\s+\S+\s+(\S+)\#(\d+) - \S+ \S+ \S+ \((\w+)\)/ or 
	    &bail("Shit! $_ ") ;
	( $name, $rev, $type ) = ($1,$2,$3) ;
 	$_ = <P4>;
    }
    else {
	&p4open( *P4, "print $fname#$frev|" );
	$smart="No, stupid." ;
	# Get header line
	# //depot/main/jam/Jamfile#39 - edit change 1749 (text)
	$_ = <P4>;
	/^(\S+)\#(\d+) - \S+ \S+ \S+ \((\w+)\)/;	
 	( $name, $rev, $type ) = ($1,$2,$3) ;
   }

    &printHeader("File $name\#$rev") ;
    print 
	"<i>This form shows you the raw contents of a file, as long as \n",
	"it isn't binary.</i>";
    if($smart == "Yes") {
	print 
	    "<ul>\n",
	    "<li>Change number -- to see the change description\n",
	    "<li>Revision number -- to see diff at selected revision\n",
	    "</ul>" ;
    }
    print 
	"<hr>\n";

    if( $type eq "binary" || $type eq "xbinary" )
    {
	print "<h2>$type</h2>\n";
    }
    else
    {
	print "<pre>\n";
	    
	if($smart eq "Yes"){
	    my ($line,$authorBranch,$change,$rev,$line) ;
	    print "Change Rev\n";
	    my $oldch=-1;
	    while( <P4> ) {
		&fixSpecChar() ;
		($line,$authorBranch,$change,$rev,$line) =
		    m/^\s+(\d+)\s+(\S+)\s+(\d+)\s+(\d+) (.*)$/ ;		
		my($chstr,$revstr)=("     ","|   ");
		if($oldch != $change){
		    $chstr=
			substr("     ",0,5-length("$change")) . 
			    &url("CMD=describe&CH=$change","$change") ;
		    $revstr = 
			substr("     ",0,4-length("$rev")) .
			    &url("CMD=diff&FSPC=$fname&REV=$rev&ACT=edit","$rev");
		}		    
		$oldch= $change ;
		print "$chstr$revstr <font color=red>|</font>$line\n" ;
	    }	    
	}
	else {
	    while( <P4> ) {
		&fixSpecChar() ;
		print $_;
	    }	    
	}
	    print "</pre>\n";
    }
    close P4;
}

################################
#
#
#  Diff two files
#
################################
sub printDiff($$$ )
# arg1: file spec
# arg2: file rev
# arg3: file action
# arg4: file rev for second file (defaults to $rev + 1)
# arg5: file spec for second file (defaults to arg1)
{
    my $name = shift @_ ;
    my $rev  = shift @_ ;
    my $mode = shift @_ ;
    my $rev2 = shift @_ ;
    my $name2 = shift @_ ;

    if(!defined $rev2) {
	$rev2=$rev-1 ;
    }
    if(!defined $name2) {
	$name2=$name;
    }
    my $samefile = ($name eq $name2)?"Yes":"No" ;

    if (($samefile eq "Yes") and ($rev < $rev2)) { my $t=$rev;$rev=$rev2;$rev2=$t;};
    
    my $nchunk = 0;

    my $f1 = "$name#" . ($rev);
    my $f2 = "$name2#" . ($rev2);
    
    my $f1start=$BLUE_TXT ;
    my $f2start=($samefile eq "Yes")?$DEL:$GREEN_TXT ;
    my $f1end=$END ;
    my $f2end=($samefile eq "Yes")?$DELEND:$END ;

    &printHeader
	("Diff between<br>$f1<small><br>and<br></small>$f2") ;
    print
	"<i>This form shows you the deltas (diffs) between two files\n",
	"or revisions</i>\n",
	"<hr>\n";

    my @start ;
    my @dels ;
    my @adds ;
    my @lines ;    

    if ($mode ne 'add' && $mode ne 'delete' && $mode ne 'branch') {
	
	&p4open(*P4, "diff2 $f2 $f1|");
	$_ = <P4>; 

	while (<P4>) {

	    my ( $dels, $adds );

	    /(\d+),?(\d*)([acd])(\d+),?(\d*)/;
	    my ( $la, $lb, $op, $ra, $rb ) = ($1,$2,$3,$4,$5) ;

	    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/^. //;
		&fixSpecChar() ;		
		$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>",
    	"$f1start $f1 $f1end\n",
	"$f2start $f2 $f2end\n",
	"</pre></center><hr><pre>\n";

    my $curlin = 1;

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

    my $n ;
    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 "$f2start";
		print $lines[ $n ];
		print "$f2end";
	}

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

	if( $adds[ $n ] )
	{
		print "$f1start";
		&display( *P4, $adds[ $n ] );
		print "$f1end";
	}

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

    &catchup( *P4, 999999999 );

    close P4;
} 

################################
#
#	list jobs
#
################################
sub listJobs($ )
# arg1: one of open, suspended and closed
{
    my $stats = shift @_ ;
    my @stats ;
    if(defined $stats) {
	push @stats,$stats ;
	&printHeader("List of $stats jobs");
    } else {
	&printHeader("List of jobs");
	push @stats,"open","suspended","closed" ; 
    };
    
    my $stat ;
    my $total=0 ;
    foreach $stat (@stats) {
	print 
	    "<hr><h2>",ucfirst($stat)," jobs:</h2>\n" ;
	&p4open( *P4, "jobs -l -s $stat|" );
	print "<dl>\n" ;
	while(<P4>) {
	    chomp ;
	    if(/^(\S+)(.*)$/) {
		$total++ ;
		print 
		    "<dt>",
		    &url("CMD=job&JOB=$1","Job $1"),
		    " $2<br><dd>" ;		
	    }
	    else {
		print "<code>$_</code><br>\n" ;
	    }
	}
	close P4 ;
	print "</dl>\n" ;
	
    }
    print "<hr>Total jobs in list: $total\n" ;
}

################################
#
#  describe a job
#
################################
sub descJob($ )
# arg1: jobspec
{
    my ( $user, $job, $status, $time, $date );

    my $jobspc = shift @_ ;
    
    &p4open( *P4, "job -o $jobspc 2>&1|" );

    while( <P4> )
    {
	chop ;
	&fixSpecChar() ;	
	next if ( /^Job:\s+(\S+)/    && ($job    = $1)) ;
	next if ( /^User:\s+(\S+)/   && ($user   = $1)) ;
	next if ( /^Status:\s+(\S+)/ && ($status = $1)) ;
	next if ( /^Date:\s+(\S+)\s+(\S+)/  && (( $date, $time ) = ($1,$2))) ;
	last if ( /^Description/ );
    }

    &printHeader("Job $job");
    print 
	"<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>$user\n",
	"<strong>Status        </strong>$status\n",
	"<strong>Date          </strong>$time $date\n",
	"</pre><hr>\n",
	"<h2>Description</h2>\n",
	"<pre>\n";

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

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

    close P4;

    # display fixes

    &p4open( *P4, "fixes -j $jobspc|" );

    my $count = 0;

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

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

	if(/^\S* fixed by change (\S*) on (\S*) by (\S*)@(\S*)/) 
	{
	    my ( $change, $date, $user, $client ) = ($1,$2,$3,$4) ;
	    print 
		"<tr>",
		"<td>", &url( "CMD=describe&CH=$change", "$change" ),
		"<td>", $date,
		"<td>", $user,
		"<td>", $client,
		"</tr>\n";
	}
    }

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

    close P4;
}

################################
#
#  describe a label
#
################################
sub descLabel($ )
# arg1: label
{
    my $label = shift @_ ;
    $label =~ s/^\@// ;


    &p4open( *P4, "label -o $label |" );

				# Get date, time and owner -- skip to description
    my ($date,$time,$owner) ;
    while(<P4>) {
	chomp ;
	&fixSpecChar() ;
	/^Label:\s+(\S+)/        && do { $label=$1 ; next ; } ;
	/^Date:\s+(\S+)\s+(\S+)/ && do { $date=$1 ; $time=$2 ;  next ; } ;
	/^Owner:\s+(\S+)/        && do { $owner=$1 ; next ; } ;
	/^Description:/          && do { last ;} ;
    }

    unless(defined $date) { 
	&bail("Can not get label info. Possibly wrong P4USER or P4CLIENT") ;
    } ;

    &printHeader("Label $label");

    print 
	"<i>This form displays the details of a label\n",
	"</i>",
	"<hr><pre>\n",
	"<strong>Label         </strong>$label\n",
	"<strong>Date          </strong>$time $date\n",
	"<strong>Owner         </strong>$owner\n",
	"</pre><hr>\n",
	"<h2>Description</h2>\n",
	"<pre>\n";

    while(<P4>) {
	&fixSpecChar() ;
	last if /^View:/ ;
	print $_;
    }
    print
	"</pre>",
	"<hr><h2>View</h2><pre>\n";

    while(<P4>) {
	&fixSpecChar() ;
	print $_;
    }
    close P4;
    print
	"</pre>",
	"<hr><h2>Files</h2>\n",
	"<table cellpadding=1>\n",
	"<tr align=left><th>File</th><th>Rev</th><th>Action</th>",
	"<th>Change</th><th>Type</th></tr>\n";

    &p4open( *P4, "files //...\@$label|" );
    my $cnt=0 ;
    while(<P4>) {
        /([^\#]+)\#(\d+) - (\w+) change (\d+) \((\S+)\)/ ;
	my ($name,$rev,$act,$change,$type)=($1,$2,$3,$4,$5) ;
	$cnt++ ;
	if(($cnt % 60) == 0) {
	    print "</table><table cellpadding=1>\n";
	}
	print
	    "<tr><td>",
	    &url( "CMD=filelog&FSPC=$name", "$name" ),
	    "</td><td>",
	    &url( "CMD=print&FSPC=$name&REV=$rev", "$rev" ),
	    "</td><td>",
	    &url( "CMD=diff&FSPC=$name&REV=$rev&ACT=$act", "$act" ),
	    "</td><td>",
	    &url( "CMD=describe&CH=$change", "$change" ),
	    "</td><td>$type</td></tr>\n",
	}  ;
    print "</table>\n" ;
    print "$cnt files<hr>\n" ;
    
    close P4;
}

################################
#
#  diff two labels
#
################################
sub labelDiff($$$$$ )
# arg1: label 1
# arg2: label 2
# arg3: if defined and "Y", show all files that are the same
# arg4: if defined and "Y", show all files that differ 
# arg5: if defined and "Y", show all files that only exists in one
{
    my $label1 = shift @_ ;
    my $label2 = shift @_ ;
    my $showSame = shift @_ ;
    my $showNotSame = shift @_ ;
    my $showDiff= shift @_ ;
    undef $showSame if $showSame ne "Y" ;
    undef $showNotSame if $showNotSame ne "Y" ;
    undef $showDiff if $showDiff ne "Y" ;
    
    $label1 =~ s/^@// ;
    $label2 =~ s/^@// ;

				# Get date, time, owner and desc for label 1
    &p4open( *P4, "label -o $label1 2>&1|" );
    my ($date1,$time1,$owner1,$desc1,$view1,$fileCnt1) ;
    while(<P4>) {
	chop ;
	&fixSpecChar() ;
	/^Label:\s+(\S+)/        && do { $label1=$1 ; next ; } ;
	/^Date:\s+(\S+)\s+(\S+)/ && do { $date1=$1 ; $time1=$2 ;  next ; } ;
	/^Owner:\s+(\S+)/        && do { $owner1=$1 ; next ; } ;
	/^Description:/          && do { last ;} ;
    }
    $desc1 = "" ;
    while(<P4>) {
	chomp ;
	next if /^\s*$/ ;
	last if /^View:/ ;
	$desc1 .= "$_\n" ;
    }
    $view1 = "" ;
    while(<P4>) {
	chomp ;
	next if /^\s*$/ ;
	$view1 .= "$_\n" ;
    }
    close P4 ;
				# Get date, time, owner and desc for label 2
    &p4open( *P4, "label -o $label2 2>&1|" );
    my ($date2,$time2,$owner2,$desc2,$view2,,$fileCnt2) ;
    while(<P4>) {
	chop ;
	&fixSpecChar() ;
	/^Label:\s+(\S+)/        && do { $label2=$1 ; next ; } ;
	/^Date:\s+(\S+)\s+(\S+)/ && do { $date2=$1 ; $time2=$2 ;  next ; } ;
	/^Owner:\s+(\S+)/        && do { $owner2=$1 ; next ; } ;
	/^Description:/          && do { last ;} ;
    }
    $desc2 = "" ;
    while(<P4>) {
	chomp ;
	next if /^\s*$/ ;
	last if /^View:/ ;
	$desc2 .= "$_\n" ;
    }
    $view2 = "" ;
    while(<P4>) {
	chomp ;
	next if /^\s*$/ ;
	$view2 .= "$_\n" ;
    }
    close P4 ;
    &printHeader("Diff between label <code>$label1</code> and <code>$label2</code>");
    print 
	"<i>This form displays the diff between two labels</i><hr>\n",
	"<table border>\n",
	"  <tr><td></td><th>$label1</th><th>$label2</th></tr>\n",
	"  <tr><th>Date</th><td>$time1 $date1</td><td>$time2 $date2</td></tr>",
	"  <tr><th>Owner</th>";
    if($owner1 eq $owner2) {
	print "<td colspan=2 align=center>$GREEN_TXT $owner1 $END</td>" ;
    }
    else {
	print "<td>$owner1</td><td>$owner2</td>" ;
    }
    print 
	"  </tr>\n",
	"  <tr><th>Description</th>";
    if($desc1 eq $desc2) {
	print "<td colspan=2 align=center>$GREEN_TXT $desc1 $END</td>" ;
    }
    else {
	print "<td>$desc1</td><td>$desc2</td>" ;
    }
    print 
	"  </tr>\n",
	"  <tr><th>View</th>";
    if($view1 eq $view2) {
	print "<td colspan=2 align=center>$GREEN_TXT $view1 $END</td>" ;
    }
    else {
	print "<td>$view1</td><td>$view2</td>" ;
    }
    print "</tr></table><hr>" ;
				# get files for label 1
    my @lfiles1 ;
    &p4open( *P4, "files //...\@$label1 2>&1|" );
    while(<P4>) {
	chomp ;
	push @lfiles1,$_ ;
    }
    close P4 ;  
				# get files for label 2
    my @lfiles2 ;
    &p4open( *P4, "files //...\@$label2 2>&1|" );
    while(<P4>) {
	chomp ;
	push @lfiles2,$_ ;
    }
    close P4 ;
    
    printf "Label $label1 has %d files<br>",scalar(@lfiles1) ;
    printf "Label $label2 has %d files<br>",scalar(@lfiles2) ;
    
    my $f1 = shift @lfiles1 ;
    my $f2 = shift @lfiles2 ;
    print 
	"<table border bgcolor=$bgcolor_bright>",
	"<tr><th>File</th>",
	"<th colspan=2>$label1<br>Rev.</th>",
	"<th colspan=2>$label2<br>Rev.</th></tr>\n";
    my ($name1,$rev1,$name2,$rev2);
    while(defined $f1 and defined $f2) {	
	if(defined $f1) {
	    $f1 =~ /^([^\#]+)\#(\d+)/ ;
	    $name1 = $1 ; $rev1 = $2 ;
	}
	if(defined $f2) {
	    $f2 =~ /^([^\#]+)\#(\d+)/ ;
	    $name2 = $1 ; $rev2 = $2 ;
	}
	if($name1 eq $name2) {
	    if((defined $showSame    and ($rev1 == $rev2)) or
	       (defined $showNotSame and ($rev1 != $rev2))) {
		print 
		    "<tr><td>",
		    &url( "CMD=filelog&FSPC=$name1", "$name1" ),
		    "</td>" ;
		if($rev1 == $rev2) {
		    print "<td colspan=4 align=center>$GREEN_TXT $rev1 $END</td>" ;		
		}
		else {
		    print 
			"<td align=center>$rev1</td>",
			"<td colspan=2 align=center>",
			&url("CMD=diff&FSPC=$name1&REV=$rev1&ACT=edit&REV2=$rev2",
			     "&lt;-&gt"),
			"</td>",
			"<td align=center>$rev2</td>" ;
		}
		print "</tr>\n" ;
	    }
	    $f1 = shift @lfiles1 ;
	    $f2 = shift @lfiles2 ;
	}
	elsif ($name1 gt $name2) {
	    if(defined $showDiff) {
		print 
		    "<tr><td>",
		    &url( "CMD=filelog&FSPC=$name2", "$name2" ),
		    "</td>",
		    "<td colspan=2 bgcolor=red align=center> ---- </td>",
		    "<td colspan=2 align=center>$rev2</td></tr>\n" ;
	    }
	    $f2 = shift @lfiles2 ;
	}
	else {
	    if(defined $showDiff) {
		print 
		    "<tr><td>",
		    &url( "CMD=filelog&FSPC=$name1", "$name1" ),
		    "</td>",
		    "<td colspan=2 align=center>$rev1</td><td colspan=2 bgcolor=red> - </td></tr>\n" ;
	    }
	    $f1 = shift @lfiles1 ;
	}
    }
    print "</table>\n"
}


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

sub printHeader($ ) {
# Print header
    my $title = $_[0];
    $title =~ s/<[^>]+>//g ;
    print 
	"<head><title>$title</title></head>\n",
	"<body bgcolor=\"$bgcolor\">\n",
	"<small>Current change level: $currentChangeLevel</small>\n",
	"<br><center><font size=+3 color=red><b>$_[0]</b></font></center>\n" ;
    if(defined $ENV{P4PORT}) {
	my ($host,$port) = split /:/,$ENV{P4PORT} ;
	print "<center><small>Host: $host  Port: $port</small></center>\n" ;
    }
} ;

sub table($@ )
{
    my $options=shift @_ ;
    return split("\n","<table $options>\n   " . join("\n   ",@_) . "\n</table>") ;
}

sub row($@ )
{
    my $options = shift @_ ;
    if($options !~ /valign=/) { $options .= " valign=top" ; } ;
    return split("\n",
		 "<tr $options>\n   " . join("\n   ",@_) . "\n</tr>" )  ;
}

sub headerCell($@ )
{
    my $options = shift @_ ;    
    return split("\n","<th $options>\n   " . join("\n   ",@_) . "\n</th>" )  ;
}

sub cell($@ )
{
    my $options = shift @_ ;    
    return split("\n","<td $options>\n   " . join("\n   ",@_) . "\n</td>" )  ;
}

sub fixSpecChar()
# Change some special characters to strings in $_
{    
    s/&/&amp;/g ; # & -> &amp;
    s/\"/&quot;/g;# " -> &quot;
    s/</&lt;/g  ; # < -> &lt;
    s/>/&gt;/g  ; # > -> &gt;
}

sub url( ) {
	my ( $url, $name, $anchor ) = @_;
	if(defined $anchor) { $anchor="#$anchor" ; } else { $anchor="" ; } ;
	return qq(<a HREF="$myname$anchor?$url">$name</a>) ;
}

sub gotoAnchor {
    my ( $anchor, $text) = @_ ;
    return qq(<a HREF="#$anchor">$text</a>) ;
}

sub anchor {
    my $anchor = shift @_ ;
    return qq(<a NAME="$anchor"></a>) ;    
}


sub helpText {
    if(defined $verbose) {
	if(defined $helpTexts{$_[0]}) {
	    return "<p><font color=green> $helpTexts{$_[0]} </font>" ;
	}
    }
    return "" ;
} ;

sub bail($ ) {
    my $err = shift @_ ;
    print
	"<head><title>ERROR: $err</title></head>\n",
	"<body bgcolor=\"#000000\" text=\"#FF0000\" >\n",
	"<table border halign=center align=center bgcolor=white>\n",
	"<tr><th><big><big>Error: $err</big></big></th></tr>\n",
	"</table>\n",
	"</body></html>\n" ;
    exit 1 ;
}

sub p4open {
	my ( $handle, @command ) = @_;
	open( $handle, "$P4PGM @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 {
	my ( $handle, $to ) = @_;

	while( $to > 0 && ( $_ = <$handle> ) ) {
	    $to--;
	}

	return $to;
}

sub display {
	my ( $handle, $to ) = @_;

	while( $to-- > 0 && ( $_ = <$handle> ) ) {
	    fixSpecChar() ;
	    print $_;
	}
}

sub catchup {

	my ( $handle, $to ) = @_;

	if( $to > $MAXCONTEXT )
	{
	    my $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;
	}
}
#
# Help texts are stored as data after the code
#
__END__
HELPTEXT=GENERAL
This browser allows you to:
<li>View the history of a Perforce depot by file or by group of files
<li>Examine changes and view files
<li>Search for files in the depot
<li>Examine labels and difference between two labels
<p>
<B>NOTE!</B> Since the page is produced by a cgi-script running on the
intranet web server the script does not know anything about who You are
or what Your view of the depot looks like. You can not find any information
about the staus of Your local copy of files from depot using this script.<P>
What You <U>can</U> do is investigate the current status of the depot<P>
For a description of concepts and functionality of the depot see the perforce
documentation (available at
<A HREF="http://www.perforce.com">http://www.perforce.com</A>)

HELPTEXT=SELECT_PREDEF
There is an (optional) configuration file that defines some "common" views
that should be of interest to different groups in the organization.<P>
If You select a view You will get a page with a list of all changes that 
affect the files in the view.

HELPTEXT=SELECT_PATTERN
Type in Your own view to list changes for.<br>
The search pattern may contain wildcards:
<dl compact>
<dt><code>...</code>
<dd>Replaces ant text
<dt><code>*</code>
<dd>Replaces and text not containing "/".
</dl>
Some examples:
<dl>
<dt><code>//...</code> or <code>...</code>
<dd>All files in depot.<br>All pattern must start with "<code>//</code>". 
    To make it easier <code>//...</code> is automatically added if not
    present.
<dt><code>*.C</code>
<dd>All files with extension <code>C</code>
<dt><code>mmi.H</code>
<dd>All files in the depot named <code>mmi.C</code>
<dt><code>/dirname/*</code>
<dd>All files in all directorys named <code>dirname</code>
</dl>

HELPTEXT=SELECT_SEARCH
Almost same as above exept that if the selected view consists of more than one file
those files will be listed and You can select which file You view changes of. 

HELPTEXT=SELECT_LABEL_CHANGES
Select a label to view the history for. The changes displayed will be the sum of 
the changes that affect all individual files in the label.<P>
Optionally a second label can be selected. The changes in both labels will be 
excluded from the list of changes. Changes only in the second label will be marked 
in the output.<P>
The purpose is to make it possible to examine the difference between two releases.