flv.cgi #2

#!/usr/local/bin/perl5
# -*- perl -*-
use P4CGI ;
use strict ;
use CGI::Carp ;
#
#####################################################################
##
##  CONFIGURATION INFORMATION 
##  All config info should be in $configFile (see init() in P4CGI.pm)
##
#####################################################################
##
##  FileLog Viewer
##
#####################################################################

# Set back references
my $homepage="index.cgi";
my $backtohome="Back to Home" ;

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

# Filehandle for P4
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 ;
my %opened ;
while(<P>) {
    chomp ;
    /\w+\#(\d+) - .* by (\w+)\@(\S+)/ or 
	&P4CGI::bail("Cannot read info from \"p4 opened\".") ;
    if(exists $opened{$1}) {
	$opened{$1} = "<br>" ;
	$opened{$1} .= "$2" . "@" . &P4CGI::ahref(-url=>&P4CGI::CLV_URL(),
							"CLIENT=$3", "$3") ;
    } else {
	$opened = "true" ;
	$opened{$1} .= "$2" . "@" . &P4CGI::ahref(-url=>&P4CGI::CLV_URL(),
							"CLIENT=$3", "$3") ;
    } ;
} ;
close *P ;


# Get list of labels (if $listLabel is set)
my @labels ;
if($listLabel eq "Yes") {
    &P4CGI::p4call( *P,"labels" ) ;
    while(<P>) {
	/^Label (\S+)/ and do { push @labels,$1 ; } ;
    }
    close P ;
}

#Create hash containing labels by filename 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) were 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 have 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} .= "<br>$lab" ; 
	} 
	else {
	    $fileToLabels{$1} = "$lab" ; 
	}
    }
} ;


my @legendList ; 
push @legendList,
    "<b>Change:</b> to see the complete change description, including other files",
    "<b>Action:</b> to see the deltas (diffs)",
    "<b>Rev:</b> to see the file text",
    "<b>User:</b> to see info about user" ;
if( defined $opened ) {
  push @legendList,
    "<b>Client:</b> to see info about client" ;
}
push @legendList,
    "<hr>",
    &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-references for labels)" ;
} ;

# Print title and legend
print
    "",
    &P4CGI::start_page("File Log",&P4CGI::ul_list(@legendList),
    $homepage,$backtohome) ;

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

print
    "",
    "<b>File:</b><font color=green> $file</font>\n" ;
    "<b>Opened:</b><font color=green> $opened</font>\n" ;

if( defined $opened ) {
  print
    "",
    &P4CGI::start_table(""),
    &P4CGI::table_row("-type","th",
	"-align","left",
	"Change","Action","Rev","Date","User","Type","Desc",$labelHead,"Opened by");
}
else {
  print
    "",
    &P4CGI::start_table(""),
    &P4CGI::table_row("-type","th",
	"-align","left",
	"Change","Action","Rev","Date","User","Type","Desc",$labelHead);
}

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 = "<b>$labels</b>" ;
	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::CHV_URL(),
			"CH=$change", "$change"),
		    &P4CGI::ahref(&P4CGI::fixspaces("FSPC=$fromname"),
			"REV=$fromrev", "$act"),
		    &P4CGI::ahref("-url",&P4CGI::FV_URL(),
			&P4CGI::fixspaces("FSPC=$file"),
			    "REV=$rev", "$rev"),
		    "$date",
		    &P4CGI::ahref(-url => &P4CGI::LU_URL(),
				  "USER=$user", "$user"),
		    "$type",
		    "<tt>$desc</tt>",
		    $labels,
		    exists $opened{$rev}?$opened{$rev}:"") ;
	}
	elsif ($act eq 'delete') {
	    print
		"",
		&P4CGI::table_row(-valign => "top",
		    &P4CGI::ahref("-url",&P4CGI::CHV_URL(),
			"CH=$change", "$change"),
		    "<strike>delete</strike>",
		    "$rev",
		    "$date",
		    &P4CGI::ahref(-url => &P4CGI::LU_URL(),
			"USER=$user", "$user"),
		    "$type",
		    "<tt>$desc</tt>",
		    $labels,
		    exists $opened{$rev}?$opened{$rev}:"") ;
	}
	else {
	    print
		"",
		&P4CGI::table_row(-valign => "top",
		    &P4CGI::ahref("-url",&P4CGI::CHV_URL(),
			"CH=$change", "$change"),
		    &P4CGI::ahref("-url",&P4CGI::FDV_URL(),
			&P4CGI::fixspaces("FSPC=$file"),
			    "REV=$rev", "ACT=$act", "$act"),
		    &P4CGI::ahref("-url",&P4CGI::FV_URL(),
			&P4CGI::fixspaces("FSPC=$file"),
			"REV=$rev", "$rev"),
		    "$date",
		    &P4CGI::ahref(-url => &P4CGI::LU_URL(),
				  "USER=$user", "$user"),
		    "$type",
		    "<tt>$desc</tt>",
		    $labels,
		    exists $opened{$rev}?$opened{$rev}:"") ;
	}
    }
}

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

if(@revs > 2) {
    print
	"<hr>",
	&P4CGI::cgi()->startform("-action",&P4CGI::FDV_URL(),
				 "-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() ;
}

# End the page
print
    "",
    &P4CGI::end_page() ;