fv.cgi #1

#!/usr/local/bin/perl5
# -*- perl -*-
use P4CGI ;
use strict ;
#
#####################################################################
##
##  CONFIGURATION INFORMATION 
##  All config info should be in $configFile (see init() in P4CGI.pm)
##
#####################################################################
##
##  File Viewer
##
#####################################################################

use viewConfig ;

#####################################################################
# A hash containing file extensions that can be viewed with special viewers
# Data is:
#   <extension> => <semicolon separated list of:
#                     url      - Url to be used
#                     typecode - Will be sent as parameter TYPE to url
#                     text     - A text for the href to url>
# Filename (depot format) will be sent as FILE parameter; revision as
# REV parameter.
#####################################################################

# Set back references
my $homepage="index.cgi";
my $backtohome="Back to Home" ;

# Get file spec
my $file = P4CGI::cgi()->param("FSPC") ;
&P4CGI::bail("No file specified") unless defined $file ;

# Get the revision number
my $revision = P4CGI::cgi()->param("REV") ;
$revision = "#$revision" if defined $revision ;
$revision="" unless defined $revision ;

# See if they want to force viewing a non-text file
my $force = P4CGI::cgi()->param("FORCE") ;

# See if they want a history trace
my $trace = P4CGI::cgi()->param("TRACE") ;
$trace = "" unless defined $trace ;
# Get the user's port (to pass to p4pr)
my $p4port = &P4CGI::USER_P4PORT() ;

# Get list of restricted files, if any
my @restrict = &P4CGI::RESTRICTED() ;

my $legend ;
# Disallow viewing restricted files
if( @restrict ) {
  my $restricted ;
  foreach $restricted ( @restrict ) {
    chomp ;
    if ( $file =~ /\/${restricted}/ ) {
      $legend = "" ;
      print
	"",
	&P4CGI::start_page("File View",$legend,$homepage,$backtohome) ;
      print
	"",
	"<font color=red>Restricted file:</font>
	 <font color=green> $file</font>",
	&P4CGI::end_page() ;
      exit 1 ;
    }
  }
}

# File info vars
my ( $name, $rev, $type ) ;

# Print a p4pr trace
if( $trace eq "yes" ) {
  $legend =  "" ;
#  $legend = 
#	&P4CGI::ul_list("<b>Change number:</b> to see the change description");
  # Print title and legend
  print
    "",
    &P4CGI::start_page("File History Trace",$legend,$homepage,$backtohome) ;

  # Get p4pr output
  if( -x "p4pr.pl" ) {
    open( P4, "./p4pr.pl -p \"$p4port\" \"$file$revision\" 2>&1 |" ) or 
	&P4CGI::bail("Error returned from p4pr. Can't provide history trace.");
    # Get header line:
    #   line author/branch change rev <filename>#<rev> - <action> change <num> <type>
    $_ = <P4>;	
    if( /^\s+\S+\s+\S+\s+\S+\s+\S+\s+(\S+)\#(\d+) - \S+ \S+ \S+ \((\w+)\)/ ) {
      ( $name, $rev, $type ) = ($1,$2,$3) ;
      $_ = <P4> ;
      print
	"",
	"<b>File:</b> <font color=green>$name</font>",
	"<br>",
	"<b>Type:</b> <font color=green>$type</font>",
	"<br>",
	"<b>Rev:</b> <font color=green>$rev</font>",
	"<hr>" ;
    }
    else {
      print
	"",
	"<b><font color=red>Error:</font></b>&nbsp;",
	"Malformed output returned from p4pr. Can't provide history trace.",
	"<br>" ;
#      exit ;
    }
    print
      "",
      "<table cellspacing=0 cellpadding=0>",
      "<tr align=center valign=top>",
      "<td width=5%>",
      "<b>Line</b>",
      "<td width=1%>",
      "<td width=11%>",
      "<b>Author/Branch</b>",
      "<td width=1%>",
      "<td width=5%>",
      "<b>Change</b>",
      "<td width=1%>",
      "<td width=4%>",
      "<b>Rev</b>",
      "<td width=1%>",
      "<td width=68%>",
      "<b>Text</b>",
      "</table>" ;
    # Print the file trace
    print "<pre>\n" ;
    while( <P4> ) {
	print
	    "",
	    &P4CGI::fixSpecChar($_) ;
    }	    
    # End the preformatted tag
    print "</pre>\n" ;
    # End the page
    print
      "",
      &P4CGI::end_page() ;
    # Close it up
    close P4 ;
    exit ;
  }
}

# Get the file extension, for "special"-file viewing
my $ext = $file ;
$ext =~ s/^.*\.// ;
$ext = uc($ext) ;

# Get the file contents and header info
local *P4 ;
&P4CGI::p4call( *P4, "print \"$file$revision\"" );
# Get header line:
#   <filename>#<rev> - <action> change <chg_no> (<type>)
$_ = <P4>;
/^(.+)\#(\d+) - \S+ \S+ \S+ \((\w+)\)/;	
( $name, $rev, $type ) = ($1,$2,$3) ;
my $filetype = $type ;

# Set legend
my $legend = "" ;
if(exists $viewConfig::ExtensionToType{$ext}) {
# See if it's a specially viewable file...
    my $type = $viewConfig::ExtensionToType{$ext} ;
    my ($url,$desc,$content,$about) = @{$viewConfig::TypeData{$type}} ;
    # If it's an HTML file, include "About..." option...
    if ( defined $about ) {
      $legend .= &P4CGI::ul_list("<i>$about</i>",
		 "<hr>",
		 &P4CGI::ahref(-url => $url,
			      "TYPE=$type",
			      &P4CGI::fixspaces("FSPC=$file"),
			      "REV=$rev",
			      "View $desc"),
			      &P4CGI::ahref(-url => "fv.cgi",
				  &P4CGI::fixspaces("FSPC=$file"),
				  "REV=$rev",
				  "TRACE=yes",
				  "View line-by-line history trace"),
			      &P4CGI::ahref(-url => "dnld.cgi",
				  &P4CGI::fixspaces("FSPC=$file"),
				  "REV=$rev",
				  "Download file")) ;
    }
    # ...otherwise just offer viewing and downloading options (for non-binary)
    else {
	if( $filetype =~ /.*binary/ ) {
	    $legend .= &P4CGI::ul_list(&P4CGI::ahref(-url => $url,
			      "TYPE=$type",
			      &P4CGI::fixspaces("FSPC=$file"),
			      "REV=$rev",
			      "View $desc"),
			      &P4CGI::ahref(-url => "dnld.cgi",
				  &P4CGI::fixspaces("FSPC=$file"),
				  "REV=$rev",
				  "Download file")) ;
	}
	else {
	    $legend .= &P4CGI::ul_list(&P4CGI::ahref(-url => $url,
			      "TYPE=$type",
			      &P4CGI::fixspaces("FSPC=$file"),
			      "REV=$rev",
			      "View $desc"),
			      &P4CGI::ahref(-url => "fv.cgi",
				  &P4CGI::fixspaces("FSPC=$file"),
				  "REV=$rev",
				  "TRACE=yes",
				  "View line-by-line history trace"),
			      &P4CGI::ahref(-url => "dnld.cgi",
				  &P4CGI::fixspaces("FSPC=$file"),
				  "REV=$rev",
				  "Download file")) ;
	}
    }
}
# ...otherwise, just offer the trace and download options
else {
    $legend = &P4CGI::ul_list(&P4CGI::ahref(-url => "fv.cgi",
				  &P4CGI::fixspaces("FSPC=$file"),
				  "REV=$rev",
				  "TRACE=yes",
				  "View line-by-line history trace"),
			      &P4CGI::ahref(-url => "dnld.cgi",
				  &P4CGI::fixspaces("FSPC=$file"),
				  "REV=$rev",
				  "Download file")) ;
}

# Print title and legend
print 
    "",
    &P4CGI::start_page("File View",$legend,$homepage,$backtohome) ;

# Print filename, and...
print
    "",
    "<b>File:</b><font color=green> $file</font>\n",
    "<br>" ;

# ...if filetype is binary and it's not being forced, tell&ask...
if(!defined $force and ($type =~ /.*binary/))
{
    print
	"<h3>Type: <font color=red>$type</font></h3>\n",
	&P4CGI::ahref(-url => &P4CGI::cgi()->url,
		      &P4CGI::cgi()->query_string()."&FORCE=Y",
		      "View anyway?") ;

}
# ...otherwise, print type and rev
else
{
    my $linecount ;
    print "<b>Type:</b><font color=green> $type</font><br>
	   <b>Revision:</b><font color=green> $rev</font><hr>\n<pre>\n";

    # Print the contents of the file
    while( <P4> ) {
	$linecount++ ;
	if( ( $linecount % 5 ) == 0 )
	{
	    print "<a name=L${linecount}></a>" ;
	}
	print &P4CGI::fixSpecChar($_) ;
    }
    # End the preformatted tag
    print "</pre>\n";
}
# Close it up
close P4;

# End the page
print
    "",    
    &P4CGI::end_page() ;