- #!/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!)
- "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
- "<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 = @_ ;
- "",&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") ;
- "<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>" ;
- "",
- (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) ;
- "<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) {
- "<dt><font color=green><hr>\n",
- "$skipped change(s) common to both labels<hr></font>\n";
- };
- $skipped=0 ;
- "<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) {
- "<dt><font color=green><hr>\n",
- "$skipped change(s) common to both labels<hr></font>\n";
- }
- $skipped=0 ;
- "<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>" ) ;
- "<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) ;
- "<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" ;
- "<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";
- }
- } ;
- "</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";
- }
- } ;
- "</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") ;
- "<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 $_;
- }
- "</pre>",
- "<hr>\n";
- # display jobs
- if( /^Jobs fixed/ )
- {
- "<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*)/ )
- {
- "<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/;
- }
- "</dl>",
- "<hr>\n";
- }
- "<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) ;
- "<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";
- }
- }
- "</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") ;
- "<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";
- "<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+).*/;
- "<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') {
- "<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 {
- "<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") ;
- "<i>This form shows you the raw contents of a file, as long as \n",
- "it isn't binary.</i>";
- if($smart == "Yes") {
- "<ul>\n",
- "<li>Change number -- to see the change description\n",
- "<li>Revision number -- to see diff at selected revision\n",
- "</ul>" ;
- }
- "<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") ;
- "<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.
- "<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) {
- "<hr><h2>",ucfirst($stat)," jobs:</h2>\n" ;
- &p4open( *P4, "jobs -l -s $stat|" );
- print "<dl>\n" ;
- while(<P4>) {
- chomp ;
- if(/^(\S+)(.*)$/) {
- $total++ ;
- "<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");
- "<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 $_;
- }
- "</pre>",
- "<hr>\n";
- close P4;
- # display fixes
- &p4open( *P4, "fixes -j $jobspc|" );
- my $count = 0;
- while( <P4> )
- {
- &fixSpecChar() ;
- "<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) ;
- "<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");
- "<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 $_;
- }
- "</pre>",
- "<hr><h2>View</h2><pre>\n";
- while(<P4>) {
- &fixSpecChar() ;
- print $_;
- }
- close P4;
- "</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";
- }
- "<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>");
- "<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>" ;
- }
- " </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>" ;
- }
- " </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 ;
- "<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))) {
- "<tr><td>",
- &url( "CMD=filelog&FSPC=$name1", "$name1" ),
- "</td>" ;
- if($rev1 == $rev2) {
- print "<td colspan=4 align=center>$GREEN_TXT $rev1 $END</td>" ;
- }
- else {
- "<td align=center>$rev1</td>",
- "<td colspan=2 align=center>",
- &url("CMD=diff&FSPC=$name1&REV=$rev1&ACT=edit&REV2=$rev2",
- "<->"),
- "</td>",
- "<td align=center>$rev2</td>" ;
- }
- print "</tr>\n" ;
- }
- $f1 = shift @lfiles1 ;
- $f2 = shift @lfiles2 ;
- }
- elsif ($name1 gt $name2) {
- if(defined $showDiff) {
- "<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) {
- "<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 ;
- "<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/&/&/g ; # & -> &
- s/\"/"/g;# " -> "
- s/</</g ; # < -> <
- s/>/>/g ; # > -> >
- }
- 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 @_ ;
- "<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 );
- "<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.
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#1 | 5093 | Hari Krishna Dara |
Populating perforce branch. I will be adding p4admin files to it. |
19 years ago | |
//guest/perforce_software/utils/p4db/P4DB_0/dbr.cgi | |||||
#1 | 1885 | rmg | For posterity: Make the old version appear in a "P4DB_0" subdirectory. (I'd have called i...t 0.99, but I'm not sure it really *is* 0.99!) « |
23 years ago | |
//guest/perforce_software/utils/p4db/dbr.cgi | |||||
#2 | 12 | Perforce maintenance | P4DB now browses all depot root paths, not just "//depot/...". (Note: This breaks the "...Browse depot tree" function on the main form -- will fix later.) « |
26 years ago | |
#1 | 11 | Perforce maintenance | Add Fredric Fredricson's depot browser, P4DB. | 26 years ago |