- #!/usr/local/bin/perl5
- # -*- perl -*-
- use P4CGI ;
- use strict ;
- #
- #####################################################################
- ##
- ## CONFIGURATION INFORMATION
- ## All config info should be in $configFile (see init() in P4CGI.pm)
- ##
- #####################################################################
- ##
- ## "Special" File Viewer (for HTML file)
- ##
- #####################################################################
- use viewConfig ;
- # Get type arg
- my $type = P4CGI::cgi()->param("TYPE") ;
- &P4CGI::bail("No file type specified") unless defined $type ;
- # Get the intranet URL
- my $intraurl = $ENV{INTRANET_URL} ;
- # (ABOUT is the HTML-coded text blurb at the bottom of this file so it
- # doesn't need any of this)
- if($type ne "ABOUT") {
- my $content = "text/html" ;
- # Get filespec
- my $file = P4CGI::cgi()->param("FSPC") ;
- &P4CGI::bail("No file specified") unless defined $file ;
- # Get revision
- my $revision = P4CGI::cgi()->param("REV") ;
- $revision = "#$revision" if defined $revision ;
- $revision="" unless defined $revision ;
- # Set filename (strip off directory path)
- my $filename=$file ;
- $filename =~ s/^.*\///;
- # Print HTML header
- "Content-Type: $content\n",
- "Content-Disposition: filename=$filename\n",
- "\n" ;
- # Get the file
- my $fileText ;
- &P4CGI::p4call(\$fileText, "print -q \"$file$revision\"" );
- my @file = split(/(<[^>]+>)/,$fileText) ;
- my $l ;
- foreach $l (@file) {
- # See if line contains an HTML tag...
- if($l =~ /^<(\w+)/) {
- my $fld=uc($1) ;
- my $prompt ;
- $prompt = "href" if $fld eq "A" ;
- $prompt = "src" if $fld eq "FRAME" ;
- $prompt = "src" if $fld eq "IMG" ;
- $prompt = "background" if $fld eq "BODY" ;
- unless(defined $prompt) {
- print $l ;
- next ;
- }
- # Set referenced file's tag and URL
- if ($l =~ /^(<.*$prompt=\")([^\"]+)(\".*)/i ) {
- my ($tag,$url,$end) = ($1,$2,$3) ;
- # If URL is fully qualified, print it and move on...
- if ($url =~ m|^\w+://| or
- $url =~ m|^/| or
- $url =~ m|:\d+$|) {
- print $l ;
- next ;
- } ;
- # Set directory path (w/o the filename)
- my $dir = $file ;
- $dir =~ s|[^/]*$|| ;
- # See if it's a relative path...
- if( $url =~ /^\.\.\// ) {
- # If we have an intranet site...
- my $relatives ;
- if( $intraurl ) {
- # If we do, count the number of relatives...
- while( $url =~ /^\.\.\// ) {
- $relatives++ ;
- $url =~ s/^\.\.\/// ;
- }
- }
- # ...else, just pass it thru as a non-link
- else {
- print $l ;
- next ;
- }
- # Translate the path...
- my $i ;
- for( $i = $relatives ; $i > 0 ; $i-- ) {
- $dir =~ s/(.*\/)\w+\/$/\1/ ;
- }
- $dir =~ s/^\/\/\w+\//$intraurl\// ;
- print "$tag$dir$url$end" ;
- next ;
- }
- # Otherwise...
- # Set the extension, if any, of the referenced file
- my $ext = "" ;
- if($url =~ /.*\.(\w+)$/) {
- $ext = uc($1) ;
- }
- my $lnfile = &P4CGI::fixspaces("$dir$url") ;
- # If it's not in the depot, just print the line & move on
- my @log ;
- &P4CGI::p4call( \@log, "filelog \"$dir$url\" 2>/dev/null" );
- if(@log == 0 or $log[1] =~ /delete on/) {
- print $l ;
- next ;
- }
- # If it is, make it a link by adding the full depot path
- # to the simple filename
- # E.g., the link was <a href="foo/bar.html"> in the src-file,
- # now it will be //depot/full/current/path/foo/bar.html
- #
- # See if the referenced file is a viewable type...
- if(exists $viewConfig::ExtensionToType{$ext}) {
- my $type = $viewConfig::ExtensionToType{$ext} ;
- my ($cgiurl,$desc,$content,$about) =
- @{$viewConfig::TypeData{$type}} ;
- # ...and set URL to be accessible thru SpecialFV cgi's
- $url = "$cgiurl?FSPC=$lnfile&TYPE=$type" ;
- }
- # ...else, just let it be accessible thru plain FV cgi
- else {
- $url = &P4CGI::FV_URL() . "?FSPC=$lnfile" ;
- }
- # Finally, print the link
- print "$tag$url$end" ;
- next ;
- }
- }
- # ...else, no tag - just print the line
- print "$l" ;
- } ;
- }
- else {
- while(<DATA>) {
- print ;
- } ;
- }
- #
- # Text for "About the HTML Viewer"
- #
- __END__
- Content-Type: text/html
- <HTML><HEAD><TITLE>P4DB: About HTML Viewer</TITLE>
- </HEAD>
- <BODY BGCOLOR="#e0f0f0" VLINK="#663366" TEXT="#000000" LINK="#000099" ALINK="#993399">
- <table bgcolor="#FFFFFF" border=10 cellspacing=8>
- <tr>
- <th>Links and the HTML File Viewer</th>
- </tr>
- <tr>
- <td>
- The HTML file viewer handles links in the source-file in
- the following way:
- <blockquote>
- <li>
- Subdirectory-based links, such as
- “subdir/file.html”,
- will be prepended with the current-directory depot path.
- If the referenced file exists
- in the depot at that path, you should be able to view it
- by clicking on the link.
- <p>
- <li>
- Relative-path links, suchs as
- “../../../index.html”,
- will be translated relative to the in-house intranet site, as specified
- in the configuration file (check with the P4DB Administrator
- for more information).
- If the file exists on the intranet at that path, you should
- be able to view the file.
- <i>Note:</i> Relative-link translation will only have a chance
- of resulting in a valid link when you are accessing the default P4 server.
- <p>
- <li>
- Fully qualifed links, such as
- “http://www.sitename.com/page.html”,
- are left unmodified and
- should work if the referenced site and page exist.
- </blockquote>
- </td>
- </tr>
- </table>
- </body>
- </html>
# | 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 |