p4file2html #1

#!perl
# -*- Perl -*-
# Copyright 1999 Greg Spencer (greg_spencer@acm.org)

######################################################################
#
# This is a "pretty printer" for code
# it takes C++, etc. as input and outputs html with 
# highlighted keywords, etc.
#
######################################################################

use p4Config;
use p4Util;
require SourceToHtml;
use CGI;
use LWP::MediaTypes;
use HTTP::Date;

# here is where we find out who did what...
# this is only invoked if we're in detail mode.
sub GetChangeInfo {
    my $file = shift;
    my $filesize = shift;
    my $nameref = shift;
    my $changeref = shift;

    # Handle # and @ notation (only for numeric changes and revisions).
    my $change = $1 if $file =~ s/\@(\d+)//;
    my $head = $1 if $file =~ s/\#(\d+)//;

    # Get the fullname of the file and the history, all from
    # the filelog for the file.
    my ($fullname, @history) = `p4 filelog $file`;
    chop($fullname);
    $fullname =~ s/\#.*//;
    my @fullname = split(m;/;, $fullname);

    # Extract the revision to change number mapping. Also
    # get the author of each revision, and for merged
    # or copied revisions, the "branch name", which we
    # use instead of an author.
    my %change,%author,%email,$thisrev,$headseen=0;
    for (@history) {
	if (/^\.\.\. \#(\d+) change (\d+) .*? by (.*?)@/) {
	    # If a change number or revision is specified, then ignore
	    # later revisions.
	    next if $change && $change < $2;
	    next if $head && $head < $1;
	    $change{$1} = $2;
	    $author{$1} = $3;
	    $email{$3} = "";
	    $head = $1 if !$head;
	    $thisrev = $1;
	    $headseen = 1;
	} else {
	    # If we see a branch from, then we know that
	    # previous revisions did not contribute to the current
	    # revision. Don't do this, however, if we haven't seen
	    # the revision we've been requested to print, yet.
	    # We used to do this for copy from, but I think
	    # it's better not to.
	    next unless $headseen;
	    if (/^\.\.\. \.\.\. (copy|branch|merge) from (\/\/[^\#]*)\#(\d+)(?:,(\#\d+))?/) {
		# If merged or copied from another part of the
		# tree, then we use the first component of the
		# name that is different, and call that the "branch"
		# Further, we make the "author" be the name of the
		# branch.
		my($type) = $1;
		my($from) = $2;
		my($fromrev) = $4;
		$fromrev =~ s/\#/%23/g if $fromrev;
		$from=~s,^//depot/,,i;
		$author{$thisrev} = "<A HREF=\"http:$wwwcgibin/$p4file2htmldataName/$from$fromrev\">$type</A>";
		$email{$author{$thisrev}} = "";
		
		# If branched, we don't bother getting any more
		# history. We treat this as starting with the branch.
		last if $type eq 'branch';
	    }
	}
    }

    # Get first revision, and list of remaining revisions
    my ($base, @revs) = sort {$a <=> $b} keys %change;

    # For each line in the file, set the change revision
    # to be the base revision.
    my @lines = ($base) x $filesize;

    # For each revision from the base to the selected revision
    # "apply" the diffs by manipulating the array of revision
    # numbers. If lines are added, we add a corresponding 
    # set of entries with the revision number that added it.
    # We ignore the actual revision text--that will be merged
    # with the change information later.
    for $rev (@revs) {
	my($r1) = $rev - 1;
	# Apply the diffs in reverse order to maintain correctness
	# of line numbers for each range as we apply it.
	for (reverse `p4 diff2 $file\#$r1 $file\#$rev`) {
	    my( $la, $lb, $op, $ra, $rb ) = /^(\d+),?(\d*)([acd])(\d+),?(\d*)/;
	    next unless defined($ra);
	    $lb = $la if ! $lb;
	    ++$la if $op eq 'a';
	    $rb = $ra if ! $rb;
	    ++$ra if $op eq 'd';
	    splice @lines, $la - 1, $lb - $la + 1, ($rev) x ($rb - $ra + 1);
	}
    }

    # now we need to get the e-mail addresses of each of the users.
    # if the user doesn't exist anymore, then we don't link it.
    %users = p4Util::GetUserInfo();
    foreach (keys %email) {
	if ($users{$_}) {
	    $email{$_} = "<A HREF=mailto:$users{$_}[0]>$_</A>";
	}
	else {
	    $email{$_} = $_;
	}
    }

    while (@lines) {
	my($rev) = shift(@lines);
	my($ch) = "<A HREF=\"http:$wwwcgibin/$p4browseName?\@describe+$change{$rev}\">$change{$rev}</A>";
	push (@{$changeref},$ch);
	push (@{$nameref},$email{$author{$rev}});
    }
}

######################################################################
#
# Argument parsing
#
######################################################################

$query = new CGI;
$input_file = $query->path_info();

if (!$input_file) {
    my @param_keys = $query->keywords;
    $input_file=$param_keys[0];
}

$input_file =~ s,^//depot,,;
$input_file = "//depot".$input_file;

$output_file="-"; # stdout
$filename="";
@user_keys=();
$printdate=1;
$use_lineno=1;
$filter=0;
$typename="";
$version = 0;
$changenum = 0;

# strip off version or change number and keep them.
$version =$1 if ($input_file=~m/(\#\d*)$/);
$changenum =$1 if ($input_file=~m/(\@\d*)$/);

$filename = $input_file;
$filename =~ s/[\#\@].*$//;
$typename = $filename;

# cgi path is where this script resides...
($cgipath = $0)=~ s:/([^/]+)$::;
$scriptname = $1;

if ($scriptname eq "$p4file2htmlName") {
    $detailmode = 0;
}
else {
    $detailmode = 1;
}

######################################################################
#
# Main
#
######################################################################

if (!open(INPUT,"p4 print \"$input_file\" |")) {
    print "Status: 200 OK\n";
    print "Content-type: text/html\n\n";
    print "<HTML><TITLE>Unable to open...</TITLE><BODY>\n";
    print "<H2>Sorry, unable to open input file \"$input_file\"...</H2>\n</BODY></HTML>";

    exit(0);
}

my $type = guess_media_type($filename);

# accelerate things a bit here based on the type.
# we only try and highlight things that are plain text
# or "application/octet-stream" (unknown).
# load the input...
my $realname = <INPUT>;
my @input = <INPUT>;

if ($realname =~ m/(no such file|protected namespace|no file\(s\) at that)/) {
    print "Status: 200 OK\n";
    print "Content-type: text/html\n\n";
    print "<HTML><TITLE>Unable to open...</TITLE><BODY bgcolor=white>\n";

    if ($version) {
	print "<H2>There is no such revision  \"$input_file\"...</H2>\n</BODY></HTML>";
    }
    elsif ($changenum) {
	print "<H2>There is no such change \"$input_file\"...</H2>\n</BODY></HTML>";
    }
    else {
	print "<H2>Sorry, unable to open input file \"$input_file\"...</H2>\n</BODY></HTML>";
    }
    
    exit(0);
}


$verstamp = $realname;
$verstamp =~ s|.*#([0-9]+).*?\(([a-zA-Z]+)\)|(Version $1)|;
$realname =~ s|.*#([^#]*)|$1|;
$filename.="&nbsp;$verstamp";

my %filehash = &p4Util::GetFileInfo($input_file);
my $info = $filehash{$input_file};

print "Status: 200 OK\n";
print "Content-type: text/html\n";
if ($info->{headTime} ne "") {
    print "Last-modified: ".&time2str($info->{headTime})."\n";
}

print "\n";
if ($info->{headType} eq "binary") {
    print "<HTML><HEAD><TITLE>Perforce - $input_file</TITLE></HEAD><BODY bgcolor=#ffffff>\n";
    print "<H2>$input_file</H2><BR>\n";
    print "<HR><BR><CENTER><B><FONT color=red size=+2>\n";
    print "This is a binary file.\n";
    print "</FONT></B></CENTER><BR>\n";
    print "<HR></BODY></HEAD>\n";
}
else {
    $sample="";
    for ($i=0;$i<10;$i++){
	$sample .= $input[$i];
    }

    $time = &SourceToHtml::Timestamp($info->{headTime});

    my $short_input = $input_file;
    $short_input =~ s,^//depot/,,;
    $short_input =~ s,#,%23,g;
    my $version_file = $input_file;
    $version_file =~ s/#.*//;
    $confidential="<TABLE><TD align=center><font color=red><b><i>$ENV{CONFIDENTIAL}</i></b></font><TR>\n";
    $confidential.="<TD align=center>[<A HREF=\"http:$wwwcgibin/$p4dirbrowseName/$short_input\">&nbsp;Browse&nbsp;</A>|\n";
    $confidential.="<A HREF=\"$wwwcgibin/$p4browseName\?\@filelog+$version_file\">&nbsp;Versions&nbsp;</A>|\n";
    $confidential.="<A HREF=\"http:$wwwcgibin/$p4browseName?\@describe+$info->{headChange}\">&nbsp;Change&nbsp;Desc&nbsp;</A>|";
    if ($detailmode) {
	$confidential.="<A HREF=\"http:$wwwcgibin/$p4file2htmlName/$short_input\">&nbsp;Simple&nbsp;</A>";
    }
    else {
	$confidential.="<A HREF=\"http:$wwwcgibin/$p4file2htmldataName/$short_input\">&nbsp;Detail&nbsp;</A>";
    }
    if ($info->{headAction} eq "edit") {
	$confidential.="|<A HREF=\"http:$wwwcgibin/$p4browseName?\@diff+$version_file+$info->{headRev}+edit\">&nbsp;Diff&nbsp;</A>";
    }
    if ($info->{headAction} eq "branch") {
	my $tmp = $input_file;
	$tmp =~ s/#.*//;
	if (!open(INPUT,"p4 filelog \"$tmp\" 2>&1 |")) {
	    print "<HTML><HEAD>Unable to open p4...</HEAD><BODY>\n";
	    print "<H2>Sorry, unable to open a pipe to 'p4'...</H2>\n</BODY></HTML>";
	    exit(0);
	}
	my $junk,$branch;
	$junk = <INPUT>; # strip off current revision info
	$junk = <INPUT>; # strip off current revision info
	$branch = <INPUT>; # get the branched-from info
	close INPUT; # don't need it all
	$branch =~ s/^.*branch from //;
	$branch =~ s/\#.*$//;
	$confidential.="|<A HREF=\"http:$wwwcgibin/$p4browseName?\@filelog+$branch\">&nbsp;Branch&nbsp;From&nbsp;</A>";
    }

    $confidential .="]</TABLE>";
	
    $converter = new SourceToHtml($typename,$sample,
				  $use_lineno,$confidential,1,
				  $time,$filename," ");

    if ($detailmode) {
	@culprits = ();
	@changes = ();
	&GetChangeInfo($input_file,scalar(@input),\@culprits,\@changes);

	$converter->SetExtraColumn(1,100,\@culprits);
	$converter->SetExtraColumn(2,50,\@changes);
    }

    if ($filter) {
	print $converter->Highlight(@input);
    }
    else {
	print $converter->Convert(@input);
    }
}
close(INPUT);
__END__