#!/usr/bin/perl -w # -*- perl -*- use P4CGI ; use strict ; # ################################################################# # CONFIGURATION INFORMATION # All config info should be in P4CGI.pm # ################################################################# # # P4 depot tree browser # ################################################################# # * Get age of data file my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) = stat(P4CGI::DTB_DATAFILE() . "0"); my $age ; if(defined $mtime) { $age = time() - $mtime ; } else { $age = 0 ; } # * Create a "DD HH mm ss"-representation of age my $fileAgeSeconds = $age ; my $fileAgeDays = int($fileAgeSeconds / (3600*24)) ; $fileAgeSeconds -= $fileAgeDays*3600*24 ; my $fileAgeHours = int($fileAgeSeconds/3600) ; $fileAgeSeconds -= $fileAgeHours*3600 ; my $fileAgeMinutes = int($fileAgeSeconds/60) ; $fileAgeSeconds -= $fileAgeMinutes*60 ; my $fileAge = "Data file is " ; $fileAge .= "$fileAgeDays days " if $age > (3600*24) ; $fileAge .= "$fileAgeHours hours " if $age > 3600 ; $fileAge .= "$fileAgeMinutes minutes and " if $age > 60 ; $fileAge .= "$fileAgeSeconds seconds old" ; $fileAge = "NO DATAFILE FOUND" if $age == 0 ; # * Get path from argument my $arg = P4CGI::cgi()->param("FSPC") ; $arg = "depot" unless defined $arg ; # * 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 $linkToAllbelow = "View changes for all files below this point"; # * Some variables... my @subdirs ; # directories information (from data file) my @files ; # files information my $change = 0; # change No. when data file was created my $filecnt ; # files in depot when data file was created my $errmsg= "ERROR Can not open local file " . P4CGI::DTB_DATAFILE() . ".*" ; # error message string (assume the worst) # ** open data file local *D ; my $filename = P4CGI::DTB_DATAFILE() . (length($arg) % P4CGI::DTB_FILESPLIT()) ; open(D,"<$filename") && do { # ** Get change and file count $change= ; $filecnt= ; # ** Set new error message (again, assume the worst) $errmsg = "Subdir //$arg not found!" ; # ** read until.... while() { if(/^$arg;/) { # ** ...line for specified dir found # ** get information part (;-separated) my @tmp = split /;/,$_ ; shift @tmp ; # ** for each sub dir foreach (@tmp) { push @subdirs,"$_/
" ; } $errmsg = "" ; # ** skip rest of data file (we got what we wanted) last ; } } # ** close file close D ; # ** Get files for specified dir my @tmp ; &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"; } ; push @files, "$file\#$rev - $inf
" ; } ; # ** Clear error message $errmsg = "" ; } ; # Check if data file update is required or in progress if($age == 0 or ((P4CGI::CURRENT_CHANGE_LEVEL() != $change) and ($age > 600))) { if(P4CGI::valid_lockfile(P4CGI::DTB_LOCKFILE())) { $fileAge .= " Data file update in progress....." ; } else { $fileAge .= " Update of data file initiated!" ; system(P4CGI::DTB_UPDATE()." >>".P4CGI::DTB_DATAFILE()."log 2>&1 &") ; } } # ** bail if error if($errmsg) { &P4CGI::bail($errmsg) ; } my $toggleHide = "Show deleted files" ; } else { $toggleHide .= "YES\">Hide deleted files" ; } print "", &P4CGI::start_page("Depot tree browser
//$arg", &P4CGI::ul_list("Subdir -- Descend to subdir", "File -- Show file log", "$linkToAllbelow", $toggleHide)) ; # ** create a "file found" flag and set it to NO my $fileFound = "N" ; print "", &P4CGI::start_table(""), &P4CGI::table_row("-type","th", "-align","left", undef,"Subdirs",undef,"Files") ; # ** Create 1 or 2 colums for subdirs my $subdirsC1 ; my $subdirsC2 ; if(@subdirs > 30) { my $all = scalar(@subdirs) ; my $half = int($all/2) ; $subdirsC1 = join("\n",@subdirs[0..$half]) ; $subdirsC2 = join("\n",@subdirs[$half+1..$all]) ; } else { $subdirsC2 = join("\n",@subdirs) ; } # ** Create 1 or 2 colums for files my $filesC1 ; my $filesC2 ; if(@files > 30) { my $half = @files/2 ; $filesC1 = join("\n",@files[0..$half]) ; $filesC2 = join("\n",@files[$half+1..@files]) ; } else { $filesC2 = join("\n",@files) ; } # ** print data print "", &P4CGI::table_row("-valign","top", $subdirsC1,$subdirsC2,$filesC1,$filesC2), &P4CGI::end_table(), "
" ; if($change == &P4CGI::CURRENT_CHANGE_LEVEL()) { print "Data file is up to date with latest changes" ; } else { print "$fileAge    ", "
(There were $filecnt files in depot and change level was $change)
\n" ; } print "", &P4CGI::end_page() ; # # That's it folks #