Helix SwarmHelix Swarm

ldv.cgi

  • //
  • guest/
  • diane_holt/
  • p4db/
  • cgi-bin/
  • ldv.cgi #1
  • View
  • Commits
  • Open Download .zip Download (9 KB) 
  1. #!/usr/local/bin/perl5
  2. # -*- perl -*-
  3. use P4CGI ;
  4. use strict ;
  5. #
  6. #####################################################################
  7. ##
  8. ##  CONFIGURATION INFORMATION 
  9. ##  All config info should be in $configFile (see init() in P4CGI.pm)
  10. ##
  11. #####################################################################
  12. ##
  13. ##  Label Diff Viewer
  14. ##
  15. #####################################################################
  16.  
  17. # Set back references
  18. my $homepage="index.cgi";
  19. my $backtohome="Back to Home" ;
  20.  
  21. # Define variables set by command arguments
  22. my $label1 ; # Labels to diff
  23. my $label2 ;
  24. my $showSame ; # defined if files that are the same in both labels
  25. 	       # should be listed
  26. my $showNotSame ; # defined if files that are not the same in both labels
  27.                   # should be listed
  28. my $showDiff ; # defined if files that exist in only one of the labels
  29.                # should be displayed
  30.  
  31. # Get arguments
  32. $label1 = P4CGI::cgi()->param("LABEL1") ;
  33. &P4CGI::bail("No first label specified") unless defined $label1 ;
  34.  
  35. $label2 = P4CGI::cgi()->param("LABEL2") ;
  36. &P4CGI::bail("No second label specified") unless defined $label2 ;
  37.  
  38. $showSame = P4CGI::cgi()->param("SHOWSAME") ;
  39. undef $showSame if $showSame ne "Y" ;
  40.  
  41. $showNotSame = P4CGI::cgi()->param("SHOWNOTSAME") ;
  42. undef $showNotSame if $showNotSame ne "Y" ;
  43.  
  44. $showDiff = P4CGI::cgi()->param("SHOWDIFF") ;
  45. undef $showDiff if $showDiff ne "Y" ;
  46.  
  47. # Print title and legend
  48. print 
  49.     "",
  50.     &P4CGI::start_page("Label Diff",
  51.     "",
  52.     $homepage,$backtohome) ;
  53.  
  54. # Define a typeglob for use as file handle
  55. local *P4 ;
  56.  
  57. #
  58. # Get basic data for labels
  59. #
  60. my ($date1,$time1,$owner1,$desc1,$opt1,$view1,@view1) = &getLabelData($label1) ;
  61. my ($date2,$time2,$owner2,$desc2,$opt2,$view2,@view2) = &getLabelData($label2) ;
  62.  
  63. #
  64. # Print basic label data
  65. #
  66.  
  67. print
  68.     "",
  69.     &P4CGI::start_table("width=100%"),
  70.     &P4CGI::table_row(-type => "th",
  71. 		      -align => "center",
  72. 		      "<font color=green>$label1</font> vs.
  73. 		       <font color=green>$label2</font>"),
  74.     &P4CGI::end_table();
  75. print
  76.     "<br>" ;
  77.  
  78. # Start table
  79. print
  80.     "",
  81.     &P4CGI::start_table(""),
  82.     &P4CGI::table_row(-type => "th",
  83. 		      -bgcolor=>"white",
  84. 		      "",$label1,$label2),
  85.     &P4CGI::table_row({-align   => "right",
  86. 		       -text    => "<b>Date:</b>"},
  87. 		      {-bgcolor => "white",
  88. 		       -text    => "$time1 $date1"},
  89. 		      {-bgcolor => "white",
  90. 		       -text    => "$time2 $date2"});    
  91. print
  92.     "",
  93.     &P4CGI::table_row({-align => "right",
  94. 		       -text  => "<b>Owner:</b>"},
  95. 		      {-bgcolor => "white",
  96. 		       -text    =>$owner1},
  97. 		      {-bgcolor => "white",
  98. 		       -text    =>$owner2});    
  99. print
  100.     "",
  101.     &P4CGI::table_row({-align=>"right",
  102. 		       -valign=>"top",
  103. 		       -text=>"<b>Description</b>"},
  104. 		      {-bgcolor => "white",
  105. 		       -text    =>$desc1},
  106. 		      {-bgcolor => "white",
  107. 		       -text    =>$desc2});    
  108. if(( $opt1 ne "") or ( $opt2 ne "")) {
  109.     print
  110. 	"",
  111. 	&P4CGI::table_row({-align => "right",
  112. 			   -text => "<b>Options:</b>"},
  113. 			  {-bgcolor => "white",
  114. 			   -text    =>$opt1},
  115. 			  {-bgcolor => "white",
  116. 			   -text    =>$opt2});    
  117. }
  118. print
  119.     "",
  120.     &P4CGI::table_row({-align => "right",
  121. 		       -valign=>"top",
  122. 		       -text  => "<b>View:</b>"},
  123. 		      {-bgcolor => "white",
  124. 		       -text    =>$view1},
  125. 		      {-bgcolor => "white",
  126. 		       -text    =>$view2});  
  127. print
  128.     "",
  129.     &P4CGI::end_table(),
  130.     "<hr>";
  131.     
  132. # Get files for labels
  133. my (@lfiles1,@lfiles2);
  134. my %files1 ;
  135. my $v ;
  136. my @tmp1 ;
  137. foreach $v (@view1) {
  138.     &P4CGI::p4call(*P4, "files \"$v\@$label1\"" );
  139.     while(<P4>) {
  140. 	push @tmp1,$_ ;
  141. 	$_ =~ s/\#(\d+).*// ;  ;
  142. 	$files1{$_} = $1  ;
  143.     }
  144.     close P4 ;
  145. } ;
  146. @lfiles1 = sort @tmp1 ;
  147.  
  148. my @tmp2 ;
  149. my $commonFound=0 ;
  150. my $commonAndSameRev=0 ;
  151. foreach $v (@view2) {
  152.     &P4CGI::p4call(*P4, "files \"$v\@$label2\"" );
  153.     while(<P4>) {
  154. 	push @tmp2,$_ ;
  155. 	$_ =~ s/\#(\d+).*// ;  
  156. 	my $otherRev = $files1{$_} ;
  157. 	if(defined $otherRev) {
  158. 	    $commonFound++ ;
  159. 	    $commonAndSameRev++ if ($otherRev == $1) ;
  160. 	}
  161.     }
  162.     close P4 ;
  163. } ;
  164. @lfiles2 = sort @tmp2 ;
  165.  
  166. my ($nfiles1,$nfiles2) ;
  167. $nfiles1 = @lfiles1 ;
  168. $nfiles2 = @lfiles2 ;
  169.     
  170. my $fileslisted = "Yes" ;
  171. print
  172.     "Label <font color=green>$label1</font> has <b>$nfiles1</b> files<br>", 
  173.     "Label <font color=green>$label2</font> has <b>$nfiles2</b> files<br>",
  174.     "The labels have <b>$commonFound</b> file", $commonFound==1?"":"s",
  175.     " in common &#150; <b>$commonAndSameRev</b> at the same revision<br>";
  176. if($commonFound == 0) {
  177.     print 
  178. 	"<font color=red>",
  179. 	"The two labels have no files in common - comparsion aborted.</font>" ;
  180. }
  181. else {
  182.     if(defined $showSame and defined $showNotSame and defined $showDiff) {
  183. 	print "<b>Files:</b><br>\n" ;
  184.     }
  185.     elsif(!defined $showSame and !defined $showNotSame and !defined $showDiff) {
  186. 	print "Listed files are:<br>\n" ;
  187. 	print "<LI> None\n" ;
  188. 	$fileslisted = undef ;
  189.     }
  190.     else {
  191. 	print "Listed files are:\n" ;
  192. 	defined $showSame and do { 
  193. 	    print "<LI> Files not modified (common file, common revision)\n";} ;
  194. 	defined $showNotSame and do { 
  195. 	    print "<LI> Modified files (common file, different revision)\n";} ;
  196. 	defined $showDiff and do {
  197. 	    print "<LI> Files in only one of <font color=green>$label1</font>
  198. 		   and <font color=green>$label2</font>\n" ; } ;
  199. 	print "\n" ;
  200.     } ;
  201.     
  202. # Print list of files
  203.     if(defined $fileslisted) {
  204. 	print 
  205. 	    "",
  206. 	    &P4CGI::start_table("border bgcolor=white"),
  207. 	    &P4CGI::table_row("-type","th",
  208. 	    "File",
  209. 	    "$label1<br>Revision",
  210. 	    undef,
  211. 	    "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;",
  212. 	    "$label2<br>Revision") ;
  213. 	
  214. 	my $f1 = shift @lfiles1 ;
  215. 	my $f2 = shift @lfiles2 ;
  216. 	while(defined $f1 or defined $f2) { 
  217. 	    my ($name1,$rev1,$name2,$rev2) = ("",0,"",0) ;
  218. 	    if(defined $f1) {
  219. 		$f1 =~ /^([^\#]+)\#(\d+)/ ;
  220. 		$name1 = $1 ; $rev1 = $2 ;
  221. 	    }
  222. 	    if(defined $f2) {
  223. 		$f2 =~ /^([^\#]+)\#(\d+)/ ;
  224. 		$name2 = $1 ; $rev2 = $2 ;
  225. 	    }
  226. 	    if($name1 eq $name2) {
  227. 		if((defined $showSame    and ($rev1 == $rev2)) or
  228. 		   (defined $showNotSame and ($rev1 != $rev2))) {
  229. 		    if($rev1 == $rev2) {
  230. 			print &P4CGI::table_row(&P4CGI::ahref("-url",
  231. 			    &P4CGI::FLV_URL(),
  232. 			    &P4CGI::fixspaces("FSPC=$name1"),"$name1"),
  233. 			    {-text  => "$rev1",
  234. 			     -align => "center"},
  235. 			    undef,
  236. 			    "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;",
  237. 			    {-text  => "(same)",
  238. 			     -align => "center"}) ;
  239. 		    }
  240. 		    else {
  241. 			print &P4CGI::table_row(&P4CGI::ahref("-url",
  242. 			    &P4CGI::FLV_URL(),
  243. 			    &P4CGI::fixspaces("FSPC=$name1"),"$name1"),
  244. 			    {-text=>&P4CGI::ahref("-url",&P4CGI::FV_URL(),
  245. 			    &P4CGI::fixspaces("FSPC=$name1"),
  246. 			    "REV=$rev1",
  247. 			    "$rev1"),
  248. 			    -align=>"center"},
  249. 			    undef,
  250. 			    {-text=>&P4CGI::ahref("-url",&P4CGI::FDV_URL(),
  251. 			    &P4CGI::fixspaces("FSPC=$name1"),
  252. 			    "REV=$rev1",
  253. 			    "REV2=$rev2",
  254. 			    "ACT=edit",
  255. 			    "<b>&lt;diff&gt;</b>"),
  256. 			    -align=>"center"},
  257. 			    {-text=>&P4CGI::ahref("-url",&P4CGI::FV_URL(),
  258. 			    &P4CGI::fixspaces("FSPC=$name1"),
  259. 			    "REV=$rev2",
  260. 			    "$rev2"),
  261. 			    -align=>"center"},) ;
  262. 		    }
  263. 		}
  264. 		if(defined $f1) { $f1 = shift @lfiles1 ;} ;
  265. 		if(defined $f2) { $f2 = shift @lfiles2 ;} ;
  266. 	    }
  267. 	    elsif (($name2 ne "") and ($name1 eq "" or $name1 gt $name2)) {
  268. 		if(defined $showDiff) {
  269. 		    print &P4CGI::table_row(&P4CGI::ahref(-url => &P4CGI::FLV_URL(),
  270. 			&P4CGI::fixspaces("FSPC=$name2"),"$name2"),
  271. 			{-text    => "&#151;&#151;",
  272. 			 -align   => "center",
  273. 			 -bgcolor => "red"},
  274. 			 undef,
  275. 			 "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;",
  276. 			 {-text=>&P4CGI::ahref("-url",&P4CGI::FV_URL(),
  277. 			 &P4CGI::fixspaces("FSPC=$name1"),
  278. 			 "REV=$rev2",
  279. 			 "$rev2"),
  280. 			 -align=>"center"},) ;
  281. 		}
  282. 		$f2 = shift @lfiles2 if(defined $f2) ;
  283. 	    }
  284. 	    else {
  285. 		if(defined $showDiff) {
  286. 			print &P4CGI::table_row(&P4CGI::ahref("-url",
  287. 			&P4CGI::FLV_URL(),
  288. 			&P4CGI::fixspaces("FSPC=$name1"),"$name1"),
  289. 			{-text=>&P4CGI::ahref("-url",&P4CGI::FV_URL(),
  290. 			&P4CGI::fixspaces("FSPC=$name1"),
  291. 			"REV=$rev1",
  292. 			"$rev1"),
  293. 			-align=>"center"},
  294. 			undef,
  295. 			"&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;",
  296. 			{-text    => "&#151;&#151;",
  297. 			 -align   => "center",
  298. 			 -bgcolor => "red"}) ;
  299. 		}
  300. 		$f1 = shift @lfiles1 if(defined $f1) ;
  301. 	    }
  302. 	}
  303. 	print
  304. 	    "",
  305. 	    &P4CGI::end_table() ;
  306.     }
  307. }
  308. print &P4CGI::end_page() ;
  309.  
  310.  
  311. ###
  312. ### Subroutines
  313. ###
  314.  
  315. # Get label data. 
  316. # Returns list containing "Mod date","mod time","owner","description","view"
  317. sub getLabelData($ ) {
  318.     my $label = shift @_ ;
  319.     local *P4 ;
  320.     my ($date,$time,$owner,$desc,$options,$view,@view) ;
  321.     # Mod. date, mod. time, owner, description, view
  322.     &P4CGI::p4call( *P4, "label -o $label" );
  323.     # Get label, time, date, owner
  324.     while(<P4>) {
  325. 	chop ;
  326. 	$_ = P4CGI::fixSpecChar($_) ;
  327. 	/^Label:\s+(\S+)/        && do { $label=$1 ; next ; } ;
  328. 	/^Date:\s+(\S+)\s+(\S+)/ && do { $date=$1 ; $time=$2 ;  next ; } ;
  329. 	/^Owner:\s+(\S+)/        && do { $owner=$1 ; next ; } ;
  330. 	/^Description:/          && do { last ;} ;
  331.     } ;
  332.     # Get description
  333.     while(<P4>) {
  334. 	chomp ;
  335. 	s/^\s+// ;
  336. 	next if /^\s*$/ ;
  337. 	/^Options:\s*(.*)/ and do { $options = $1 ; next ; } ;
  338. 	last if /^View:/ ;
  339. 	if(defined $desc) {
  340. 	    $desc .= "<br>\n$_" ;
  341. 	}
  342. 	else {
  343. 	    $desc = $_ ;
  344. 	}
  345.     } ;
  346.     # Get view
  347.     while(<P4>) {
  348. 	chomp ;
  349. 	s/^\s+// ;
  350. 	s/\s+$// ;
  351. 	next if /^\s*$/ ;	
  352. 	push @view,$_ ;
  353. 	if(defined $view) {
  354. 	    $view .= "<br>\n$_" ;
  355. 	}
  356. 	else {
  357. 	    $view = $_ ;
  358. 	}
  359.     } ;
  360.     close P4 ;
  361.     return ($date,$time,$owner,
  362.             "<tt>$desc</tt>",$options,"<tt>$view</tt>",@view) ;
  363. };
  364.  
# Change User Description Committed
#1 271 Diane Holt The Perl files for P4DB.
These (almost) match the files in
rev 1 of the p4db.tar file --... a few files have some minor
cosmetic changes in the code, and chv.cgi has a Legend item
added that was missing in the one in the tar-file. These files,
at rev 1 (and the files in p4db.tar at rev 1), are suitable for
for running the app with release 98.2 of P4. «		 25 years ago