- #!/usr/bin/perl -w
- # -*- perl -*-
- use P4CGI ;
- use strict ;
- #
- #################################################################
- # CONFIGURATION INFORMATION
- # All config info should be in P4CGI.pm
- #
- #################################################################
- #
- # P4 label diff viewer
- # View diff between two labels
- #
- #################################################################
-
- # 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 botha labels
- # should be listed
- my $showDiff ; # defined if files that exists only in one of the labels
- # shold be displayed
-
- # Get arguments
- $label1 = P4CGI::cgi()->param("LABEL1") ;
- &P4CGI::bail("No label first specified") unless defined $label1 ;
-
- $label2 = P4CGI::cgi()->param("LABEL2") ;
- &P4CGI::bail("No label second 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" ;
-
- #
- # Start page
- #
- print
- "",
- &P4CGI::start_page("Diff between label<br> $label1 and $label2","") ;
-
- # 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 "", # Start table
- &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"});
- if($owner1 eq $owner2) {
- print "",
- &P4CGI::table_row({-align => "right",
- -text => "<b>Owner:</b>"},
- undef,
- {-bgcolor => "white",
- -align => "center",
- -text =>$owner2});
- }
- else {
- print "",
- &P4CGI::table_row({-align => "right",
- -text => "<b>Owner:</b>"},
- {-bgcolor => "white",
- -text =>$owner1},
- {-bgcolor => "white",
- -text =>$owner2});
- }
-
- if($desc1 eq $desc2) {
- print "",
- &P4CGI::table_row({-align=>"right",
- -valign=>"top",
- -text=>"<b>Description</b>"},
- undef,
- {-bgcolor => "white",
- -text =>$desc2});
- }
- else {
- 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 "")) {
- if($opt1 eq $opt2) {
- print "",
- &P4CGI::table_row({-align => "right",
- -text => "<b>Options:</b>"},
- undef,
- {-bgcolor => "white",
- -text =>$opt2});
- }
- else {
- print "",
- &P4CGI::table_row({-align => "right",
- -text => "<b>Options:</b>"},
- {-bgcolor => "white",
- -text =>$opt1},
- {-bgcolor => "white",
- -text =>$opt2});
- }
- } ;
- if($view1 eq $view2) {
- print "",
- &P4CGI::table_row({-align => "right",
- -valign=>"top",
- -text => "<b>View:</b>"},
- undef,
- {-bgcolor => "white",
- -text =>$view2});
- }
- else {
- 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 \"$label1\" has $nfiles1 files<br>",
- "Label \"$label2\" has $nfiles2 files<br>",
- "Label \"$label1\" and \"$label2\" has $commonFound file",
- $commonFound==1?"":"s",
- " in common ($commonAndSameRev with same revision)<br>";
- if($commonFound == 0) {
- print
- "<FONT SIZE=+2 COLOR=red>",
- "The two labels has 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 "No files listed!<br>\n" ;
- $fileslisted = undef ;
- }
- else {
- print "<B>Listed files are:<BR>\n" ;
- defined $showSame and do {
- print "<LI> Files not modified\n" ; } ;
- defined $showNotSame and do {
- print "<LI> Modified files (different rev.)\n" ; } ;
- defined $showDiff and do {
- print "<LI> Files only in one of the labels $label1 and $label2\n" ; } ;
- print "</B>\n" ;
- } ;
-
- #
- # Start print list of files
- #
- if(defined $fileslisted) {
- print
- "",
- &P4CGI::start_table("border bgcolor=white"),
- &P4CGI::table_row("-type","th",
- "File",undef,"$label1<br>Rev.",undef,"$label2<br>Rev.") ;
-
- 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(),
- "FSPC=$name1","$name1"),
- undef,undef,undef,
- {-text=>"<font color=green> $rev1 </font>",
- -align=>"center"}) ;
- }
- else {
- print &P4CGI::table_row(&P4CGI::ahref("-url",&P4CGI::FLV_URL(),
- "FSPC=$name1","$name1"),
- {-text=>"$rev1",
- -align=>"center"},
- undef,
- {-text=>&P4CGI::ahref("-url",&P4CGI::FDV_URL(),
- "FSPC=$name1",
- "REV=$rev1",
- "REV2=$rev2",
- "ACT=edit",
- "<->"),
- -align=>"center"},
- {-text=>"$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(),
- "FSPC=$name2","$name2"),
- undef,
- {-text => "----",
- -align => "center",
- -bgcolor => "red"},
- undef,
- {-text => "$rev2",
- -align => "center"}) ;
- }
- $f2 = shift @lfiles2 if(defined $f2) ;
- }
- else {
- if(defined $showDiff) {
- print &P4CGI::table_row(&P4CGI::ahref("-url",&P4CGI::FLV_URL(),
- "FSPC=$name1","$name1"),
- undef,
- {-text => "$rev1",
- -align => "center"},
- undef,
- {-text => "----",
- -align => "center",
- -bgcolor => "red"}) ;
- }
- $f1 = shift @lfiles1 if(defined $f1) ;
- }
- }
- print
- "",
- &P4CGI::end_table() ;
- }
- }
- print &P4CGI::end_page() ;
-
-
- ###
- ### Subroutines
- ###
-
- #
- # Get label data.
- # Returns list containg "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) ;
- };
-
- #
- # That's it folks
- #
-
-
-
-