ldv.cgi #1

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

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

# Define variables set by command arguments
my $label1 ; # Labels to diff
my $label2 ;
my $showSame ; # defined if files that are the same in both labels
	       # should be listed
my $showNotSame ; # defined if files that are not the same in both labels
                  # should be listed
my $showDiff ; # defined if files that exist in only one of the labels
               # should be displayed

# Get arguments
$label1 = P4CGI::cgi()->param("LABEL1") ;
&P4CGI::bail("No first label specified") unless defined $label1 ;

$label2 = P4CGI::cgi()->param("LABEL2") ;
&P4CGI::bail("No second label specified") unless defined $label2 ;

$showSame = P4CGI::cgi()->param("SHOWSAME") ;
undef $showSame if $showSame ne "Y" ;

$showNotSame = P4CGI::cgi()->param("SHOWNOTSAME") ;
undef $showNotSame if $showNotSame ne "Y" ;

$showDiff = P4CGI::cgi()->param("SHOWDIFF") ;
undef $showDiff if $showDiff ne "Y" ;

# Print title and legend
print 
    "",
    &P4CGI::start_page("Label Diff",
    "",
    $homepage,$backtohome) ;

# Define a typeglob for use as file handle
local *P4 ;

#
# Get basic data for labels
#
my ($date1,$time1,$owner1,$desc1,$opt1,$view1,@view1) = &getLabelData($label1) ;
my ($date2,$time2,$owner2,$desc2,$opt2,$view2,@view2) = &getLabelData($label2) ;

#
# Print basic label data
#

print
    "",
    &P4CGI::start_table("width=100%"),
    &P4CGI::table_row(-type => "th",
		      -align => "center",
		      "<font color=green>$label1</font> vs.
		       <font color=green>$label2</font>"),
    &P4CGI::end_table();
print
    "<br>" ;

# Start table
print
    "",
    &P4CGI::start_table(""),
    &P4CGI::table_row(-type => "th",
		      -bgcolor=>"white",
		      "",$label1,$label2),
    &P4CGI::table_row({-align   => "right",
		       -text    => "<b>Date:</b>"},
		      {-bgcolor => "white",
		       -text    => "$time1 $date1"},
		      {-bgcolor => "white",
		       -text    => "$time2 $date2"});    
print
    "",
    &P4CGI::table_row({-align => "right",
		       -text  => "<b>Owner:</b>"},
		      {-bgcolor => "white",
		       -text    =>$owner1},
		      {-bgcolor => "white",
		       -text    =>$owner2});    
print
    "",
    &P4CGI::table_row({-align=>"right",
		       -valign=>"top",
		       -text=>"<b>Description</b>"},
		      {-bgcolor => "white",
		       -text    =>$desc1},
		      {-bgcolor => "white",
		       -text    =>$desc2});    
if(( $opt1 ne "") or ( $opt2 ne "")) {
    print
	"",
	&P4CGI::table_row({-align => "right",
			   -text => "<b>Options:</b>"},
			  {-bgcolor => "white",
			   -text    =>$opt1},
			  {-bgcolor => "white",
			   -text    =>$opt2});    
}
print
    "",
    &P4CGI::table_row({-align => "right",
		       -valign=>"top",
		       -text  => "<b>View:</b>"},
		      {-bgcolor => "white",
		       -text    =>$view1},
		      {-bgcolor => "white",
		       -text    =>$view2});  
print
    "",
    &P4CGI::end_table(),
    "<hr>";
    
# Get files for labels
my (@lfiles1,@lfiles2);
my %files1 ;
my $v ;
my @tmp1 ;
foreach $v (@view1) {
    &P4CGI::p4call(*P4, "files \"$v\@$label1\"" );
    while(<P4>) {
	push @tmp1,$_ ;
	$_ =~ s/\#(\d+).*// ;  ;
	$files1{$_} = $1  ;
    }
    close P4 ;
} ;
@lfiles1 = sort @tmp1 ;

my @tmp2 ;
my $commonFound=0 ;
my $commonAndSameRev=0 ;
foreach $v (@view2) {
    &P4CGI::p4call(*P4, "files \"$v\@$label2\"" );
    while(<P4>) {
	push @tmp2,$_ ;
	$_ =~ s/\#(\d+).*// ;  
	my $otherRev = $files1{$_} ;
	if(defined $otherRev) {
	    $commonFound++ ;
	    $commonAndSameRev++ if ($otherRev == $1) ;
	}
    }
    close P4 ;
} ;
@lfiles2 = sort @tmp2 ;

my ($nfiles1,$nfiles2) ;
$nfiles1 = @lfiles1 ;
$nfiles2 = @lfiles2 ;
    
my $fileslisted = "Yes" ;
print
    "Label <font color=green>$label1</font> has <b>$nfiles1</b> files<br>", 
    "Label <font color=green>$label2</font> has <b>$nfiles2</b> files<br>",
    "The labels have <b>$commonFound</b> file", $commonFound==1?"":"s",
    " in common &#150; <b>$commonAndSameRev</b> at the same revision<br>";
if($commonFound == 0) {
    print 
	"<font color=red>",
	"The two labels have no files in common - comparsion aborted.</font>" ;
}
else {
    if(defined $showSame and defined $showNotSame and defined $showDiff) {
	print "<b>Files:</b><br>\n" ;
    }
    elsif(!defined $showSame and !defined $showNotSame and !defined $showDiff) {
	print "Listed files are:<br>\n" ;
	print "<LI> None\n" ;
	$fileslisted = undef ;
    }
    else {
	print "Listed files are:\n" ;
	defined $showSame and do { 
	    print "<LI> Files not modified (common file, common revision)\n";} ;
	defined $showNotSame and do { 
	    print "<LI> Modified files (common file, different revision)\n";} ;
	defined $showDiff and do {
	    print "<LI> Files in only one of <font color=green>$label1</font>
		   and <font color=green>$label2</font>\n" ; } ;
	print "\n" ;
    } ;
    
# Print list of files
    if(defined $fileslisted) {
	print 
	    "",
	    &P4CGI::start_table("border bgcolor=white"),
	    &P4CGI::table_row("-type","th",
	    "File",
	    "$label1<br>Revision",
	    undef,
	    "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;",
	    "$label2<br>Revision") ;
	
	my $f1 = shift @lfiles1 ;
	my $f2 = shift @lfiles2 ;
	while(defined $f1 or defined $f2) { 
	    my ($name1,$rev1,$name2,$rev2) = ("",0,"",0) ;
	    if(defined $f1) {
		$f1 =~ /^([^\#]+)\#(\d+)/ ;
		$name1 = $1 ; $rev1 = $2 ;
	    }
	    if(defined $f2) {
		$f2 =~ /^([^\#]+)\#(\d+)/ ;
		$name2 = $1 ; $rev2 = $2 ;
	    }
	    if($name1 eq $name2) {
		if((defined $showSame    and ($rev1 == $rev2)) or
		   (defined $showNotSame and ($rev1 != $rev2))) {
		    if($rev1 == $rev2) {
			print &P4CGI::table_row(&P4CGI::ahref("-url",
			    &P4CGI::FLV_URL(),
			    &P4CGI::fixspaces("FSPC=$name1"),"$name1"),
			    {-text  => "$rev1",
			     -align => "center"},
			    undef,
			    "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;",
			    {-text  => "(same)",
			     -align => "center"}) ;
		    }
		    else {
			print &P4CGI::table_row(&P4CGI::ahref("-url",
			    &P4CGI::FLV_URL(),
			    &P4CGI::fixspaces("FSPC=$name1"),"$name1"),
			    {-text=>&P4CGI::ahref("-url",&P4CGI::FV_URL(),
			    &P4CGI::fixspaces("FSPC=$name1"),
			    "REV=$rev1",
			    "$rev1"),
			    -align=>"center"},
			    undef,
			    {-text=>&P4CGI::ahref("-url",&P4CGI::FDV_URL(),
			    &P4CGI::fixspaces("FSPC=$name1"),
			    "REV=$rev1",
			    "REV2=$rev2",
			    "ACT=edit",
			    "<b>&lt;diff&gt;</b>"),
			    -align=>"center"},
			    {-text=>&P4CGI::ahref("-url",&P4CGI::FV_URL(),
			    &P4CGI::fixspaces("FSPC=$name1"),
			    "REV=$rev2",
			    "$rev2"),
			    -align=>"center"},) ;
		    }
		}
		if(defined $f1) { $f1 = shift @lfiles1 ;} ;
		if(defined $f2) { $f2 = shift @lfiles2 ;} ;
	    }
	    elsif (($name2 ne "") and ($name1 eq "" or $name1 gt $name2)) {
		if(defined $showDiff) {
		    print &P4CGI::table_row(&P4CGI::ahref(-url => &P4CGI::FLV_URL(),
			&P4CGI::fixspaces("FSPC=$name2"),"$name2"),
			{-text    => "&#151;&#151;",
			 -align   => "center",
			 -bgcolor => "red"},
			 undef,
			 "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;",
			 {-text=>&P4CGI::ahref("-url",&P4CGI::FV_URL(),
			 &P4CGI::fixspaces("FSPC=$name1"),
			 "REV=$rev2",
			 "$rev2"),
			 -align=>"center"},) ;
		}
		$f2 = shift @lfiles2 if(defined $f2) ;
	    }
	    else {
		if(defined $showDiff) {
			print &P4CGI::table_row(&P4CGI::ahref("-url",
			&P4CGI::FLV_URL(),
			&P4CGI::fixspaces("FSPC=$name1"),"$name1"),
			{-text=>&P4CGI::ahref("-url",&P4CGI::FV_URL(),
			&P4CGI::fixspaces("FSPC=$name1"),
			"REV=$rev1",
			"$rev1"),
			-align=>"center"},
			undef,
			"&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;",
			{-text    => "&#151;&#151;",
			 -align   => "center",
			 -bgcolor => "red"}) ;
		}
		$f1 = shift @lfiles1 if(defined $f1) ;
	    }
	}
	print
	    "",
	    &P4CGI::end_table() ;
    }
}
print &P4CGI::end_page() ;


###
### Subroutines
###

# Get label data. 
# Returns list containing "Mod date","mod time","owner","description","view"
sub getLabelData($ ) {
    my $label = shift @_ ;
    local *P4 ;
    my ($date,$time,$owner,$desc,$options,$view,@view) ;
    # Mod. date, mod. time, owner, description, view
    &P4CGI::p4call( *P4, "label -o $label" );
    # Get label, time, date, owner
    while(<P4>) {
	chop ;
	$_ = P4CGI::fixSpecChar($_) ;
	/^Label:\s+(\S+)/        && do { $label=$1 ; next ; } ;
	/^Date:\s+(\S+)\s+(\S+)/ && do { $date=$1 ; $time=$2 ;  next ; } ;
	/^Owner:\s+(\S+)/        && do { $owner=$1 ; next ; } ;
	/^Description:/          && do { last ;} ;
    } ;
    # Get description
    while(<P4>) {
	chomp ;
	s/^\s+// ;
	next if /^\s*$/ ;
	/^Options:\s*(.*)/ and do { $options = $1 ; next ; } ;
	last if /^View:/ ;
	if(defined $desc) {
	    $desc .= "<br>\n$_" ;
	}
	else {
	    $desc = $_ ;
	}
    } ;
    # Get view
    while(<P4>) {
	chomp ;
	s/^\s+// ;
	s/\s+$// ;
	next if /^\s*$/ ;	
	push @view,$_ ;
	if(defined $view) {
	    $view .= "<br>\n$_" ;
	}
	else {
	    $view = $_ ;
	}
    } ;
    close P4 ;
    return ($date,$time,$owner,
            "<tt>$desc</tt>",$options,"<tt>$view</tt>",@view) ;
};