#!/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: # => # 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 "", "Restricted file: $file", &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("Change number: 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 # - change $_ = ; if( /^\s+\S+\s+\S+\s+\S+\s+\S+\s+(\S+)\#(\d+) - \S+ \S+ \S+ \((\w+)\)/ ) { ( $name, $rev, $type ) = ($1,$2,$3) ; $_ = ; print "", "File: $name", "
", "Type: $type", "
", "Rev: $rev", "
" ; } else { print "", "Error: ", "Malformed output returned from p4pr. Can't provide history trace.", "
" ; # exit ; } print "", "", "", "
", "Line", "", "", "Author/Branch", "", "", "Change", "", "", "Rev", "", "", "Text", "
" ; # Print the file trace print "
\n" ;
    while(  ) {
	print
	    "",
	    &P4CGI::fixSpecChar($_) ;
    }	    
    # End the preformatted tag
    print "
\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: # # - change () $_ = ; /^(.+)\#(\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("$about", "
", &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 "", "File: $file\n", "
" ; # ...if filetype is binary and it's not being forced, tell&ask... if(!defined $force and ($type =~ /.*binary/)) { print "

Type: $type

\n", &P4CGI::ahref(-url => &P4CGI::cgi()->url, &P4CGI::cgi()->query_string()."&FORCE=Y", "View anyway?") ; } # ...otherwise, print type and rev else { my $linecount ; print "Type: $type
Revision: $rev
\n
\n";

    # Print the contents of the file
    while(  ) {
	$linecount++ ;
	if( ( $linecount % 5 ) == 0 )
	{
	    print "" ;
	}
	print &P4CGI::fixSpecChar($_) ;
    }
    # End the preformatted tag
    print "
\n"; } # Close it up close P4; # End the page print "", &P4CGI::end_page() ;