#!/usr/bin/perl -w # -*- perl -*- use P4CGI ; use strict ; use CGI::Carp ; # ################################################################# # CONFIGURATION INFORMATION # All config info should be in P4CGI.pm # ################################################################# # # P4 file log viewer # ################################################################# sub offsetOf($@ ) { my $v = shift @_ ; my $pos = 0 ; while(@_ > 0) { if($v eq (shift @_)) { return $pos ; } $pos++ ; } return -1 ; } local *P ; # Get file argument my $file = P4CGI::cgi()->param("FSPC") ; my $listLabel = P4CGI::cgi()->param("LISTLAB") ; $listLabel = "No" unless defined $listLabel ; &P4CGI::bail("No file spec") unless defined $file ; # Get file data my @filelog ; &P4CGI::p4call(\@filelog,"filelog \"$file\"") ; &P4CGI::bail("No data for file \"$file\"") if @filelog == 0 ; # Get info about opened status &P4CGI::p4call(*P,"opened -a \"$file\" 2>/dev/null") ; my %opened ; while(
) {
chomp ;
/\w+\#(\d+) - .* by (\w+)\@(\S+)/ or
&P4CGI::bail("Can not read info from \"p4 opened\"") ;
if(exists $opened{$1}) {
$opened{$1} .= "
and " . &P4CGI::ahref( -url => &P4CGI::LU_URL(),
"USER=$2",
"$2") . ": $3" ;
} else {
$opened{$1} = &P4CGI::ahref( -url => &P4CGI::LU_URL(),
"USER=$2",
"$2") . ": $3" ;
} ;
} ;
close *P ;
# Get list of labels (if $listLabel is set)
my @labels ;
if($listLabel eq "Yes") {
&P4CGI::p4call(*P,"labels") ;
while(
) {
/^Label (\S+)/ and do { push @labels,$1 ; } ;
}
close P ;
}
# Create hash containing labes by file name and
# version
my %fileToLabels ;
if(@labels > 0) {
my $filelabels = "" ;
foreach (@labels) {
$filelabels .= " \"$file\@$_\"" ;
}
my @filesInLabels ;
&P4CGI::p4call(\@filesInLabels,"files $filelabels 2>&1") ;
my $l ;
# Remove labels not in list
# NOTE! The errors (file not in label-messages)
# where printed to stderr and there
# is no guarantee that output from stderr and
# stdout will come in order. This is why
# we first must figure out which labels
# that NOT affected the file
foreach $l (reverse map {/.*@(\S+)\s.*not in label/?$1:()} @filesInLabels) {
my $offset = offsetOf($l,@labels) ;
splice @labels,$offset,1 ;
}
# Build file-to-label hash. Use only data from
# stdout (not stderr). (grep is used to filter)
foreach (grep(!/not in label/,@filesInLabels)) {
my $lab = shift @labels ;
/^(\S+)/ ;
if(defined $fileToLabels{$1}) {
$fileToLabels{$1} .= "
$lab" ;
}
else {
$fileToLabels{$1} = "$lab" ;
}
}
} ;
my @legendList ;
push @legendList,
"Revision Number -- see the file text",
"Action -- see the deltas (diffs)",
"User -- see info about user",
"Change -- see the complete change description, including other files",
&P4CGI::ahref("-url",P4CGI::CHB_URL(),
&P4CGI::fixspaces("FSPC=$file"),
"Changes") . "-- see list of all changes for this file" ;
if($listLabel ne "Yes") {
push @legendList,
&P4CGI::ahref("-url",&P4CGI::cgi()->url(),
&P4CGI::cgi()->query_string(),
"LISTLAB=Yes",
"List labels") . "-- list cross ref. for labels" ;
} ;
print "",&P4CGI::start_page("File log
$file",&P4CGI::ul_list(@legendList)) ;
my $labelHead ="";
if($listLabel eq "Yes") {
$labelHead="In label(s)" ;
} ;
print
"",
&P4CGI::start_table(""),
&P4CGI::table_row("-type","th",
"-align","left",
"Rev","Act.","Date","User","Change","Type","Desc",$labelHead,"Opened by");
my $log ;
my @revs ;
for($log = shift @filelog ; defined $log ; $log = shift @filelog) {
$_ = &P4CGI::fixSpecChar($log) ;
if(/^\.\.\. \#(\d+) \S+ (\d+) (\S+) on (\S+) by (\S*)@(\S*) (\S*)\s*'(.*)'/ )
{
my ($rev,$change,$act,$date,$user,$client,$type,$desc) =
($1,$2,$3,$4,$5,$6,$7,$8) ;
$type =~ s/\((.*)\)/$1/ ;
$desc = &P4CGI::magic($desc) ;
push @revs,$rev ;
my $labels = $fileToLabels{"$file\#$rev"} ;
$labels = "" unless defined $labels ;
$labels = "$labels" ;
if ($act eq 'branch') {
$_ = &P4CGI::fixSpecChar(shift @filelog) ;
my ($fromname,$fromrev) = /^.*branch from (\S+?)\#(\d+).*/;
print
"",
&P4CGI::table_row(-valign => "top",
&P4CGI::ahref("-url",&P4CGI::FV_URL(),
&P4CGI::fixspaces("FSPC=$file"),
"REV=$rev",
"$rev"),
&P4CGI::ahref(&P4CGI::fixspaces("FSPC=$fromname"),
"REV=$fromrev",
"$act"),
"$date",
&P4CGI::ahref(-url => &P4CGI::LU_URL(),
"USER=$user",
"$user"),
&P4CGI::ahref("-url",&P4CGI::CHV_URL(),
"CH=$change",
"$change"),
"$type",
"$desc",
$labels,
exists $opened{$rev}?$opened{$rev}:"") ;
}
elsif ($act eq 'delete') {
print
"",
&P4CGI::table_row(-valign => "top",
&P4CGI::ahref("-url",&P4CGI::FV_URL(),
&P4CGI::fixspaces("FSPC=$file"),
"REV=$rev",
"$rev"),
"delete",
"$date",
&P4CGI::ahref(-url => &P4CGI::LU_URL(),
"USER=$user",
"$user"),
&P4CGI::ahref("-url",&P4CGI::CHV_URL(),
"CH=$change",
"$change"),
"$type",
"$desc",
$labels,
exists $opened{$rev}?$opened{$rev}:"") ;
}
else {
print
"",
&P4CGI::table_row(-valign => "top",
&P4CGI::ahref("-url",&P4CGI::FV_URL(),
&P4CGI::fixspaces("FSPC=$file"),
"REV=$rev",
"$rev"),
&P4CGI::ahref("-url",&P4CGI::FDV_URL(),
&P4CGI::fixspaces("FSPC=$file"),
"REV=$rev",
"ACT=$act",
"$act"),
"$date",
&P4CGI::ahref(-url => &P4CGI::LU_URL(),
"USER=$user",
"$user"),
&P4CGI::ahref("-url",&P4CGI::CHV_URL(),
"CH=$change",
"$change"),
"$type",
"$desc",
$labels,
exists $opened{$rev}?$opened{$rev}:"") ;
}
}
}
print
"",
&P4CGI::end_table("") ;
if(@revs > 2) {
print
"