- #!/usr/bin/perl -w
- # -*- perl -*-
- use P4CGI ;
- use strict ;
- #
- #################################################################
- # CONFIGURATION INFORMATION
- # All config info should be in P4CGI.pm
- #
- #################################################################
- #
- # P4 file viewer
- # View a file
- #
- #################################################################
- # 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>
- # Other than the TYPE parameter mentioned above the file name (depot format) will
- # be sent as FILE parameter and file revision as REV parameter.
- #
- my %specialext = (
- html => &P4CGI::SFV_URL() . ";HTML;View html file using browser",
- htm => &P4CGI::SFV_URL() . ";HTML;View html file using browser",
- HTML => &P4CGI::SFV_URL() . ";HTML;View html file using browser",
- HTM => &P4CGI::SFV_URL() . ";HTML;View html file using browser",
- gif => &P4CGI::SFV_URL() . ";GIF;View gif picture using browser",
- GIF => &P4CGI::SFV_URL() . ";GIF;View gif picture using browser",
- jpeg => &P4CGI::SFV_URL() . ";JPEG;View jpeg picture using browser",
- JPEG => &P4CGI::SFV_URL() . ";JPEG;View jpeg picture using browser",
- jpg => &P4CGI::SFV_URL() . ";JPEG;View jpeg picture using browser",
- JPG => &P4CGI::SFV_URL() . ";JPEG;View jpeg picture using browser"
- ) ;
- # Get file spec argument
- my $file = P4CGI::cgi()->param("FSPC") ;
- &P4CGI::bail("No file specified") unless defined $file ;
- my $ext = $file ;
- $ext =~ s/^.*\.// ;
- my $revision = P4CGI::cgi()->param("REV") ;
- &P4CGI::bail("No revision specified") unless defined $revision ;
- # find out if p4br.perl is available, if true set smart
- local *P4 ;
- my $smart;
- my ( $name, $rev, $type ) ;
- if(-x "p4pr.perl") {
- open(P4,"./p4pr.perl $file\#$revision |") or
- &P4CGI::bail("Can't start p4pr!!!!. too bad!") ;
- $smart="Yes";
- # Get header line
- # line author/branch change rev //depot/main/jam/Jamfile#39 - edit change 1749 (text)
- $_ = <P4>;
- /^\s+\S+\s+\S+\s+\S+\s+\S+\s+(\S+)\#(\d+) - \S+ \S+ \S+ \((\w+)\)/ or
- &P4CGI::bail("\"$_\"<BR>Path $ENV{PATH}<BR> $< $>") ;
- ( $name, $rev, $type ) = ($1,$2,$3) ;
- $_ = <P4>;
- }
- else {
- &P4CGI::p4call( *P4, "print $file#$revision" );
- $smart="No, stupid." ;
- # Get header line
- # //depot/main/jam/Jamfile#39 - edit change 1749 (text)
- $_ = <P4>;
- /^(\S+)\#(\d+) - \S+ \S+ \S+ \((\w+)\)/;
- ( $name, $rev, $type ) = ($1,$2,$3) ;
- }
- my $legend = "" ;
- if($smart eq "Yes") {
- $legend =
- &P4CGI::ul_list("<b>Change number</b> -- see the change description",
- "<b>Revision number</b> -- see diff at selected revision") ;
- }
- if(defined $specialext{$ext}) {
- my ($url,$type,$desc) = split(/;/,$specialext{$ext}) ;
- $legend .= &P4CGI::ahref(-url => $url,
- "TYPE=$type",
- "FSPC=$file",
- "REV=$rev",
- "$desc") ;
- }
- "",
- &P4CGI::start_page("File<br><code>$file\#$rev</code>",$legend) ;
- if( $type eq "binary" || $type eq "xbinary" )
- {
- print "<h2>$type</h2>\n";
- }
- else
- {
- print "Type: $type<br>\n<pre>\n";
- if($smart eq "Yes"){
- my ($line,$authorBranch,$change,$rev,$line) ;
- print " Ch. Rev\n";
- my $oldch=-1;
- while( <P4> ) {
- $_ = &P4CGI::fixSpecChar($_) ;
- ($line,$authorBranch,$change,$rev,$line) =
- m/^\s+(\d+)\s+(\S+)\s+(\d+)\s+(\d+) (.*)$/ ;
- my($chstr,$revstr)=(" "," ");
- if($oldch != $change){
- $chstr=
- substr(" ",0,5-length("$change")) .
- &P4CGI::ahref("-url",&P4CGI::CHV_URL(),
- "CH=$change",
- "$change") ;
- $revstr =
- substr(" ",0,3-length("$rev")) .
- &P4CGI::ahref("-url",&P4CGI::FDV_URL(),
- "FSPC=$name","REV=$rev","ACT=edit",
- "$rev");
- }
- $oldch= $change ;
- print "$chstr$revstr <font color=red>|</font>$line\n" ;
- }
- }
- else {
- while( <P4> ) {
- "",
- &P4CGI::fixSpecChar($_) ;
- }
- }
- print "</pre>\n";
- }
- close P4;
- "",
- &P4CGI::end_page() ;
- #
- # That's it folks
- #
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#1 | 1985 | Sean Nolan | my initial branch | 22 years ago | |
//guest/perforce_software/utils/p4db/P4DB_0/fv.cgi | |||||
#1 | 1885 | rmg | For posterity: Make the old version appear in a "P4DB_0" subdirectory. (I'd have called i...t 0.99, but I'm not sure it really *is* 0.99!) « |
23 years ago | |
//guest/perforce_software/utils/p4db/fv.cgi | |||||
#1 | 11 | Perforce maintenance | Add Fredric Fredricson's depot browser, P4DB. | 26 years ago |