#!/usr/local/bin/perl5
# -*- perl -*-
use P4CGI ;
use strict ;
#
#####################################################################
##
## CONFIGURATION INFORMATION
## All config info should be in $configFile (see init() in P4CGI.pm)
##
#####################################################################
##
## Depot Tree Browser
##
#####################################################################
# Set back references
my $homepage="index.cgi";
my $backtohome="Back to Home" ;
# Get path argument from filespec
my $arg = P4CGI::cgi()->param("FSPC") ;
# See if we were called from the index.cgi
my $index = P4CGI::cgi()->param("NDX") ;
# Make arg (FSPC) palatable, unless we were called from index.cgi
if( $index ) { $arg = "/" ; }
else { $arg =~ s|/\*$|| ; }
# Get the user's port (for cookiestuff)
my $p4port = &P4CGI::USER_P4PORT() ;
# Set when accessing a multi-depot server
my $p4root ;
# Get HIDEDEL argument (Hide deleted files)
my $hidedel = P4CGI::cgi()->param("HIDEDEL") ;
$hidedel = "NO" unless defined $hidedel ;
$hidedel = "YES" unless $hidedel eq "NO" ;
# Create link to changes for all files below
my $argnosp ;
if( $index ) { $argnosp = "/" ; }
else { $argnosp = &P4CGI::fixspaces($arg) ; }
# Legend option to see changes for files
my $linkToAllbelow =
"
View changes for all files below this point";
# Some variables...
## Directories printout information
my $dirsRemainder ;
my $dirsPerColumn ;
my $dirsColumn1 ;
my $dirsColumn2 ;
my $dirsColumn3 ;
my $dirs1 ;
my $dirs2 ;
my $dirs3 ;
my $totalDirs ;
my @subdirs ;
## Files printout information
my $filesRemainder ;
my $filesPerColumn ;
my $filesColumn1 ;
my $filesColumn2 ;
my $filesColumn3 ;
my $totalFiles ;
my $files1 ;
my $files2 ;
my $files3 ;
my @files ;
# "Subdirs"/"Depots"
my $subdirs ;
# Are we multi-depot, coming back up the tree?
if( $argnosp eq "/" && ! $index ) { $subdirs = "Depots" ; }
# Read dirs
my $treetop ;
my @tmp ;
&P4CGI::p4call( \@tmp, "dirs \"$arg/*\" 2>/dev/null") ;
# If we were called from index.cgi, then we're at the top of the repository...
if ( $index ) {
# If there's only one depot, don't make the user go thru it, do it for them
# (which puts $arg to the depot name and sends us back thru normally)...
if ( scalar(@tmp) == 1 ) {
$arg = $tmp[0] ;
&P4CGI::p4call( \@tmp, "dirs \"$arg/*\" 2>/dev/null") ;
}
# Else, we have more than one depot for this server
else {
# Set cookie to note this a multi-depot server
my $state_addr = "TRUE" . "-" . $p4port ;
my $cookie="MULTI_DEPOT=$state_addr" ;
&P4CGI::set_cookie($cookie) ;
# Set subdirs, treetop, p4root
$subdirs = "Depots" ;
$treetop = $arg ;
$p4root = "[P4ROOT]" ;
}
}
# Else, we were called from dtb.cgi (from a subdir or one of multi depots), so
# find the top of this depot (for going back up it, with Back-to)
else {
$arg =~ /^(\/\/\w+)\// ;
$treetop = $1 ;
}
# If all else fails, just set things normally...
$treetop = $arg unless defined $treetop ;
$subdirs = "Subdirs" unless defined $subdirs ;
my $dir ;
foreach $dir (@tmp) {
my $nosp = &P4CGI::fixspaces($dir) ;
my $dirname ;
if ( $subdirs eq "Depots" ) {
($dirname = $dir) ;
}
else {
if( !defined $index && $arg eq "/" ) {
$dirname = $dir ;
}
else {
($dirname = $dir) =~ s/^.*\/// ;
$dirname .= "/" ;
}
}
++$totalDirs ;
push @subdirs,"$dirname
" ;
}
$dirsPerColumn = $totalDirs / 3 ;
$dirsRemainder = $totalDirs % 3 ;
if ( $dirsRemainder ) {
$dirsColumn1 = $dirsPerColumn + 1 ;
$dirsColumn2 = $dirsPerColumn + 1 ;
$dirsColumn3 = $dirsPerColumn ;
}
else {
$dirsColumn1 = $dirsPerColumn ;
$dirsColumn2 = $dirsPerColumn ;
$dirsColumn3 = $dirsPerColumn ;
}
# Read files
&P4CGI::p4call( \@tmp, "files \"$arg/*\" 2>/dev/null") ;
foreach (@tmp) {
/([^\#]+)\#(.*)/ ;
my $filename=$1 ;
my $info=$2 ;
$filename =~ s|^.*/|| ;
my ($rev,$inf) = split / - /,$info ;
my $file = $filename ;
if($inf =~ /delete/) {
if($hidedel eq "YES") { next ; }
$file = "$filename";
}
$filename = &P4CGI::fixspaces($filename) ;
++$totalFiles ;
push @files,
"$file
" ;
}
$filesPerColumn = $totalFiles / 3 ;
$filesRemainder = $totalFiles % 3 ;
if ( $filesRemainder ) {
$filesColumn1 = $filesPerColumn + 1 ;
$filesColumn2 = $filesPerColumn + 1 ;
$filesColumn3 = $filesPerColumn ;
}
else {
$filesColumn1 = $filesPerColumn ;
$filesColumn2 = $filesPerColumn ;
$filesColumn3 = $filesPerColumn ;
}
my $toggleHide = "Show deleted files" ;
}
else {
$toggleHide .= "YES\">Hide deleted files" ;
}
# Print title and legend
if( $subdirs eq "Depots" ) {
print
"",
&P4CGI::start_page("Depot Tree Browser
",
&P4CGI::ul_list(
"Depot: to browse that depot",
"
",
"$linkToAllbelow"),
$homepage,$backtohome) ;
}
else {
print
"",
&P4CGI::start_page("Depot Tree Browser
",
&P4CGI::ul_list(
"Subdir: to descend to that directory level",
"File: to display the filelog",
"
",
"$linkToAllbelow",
$toggleHide),
$homepage,$backtohome) ;
}
# Determine what to print for subdirs
my @tmpdirs1 ;
my @tmpdirs2 ;
my @tmpdirs3 ;
if(@subdirs) {
@tmpdirs1 = splice(@subdirs,0,$dirsColumn1) ;
@tmpdirs2 = splice(@subdirs,0,$dirsColumn2) ;
@tmpdirs3 = splice(@subdirs,0,$dirsColumn3) ;
}
if( @tmpdirs1 ) {
$dirs1 = join("\n",@tmpdirs1) ;
}
else {
$dirs1 = "[No more subdirectories]\n" ;
}
if( @tmpdirs2 ) {
$dirs2 = join("\n",@tmpdirs2) ;
}
if( @tmpdirs3 ) {
$dirs3 = join("\n",@tmpdirs3) ;
}
# Determine what to print for Files
my @tmpfiles1 ;
my @tmpfiles2 ;
my @tmpfiles3 ;
if(@files) {
@tmpfiles1 = splice(@files,0,$filesColumn1) ;
@tmpfiles2 = splice(@files,0,$filesColumn2) ;
@tmpfiles3 = splice(@files,0,$filesColumn3) ;
}
if( @tmpfiles1 ) {
$files1 = join("\n",@tmpfiles1) ;
}
else {
$files1 = "[No files in this directory]\n" ;
}
if( @tmpfiles2 ) {
$files2 = join("\n",@tmpfiles2) ;
}
if( @tmpfiles3 ) {
$files3 = join("\n",@tmpfiles3) ;
}
# Find out if this repository has multiple depots (look in the cookie jar :)
#
# Load IPaddr/host:port cookie pairs into lookup table
my %chkdepot ;
my ($key,$val,$state,$port) ;
my @cookies = split( /; /, $ENV{HTTP_COOKIE} ) ;
foreach( @cookies ) {
($key, $val) = split( /=/, $_ ) ;
if( $key eq "MULTI_DEPOT" ) {
($state,$port) = split( /-/, $val ) ;
$chkdepot{$port} = $state ;
}
}
# See if they have a cookie...
if( defined $chkdepot{$p4port} ) {
$p4root = "[P4ROOT]" ;
}
# Print CWD
if ( defined $p4root && $arg eq "/" ) {
print
"",
"Current directory: $p4root\n" ;
}
else {
print
"",
"Current directory: $arg\n" ;
}
# Climb back up the tree
#
# Create filespecs to previous directory(s) and attach to path element(s).
# Will print out (e.g.):
# Back to //depot /main /docs /intranet
# and allow you to click on any element to return to that directory directly
# (no climbing back a previous directory at a time -- jump all the way to the
# depot root if you want to.
#
my @backdirs ;
my @backtmp ;
my @fspcs ;
my @fspctmp ;
my $prevdir ;
my $prevdirnosp ;
my $notfirst ;
my $backup = $arg ;
until ( $backup eq $treetop )
{
my $partial ;
$backup =~ /(.*)(\/.*)/ ;
$prevdir = "$1" ;
if( $notfirst ) { $partial = "$2" ; } #skip first time; we're already there
push( @backtmp, $partial ) ;
$prevdirnosp=&P4CGI::fixspaces($prevdir) ;
push( @fspctmp, $prevdirnosp ) ;
$backup = $prevdir ;
$notfirst = 1 ;
}
push( @backtmp, $prevdir ) ;
if ( defined $p4root ) {
push( @fspctmp, "/" ) ;
push( @backtmp, "[P4ROOT]" ) ;
}
@backdirs = reverse( @backtmp ) ;
@fspcs = reverse( @fspctmp ) ;
# Print them out
my $printed = 0 ;
print
"
",
" Back to \n" ;
if ( $p4root && $arg =~ /^\/\/\w+$/ ) {
print
"",
&P4CGI::ahref( -url => &P4CGI::DTB_URL(),
"FSPC=/", "$p4root") ;
$printed = 1 ;
}
if ( $arg eq $treetop || ( ($p4root) && ($arg eq "/") ) ) {
if ( $printed == 0 ) {
print
"",
"[Home]" ;
}
}
else {
my $i = 0 ;
foreach ( @backdirs )
{
my $backdir ;
my $fspc ;
$backdir="@backdirs[$i]" ;
$fspc="@fspcs[$i]" ;
print
"  ",
&P4CGI::ahref(-url => &P4CGI::DTB_URL(),
"FSPC=$fspc", "HIDEDEL=$hidedel", "$backdir") ;
$i++ ;
}
}
# Print subdirs in 3 columns
print
"
",
"$subdirs";
print
"
",
"",
"",
"",
"$dirs1",
" | ",
" | ",
"$dirs2",
" | ",
" | ",
"$dirs3",
" |
" ;
# Print files in 3 columns
if ( $subdirs ne "Depots" ) {
print
"
",
"Files" ;
print
"
",
"",
"",
"",
"$files1",
" | ",
" | ",
"$files2",
" | ",
" | ",
"$files3",
" |
";
}
# End the page
print
"",
&P4CGI::end_page() ;