p4_filelog #4 

#!/usr/bin/perl -w
# -*- perl -*-
use strict ;
use HTML::Entities ;

#
# p4_filelog for Safari
# Copyright (c) 1999 by Barrie Slaymaker, rbs@telerama.com
#
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the README file.
#
#
# Port of flv.cgi to safari.
#
#################################################################
#  CONFIGURATION INFORMATION 
#  All config info should be in P4CGI.pm
#
#################################################################
#
#  P4 file log viewer
#
#################################################################

local *P ;

# Get file argument
my $file = $ARGV[ 0 ] ;
my $listLabel = "Yes" ;
$listLabel = "No" unless defined $listLabel ;

die "No file spec" unless defined $file ;

my $up_to_project = $ENV{SAF_UP_TO_PROJECT} ;
my $up_to_rev     = $ENV{SAF_UP_TO_REV} ;
my $up_to_filter  = $ENV{SAF_UP_TO_FILTER} ;
my $path_filter   = $ENV{SAF_PATH_FILTER} ;

# Get file data
my @filelog ;
p4call(\@filelog,"filelog $file") ;

die "No data for file \"$file\"" if @filelog == 0 ;

# Get info about opened status
p4call(*P,"opened -a $file 2>/dev/null") ;
my %opened ;
while(<P>) {
    chomp ;
    /\w+\#(\d+) - .* by (\w+)\@(\S+)/ or 
	die "Can not read info from \"p4 opened\"" ;
    if(exists $opened{$1}) {
	$opened{$1} .= "<br> and $2\@$3" ;
    } else {
	$opened{$1} = "$2\@$3" ;
    } ;
} ;
close *P ;

# Get list of labels (if $listLabel is set)
my @labels ;
if($listLabel eq "Yes") {
    p4call(*P,"labels") ;
    while(<P>) {
	/^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 ;
    p4call(\@filesInLabels,"files $filelabels 2>&1") ;
    foreach (@filesInLabels) {
	my $lab = shift @labels ;
	/not in label/ or do {
	    /^(\S+)/ ;
	    if(defined $fileToLabels{$1}) {
		$fileToLabels{$1} .= "<br>$lab" ; 
	    } 
	    else {
		$fileToLabels{$1} = "$lab" ; 
	    }
	}	
    }
} ;


print <<TOHERE ;
<HTML>
<HEAD>
   <TITLE>File log for $file</TITLE>
</HEAD>
<BODY>
<UL>
TOHERE

print
    "",
    "<TABLE>\n" ,
    "<TR ALIGN=\"LEFT\">",
    map{ "<TH>$_</TH>" } qw( Rev Act. Date User Change Desc Labels Opened_by ),
    "</TR>\n",
;

my $log ;
my @revs ;
for($log = shift @filelog ; defined $log ; $log = shift @filelog) {
    $_ = $log ; #&P4CGI::fixSpecChar($log) ;
    if(/^\.\.\. \#(\d+) \S+ (\d+) (\S+) on (\S+) by (\S*)@(\S*) \((\S*)\) '(.*)'/ )
    {
	my ($rev,$change,$act,$date,$user,$client,$ftype,$desc) =($1,$2,$3,$4,$5,$6,$7,$8) ;
#	$desc = &P4CGI::magic($desc) ;
	push @revs,$rev ;
	my $labels = $fileToLabels{"$file\#$rev"} ;
	$labels = "" unless defined $labels ;
	$labels = "<b>$labels</b>" ;
	my $file_path = $file ;
	$file_path =~ s@^//@/@ ;
	my $rev_anchor = encode_entities( "#$rev" ) ;
#          qq{<A HREF="${up_to_project}_$rev/$path_filter$file_path">#$rev</A>} ;
	my $change_anchor = join(
          '',
	  qq{<A HREF="${up_to_project}\@$change/$path_filter$file_path">\@},
          encode_entities( $change ),
          '</A>',
        ) ;
	if ($act eq 'branch') {
	    $_ = shift @filelog ; # &P4CGI::fixSpecChar(shift @filelog) ;
	    my ($fromname,$fromrev) = /^.*branch from (\S+?)\#(\d+).*/;
	    print
		"",
		"<TR>",
		map { "<TD VALIGN=\"TOP\">$_</TD>" } (
						$rev_anchor,
						$act,
                      				$date,
						$user,
						$change_anchor,
				  "<tt>$desc</tt>",
				  $labels,
				  exists $opened{$rev}?$opened{$rev}:""),
                "</TR>\n",
		;
	}
	elsif ($act eq 'delete') {
	    print
		"",
		"<TR>",
		map { "<TD VALIGN=\"TOP\">$_</TD>" } (
						$rev_anchor,
				  "<strike>delete</strike>",
				  "$date",
			 	  "$user",
				  $change_anchor,
				  "<tt>$desc</tt>",
				  $labels,
				  exists $opened{$rev}?$opened{$rev}:""),
	        "</TR>\n",
		;
	}
	else {
	    print
		"",
		"<TR>",
		map { "<TD VALIGN=\"TOP\">$_</TD>" } (
						"$rev_anchor",
						"$act",				  
				  "$date",
						"$user",
						$change_anchor,
				  "<tt>$desc</tt>",
				  $labels,
				  exists $opened{$rev}?$opened{$rev}:""),
	        "</TR>\n",
		;
	}
    }
}

print "", "</TABLE>\n" ;

#if(@revs > 2) {
#    print
#	"<hr>",
#	&P4CGI::cgi()->startform("-action",&P4CGI::FDV_URL(),
#				 "-method","GET"),
#	&P4CGI::cgi()->hidden("-name","FSPC",
#			      "-value","$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() ;
#}
#
print <<TOHERE ;
</BODY>
</HTML>
TOHERE
    

#
# That's it folks
#

0 ;


sub p4call {
    my ( $fh, $cmd ) = @_ ;
    $cmd = "p4 $cmd |" ;
    if ( ref( $fh ) eq 'ARRAY' ) {
        open( CMD, $cmd ) or
	    die "$!: $cmd" ;
	while (<CMD>) {
	    push( @$fh, $_ ) ;
	}
	close( CMD ) ;
    }
    else {
	open( $fh, $cmd ) or
	    die "$!: $cmd" ;
    }
}
# Change User Description Committed
#4 198 Barrie Slaymaker Removed HREF anchor around rev number, fixed URL in change
number anchor in file log.

Made perl/cgimake.conf set SAF_PATH_... env. vars properly.
#3 168 Barrie Slaymaker Added YAPC paper, slides
#2 165 Barrie Slaymaker Applied Greg KH's license patch.
#1 162 Barrie Slaymaker First code & documentation checkin