- #!/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 = "" ;
- "",
- &P4CGI::start_page("File View",$legend,$homepage,$backtohome) ;
- "",
- "<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
- "",
- &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> ;
- "",
- "<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 {
- "",
- "<b><font color=red>Error:</font></b> ",
- "Malformed output returned from p4pr. Can't provide history trace.",
- "<br>" ;
- # exit ;
- }
- "",
- "<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> ) {
- "",
- &P4CGI::fixSpecChar($_) ;
- }
- # End the preformatted tag
- print "</pre>\n" ;
- # End the page
- "",
- &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
- "",
- &P4CGI::start_page("File View",$legend,$homepage,$backtohome) ;
- # Print filename, and...
- "",
- "<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/))
- {
- "<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
- "",
- &P4CGI::end_page() ;
# | 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 |