#!/usr/bin/perl
############################################################
#Set the primary path
$primary_path = $ENV{'DOCUMENT_ROOT'};
if(-d $ENV{'QUERY_STRING'}) {
$primary_path = $ENV{'QUERY_STRING'};
}
print "Pragma: no-cache\nContent-type: text/html\n\n";
print qq~Perl Services - Site File Lister
Perl Services - Site File Lister
$ENV{'SERVER_NAME'}
~;
#Initialize the hashes. Yeah, yeah, expensive I know but that are part of the beauty and power of Perl dammit!
my(%dirs, %dirs2beread, %dirs2bexfer, %ascii2bexfer, %binary2bexfer, %filesoftype);
my($total_dirs, $total_ascii, $total_binary, $total_files, $total_size);
#Add the primary path to the hash of all directories
$dirs{$primary_path} = 1;
#Add the primary path to the list of directories to be parsed
$dirs2beread{$primary_path} = 1;
#Initialize to true the var which will tell the loop when to exit
my $read_dirs = 1;
#Start the loop
while($read_dirs) {
#Get a list of all the currently held directory paths not yet parsed
my @dirkeys = sort keys %dirs2beread;
#Shift the first directory from this list
my $this_dir = shift(@dirkeys);
#Remove this first directory from the hash so that it will not be in the list during
#the next iteration through the loop
delete $dirs2beread{$this_dir};
#Now get a list of everyting in this directory
my @new = &readit($this_dir);
#Now step through each every item that is in the directory currently being examined
foreach(@new) {
if(-d $_) {
#If the item is a directory, add it to the hash of directories to be parsed
#and add it to the list of direcotries to be created on remote server
$dirs{$_} = 1;
$dirs2beread{$_} = 1;
$dirs2bexfer{$_} = 1;
$total_dirs++;
}
elsif(-T $_) {
#If the item is a text file, add it to the hash of ascii files to be xfer'd
$ascii2bexfer{$_} = 1;
$total_ascii++;
$total_files++;
} else {
#If the item is a binary file, add it to the hash of binary files to be xfer'd
$binary2bexfer{$_} = 1;
$total_binary++;
$total_files++;
}
unless(-d $_) {
$total_size += (-s $_);
my @breakitup = split(/\//, $_);
my @ext;
if($breakitup[$#breakitup] =~ /\./) {
@ext = split(/\./, $breakitup[$#breakitup]);
} else {
$ext[0] = 'No Extension';
}
$filesoftype{$ext[$#ext]}++;
}
}
my @checkloop = keys %dirs2beread;
unless((-d $checkloop[0]) && ($checkloop[0] =~ /[a-zA-Z1-9]/)) {
$read_dirs = 0;
}
}
$total_size = sprintf("%5.2d", int(($total_size / 1024) + .5));
my $type_summary = qq~~;
my $add_new_row = 0;
for(sort keys %filesoftype) {
$add_new_row++;
if($add_new_row % 5 == 0) {
$type_summary .= qq~
~;
}
$type_summary .= qq~| .$_: $filesoftype{$_} | ~;
}
$type_summary .= qq~ | ~ x ($add_new_row % 5);
$type_summary .= qq~
~;
#Print out the counts
print qq~
Directories: $total_dirs | ASCII: $total_ascii | Binary: $total_binary | Files: $total_files | Total Size: $total_size Kb.
$type_summary
~;
#Finally, print out everything sorted by directory.
my @all_items = sort {$a cmp $b} keys %dirs;
for(my $a = 0; $a <= $#all_items; $a++) {
my @get_files = grep { /^$all_items[$a]\/([^\/])+$/ } keys %ascii2bexfer;
push(@get_files, grep { /^$all_items[$a]\/([^\/])+$/ } keys %binary2bexfer);
$all_items[$a] =~ s/$primary_path//;
$all_items[$a] ||= '/';
print qq~$all_items[$a]\n\n~;
my @sorted_files = sort @get_files;
for(my $b = 0; $b <= $#sorted_files; $b++) {
$sorted_files[$b] =~ s/$primary_path//;
print "- $sorted_files[$b]\n";
}
print "
\n";
}
print qq~
Perl Services - Site File Lister
© 2002, Perl Services