- #!/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("<b>owner</b> -- view user info",
- "<b>view</b> -- 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(<P4>) {
- chomp ;
- next if /^#/ ;
- next if /^\s*$/ ;
- /^Date:\s(.*)$/ and do { $date=$1 ; } ;
- /^Owner:\s(.*)$/ and do { $owner=$1 ; } ;
- last if /^Description:/ ;
- }
- my $descWhiteSpace ;
- while(<P4>) {
- 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 .= "<br>$_" ;
- }
- else {
- $desc .= $_ ;
- }
- } ;
-
- while(<P4>) {
- 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 .= "<br>$t" ;
- }
- else {
- $view .= "$t" ;
- } ;
- } ;
-
- print
- "",
- &P4CGI::table_row({-type=>"th",
- -align=>"right",
- -valign=>"bottom",
- -text=>"<font size=+2>Label</font>"},
- "<font size=+2><b>$label<b></font>"),
- &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 => "<tt>$desc</tt>"}),
- &P4CGI::table_row({-type=>"th",
- -align=>"right",
- -text=>"Options:"},
- "$options"),
- &P4CGI::table_row({-type=>"th",
- -align=>"right",
- -valign=>"top",
- -text=>"View:"},
- "<tt>$view</tt>"),
- &P4CGI::table_row(undef,
- &P4CGI::ahref(-url => &P4CGI::CHB_URL(),
- "FSPC=//...",
- "LABEL=$label",
- "View changes for label $label")) ;
-
- print
- "",
- &P4CGI::end_table() ;
-
- print
- "<hr>",
- &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),
- "<br>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"),
- "<br>",
- &P4CGI::cgi()->submit(-name => "Go",
- -value => "Go"),
- &P4CGI::cgi()->endform() ;
-
-
- print
- "<hr>",
- &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),
- "<br>",
- &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
- #