#!/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() ;