#!/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 </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" ), " ) <$type> </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/&/&/g; s/\"/"/g; s/</</g; s/>/>/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>\ </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/&/&/g; s/\"/"/g; s/</</g; s/>/>/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/&/\&/g; s/</\</g; s/>/\>/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\">* * *<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/&/\&/g; s/</\</g; s/>/\>/g; } print $_; } } sub catchup { local( $handle, $to ) = @_; if( $to > $MAXCONTEXT ) { local( $skipped ) = $to - $NCONTEXT * 2; &display( $handle, $NCONTEXT ); $skipped -= &skip( $handle, $skipped ); print "<hr><center><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; }
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#3 | 154 | Matthew Rees | Re-added conversion of hex numbers in url | ||
#2 | 151 | Matthew Rees |
Changed form arguments to make them more consistent. Added translator so perfbrowse is backwards "url compatible" with old version which did not use forms-style input. |
||
#1 | 146 | Matthew Rees | check in my version of perfbrowse.pl |