Helix SwarmHelix Swarm

p4browse

  • //
  • guest/
  • greg_spencer/
  • perforce/
  • utils/
  • p4dir/
  • javascript/
  • cgi-bin/
  • p4browse #1
  • View
  • Commits
  • Open Download .zip Download (27 KB) 
  1. #!perl5
  2. #
  3. # perfbrowse.perl -- CGI browser for PERFORCE
  4. #
  5. # $Id: p4browse,v 1.3 1997/08/20 22:28:40 gspencer Exp gspencer $
  6. #
  7. # Point P4PORT and P4CLIENT differently if you're not using the defaults.
  8. # PATH is set to pick up the Perforce client program.
  9. #
  10. #
  11.  
  12. # Updated by Jeff Marshall at Paragon Software, Inc.
  13. # (jam@paragon-software.com)
  14. #
  15. # Please email me your improvements
  16. #
  17. # My changes:
  18. #   - Added white background
  19. #   - New browsing goodies -- like:
  20. #     o clients
  21. #     o users
  22. #     o opened files, by client and user
  23. #     o branches
  24. #     o labels
  25. #     o jobs
  26. #     o files within a given client
  27. #   - Footer on every page with a link to the "top browser page" and links
  28. #     to the browsing functionality listed above
  29. #   - Also put in hyperlinks anywhere a perforce user, client or mail address
  30. #     is seen.
  31. #
  32. # Tested with p4d 98.2 on a solaris 2.6 sparc server.
  33. #
  34. # Note: I'm not a perl programmer...
  35. #
  36. # Modifications by Greg Spencer (greg_spencer@acm.org):
  37. #   - added links to the p4dir html browser.
  38. #   - modified this to use the p4Config.pm file for configuration info
  39. #
  40.  
  41. use p4Config;
  42.  
  43. # Boilerplate
  44.  
  45. $myname = "$0";
  46. $myname =~ s!^.*/!!;
  47. $p4dir="http:$wwwcgibin/p4file2html";
  48.  
  49. $BLUE = qq(<font color="#0000FF">);
  50. $GREEN = qq(<font color="#00B000">);
  51. $RED = qq(<font color="#B00000">);
  52. $END = qq(</font>);
  53.  
  54. $ADD = $BLUE;
  55. $ADDEND = $END;
  56. $DEL = "<STRIKE>$RED";
  57. $DELEND = "$END</STRIKE>";
  58.  
  59. $MAXCONTEXT = 30;
  60. $NCONTEXT = 10;
  61.  
  62. @HTMLHEADER = (
  63. 	"Content-type: text/html\n",
  64. 	"\n",
  65. 	"<html>\n",
  66. 	"<head>\n",
  67. 	"<body bgcolor=\"#ffffff\">\n" );
  68.  
  69. @HTMLERROR = (
  70. 	"Content-type: text/html\n",
  71. 	"\n",
  72. 	"<html>\n",
  73. 	"<head>\n",
  74. 	"<body bgcolor=\"#ffffff\">\n" );
  75.  
  76. @OTHER_FOOTERS = ();
  77. #
  78. # Switch on ARGV[0]
  79. #
  80.  
  81. # handle isindex compatibility
  82.  
  83. unshift( @ARGV, "\@changes" ) if( @ARGV && @ARGV[0] !~ m!^@! );
  84.  
  85. ################################
  86. #
  87. # No arguments. 
  88. #
  89. #	Put up the introductory screen.
  90. #
  91. ################################
  92.  
  93. if (!@ARGV) {
  94.  
  95.     # Default codelines data is just a simple list of everything.
  96.     # If $CODELINES is set in the environment, the codelines comes
  97.     # from that.  The format is:
  98.     #
  99.     #	description1
  100.     #	//path1
  101.     #	description2
  102.     #	//path2
  103.  
  104.     if ($ENV{CODELINES}) {
  105. 	open( P4, "$ENV{CODELINES}" ) || &bail( "No codelines file." );
  106. 	@CODELINES = <P4>;
  107.     }
  108.     else {
  109. 	open (P4, "p4 dirs //depot/mainline/*|");
  110. 	@CODELINES = <P4>;
  111. 	close P4;
  112. 	my(@tmp) = ();
  113.  
  114. 	push(@tmp,("Full Depot Source\n", "//depot/...\n" ));
  115. 	foreach (@CODELINES) {
  116. 	    chomp;
  117. 	    my ($short) = $_;
  118. 	    $short =~ s,.*/(.),\U$1\E,;
  119.  
  120. 	    push (@tmp,"Mainline Project $short:\n");
  121. 	    push (@tmp,"$_/...\n");
  122. 	}
  123. 	@CODELINES = @tmp;
  124.     }
  125.  
  126.     print 
  127. 	@HTMLHEADER,
  128. 	"<title>Perforce Change Browser</title>\n",
  129. 	"<center><h1>Perforce Change Browser</h1>\n</center>",
  130. 	"<i>This browser allows you to view the history of a Perforce depot.\n",
  131. 	"The first step is to select the files you want history for.</i>\n",
  132. 	"<isindex prompt=\"Click below or type a file pattern here: \">\n";
  133.  
  134.     foreach ( @CODELINES )
  135.     {
  136. 	chop;
  137.  
  138. 	if( m:^/: )
  139. 	{
  140. 	    print "<li>", &url( "\@changes+$_", $_ ), "\n";
  141. 	}
  142. 	elsif( !/^\s*$/ )
  143. 	{
  144. 	    print "</blockquote><p><h3>$_</h3><blockquote>\n";
  145. 	}
  146.     }
  147. }
  148. elsif ( @ARGV[0] eq "\@users" ) {
  149.     &p4open( 'P4', "users|" );
  150.  
  151.     print @HTMLHEADER,
  152. 	"<title>Perforce Users</title>\n",
  153. 	"<center><h1>Perforce Users</h1>\n</center>",
  154. 	"<i>This browser allows you to view information about ",
  155.     	" Perforce users.\n",
  156. 	"The first step is to select which user you want to view</i>\n",
  157. 	"<hr>";
  158.  
  159.     print
  160. 	"<table cellpadding=1>",
  161. 	"<tr align=left><th>User<th>Email<th>Full Name",
  162. 	"<th>Last Accessed</tr>\n";
  163.  
  164.     # Sample:
  165.     # jam <jam@bar.com> (Jeffrey A. Marshall) accessed 1998/07/03
  166.  
  167.     while( <P4> ) {
  168. #	print "<tr><td>$_</tr>\n";
  169. 	if (local( $user, $email, $fullname, $accessed ) = 
  170. 	    /(\S+) <(\S+)> \((.*)\) accessed (\S+)/)
  171. 	{
  172. 	    print "<tr>",
  173. 	    	  "<td>", &url ( "\@user+$user", "$user"),
  174. 		  "<td>", &mailto ( "$email" ),
  175. 	    	  "<td>", "$fullname",
  176. 		  "<td>", "$accessed",
  177. 	       	  "</tr>\n";
  178. 	}
  179.     }
  180.     print "</table>\n";
  181.     close P4;
  182. } elsif ( @ARGV[0] eq "\@user" ) {
  183.     local( $user, $email, $access, $fullname, $jobview );
  184.     $user = $ARGV[1];
  185.     &p4open ('P4', "user -o $user|");
  186.  
  187.     while (<P4>)
  188.     {
  189. 	next if (/^User:/);
  190. 	next if (/^Email:/ && (( $email ) = /^Email:\s*(.*)$/ ));
  191. 	next if (/^Access:/ && (( $access ) = /^Access:\s*(.*)$/ ));
  192. 	next if (/^FullName:/ && (( $fullname ) = /^FullName:\s*(.*)$/ ));
  193. 	next if (/^JobView:/ && (( $jobview ) = /^JobView:\s*(.*)$/ ));
  194. 	last if (/^Reviews:/);
  195.     }
  196.  
  197.     print @HTMLHEADER,
  198.     	"<title>Perforce User Information for $user</title>\n",
  199. 	"<center><h1>Perforce User Information for $user</h1>\n</center>",
  200. 	"<i>This browser allows you to view information about ",
  201.     	" a given Perforce user.</i>\n<hr>",
  202. 	"<h3>Full Name</h3><pre>        $fullname</pre>\n",
  203. 	"<h3>Email</h3><pre>        ", &mailto ("$email"), "</pre>\n",
  204. 	"<h3>Last Access</h3><pre>        $access</pre>\n",
  205. 	"<h3>JobView</h3><pre>        $jobview</pre>\n",
  206. 	"<h3>Reviews</h3>\n<pre>";
  207.  
  208.     while (<P4>)
  209. 	{
  210. 	   print;
  211. 	}
  212.     print "</pre>\n";
  213.     close P4;
  214.     @OTHER_FOOTERS = (" | ",
  215. 		      , &url ("\@opened+user+$user",
  216. 			      "Files Opened by $user"));
  217. } elsif ( @ARGV[0] eq "\@clients" ) {
  218.     &p4open( 'P4', "clients|" );
  219.  
  220.     print @HTMLHEADER,
  221. 	"<title>Perforce Clients</title>\n",
  222. 	"<center><h1>Perforce Clients</h1>\n</center>",
  223. 	"<i>This browser allows you to view information about ",
  224.     	" Perforce clients.\n",
  225. 	"The first step is to select which client you want to view</i>\n",
  226. 	"<hr>";
  227.  
  228.     print
  229. 	"<table cellpadding=1>",
  230. 	"<tr align=left><th>Client<th>Date<th>Root Directory",
  231. 	"<th>Description</tr>\n";
  232.  
  233.     # Sample:
  234.     # Client oak.template 1998/06/25 root /tmp 'OAK client template '
  235.  
  236.     while( <P4> ) {
  237. 	if (local( $client, $date, $root, $descrip ) = 
  238. 	    /Client (\S+) (\S+) root (\S+) '(.*)'/)
  239. 	{
  240. 	    print "<tr>",
  241. 	    	  "<td>", &url ( "\@client+$client", "$client"),
  242. 		  "<td>$date",
  243. 		  "<td>$root",
  244. 		  "<td>$descrip",
  245. 	       	  "</tr>\n"
  246. 	}
  247.     }
  248.     print "</table>\n";
  249.     close P4;
  250. } elsif ( @ARGV[0] eq "\@client" ) {
  251.     local( $client, $date, $owner, $root, $opts );
  252.     $client = $ARGV[1];
  253.     &p4open ('P4', "client -o $client|");
  254.  
  255.     while (<P4>)
  256.     {
  257. 	next if (/^Client:/);
  258. 	next if (/^Date:/ && (( $date ) = /^Date:\s*(.*)$/ ));
  259. 	next if (/^Owner:/ && (( $owner ) = /^Owner:\s*(\S+)$/ ));
  260. 	last if (/^Description:/);
  261.     }
  262.  
  263.     print @HTMLHEADER,
  264.     	"<title>Perforce Client Information for $client</title>\n",
  265. 	"<center><h1>Perforce Client Information for $client</h1>\n</center>",
  266. 	"<i>This browser allows you to view information about ",
  267.     	" a given Perforce client.</i>\n<hr>";
  268.  
  269.     if ("$date" eq "") {
  270. 	print "<h3>Client <i>$client</i> doesn't exist</h3>";
  271.     }
  272.     else
  273.     {
  274. 	print "<h3>Date</h3><pre>        $date</pre>\n",
  275. 	      "<h3>User</h3><pre>        ",
  276. 	      &url ("\@user+$owner", "$owner"), "</pre>\n",
  277. 	      "<h3>Description</h3><pre>\n";
  278.  
  279. 	while (<P4>)
  280. 	{
  281. 	   next if (/^$/);
  282. 	   last if (/^Root:/ && (( $root ) = /^Root:\s*(.*)$/ ));
  283. 	   print;
  284. 	}
  285. 	while (<P4>)
  286. 	{
  287. 	   next if (/^Options:/ && (( $opts ) = /^Options:\s*(.*)$/ ));
  288. 	   last if (/^View:/);
  289.         }
  290. 	print "</pre><h3>Root Directory</h3><pre>        $root</pre>\n",
  291.     	  "<h3>Options</h3><pre>        $opts</pre>\n",
  292. 	  "<h3>View</h3><pre>";
  293. 	while (<P4>)
  294. 	{
  295. 	    last if (/^$/);
  296. 	    print;
  297. 	}
  298. 	print "</pre>";
  299.     }
  300.     close P4;
  301.     @OTHER_FOOTERS = (" | ", &url ("\@files+\@$client", "Files in $client"),
  302. 		      " | ", &url ("\@opened+client+$client", "Files Opened in $client"));
  303. } elsif ( @ARGV[0] eq "\@jobs" ) {
  304.     &p4open( 'P4', "jobs|" );
  305.  
  306.     print @HTMLHEADER,
  307. 	"<title>Perforce Jobs</title>\n",
  308. 	"<center><h1>Perforce Jobs</h1>\n</center>",
  309. 	"<i>This browser allows you to view information about ",
  310.     	" Perforce Jobs.\n",
  311. 	"The first step is to select which job you want to view</i>\n",
  312. 	"<hr>";
  313.  
  314.     print
  315. 	"<table cellpadding=1>",
  316. 	"<tr align=left><th>Job Name<th>Date<th>User",
  317. 	"<th>Status<th>Description</tr>\n";
  318.  
  319.     # Sample:
  320.     # job000011 on 1998/07/03 by jam *open* 'Another test. '
  321.  
  322.     while( <P4> ) {
  323. 	if (local( $name, $date, $user, $status, $descrip ) = 
  324. 	    /^(\S+) on (\S+) by (\S+) \*(\S+)\* '(.*) '$/)
  325. 	{
  326. 	    print "<tr>",
  327. 	    	  "<td>", &url ( "\@job+$name", "$name"),
  328. 		  "<td>$date",
  329. 	    	  "<td>", &url ( "\@user+$user", "$user"),
  330. 		  "<td>$status",
  331. 		  "<td>$descrip",
  332. 	       	  "</tr>\n";
  333. 	}
  334.     }
  335.     print "</table>\n";
  336.     close P4;
  337. } elsif ( @ARGV[0] eq "\@branches" || @ARGV[0] eq "\@labels" ) {
  338.     local ($type, $cmd, $viewer);
  339.  
  340.     if (@ARGV[0] eq "\@branches")
  341.       {
  342. 	$type = "Branch";
  343. 	$cmd = "branches";
  344. 	$viewer = "branch";
  345.       }
  346.     else
  347.       {
  348. 	$type = "Label";
  349. 	$cmd = "labels";
  350. 	$viewer = "label";
  351.       }
  352.     &p4open( 'P4', "$cmd|" );
  353.  
  354.     print @HTMLHEADER,
  355. 	"<title>Perforce ${type}es</title>\n",
  356. 	"<center><h1>Perforce ${type}es</h1>\n</center>",
  357. 	"<i>This browser allows you to view information about ",
  358.     	" Perforce ${type}es.\n",
  359. 	"The first step is to select which $viewer you want to view</i>\n",
  360. 	"<hr>",
  361. 	"<table cellpadding=1>",
  362. 	"<tr align=left><th>$type Name<th>Date<th>Description</tr>\n";
  363.  
  364.     # Sample:
  365.     # Branch test 1998/07/03 'Created by jam. '
  366.     # Label example-label.template 1998/06/26 'Label tempalte for the example '
  367.  
  368.     while( <P4> ) {
  369. 	if (local( $name, $date, $descrip ) = 
  370. 	    /^$type (\S+) (\S+) '(.*) '$/)
  371. 	{
  372. 	    print "<tr>",
  373. 	    	  "<td>", &url ( "\@$viewer+$name", "$name"),
  374. 		  "<td>$date",
  375. 	    	  "<td>$descrip",
  376. 	       	  "</tr>\n";
  377. 	}
  378.     }
  379.     print "</table>\n";
  380.     close P4;
  381. } elsif ( @ARGV[0] eq "\@branch" || @ARGV[0] eq "\@label") {
  382.     local( $type, $cmd, $name, $date, $owner, $opts, $filespec );
  383.  
  384.     $name = $ARGV[1];
  385.  
  386.     if (@ARGV[0] eq "\@branch")
  387.       {
  388.         $type = "Branch";
  389.         $cmd = "branch";
  390. 	$filespec = "//$name/...";
  391.       }
  392.     else
  393.       {
  394.         $type = "Label";
  395. 	$cmd = "label";
  396. 	$filespec = "+\@$name";
  397.       }
  398.  
  399.     &p4open ('P4', "$cmd -o $name|");
  400.  
  401.     while (<P4>)
  402.     {
  403. 	next if (/^$type:/);
  404. 	next if (/^Date:/ && (( $date ) = /^Date:\s*(.*)$/ ));
  405. 	next if (/^Owner:/ && (( $owner ) = /^Owner:\s*(\S+)$/ ));
  406. 	last if (/^Description:/);
  407.     }
  408.  
  409.     print @HTMLHEADER,
  410.     	"<title>Perforce $type Information for $name</title>\n",
  411. 	"<center><h1>Perforce $type Information for $name</h1>\n</center>",
  412. 	"<i>This browser allows you to view information about ",
  413.     	" a given Perforce $cmd.</i>\n<hr>";
  414.  
  415.     if ("$date" eq "") {
  416. 	print "<h3>$type <i>$name</i> doesn't exist</h3>";
  417.     }
  418.     else
  419.     {
  420. 	print "<h3>Date</h3><pre>        $date</pre>\n",
  421. 	      "<h3>User</h3><pre>        ",
  422. 	      &url ("\@user+$owner", "$owner"), "</pre>\n",
  423. 	      "<h3>Description</h3><pre>\n";
  424.  
  425. 	while (<P4>)
  426. 	{
  427. 	   next if (/^$/);
  428. 	   last if (/^View:/);
  429. 	   last if (/^Options:/ && (( $opts ) = /^Options:\s*(.*)$/ ));
  430. 	   print;
  431. 	}
  432.  
  433. 	print "</pre>";
  434.  
  435. 	if ("$opts" ne "")
  436. 	  {
  437. 	    print "<h3>Options</h3><pre>        $opts</pre>\n";
  438. 	    while (<P4>)
  439.  	     {
  440. 	       last if (/^View:/);
  441. 	     }
  442. 	  }
  443. 	print "<h3>View</h3><pre>";
  444. 	$filespec = "" if ("$cmd" eq "branch");
  445. 	while (<P4>)
  446. 	{
  447. 	    last if (/^$/);
  448. 	    if ("$cmd" eq "branch")
  449. 	      {
  450. 	        local ($spec) = /^\s*\S+ (\S+)$/;
  451. 		$filespec = "$filespec+$spec";
  452. 	      }
  453. 	    print;
  454. 	}
  455. 	print "</pre>";
  456.     }
  457.     close P4;
  458.  
  459.     @OTHER_FOOTERS = (" | ", &url ("\@files$filespec", "Files in this $type"));
  460. }
  461. ################################
  462. #
  463. # changes [ path ]
  464. #
  465. #	show changes for path
  466. #
  467. ################################
  468.  
  469. elsif( $ARGV[0] eq "\@changes" ) {
  470.  
  471.     &p4open( 'P4', "changes -l $ARGV[1]|" );
  472.  
  473.     print 
  474. 	@HTMLHEADER,
  475. 	"<title>Changes for $ARGV[1]</title>\n",
  476. 	"<center><h1>Changes for $ARGV[1]</h1></center>\n",
  477. 	"<i>This form displays the changes for the files you've selected.\n",
  478. 	"Click on the change number to see details of a change.  Changes\n",
  479. 	"are listed in reverse chronological order, so you see what's\n",
  480. 	"most recent first.</i>\n",
  481. 	"<hr><dl>\n";
  482.  
  483.     while (<P4>) {
  484.  
  485.         s/&/&amp;/g;
  486.         s/\"/&quot;/g;
  487.         s/</&lt;/g;
  488.         s/>/&gt;/g;
  489.  
  490. 	if( local( $change, $on, $user, $client ) = /^Change (\d+) on (\S+) by (\S+)@(\S+)$/ ) 
  491. 	{
  492. 	    print 
  493. 		"<dt>", &url( "\@describe+$change", "Change $change" ), 
  494. 		" on $on by ", &url ("\@user+$user", "$user"),
  495. 		"\@", &url ("\@client+$client", "$client"), "<dd>\n";
  496. 	} 
  497. 	else 
  498. 	{
  499. 	    chop;
  500. 	    print "<tt>$_</tt><br>\n";
  501. 	}
  502.     }
  503.  
  504.     print "</dl>\n";
  505.  
  506.     close P4;
  507. }
  508.  
  509. ################################
  510. #
  511. # describe change
  512. #
  513. #	describe a change
  514. #
  515. ################################
  516.  
  517. elsif( $ARGV[0] eq "\@describe" ) {
  518.  
  519.     &p4open( 'P4', "describe -s $ARGV[1]|" );
  520.  
  521.     $_ = <P4>;
  522.  
  523.     ( local($chn, $user, $client, $date, $time) = 
  524. 	/^Change (\d+) by (\S*)@(\S*) on (\S*) (\S*)$/ )
  525. 	|| &bail( $_ );
  526.  
  527.     print 
  528. 	@HTMLHEADER,
  529. 	"<title>Change $chn</title>\n",
  530. 	"<center><h1>Change $chn</h1></center>\n",
  531. 	"<i>This form displays the details of a change.  For each of the\n",
  532. 	"files affected, you can click on:\n",
  533. 	"<ul>\n",
  534. 	"<li>Filename -- to see the complete file history\n",
  535. 	"<li>Revision Number -- to see the file text\n",
  536. 	"<li>Action -- to see the deltas (diffs)\n",
  537. 	"</ul></i>",
  538. 	"<hr><pre>\n",
  539. 	"<strong>Author        </strong>", &url ("\@user+$user", "$user"), "\n",
  540. 	"<strong>Client        </strong>", &url ("\@client+$client", "$client"), "\n",
  541. 	"<strong>Date          </strong>$time $date\n",
  542. 	"</pre><hr>\n",
  543. 	"<h2>Description</h2>\n",
  544. 	"<pre>\n";
  545.  
  546.     while(<P4>) {
  547. 	next if /^\s*$/;
  548. 	last if /^Jobs fixed/;
  549. 	last if /^Affected files/;
  550. 	print $_;
  551.     }
  552.  
  553.     print
  554. 	"</pre>",
  555. 	"<hr>\n";
  556.  
  557.     # display jobs
  558.  
  559.     if( /^Jobs fixed/ )
  560.     {
  561. 	print 
  562. 	    "<h2>Jobs Fixed</h2>\n",
  563. 	    "<ul>\n";
  564.  
  565. 	while ( <P4> ) {
  566. 	    local( $job, $time, $user, $client );
  567.  
  568. 	    while( ( $job, $time, $user, $client ) = 
  569. 		/(\S*) fixed on (\S*) by (\S*)@(\S*)/ )
  570. 	    {
  571. 		print
  572. 		    "<li><h3>",
  573. 		    &url( "\@job+$job", $job ),
  574. 		    "</h3><pre>\n";
  575.  
  576. 		while(<P4>) {
  577. 		    last if /^\S/;
  578. 		    print $_;
  579. 		}
  580.  
  581. 	    }
  582.  
  583. 	    print "</pre>\n";
  584.  
  585. 	    last if /^Affected files/;
  586. 	}
  587.  
  588. 	print 
  589. 	    "</dl>",
  590. 	    "<hr>\n";
  591.     }
  592.  
  593.     print
  594. 	"<h2>Files</h2>\n",
  595. 	"<ul>\n",
  596. 	"<table cellpadding=1>",
  597. 	"<tr align=left><th>File<th>Rev<th>Action</tr>\n";
  598.  
  599.     # Sample:
  600.     # ... //depot/main/p4/Jamrules#71 edit
  601.  
  602.     while(<P4>) {
  603.  
  604. 	if( local( $file, $rev, $act ) = /^\.\.\. (\S*)#(\d*) (\S*)$/ )
  605. 	{
  606. 	    print 
  607. 		"<tr>",
  608. 		"<td>", &url( "\@filelog+$file", "$file" ),
  609. 		"<td>", &p4dirurl( $file, $rev, $rev );
  610. 	    if ($act ne 'delete' && $act ne 'add') {
  611. 		print
  612. 		    "<td>", &url( "\@diff+$file+$rev+$act", "$act" );
  613. 	    }
  614. 	    else {
  615. 		print
  616. 		    "<td>$act";
  617. 	    }
  618. 	    print
  619. 		"</tr>\n";
  620. 	}
  621.     }
  622.     print
  623. 	"</table></ul>\n";
  624.  
  625.     close P4;
  626. }
  627.  
  628. ################################
  629. #
  630. # filelog file 
  631. #
  632. #	show filelog of the file
  633. #
  634. ################################
  635.  
  636. elsif ($ARGV[0] eq "\@filelog") {
  637.  
  638.     local( $name ) = $ARGV[1];
  639.  
  640.     &p4open( 'P4', "filelog $name|" );
  641.  
  642.     $name = <P4>;
  643.     chop $name;
  644.  
  645.     print 
  646. 	@HTMLHEADER,
  647. 	"<title>Filelog $name</title>\n",
  648. 	"<center><h1>Filelog $name</h1></center>\n",
  649. 	"<i>This form shows the history of an individual file across\n",
  650. 	"changes.  You can click on the following:\n",
  651. 	"<ul>\n",
  652. 	"<li>Revision Number -- to see the file text\n",
  653. 	"<li>Action -- to see the deltas (diffs)\n",
  654. 	"<li>Change -- to see the complete change description, including\n",
  655. 	"other files.\n",
  656. 	"</ul></i>",
  657. 	"<hr>\n";
  658.  
  659.     print
  660. 	"<table cellpadding=1>",
  661. 	"<tr align=left><th>Rev<th>Action<th>Date",
  662. 	"<th>User\@client<th>Change<th>Desc</tr>\n";
  663.  
  664.     # Sample:
  665.     # ... #78 change 1477 edit on 04/18/1996 by user@client 'Fix NT mkdi'
  666.  
  667.     while( <P4> ) {
  668. 	if (local( $rev, $change, $act, $date, $user, $client, $edit_type, $desc ) =
  669. 	    /^\.\.\. \#(\d+) \S+ (\d+) (\S+) on (\S+) by (\S*)@(\S*) \((\S+)\) '(.*)'/)
  670. 	{
  671. 	    if ($act eq 'branch') {
  672. 		$_ = <P4>;
  673. 		my ($fromname,$fromrev) = /^.*branch from (\S+?)\#(\d+).*/;
  674. 		print
  675. 		    "<tr>",
  676. 		    "<td>", &p4dirurl( $name, $rev, $rev),
  677. 		    "<td>", &url( "\@filelog+$fromname+$fromrev", $act ),
  678. 		    "<td>$date",
  679. 		    "<td>", &url ("\@user+$user", "$user"), "\@",
  680. 		    	    &url ("\@client+$client", "$client"),
  681. 		    "<td>", &url( "\@describe+$change", "$change" ),
  682. 		    "<td><tt>$desc</tt>",
  683. 		    "</tr>\n";
  684. 	    }
  685. 	    elsif ($act eq 'delete') {
  686. 		print
  687. 		    "<tr>",
  688. 		    "<td>", &p4dirurl( $name, $rev, $rev),
  689. 		    "<td>$DEL$act$DELEND",
  690. 		    "<td>$date",
  691. 		    "<td>", &url ("\@user+$user", "$user"), "\@",
  692. 		    	    &url ("\@client+$client", "$client"),
  693. 		    "<td>", &url( "\@describe+$change", "$change" ),
  694. 		    "<td><tt>$desc</tt>",
  695. 		    "</tr>\n";
  696. 	    }
  697. 	    elsif ($act eq 'add') {
  698. 		print
  699. 		    "<tr>",
  700. 		    "<td>", &p4dirurl( $name, $rev, $rev),
  701. 		    "<td>$act",
  702. 		    "<td>$date",
  703. 		    "<td>$user@$client",
  704. 		    "<td>", &url( "\@describe+$change", "$change" ),
  705. 		    "<td><tt>$desc</tt>",
  706. 		    "</tr>\n";
  707. 	    }
  708. 	    else {
  709. 		print
  710. 		    "<tr>",
  711. 		    "<td>", &p4dirurl( $name, $rev, $rev),
  712. 		    "<td>", &url( "\@diff+$name+$rev+$act", $act ),
  713. 		    "<td>$date",
  714. 		    "<td>", &url ("\@user+$user", "$user"), "\@",
  715. 		    	    &url ("\@client+$client", "$client"),
  716. 		    "<td>", &url( "\@describe+$change", "$change" ),
  717. 		    "<td><tt>$desc</tt>",
  718. 		    "</tr>\n";
  719. 	    }
  720. 	}
  721.     }
  722.  
  723.     print "</table>\n";
  724.  
  725.     close P4;
  726. }
  727. elsif ($ARGV[0] eq "\@files") {
  728.     &p4open( 'P4', "files @ARGV[1..$#ARGV]|" );
  729.     print 
  730. 	@HTMLHEADER,
  731. 	"<title>Files for $ARGV[1..$#ARGV]</title>\n",
  732. 	"<center><h1>Files for @ARGV[1..$#ARGV]</h1></center>\n",
  733. 	"<i>This form displays files in the depot for a given revision.\n",
  734. 	"For each of the files, you can click on:\n",
  735. 	"<ul>\n",
  736. 	"<li>Filename -- to see the complete file history\n",
  737. 	"<li>Revision Number -- to see the file text\n",
  738. 	"<li>Action -- to see the deltas (diffs)\n",
  739. 	"<li>Change -- to see the complete change description, including\n",
  740. 	"other files.\n",
  741. 	"</ul></i>",
  742. 	"<hr>\n";
  743.  
  744.     print
  745. 	"<h3>Files</h3>\n",
  746. 	"<ul>\n",
  747. 	"<table cellpadding=1>",
  748. 	"<tr align=left><th>File<th>Rev<th>Action<th>Change</tr>\n";
  749.  
  750.     # Sample:
  751.     # //example/find/TypeExpr.java#1 - add change 5 (ktext)
  752.  
  753.     while(<P4>) {
  754. 	if( local( $file, $rev, $act, $change, $type ) =
  755. 	    /^(\S+)#(\d*) - (\S+) change (\d*) \((\S+)\)$/ )
  756. 	{
  757. 	    print 
  758. 		"<tr>",
  759. 		"<td>", &url( "\@filelog+$file", "$file" ),
  760. 		"<td>", &url( "\@print+$file+$rev", "$rev" ),
  761. 		"<td>", &url( "\@diff+$file+$rev+$act", "$act" ),
  762. 		"<td>", &url( "\@describe+$change", "$change" ),
  763. #		"<td>", "$type",
  764. 		"</tr>\n";
  765. 	}
  766.     }
  767.     print
  768. 	"</table></ul>\n";
  769.  
  770.     close P4;
  771. }
  772. elsif ($ARGV[0] eq "\@opened") {
  773.     &p4open( 'P4', "opened -a|" );
  774.  
  775.     print 
  776. 	@HTMLHEADER,
  777. 	"<title>Opened files for @ARGV[1..$#ARGV]</title>\n",
  778. 	"<center><h1>Opened files for @ARGV[1..$#ARGV]</h1></center>\n",
  779. 	"<i>This form displays files opened by the specified @ARGV[1].\n",
  780. 	"For each of the files, you can click on:\n",
  781. 	"<ul>\n",
  782. 	"<li>Filename -- to see the complete file history\n",
  783. 	"<li>Revision Number -- to see the file text\n",
  784. 	"<li>User -- to see the a user description\n",
  785. 	"<li>Client -- to see the a client description\n",
  786. 	"</ul></i>",
  787. 	"<hr>\n";
  788.  
  789.     print
  790. 	"<h3>Files</h3>\n",
  791. 	"<ul>\n",
  792. 	"<table cellpadding=1>",
  793. 	"<tr align=left><th>File<th>Rev<th>Action<th>Change List",
  794. 	"<th>Type<th>User\@Client</tr>\n";
  795.  
  796.     # Sample:
  797.     # //foo/file.java#2 - edit default change (text) by user@client
  798.  
  799.     while(<P4>) {
  800. 	if (local( $file, $rev, $act, $change, $type, $user, $client ) =
  801. 	     /^(\S+)#(\d*) - (\S+) (\S+) change \((\S+)\) by (\S+)@(\S+)$/)
  802. 	  {
  803. 	    next if ((@ARGV[1] eq "user" ? $user : $client) ne @ARGV[2]);
  804. 	    print 
  805. 		"<tr>",
  806. 		"<td>", &url( "\@filelog+$file", "$file" ),
  807. 		"<td>", &url( "\@print+$file+$rev", "$rev" ),
  808. 		"<td>$act<td>$change<td>$type",
  809. 		"<td>", &url( "\@user+$user", "$user" ), "\@",
  810. 		&url( "\@client+$client", "$client" ),
  811. 		"</tr>\n";
  812. 	}
  813.     }
  814.     print
  815. 	"</table></ul>\n";
  816.  
  817.     close P4;
  818. }
  819. ################################
  820. #
  821. # print file rev action
  822. #
  823. #	print file text
  824. #
  825. ################################
  826.  
  827. elsif ($ARGV[0] eq "\@print") {
  828.  
  829.     local($name, $rev) = @ARGV[1..2];
  830.  
  831.     &p4open( 'P4', "print $name#$rev|" );
  832.  
  833.     # Get header line
  834.     # //depot/main/jam/Jamfile#39 - edit change 1749 (text)
  835.  
  836.     $_ = <P4>;
  837.     local( $name, $rev, $type ) = m!^(\S+)\#(\d+) - \S+ \S+ \S+ \((\w+)\)!;
  838.  
  839.     print 
  840. 	@HTMLHEADER,
  841. 	"<title>File $name</title>\n",
  842. 	"<center><h1>File $name#$rev</h1></center>\n",
  843. 	"<i>This form shows you the raw contents of a file, as long as \n",
  844. 	"it isn't binary.</i>",
  845. 	"<hr>\n";
  846.  
  847.     if( $type eq "binary" || $type eq "xbinary" )
  848.     {
  849. 	print "<center><font color=red><h2>This is a binary file</h2></font></center>\n";
  850.     }
  851.     else
  852.     {
  853. 	print "<pre>\n";
  854.  
  855. 	while( <P4> ) {
  856. 	    s/&/&amp;/g;
  857. 	    s/\"/&quot;/g;
  858. 	    s/</&lt;/g;
  859. 	    s/>/&gt;/g;
  860. 	    print $_;
  861. 	}
  862.  
  863. 	print "</pre>\n";
  864.     }
  865.  
  866.     close P4;
  867. }
  868.  
  869. ################################
  870. #
  871. # diff file rev action
  872. #
  873. #	describe a change
  874. #
  875. ################################
  876.  
  877. elsif ($ARGV[0] eq "\@diff") {
  878.  
  879.     local( $name, $rev, $mode ) = @ARGV[1..3];
  880.     local( $nchunk ) = 0;
  881.     local( $file ) = "$name#" . ($rev);
  882.     local( $anybinary ) = 0;
  883.  
  884.     print
  885. 	@HTMLHEADER,
  886. 	"<title>$file</title>\n",
  887. 	"<center><h1>$file - $mode</h1></center>\n",
  888. 	"<i>This form shows you the deltas (diffs) that lead from the\n",
  889. 	"previous to the current revision.</i>\n",
  890. 	"<hr>\n";
  891.  
  892.     if ($mode ne 'add' && $mode ne 'delete' && $mode ne 'branch') {
  893. 	local( $f1 ) = "$name#" . ($rev - 1);
  894. 	local( $f2 ) = $file;
  895.  
  896. 	&p4open('P4', "fstat $f1 $f2 |");
  897. 	while (<P4>) {
  898. 	    $anybinary = 1 if (/headType.*binary/);
  899. 	}
  900. 	close P4;
  901.  
  902. 	if (!$anybinary) {
  903. 	&p4open('P4', "diff2 $f1 $f2|");
  904. 	$_ = <P4>; 
  905.  
  906. 	while (<P4>) {
  907.  
  908. 	    local( $dels, $adds );
  909.  
  910. 	    local( $la, $lb, $op, $ra, $rb ) = 
  911. 		    /^(\d+),?(\d*)([acd])(\d+),?(\d*)/;
  912.  
  913. 	    next unless $ra;
  914.  
  915. 	    if( !$lb ) { $lb = $op ne 'a' ? $la : $la - 1; }
  916. 	    if( !$rb ) { $rb = $op ne 'd' ? $ra : $ra - 1; }
  917.  
  918. 		$start[ $nchunk ] = $op ne 'd' ? $ra : $la;
  919. 	    $dels[ $nchunk ] = $dels = $lb - $la + 1;
  920. 	    $adds[ $nchunk ] = $adds = $rb - $ra + 1;
  921. 	    @lines[ $nchunk ] = ();
  922.  
  923. 	    # deletes
  924.  
  925. 	    while( $dels-- ) {
  926. 	    	$_ = <P4>; 	
  927. 		s/^. //;
  928. 		if (/[&<>]/) {
  929. 		    s/&/\&amp;/g;
  930. 		    s/</\&lt;/g;
  931. 		    s/>/\&gt;/g;
  932. 		}
  933. 		@lines[ $nchunk ] .= $_;
  934. 	    }
  935. 	    
  936. 	    # separator
  937.  
  938. 	    if ($op eq 'c') {	
  939. 		$_ = <P4>; 
  940. 	    }
  941.  
  942. 	    # adds
  943.  
  944. 	    while( $adds-- ) {
  945. 		$_ = <P4>;
  946. 	    }
  947.  
  948. 	    $nchunk++;
  949. 	}
  950.  
  951. 	close P4;
  952.     }
  953.     }
  954.     else {
  955. 	&p4open('P4', "fstat $file |");
  956. 	while (<P4>) {
  957. 	    $anybinary = 1 if (/headType.*binary/);
  958. 	}
  959. 	close P4;
  960.     }
  961.  
  962.     if ($anybinary == 1) {
  963. 	print 
  964. 	    "<center>\n",
  965. 	    "<font color=red><h2>Differences in binary files cannot be displayed.</h2></font>\n",
  966. 	    "</center><hr>\n";
  967.     }
  968.     elsif ($nchunk > 0) {
  969.     # Now walk through the diff chunks, reading the current rev and
  970.     # displaying it as necessary.
  971.  
  972.     print 
  973.     	"<center><pre>",
  974.     	"$ADD added lines $ADDEND\n",
  975. 	"$DEL deleted lines $DELEND\n",
  976. 	"</pre></center><hr><pre>\n";
  977.  
  978.     local( $curlin ) = 1;
  979.  
  980.     &p4open('P4', "print -q $name#$rev|");
  981.  
  982.     for( $n = 0; $n < $nchunk; $n++ )
  983.     {
  984. 	# print up to this chunk.
  985.  
  986. 	&catchup( 'P4', $start[ $n ] - $curlin );
  987.  
  988. 	# display deleted lines -- we saved these from the diff
  989.  
  990. 	if( $dels[ $n ] )
  991. 	{
  992. 		print "$DEL";
  993. 		print @lines[ $n ];
  994. 		print "$DELEND";
  995. 	}
  996.  
  997. 	# display added lines -- these are in the file stream.
  998.  
  999. 	if( $adds[ $n ] )
  1000. 	{
  1001. 		print "$ADD";
  1002. 		&display( 'P4', $adds[ $n ] );
  1003. 		print "$ADDEND";
  1004. 	}
  1005.  
  1006. 	$curlin = $start[ $n ] + $adds[ $n ];
  1007.     }
  1008.  
  1009.     &catchup( 'P4', 999999999 );
  1010.  
  1011.     close P4;
  1012. } 
  1013.     else {
  1014. 	print 
  1015. 	    "<center>\n",
  1016. 	    "<font color=blue><h2>There are no differences to display</h2></font>\n",
  1017. 	    "</center><hr>\n";
  1018.     }
  1019. } 
  1020.  
  1021. ################################
  1022. #
  1023. # job job
  1024. #
  1025. #	describe a job
  1026. #
  1027. ################################
  1028.  
  1029. elsif ($ARGV[0] eq "\@job") {
  1030.  
  1031.     local( $user, $job, $status, $time, $date );
  1032.  
  1033.     &p4open( 'P4', "job -o $ARGV[1]|" );
  1034.  
  1035.     while( <P4> )
  1036.     {
  1037. 	next if ( /^Job/ && ( ( $job ) = /^Job:\s(\S*)/ ) );
  1038. 	next if ( /^User/ && ( ( $user ) = /^User:\s*(\S*)/ ) );
  1039. 	next if ( /^Status/ && ( ( $status ) = /^Status:\s*(\S*)/ ) );
  1040. 	next if ( /^Date/ && ( ( $date, $time ) = /^Date:\s*(\S*) (\S*)/ ) );
  1041. 	last if ( /^Description/ );
  1042.     }
  1043.  
  1044.     print 
  1045. 	@HTMLHEADER,
  1046. 	"<title>Job $job</title>\n",
  1047. 	"<center><h1>Job $job</h1></center>\n",
  1048. 	"<i>This form displays the details of a job.  You can click on a\n",
  1049. 	"change number to see its description.\n",
  1050. 	"</i>",
  1051. 	"<hr><pre>\n",
  1052.         "<strong>User          </strong>", &url ("\@user+$user", "$user"), "\n",
  1053. 	"<strong>Status        </strong>$status\n",
  1054. 	"<strong>Date          </strong>$time $date\n",
  1055. 	"</pre><hr>\n",
  1056. 	"<h2>Description</h2>\n",
  1057. 	"<pre>\n";
  1058.  
  1059.     while(<P4>) {
  1060. 	print $_;
  1061.     }
  1062.  
  1063.     print
  1064. 	"</pre>",
  1065. 	"<hr>\n";
  1066.  
  1067.     close P4;
  1068.  
  1069.     # display fixes
  1070.  
  1071.     &p4open( 'P4', "fixes -j $ARGV[1]|" );
  1072.  
  1073.     $count = 0;
  1074.  
  1075.     while( <P4> )
  1076.     {
  1077. 	print
  1078. 	    "<h2>Fixes</h2>\n",
  1079. 	    "<ul>\n",
  1080. 	    "<table cellpadding=1>",
  1081. 	    "<tr align=left><th>Change<th>Date<th>User\@Client</tr>\n"
  1082. 		if( !$count++ );
  1083.  
  1084. 	# jobx fixed by change N on 1997/04/25 by user@host
  1085.  
  1086. 	if( local( $change, $date, $user, $client ) 
  1087. 		= /^\S* fixed by change (\S*) on (\S*) by (\S*)@(\S*)/ ) 
  1088. 	{
  1089. 	    print 
  1090. 		"<tr>",
  1091. 		"<td>", &url( "\@describe+$change", "$change" ),
  1092. 		"<td>", $date,
  1093. 		"<td>", &url ("\@user+$user", "$user"), "\@",
  1094. 			&url ("\@client+$client", "$client"),
  1095. 		"</tr>\n";
  1096. 	}
  1097.     }
  1098.  
  1099.     print "</table></ul>\n"
  1100. 	if( $count );
  1101.  
  1102.     close P4;
  1103. }
  1104.  
  1105. ################################
  1106. #
  1107. # None of the above.
  1108. #
  1109. ################################
  1110.  
  1111. else {
  1112. 	&bail( "Invalid invocation @ARGV" );
  1113. }
  1114.  
  1115. # Trailer
  1116.  
  1117. @HTMLFOOTER = (
  1118. 	"<p align=\"center\">*&nbsp; *&nbsp; *<br>",
  1119. 	&url ("", "Top"), " | ",
  1120. 	&url ("\@clients", "Clients"), " | ",
  1121. 	&url ("\@users", "Users"), " | ",
  1122. 	&url ("\@branches", "Branches"), " | ",
  1123. 	&url ("\@labels", "Labels"), " | ",
  1124. 	&url ("\@jobs", "Jobs"),
  1125. 	@OTHER_FOOTERS,
  1126. 	"</center></body>\n");
  1127.  
  1128. print   @HTMLFOOTER;
  1129.  
  1130. ##################################################################
  1131. ##################################################################
  1132. #
  1133. # Subroutines.
  1134. #
  1135. ##################################################################
  1136. ##################################################################
  1137.  
  1138. sub p4dirurl {
  1139. 	local( $file, $rev, $text ) = @_;
  1140. 	$file =~ s,//depot/,,;
  1141. 	return qq(<a HREF="$p4dir/$file%23$rev">$text</a>) ;
  1142. }
  1143.  
  1144. sub url {
  1145. 	local( $url, $name ) = @_;
  1146. 	return qq(<a HREF="$myname?$url">$name</a>) ;
  1147. }
  1148.  
  1149. sub mailto {
  1150. #	local( $uname ) = @_;
  1151. 	return qq(<a HREF="mailto:@_">@_</a>) ;
  1152. }
  1153.  
  1154. sub bail {
  1155. 	print @HTMLERROR, @_, "\n";
  1156. 	die @_;
  1157. }
  1158.  
  1159. sub p4open {
  1160. 	local( $handle, @command ) = @_;
  1161. 	open( $handle, "p4 @command" ) || &bail( "p4 @command failed" );
  1162. }
  1163.  
  1164. # Support for processing diff chunks.
  1165. #
  1166. # skip: skip lines in source file
  1167. # display: display lines in source file, handling funny chars 
  1168. # catchup: display & skip as necessary
  1169. #
  1170.  
  1171. sub skip {
  1172. 	local( $handle, $to ) = @_;
  1173.  
  1174. 	while( $to > 0 && ( $_ = <$handle> ) ) {
  1175. 	    $to--;
  1176. 	}
  1177.  
  1178. 	return $to;
  1179. }
  1180.  
  1181. sub display {
  1182. 	local( $handle, $to ) = @_;
  1183.  
  1184. 	while( $to-- > 0 && ( $_ = <$handle> ) ) {
  1185.  
  1186. 	    if (/[&<>]/) 
  1187. 	    {
  1188. 		s/&/\&amp;/g;
  1189. 		s/</\&lt;/g;
  1190. 		s/>/\&gt;/g;
  1191. 	    }
  1192. 	    print $_;
  1193. 	}
  1194. }
  1195.  
  1196. sub catchup {
  1197.  
  1198. 	local( $handle, $to ) = @_;
  1199.  
  1200. 	if( $to > $MAXCONTEXT )
  1201. 	{
  1202. 	    local( $skipped ) = $to - $NCONTEXT * 2;
  1203.  
  1204. 	    &display( $handle, $NCONTEXT );
  1205. 	    
  1206. 	    $skipped -= &skip( $handle, $skipped );
  1207.  
  1208. 	    print 
  1209. 		"<hr><center><strong>",
  1210. 		"$skipped lines skipped",
  1211. 		"</strong></center><hr>\n" if( $skipped );
  1212.  
  1213. 	    &display( $handle, $NCONTEXT );
  1214. 	}
  1215. 	else
  1216. 	{
  1217. 	    &display;
  1218. 	}
  1219. }
  1220.  
# Change User Description Committed
#1 80 Greg Spencer This adds the file-centric perforce browser to the guest depot.

I rewrote it (again) th...is week to split out a simpler,
non-javascript version that is easier to install (and doesn't
need the CGI package).  Both are included here.

I still need to rewrite the INSTALL.txt file to reflect this,
and update the README.

I'd love to have a MakeMaker script to install this, but I
haven't done that before, so I've got some trepidation. «		 26 years ago