#!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 .= "Unable to open file...\n";
$header .= "
\n";
$header .= "\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} = "$type";
$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{$_} = "$_";
}
else {
$email{$_} = $_;
}
}
while (@lines) {
my($rev) = shift(@lines);
my($ch) = "$change{$rev}";
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 "Unable to open...\n";
Print "
Sorry, unable to open input file \"$input_file\"...
\n";
return;
}
my $realname = ;
my @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 "Unable to open...\n";
if ($version) {
Print "