#!/usr/bin/perl -w # -*- perl -*- use P4CGI ; use strict ; # ################################################################# # CONFIGURATION INFORMATION # All config info should be in P4CGI.pm # ################################################################# # # View labels # ################################################################# sub equalChars($$ ) ; # Get label my $label = P4CGI::cgi()->param("LABEL") ; &P4CGI::bail("No label specified") unless defined $label ; my $found ; # Get list of all labels and also check that supplied label exists my @labels ; &P4CGI::p4call(\@labels, "labels" ); foreach (@labels) { $_ =~ s/^Label (\S+).*$/$1/ ; if($_ eq $label) { $found = "Yes" ; } ; } &P4CGI::bail("Label $label not in depot") unless $found ; # Print header print "", &P4CGI::start_page("Label $label", &P4CGI::ul_list("owner -- view user info", "view -- View changes for view")) ; my @allOtherLabels ; foreach (@labels) { next if ($_ eq $label) ; push @allOtherLabels,$_ ; } ; my @otherLabels ; my @different ; my $firstword ; ($firstword = $label) =~ s/(\w+).*/$1/ ; while(@allOtherLabels > 0) { my $l = shift @allOtherLabels ; my $w = $l ; $w =~ s/(\w+).*/$1/ ; if($w eq $firstword) { push @otherLabels,$l ; } else { push @different,$l ; } ; } ; push @otherLabels,@different ; # Get label info print "", &P4CGI::start_table("") ; local *P4 ; my $date ; my $owner ; my $desc ; my $options ; my @view ; &P4CGI::p4call(*P4, "label -o $label" ); while() { chomp ; next if /^#/ ; next if /^\s*$/ ; /^Date:\s(.*)$/ and do { $date=$1 ; } ; /^Owner:\s(.*)$/ and do { $owner=$1 ; } ; last if /^Description:/ ; } my $descWhiteSpace ; while() { chomp ; next if /^\s*$/ ; if(/^Options:\s+(.*)/) { $options = $1 ; next ; } ; last if /^View:/ ; unless(defined $descWhiteSpace) { /^(\s*)/ ; $descWhiteSpace = $1 ; } ; s/^$descWhiteSpace// ; if(defined $desc) { $desc .= "
$_" ; } else { $desc .= $_ ; } } ; while() { chomp ; next if /^\s*$/ ; push @view,$_ ; } close P4 ; # Fix up data $owner = &P4CGI::ahref(-url => &P4CGI::LU_URL(), "USER=$owner", $owner) ; my $view ; foreach (@view) { s/^\s*(\S+\s+\S+)\s*/$1/ ; my $t = &P4CGI::ahref(-url => &P4CGI::CHB_URL(), "FSPC=$_", $_) ; if (defined $view) { $view .= "
$t" ; } else { $view .= "$t" ; } ; } ; print "", &P4CGI::table_row({-type=>"th", -align=>"right", -valign=>"bottom", -text=>"Label"}, "$label"), &P4CGI::table_row({-type=>"th", -align=>"right", -text=>"Date:"}, "$date"), &P4CGI::table_row({-type=>"th", -align=>"right", -text=>"Owner:"}, "$owner"), &P4CGI::table_row({-type=>"th", -align=>"right", -valign=>"top", -text=>"Description:"}, {-bgcolor => "white", -text => "$desc"}), &P4CGI::table_row({-type=>"th", -align=>"right", -text=>"Options:"}, "$options"), &P4CGI::table_row({-type=>"th", -align=>"right", -valign=>"top", -text=>"View:"}, "$view"), &P4CGI::table_row(undef, &P4CGI::ahref(-url => &P4CGI::CHB_URL(), "FSPC=//...", "LABEL=$label", "View changes for label $label")) ; print "", &P4CGI::end_table() ; print "
", &P4CGI::cgi()->startform(-action => &P4CGI::LDV_URL(), -method => "GET"), &P4CGI::cgi()->hidden(-name=>"LABEL1", -value=>"$label"), "Diff with label: ", &P4CGI::cgi()->popup_menu(-name => "LABEL2", -value => \@otherLabels), "
Show files that: ", &P4CGI::cgi()->checkbox(-name => "SHOWSAME", -value => "Y", -label => " are not modified"), &P4CGI::cgi()->checkbox(-name => "SHOWNOTSAME", -checked => "Y", -value => "Y", -label => " are modified"), &P4CGI::cgi()->checkbox(-name => "SHOWDIFF", -checked => "Y", -value => "Y", -label => " differ"), "
", &P4CGI::cgi()->submit(-name => "Go", -value => "Go"), &P4CGI::cgi()->endform() ; print "
", &P4CGI::cgi()->startform(-action => &P4CGI::CHB_URL(), -method => "GET"), &P4CGI::cgi()->hidden(-name=>"LABEL", -value=>"$label"), "View changes for label $label excluding label: ", &P4CGI::cgi()->popup_menu(-name => "EXLABEL", -value => \@otherLabels), "
", &P4CGI::cgi()->submit(-name => "Go", -value => "Go"), &P4CGI::cgi()->endform() ; print "", &P4CGI::end_page() ; sub equalChars($$ ) { my $a = shift @_ ; my $b = shift @_ ; my $res = 0 ; while(substr($a,$res,1) eq substr($b,$res,1)) { $res++ ; } return $res ; } # # That's it folks #