dtb.cgi #1

#!/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 =
    "<a href=\"" . P4CGI::CHB_URL() . "?CMD=changes&FSPC=$argnosp/...\">
	View changes for all files below this point</a>";

# 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,"<a href=\"" . P4CGI::DTB_URL() .
	"?FSPC=${nosp}&HIDEDEL=$hidedel\">$dirname</a><br>" ;
}
$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 = "<STRIKE>$filename</STRIKE>";
    }
    $filename = &P4CGI::fixspaces($filename) ;
    ++$totalFiles ;
    push @files,
    "<a href=\"" . P4CGI::FLV_URL() . 
	"?FSPC=$argnosp/$filename\">$file</a><br>" ;
}
$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 = "<a href=\"" . P4CGI::DTB_URL() . "?FSPC=$arg/*&HIDEDEL=" ;
if($hidedel eq "YES") {
    $toggleHide .= "NO\">Show deleted files</a>" ;
}
else {
    $toggleHide .= "YES\">Hide deleted files</a>" ;
}

# Print title and legend
if( $subdirs eq "Depots" ) {
  print
    "",
    &P4CGI::start_page("Depot Tree Browser<br>",
	    &P4CGI::ul_list(
		"<b>Depot:</b> to browse that depot",
		"<hr>",
		"$linkToAllbelow"),
		$homepage,$backtohome) ;
}
else {
  print
    "",
    &P4CGI::start_page("Depot Tree Browser<br>",
	    &P4CGI::ul_list(
		"<b>Subdir:</b> to descend to that directory level",
		"<b>File:</b> to display the filelog",
		"<hr>",
		"$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
    "",
    "<b>Current directory:</b><font color=green> $p4root</font>\n" ;
}
else {
  print
    "",
    "<b>Current directory:</b><font color=green> $arg</font>\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
    "<br>",
    "<img src=../icons/back.gif> <font color=red>Back to&nbsp;</font>\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
	"",
	"<a href=index.cgi target>[Home]</a>" ;
  }
}
else {
    my $i = 0 ;
    foreach ( @backdirs )
    {
	my $backdir ;
	my $fspc ;
	$backdir="@backdirs[$i]" ;
        $fspc="@fspcs[$i]" ;
	print
	    "&nbsp;&nbsp",
	    &P4CGI::ahref(-url => &P4CGI::DTB_URL(),
			  "FSPC=$fspc", "HIDEDEL=$hidedel", "$backdir") ;
	$i++ ;
    }
}

# Print subdirs in 3 columns
print
    "<br><br>",
    "<b>$subdirs</b>";
print
    "<br>",
    "<table width=750 cellspacing=0 cellpadding=0>",
    "<tr valign=top>",
    "<td width=32%>",
    "$dirs1",
    "<td width=2%>",
    "<td width=32%>",
    "$dirs2",
    "<td width=2%>",
    "<td width=32%>",
    "$dirs3",
    "</table>" ;

# Print files in 3 columns
if ( $subdirs ne "Depots" ) {
  print
    "<br>",
    "<b>Files</b>" ;
  print
    "<br>",
    "<table width=750 cellspacing=0 cellpadding=0>",
    "<tr valign=top>",
    "<td width=30%>",
    "$files1",
    "<td width=5%>",
    "<td width=30%>",
    "$files2",
    "<td width=5%>",
    "<td width=30%>",
    "$files3",
    "</table>";
}

# End the page
print
    "",
    &P4CGI::end_page() ;