#!perl
# -*- Perl -*-
# Copyright 1999 Greg Spencer (greg_spencer@acm.org)
######################################################################
#
# Argument parsing
#
######################################################################
use p4Config;
use p4Util;
require SourceToHtml;
use LWP::MediaTypes;
use HTTP::Date;
package p4Cat;
sub Print {
print STDOUT "@_";
}
# This collects the date of a file from the GetFileInfo, and then
# converts it to a representation that HTTP headers expect.
# This allows the file to have the correct modification date when the user
# looks at the page info in the browser.
sub GetModDate {
my $filehash = shift;
my $file = shift;
my $modtime = $filehash->{$file}{headTime};
my $date = &HTTP::Date::time2str($modtime);
return $date;
}
sub CreateHeader {
my $p4dirobj = shift;
my $input_file = $p4dirobj->{input_file};
my $fileinfo = $p4dirobj->{fileinfo};
my $type = shift;
my $header = "";
my $file_name = $input_file;
$file_name =~ s/\[#\@].*$//; # strip off the version number, if any
if (!$type) {
$type = LWP::MediaTypes::guess_media_type($file_name);
}
# if we don't know what it is, return it as text.
# (application/octet-stream is virtually useless to the browser)
$type = "text/plain" if ($type eq "application/octet-stream");
if (!$fileinfo->{exists}) {
$header .= "Status: 200 OK\n";
$header .= "Content-type: text/html\n\n";
$header .= "<HTML><TITLE>Unable to open file...</TITLE><BODY bgcolor=white>\n";
$header .= "<H2>$input_file</H2><HR>\n";
$header .= "<BR><CENTER><B><FONT color=red size=+2>\n";
$header .= "File or Path Doesn't Exist.\n";
$header .= "</FONT></B></CENTER><BR>\n";
$header .= "<HR></BODY></HEAD>\n";
return (0,$header);
}
my $modDate = GetModDate($fileinfo, $input_file);
$header .= "Status: 200 OK\n";
$header .= "Content-type: $type\n";
if ($modDate ne "") {
$header .= "Last-modified: $modDate\n";
}
$header .= "\n";
return (1,$header);
}
# here is where we find out who did what...
# this is only invoked if we're in detail mode.
sub GetChangeInfo {
my $p4dirobj = shift;
my $file = $p4dirobj->{input_file};
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);
$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}});
}
}
sub SyntaxHighlight {
my $p4dirobj = shift;
my $input_file = $p4dirobj->{input_file};
my $fileinfo = $p4dirobj->{fileinfo};
my $filename = $input_file;
$filename =~ s/[\#\@].*$//;
my $typename = $filename;
my $version = 0;
my $changenum = 0;
my $use_lineno=1;
my $filter=0;
$version =$1 if ($input_file=~m/(\#\d*)$/);
$changenum =$1 if ($input_file=~m/(\@\d*)$/);
# 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...
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>";
return;
}
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>";
}
return;
}
$verstamp = $realname;
$verstamp =~ s|.*#([0-9]+).*?\(([a-zA-Z]+)\)|(Version $1)|;
$realname =~ s|.*#([^#]*)|$1|;
$filename.=" $verstamp";
if ($fileinfo->{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($fileinfo->{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\"> Browse </A>|\n";
$confidential.="<A HREF=\"$wwwcgibin/$p4browseName\?\@filelog+$version_file\"> Versions </A>|\n";
$confidential.="<A HREF=\"http:$wwwcgibin/$p4browseName?\@describe+$fileinfo->{headChange}\"> Change Desc </A>|";
if ($p4dirobj->{isdetail}) {
$confidential.="<A HREF=\"http:$wwwcgibin/$p4file2htmlName/$short_input\"> Simple </A>";
}
else {
$confidential.="<A HREF=\"http:$wwwcgibin/$p4file2htmldataName/$short_input\"> Detail </A>";
}
if ($fileinfo->{headAction} eq "edit") {
$confidential.="|<A HREF=\"http:$wwwcgibin/$p4browseName?\@diff+$version_file+$fileinfo->{headRev}+edit\"> Diff </A>";
}
if ($fileinfo->{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>";
return;
}
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\"> Branch From </A>";
}
$confidential .="]</TABLE>";
$converter = new SourceToHtml($typename,$sample,
$use_lineno,$confidential,1,
$time,$filename," ");
if ($p4dirobj->{isdetail}) {
@culprits = ();
@changes = ();
&GetChangeInfo($p4dirobj,scalar(@input),\@culprits,\@changes);
$converter->SetExtraColumn(1,100,\@culprits);
$converter->SetExtraColumn(2,50,\@changes);
}
Print $converter->Convert(@input);
}
close(INPUT);
}
1;
| # | Change | User | Description | Committed | |
|---|---|---|---|---|---|
| #1 | 80 | Greg Spencer |
This adds the file-centric perforce browser to the guest depot. I rewrote it (again) this 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. |