#!/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
#