- #!/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 =
- "<a href=\"" . P4CGI::CHB_URL() . "?CMD=changes&FSPC=//$arg/...\">View changes for all files below this point</a>";
- # * 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=<D> ;
- $filecnt=<D> ;
- # ** Set new error message (again, assume the worst)
- $errmsg = "Subdir //$arg not found!" ;
- # ** read until....
- while(<D>) {
- if(/^$arg;/) {
- # ** ...line for specified dir found
- # ** get information part (;-separated)
- my @tmp = split /;/,$_ ;
- shift @tmp ;
- # ** for each sub dir
- foreach (@tmp) {
- push @subdirs,"<a href=\"" . P4CGI::DTB_URL() .
- "?FSPC=$arg/$_&HIDEDEL=$hidedel\">$_/</A><BR>" ;
- }
- $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= "<STRIKE>$filename</STRIKE>";
- } ;
- push @files,
- "<a href=\"" . P4CGI::FLV_URL() .
- "?FSPC=//$arg/$filename\">$file</A>\#$rev - $inf<BR>" ;
- } ;
- # ** 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 .=
- "<font color=red> Data file update in progress.....</font>" ;
- }
- else {
- $fileAge .=
- "<blink><font color=red> Update of data file initiated!</font></blink>" ;
- system(P4CGI::DTB_UPDATE()." >>".P4CGI::DTB_DATAFILE()."log 2>&1 &") ;
- }
- }
- # ** bail if error
- if($errmsg) {
- &P4CGI::bail($errmsg) ;
- }
- 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>" ;
- }
- "",
- &P4CGI::start_page("Depot tree browser<br>//$arg",
- &P4CGI::ul_list("<b>Subdir</b> -- Descend to subdir",
- "<b>File</b> -- Show file log",
- "$linkToAllbelow",
- $toggleHide)) ;
- # ** create a "file found" flag and set it to NO
- my $fileFound = "N" ;
- "",
- &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
- "",
- &P4CGI::table_row("-valign","top",
- $subdirsC1,$subdirsC2,$filesC1,$filesC2),
- &P4CGI::end_table(),
- "<hr>" ;
- if($change == &P4CGI::CURRENT_CHANGE_LEVEL()) {
- print "Data file is up to date with latest changes" ;
- }
- else {
- "$fileAge <i>",
- "<br>(There were $filecnt files in depot and change level was $change)</i>\n" ;
- }
- "",
- &P4CGI::end_page() ;
- #
- # That's it folks
- #
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#1 | 5093 | Hari Krishna Dara |
Populating perforce branch. I will be adding p4admin files to it. |
20 years ago | |
//guest/perforce_software/utils/p4db/P4DB_0/dtb.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/dtb.cgi | |||||
#1 | 11 | Perforce maintenance | Add Fredric Fredricson's depot browser, P4DB. | 26 years ago |