Here is a sample, i want customize it according to my needs.
#!/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~<HEAD><TITLE>Perl Services - Site File Lister</TITLE></HEAD>
<BODY BGCOLOR="#F9F9F9" TEXT="#000080" LINK="ROYALBLUE" ALINK="ROYALBL
+UE" VLINK="ROYALBLUE">
<font face="verdana" size=2 color="#000080">
<center><B>Perl Services - Site File Lister</B><BR>$ENV{'SERVER_NAME'}
+<BR><BR>
~;
#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 pars
+ed
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 current
+ly being examined
foreach(@new) {
if(-d $_) {
#If the item is a directory, add it to the hash of directo
+ries to be parsed
#and add it to the list of direcotries to be created on re
+mote 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 f
+iles to be xfer'd
$ascii2bexfer{$_} = 1;
$total_ascii++;
$total_files++;
} else {
#If the item is a binary file, add it to the hash of binar
+y 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~<table border=0 cellspacing=0 cellpadding=5 styl
+e="font-family:verdana;font-size:12px;"><tr>~;
my $add_new_row = 0;
for(sort keys %filesoftype) {
$add_new_row++;
if($add_new_row % 5 == 0) {
$type_summary .= qq~</tr><tr>~;
}
$type_summary .= qq~<td><B>.$_:</B> $filesoftype{$_}</td>~;
}
$type_summary .= qq~<td> </td>~ x ($add_new_row % 5);
$type_summary .= qq~</tr></table>~;
#Print out the counts
print qq~
<B>Directories:</B> $total_dirs | <B>ASCII:</B> $total_ascii | <B>Bina
+ry:</B> $total_binary | <B>Files:</B> $total_files | <B>Total Size:</
+B> $total_size Kb.
<BR><BR>$type_summary
</center><BR><BR><BR>
~;
#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 %ascii2
+bexfer;
push(@get_files, grep { /^$all_items[$a]\/([^\/])+$/ } keys %binar
+y2bexfer);
$all_items[$a] =~ s/$primary_path//;
$all_items[$a] ||= '/';
print qq~<LI><B>$all_items[$a]</B>\n<OL>\n~;
my @sorted_files = sort @get_files;
for(my $b = 0; $b <= $#sorted_files; $b++) {
$sorted_files[$b] =~ s/$primary_path//;
print "<LI>$sorted_files[$b]\n";
}
print "</OL>\n";
}
print qq~
<HR SIZE=5><BR><BR>
<CENTER><A HREF="http://www.perlservices.net/en/programs/site_file_lis
+ter/index.shtml" TARGET="_blank">Perl Services - Site File Lister</A>
<BR><BR>© 2002, <A HREF="http://www.perlservices.net" TARGET="_bl
+ank">Perl Services</A></CENTER><BR>
</FONT></BODY></HTML>
~;
sub readit {
my $path = shift;
opendir(READ, $path);
my @temp = readdir(READ);
closedir READ;
my @temp2;
foreach(@temp) {
unless(($_ eq '.') || ($_ eq '..')) {
push(@temp2, "$path/$_");
}
}
return(@temp2);
}
|