fileLogView.cgi #8

#!/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
#
#################################################################

## Check if we have GD (required for branchGraph.cgi).
my $GD_AVAILABLE=undef ;
{
    my $tmpDie = $SIG{'__DIE__'} ;
    $SIG{'__DIE__'} = "" ;
    eval ' use GD ; ' ;
    if(length($@) == 0) {
	$GD_AVAILABLE= "Y" ;
    }
    $SIG{'__DIE__'} = $tmpDie ;
}

sub offsetOf($@ ) {
    my $v = shift @_ ;
    my $pos = 0 ;
    while(@_ > 0) {
	if($v eq (shift @_)) {
	    return $pos ;
	}
	$pos++ ;
    }
    return -1 ;
}

my $err2null = &P4CGI::REDIRECT_ERROR_TO_NULL_DEVICE() ;
my $err2stdout =  &P4CGI::REDIRECT_ERROR_TO_STDOUT() ;

my ($serverYear,$serverNo) = &P4CGI::SERVER_VERSION() ;

local *P ;
				# File argument
my $file = P4CGI::cgi()->param("FSPC") ;
&P4CGI::bail("No file spec") unless defined $file ;

				# Label x-reference argument
my $listLabel = P4CGI::cgi()->param("LISTLAB") ;
$listLabel = "No" unless defined $listLabel ;

				# Show branch info argument
my $showBranch = P4CGI::cgi()->param("SHOWBRANCH") ;
$showBranch="No" unless defined $showBranch ;

				# Show full change text
my $showFullDesc = P4CGI::cgi()->param("FULLDESC") ;
if(&P4CGI::SHOW_FULL_DESC() == 0) {
    $showFullDesc="No" unless defined $showFullDesc and $showFullDesc eq "Yes" ;
}
else { 
    $showFullDesc="Yes" unless defined $showFullDesc and $showFullDesc eq "No" ;
} ;

				# Get file data
my @filelog ;
if($serverYear >= 2002) {
				# For servers from 2002 and later we use the -l flag
				# for the filelog command to always get log descriptions.
				# We will then trucate the description if the user asked for
				# "truncated description"
    &P4CGI::p4call(\@filelog,"filelog -l \"$file\"") ;
}
else {
				# For 2001 servers and earlier we assume the -l flag does not
				# exist. Here we us the "change" command to get the long
				# descriptions, but only when we need it.
				# (I do not actually _know_ when the -l flag was implemented
				#  so I assume it was for 2002.1 to make my life simpler)
    &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\" $err2null") ;
my %opened ;
my $openedText = "" ;
while(<P>) {
    $openedText = "Opened by" ;
    chomp ;
    /\w+\#(\d+) - .* by (\w+)\@(\S+)/ or 
	&P4CGI::bail("Can not read info from \"p4 opened\"") ;
    my $user =  &P4CGI::ahref(-url => "userView.cgi",
			      "USER=$2",
			      "HELP=View user info",
			      "$2") ;
    
    my $client =  &P4CGI::ahref(-url => "clientView.cgi",
				"CLIENT=$3",
				"HELP=View client info",
				"$3") ;
    
    if(exists $opened{$1}) {
	$opened{$1} .= "<br> and $user\@$client" ;
    } else {
	$opened{$1} = "$user\@$client" ;
    } ;
} ;
close *P ;

##
## Get Label cross reference
##

my %fileToLabels ;    # Hash containing labels by file name and version

my @labels ;			# Labels containing file

#
# Find labels containing file
#

				# There are two ways to do this, pre and
				# post 2001.1 version. Pre 2001.1 the
				# "p4 labels" command did not take a file
				# name and could not be used. A more complicated
				# algorithm must be used that made cross
				# referenceing slow and it is thus optional.
				# Post 2001.1 it is fast and does not have to be
				# optional anymore.
if($serverYear < 2001) {
				# OK. We have an older server

				# Get list of all labels (if $listLabel is set)
    if($listLabel eq "Yes") {
	&P4CGI::p4call(*P,"labels") ;
	while(<P>) {
	    /^Label (\S+)/ and do { push @labels,$1 ; } ;
	}
	close P ;
    }
    
    if(@labels > 0) {
				# Speed things up by looking up
				# file view for each label and removing all
				# labels that don't match
				#   This is an act of desperation because in our
				#   p4 depot the label search takes forever (well..
				#   a long time, 20 secs or so...)
	my $l ;
	my @l ;
      LABEL: foreach $l (@labels) {
	  my %data ;
	  &P4CGI::p4readform("label -o \"$l\"",\%data) ;
	  if(exists $data{"View"}) {
	      my @v = split("\n",$data{"View"}) ;
	      foreach (@v) {
		  # p4-to-perl regexp conversion
		  my $in = $_ ;
		  my $re = "" ;
		  while($in =~ s/(.*?)(\Q...\E|\Q*\E)//) {
		      $re .= "\Q$1\E" ;
		      if($2 eq "...") { $re .= ".*"    ; } 
		      else            { $re .= "[^/]*" ; }
		  }
		  $re .= "\Q$in\E" ;
		  if($file =~ /$re/) {
		      push @l,$l ;
		      next LABEL ;
		  }
	      } 
	  }
      }
	my $lb = @labels ;
	my $la = @l ;
	&P4CGI::ERRLOG("reduced from $lb to $la labels") ; # DEBUG
	@labels = @l ;
				# <RANT>
				# Frankly, I find it very strange that I can speed
				# up the search by "manually" reading all label
				# specs, parsing them, and checking if the file
				# matches any part of the view before actually
				# asking p4 to do it. Some developer must have had
				# a bad day at perforce. And p4 is not open
				# source.... sigh.
				# </RANT>
    }
}
else {
				# We have a newer server
   $listLabel = "Yes" ;
   
   &P4CGI::p4call(\@labels,"labels $file") ;

   map { s/^Label (\S+).*/$1/ ; } @labels ;   
}

if(@labels > 0) {
    my $filelabels = "" ;
    foreach (@labels) {
	$filelabels .= " \"$file\@$_\"" ;
    }
    my @filesInLabels ;
    &P4CGI::p4call(\@filesInLabels,"files $filelabels $err2stdout") ;
    my $l ;
				# Remove labels not in list
				#   NOTE! The errors (file not in label-messages)
				#         are 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 ;
	$lab = &P4CGI::ahref(-url => "labelView.cgi",
			     "LABEL=$lab",
			     "HELP=View label",
			     "$lab") ;
	/^(\S+)/ ;
	if(defined $fileToLabels{$1}) {
	    $fileToLabels{$1} .= "<br>$lab" ; 
	} 
	else {
	    $fileToLabels{$1} = "$lab" ; 
	}
    }
} ;

my @legendList ; 
push @legendList,
    "<b>Revision Number</b> -- see the file text",
    "<b>Action</b> -- see the deltas (diffs)",
    "<b>User</b> -- see info about user",
    "<b>Change</b> -- see the complete change description, including other files",
    &P4CGI::ahref("-url","changeList.cgi",
		  "FSPC=$file",
		  "Changes") . "-- see list of all changes for this file" ;

my @parsListLab ;
my @parsShowBranch ;
my $p ;
foreach $p (&P4CGI::cgi()->param()) {
    push @parsListLab, "$p=" . &P4CGI::cgi()->param($p) unless $p eq "LISTLAB" ;
    push @parsShowBranch, "$p=" . &P4CGI::cgi()->param($p) unless $p eq "SHOWBRANCH" ;
}

if($listLabel ne "Yes") {
    push @legendList,
    &P4CGI::ahref(@parsListLab,
		  "LISTLAB=Yes",
		  "List labels") . "-- list cross ref. for labels" ;
} ;
if($showBranch ne "No") {
    push @legendList,
    &P4CGI::ahref(@parsShowBranch,
		  "SHOWBRANCH=No",
		  "Hide branch info") . "-- hide info about branches, merges and copy of file" ;
} 
else {
    push @legendList,
    &P4CGI::ahref(@parsShowBranch,
		  "SHOWBRANCH=Yes",
		  "Show branch info") . "-- show info about branches, merges and copy of file" ;
} ;

				# Get file directory part
my $fileDir=$file ;
$fileDir =~ s#/[^/]+$## ;
push @legendList,
    &P4CGI::ahref("-url","depotTreeBrowser.cgi",
		  "FSPC=$fileDir",
		  "Browse directory") . 
    "-- Browse depot tree at $fileDir" ;
my %vars ;
{
    my $par ;
    foreach $par (&P4CGI::cgi()->param()) {
	$vars{$par} = &P4CGI::cgi()->param($par);
    } ;
} ;

if($showFullDesc eq "Yes") {
    $vars{"FULLDESC"}="No" ;
    my @pars ;
    foreach (keys %vars) {
	push @pars,"$_=$vars{$_}" ;
    } ;
    push @legendList, &P4CGI::ahref(@pars,
				    "Show truncated descriptions") ;
}
else {
    $vars{"FULLDESC"}="Yes" ;
    my @pars ;
    foreach (keys %vars) {
	push @pars,"$_=$vars{$_}" ;
    } ;
    push @legendList, &P4CGI::ahref(@pars,
				    "Show full descriptions") ;
} ;

if($GD_AVAILABLE) {
    push 
	@legendList, 
	&P4CGI::ahref("-url","branchGraph.cgi",
		      "FSPC=$file",
		      "Graph Branches/Merges") .
			  "-- Graph branches and merges to/from this file";
} else {
    push 
	@legendList, 
	"Graph Branches/Merges-- Graph branches and merges to/from this file ".
	    "(requires GD package)" ;    
}

print "",&P4CGI::start_page("File log<br>$file",&P4CGI::ul_list(@legendList)) ;

my $labelHead ="";
if($listLabel eq "Yes") {
    $labelHead="In label(s)" ;
} ;

print
    "",
    &P4CGI::start_table("width=100%"),
    &P4CGI::table_header("Rev/view<br> file",
			 "Action/view<br> diff",
			 "Date",
			 "User/view<br> user",
			 "Change/view<br> change",
			 "Type",
			 "Desc",
			 $labelHead,
			 $openedText) ;

my @revs ;
my %relatedFiles ;
my ($rev,$change,$act,$date,$user,$client,$type,$desc) ;
my $chbuffer = "" ;
while(@filelog) {
    $_ = &P4CGI::fixSpecChar(shift @filelog) ;
    if(/^\.\.\. \#(\d+) \S+ (\d+) (\S+) on (\S+) by (\S*)@(\S*) (\S*)\s*'(.*)'/  or
       /^\.\.\. \#(\d+) \S+ (\d+) (\S+) on (\S+) by (\S*)@(\S*) (\S*)/) {
	print $chbuffer ;
	$chbuffer = "" ;
	($rev,$change,$act,$date,
	 $user,$client,$type,$desc) = ($1,$2,$3,$4,$5,$6,$7,$8) ;
	if(!$desc) {
	    shift @filelog ;
	    my $l ;
	    $desc = "" ;
	    while(@filelog) {
		$l = shift @filelog ;
		chomp $l ;
		$l =~ s/^\t// ;
		last if(length($l) == 0) ;
		$desc .= "\n" if($desc ne "") ;
		$desc .= $l ;
	    }
	} ;
	$type =~ s/\((.*)\)/$1/ ;
	if($showFullDesc eq "Yes" and $serverYear < 2002) {
	    my %changeData ;
	    &P4CGI::p4readform("change -o $change",\%changeData) ;
	    $desc = $changeData{"Description"} if exists $changeData{"Description"} ;
	}  ;
	if($showFullDesc ne "Yes") {
				# See earlier comment about "$serverYear >= 2002"
	    if($serverYear >= 2002) {
		$desc =~ s/\n.*$//s ;
		$desc = substr($desc,0,40) . "..." ;
	    }
	    else {
		$desc .="..." if length($desc) >= 31;
	    }
	}
	$desc = &P4CGI::fixSpecChar($desc) ;
	$desc = &P4CGI::magic($desc) ;
	$desc =~ s/\n/<br>\n/gm ;
	$desc =~ s/ /&nbsp;/gm ;
	push @revs,$rev ;
	my $labels = $fileToLabels{"$file\#$rev"} ;
	$labels = "" unless defined $labels ;
	$labels = "<b>$labels</b>" ;
	$type="<small>$type</small>" ;
	$desc="<tt>$desc</tt>" ;
	my %desc = ( -text => "$desc" ,
		     ) ;
	if ($act eq 'branch') {
	    $chbuffer .= 
		&P4CGI::table_row(-valign => "top",
				  &P4CGI::ahref("-url","fileViewer.cgi",
						"FSPC=$file",
						"REV=$rev",
						"HELP=View file",
						"$rev"),
				  "$act",
				  "$date",
				  &P4CGI::ahref(-url => "userView.cgi" ,
						"USER=$user",
						"HELP=View user info",
						"$user"),
				  &P4CGI::ahref("-url","changeView.cgi",
						"CH=$change",
						"HELP=View change",
						"$change"),
				  "$type",
				  \%desc,
				  $labels,
				  exists $opened{$rev}?$opened{$rev}:"") ;
	}
	elsif ($act eq 'delete') {
	    $chbuffer .= 
		&P4CGI::table_row(-valign => "top",
				  "$rev",
				  "<strike>delete</strike>",
				  "$date",
				  &P4CGI::ahref(-url => "userView.cgi" ,
						"USER=$user",
						"HELP=View user info",
						"$user"),
				  &P4CGI::ahref("-url","changeView.cgi",
						"CH=$change",
						"HELP=View change",
						"$change"),
				  "$type",
				  \%desc,
				  $labels,
				  exists $opened{$rev}?$opened{$rev}:"") ;
	}
	else {
	    $chbuffer .= 
		&P4CGI::table_row(-valign => "top",
				  &P4CGI::ahref("-url","fileViewer.cgi",
						"FSPC=$file",
						"REV=$rev",
						"HELP=View file",
						"$rev"),
				  &P4CGI::ahref("-url","fileDiffView.cgi",
						"FSPC=$file",
						"REV=$rev",
						"ACT=$act",
						($act ne "add") ? "HELP=View diff" : "",
						"$act"),				  
				  "$date",
				  &P4CGI::ahref(-url => "userView.cgi" ,
						"USER=$user",
						"HELP=View user info",
						"$user"),
				  &P4CGI::ahref("-url","changeView.cgi",
						"CH=$change",
						"HELP=View change",
						"$change"),
				  "$type",
				  \%desc,
				  $labels,
				  exists $opened{$rev}?$opened{$rev}:"") ;
	}
    }
    else {
	if(/^\.\.\. \.\.\. (\w+) (\w+) (\S+?)\#(\S+)/) {
	    my ($op,$direction,$ofile,$orev) = ($1,$2,$3,$4) ;	
	    my $file = $ofile ;
	    $file =~ s/\#.*$// ; 
	    $relatedFiles{$file} = 1 ;
	    if($showBranch ne "No") {
		my ($b1,$b2) = ("","") ;
		if($op eq "copy") {
		    ($b1,$b2) = ("<b> ! ","</b>") ;
		}
		my $d = &P4CGI::table_row(-valign => "top",
					  "",
					  undef,
					  undef,
					  undef,
					  undef,
					  undef,
					  undef,
					  undef,
					  undef,
					  "$b1$op $direction ".
					  &P4CGI::ahref("-url","fileLogView.cgi",
							"FSPC=$ofile", 
							"HELP=View file log",
							"$ofile\#$orev"). "$b2") ;
		
		if($direction ne "from") {
		    $chbuffer = "$d\n$chbuffer" ;
		}
		else {
		    print "$chbuffer\n$d\n" ;
		    $chbuffer = "" ;
		}
	    }
	}
    }
}
print "$chbuffer\n" ;

print
    "",
    &P4CGI::end_table("") ;

if(@revs > 2) {
    print
	"<hr>",
	&P4CGI::cgi()->startform("-action","fileDiffView.cgi",
				 "-method","GET"),
	&P4CGI::cgi()->hidden("-name","FSPC",
			      "-value",&P4CGI::fixspaces("$file")),    
	&P4CGI::cgi()->hidden("-name","ACT",
			      "-value","edit"),    
	"\nShow diff between revision: ",    
	&P4CGI::cgi()->popup_menu(-name   =>"REV",
				  "-values" =>\@revs);
    shift @revs ;
    print
	" and ",
	&P4CGI::cgi()->popup_menu(-name   =>"REV2",
				  "-values" =>\@revs),
	"   ",
	&P4CGI::cgi()->submit(-name  =>"Go",
			      -value =>"Go"),
	&P4CGI::cgi()->endform() ;
} ;

my @fixes ;
if($showBranch ne "No") {
    &P4CGI::p4call(\@fixes,"fixes -i \"$file\"") ;
} else {
    &P4CGI::p4call(\@fixes,"fixes \"$file\"") ;
}
if(@fixes) {
    my @jobs ;
    &P4CGI::p4call(\@jobs,"jobs -i \"$file\"") ;
    my %job2desc ;
    %job2desc = map { /(\S+) on .* \'(.*)\'/ ;
		      my ($job,$desc) = ($1,$2) ;
		      $desc .= "..." if length($desc) > 30 ; 
		      ($job,$desc) ; } @jobs ;

    if($showFullDesc eq "Yes") {
	my $j ;
	foreach $j (keys %job2desc) { 
	    my %jobData ;
	    &P4CGI::p4readform("job -o \"$j\"",\%jobData) ;
	    if(exists $jobData{"Description"}) {
		my $d = $jobData{"Description"} ; 
		$d =~ s/\n/<br>\n/gm ;
		$job2desc{$j} = $d ;
	    }
	} 
    }
    
    
    print "<hr><b><font size=+1>Fixes</font></b>",
	&P4CGI::start_table(""),
	&P4CGI::table_header("Job/view job",
			     "Change/view change",
			     "Date",
			     "User/view user",
			     "Description") ;
    my $fix ;
    foreach $fix (sort { my $ach = $a ;
			 my $bch = $b ;
			 $ach =~ s/.* by change (\d+) .*/$1/ ;
			 $bch =~ s/.* by change (\d+) .*/$1/ ;
			 $bch <=> $ach } @fixes)
    {
	$fix =~ /(.*) fixed by change (\d+) on (\S+) by (\S+)@(\S+)/ ;
	my ($job,$change,$date,$user,$client) = ($1,$2,$3,$4,$5) ;
	print 
	    &P4CGI::table_row(-valign => "top",
			      &P4CGI::ahref("-url","jobView.cgi",
					    "JOB=$job",
					    "HELP=View job",
					    "$job"),
			      &P4CGI::ahref("-url","changeView.cgi", 
					    "CH=$change",
					    "HELP=View change",
					    "$change"),
			      "$date",
			      &P4CGI::ahref(-url => "userView.cgi" ,
					    "USER=$user",
					    "HELP=View user info",
					    "$user"),
			      "<tt>$job2desc{$job}</tt>") ;
    }
    print   
	&P4CGI::end_table("") ;
}

sub getRelatedFiles($ )
{
    my $file = shift @_ ;
    my @data ;
    &P4CGI::p4call(\@data,"filelog \"$file\"") ;
    my %res ;
    map  {  if(/^\.\.\. \.\.\. \w+ \w+ (\S+?)\#/) { $res{$1} = 1 ; } ; } @data  ;
    return ( sort keys %res ) ;
} ;

if((keys %relatedFiles) > 0) {
    my @rel = sort keys %relatedFiles ;
    my @fileLinks = map {  &P4CGI::ahref("-url","fileLogView.cgi",
					 "FSPC=$_", 
					 "HELP=View file log",
					 "$_") ; } @rel ;
    my %indrel ;
    $relatedFiles{$file} = 1 ;    
    while(@rel > 0) {
	my $r ;
	foreach $r (map { exists $relatedFiles{$_} ? () : $_ } getRelatedFiles(shift @rel)) {
	    &P4CGI::ERRLOG("found: $r") ;
	    $indrel{$r} = 1;
	    push @rel, $r ;
	    $relatedFiles{$r} = 1 ;
	}
    }

    my @indFileLinks = map {  &P4CGI::ahref("-url","fileLogView.cgi",
					    "FSPC=$_", 
					    "HELP=View file log",
					    "$_") ; } sort keys %indrel ;
    
    print
	"<hr>",
	&P4CGI::start_table(),
	&P4CGI::table_row({ -valign => "top",
			    -align => "right",
			    -type => "th",
			    -text => "Related files:" },
			  { -text => &P4CGI::ul_list(@fileLinks) }) ;
    if(@indFileLinks > 0) {
	print "", &P4CGI::table_row({ -valign => "top",
				      -align => "right",
				      -type => "th",
				      -text => "Indirect:" },
				    { -text => &P4CGI::ul_list(@indFileLinks) }) ;
    } ;
    print "", &P4CGI::end_table() ;
} ;						


print
    "",
    &P4CGI::end_page() ;

#
# That's all folks
#