Generated: Tue Feb 2 17:54:58 2010 from testfish.pl 2009/03/11 13.3 KB.
#!/usr/bin/perl #BEGIN{unshift @INC, "/tmp"} # can be replaced with the more elegant: #use lib "/tmp"; use lib "C:\\GTools\\perl"; use strict; use Cwd; use File::stat; use Fish; # <<-- your new class/module #--------------------------------------------- my $start_time = time(); my $program = 'testfish.pl'; my @in_files; # list of input folders my $verbose = 0; my $verb2 = 0; my $cwdir = getcwd(); my $block = 512; my $dbg = 0; my $shwtm = 1; my $fullname = 0; my $actdir; my @m_rows; my @m_row2; my $out_name = 'tempdgp1.htm'; my $in_file; my $tot = 0; my $tot_dirs = 0; my $tot_files = 0; my $g_tot_dirs = 0; my $g_tot_files = 0; my $msg; my $hdrs = ""; my $tab_width = 600; my $row_count; my @colors = qw(red blue green yellow orange purple violet); for my $name (@colors) { no strict 'refs'; # allow symbol table manipulation *$name = *{uc $name} = sub { "<FONT COLOR='$name'>@_</FONT>" }; } my $show = 1; my $fish_obj = Fish->new(); # set your favorite fish $fish_obj->favorite("Kuhli Loach"); print "Fish Chart:\n"; for my $fish ( sort $fish_obj->family ) { printf "%15s --> %s\n", $fish, $fish_obj->size($fish); # keep track of last fish seen here $fish_obj->current_fish($fish); } print "The last fish family I saw was ", $fish_obj->current_fish, ".\n"; # try to reset the "writeonce" favorite $fish_obj->favorite("7 Gill Shark"); print "My favorite fish is still the ", $fish_obj->favorite, ".\n"; if ($show) { print "Got " . scalar @INC . " in global include variable ...\n"; foreach my $i (@INC) { if ($i eq ".") { print "$cwdir (current work directory)\n"; } else { print "$i\n" } } print "Done " . scalar @INC . " items ...\n"; exit(0); } parse_arguments(@ARGV); print "$program: Started on " . localtime($start_time) . " in $cwdir ...\n" if $shwtm; die "$program: no input files found or specified\n" if ! @in_files; # show count in the array ... #print ("Processing " . $#in_files + 1 . " directories ...\n") if $verbose; print ("Processing " . scalar @in_files . " directories ...\n") if $verbose; foreach $in_file (@in_files) { $actdir = retfulldir($in_file); if (length($hdrs)) { $hdrs .= "|"; } $hdrs .= $actdir; print ("Processing [$in_file], as [$actdir] ... moment ...\n") if ($in_file ne $actdir); $tot += do_user_dir($actdir); } print "Totals: $tot bytes, in $g_tot_dirs folders, $g_tot_files files ...\n"; #print "$program: Got ". red($tot) . " bytes, in $tot_dirs folders, $tot_files files ...\n"; die "No table rows to write to $out_name ...\n" if ! @m_rows; # set header line $msg = ("Totals|$tot|$g_tot_dirs|$g_tot_files"); push(@m_rows,$msg); # establish total line @m_row2 = @m_rows; # COPY rows accumulated $row_count = scalar @m_rows; writeHTML(); print "$program: Ended on " . localtime(time()) . ".\n" if $shwtm; # system $package; # load html results system $out_name; # start HTML file print "Results written to $out_name ...\n"; 0; sub writeHTML { # write HTML file print "Creating $out_name, with table of $row_count rows ...\n" if $verbose; open(DSP, ">$out_name") || die "Can not create $out_name: $!\n"; #html_head(\*DSP, $hdrs); html_head2(\*DSP, $hdrs); writeGraph(\*DSP); print DSP "<p>\n"; #print DSP "<TABLE>\n"; #print DSP "<TABLE class=sbfixed border=\"1\" width=\"" . $tab_width . "\">\n"; print DSP "<TABLE class=sbfixed border=\"1\">\n"; print DSP "<TR><TD><b>Folders</b></TD><TD><b>Bytes</b></TD><TD><b>Dirs</b></TD><TD><b>Files</b></TD></TR>\n"; my $rcnt = 0; my $ccnt = 0; foreach $msg (@m_rows) { $rcnt++; # print DSP "$msg<BR>\n"; print DSP "<TR>\n"; $ccnt = 0; my (@mcols) = split( /\|/, $msg); foreach my $col (@mcols) { if($rcnt == $row_count) { # ***LAST ROW*** if ($ccnt) { # is column 1++ if ($ccnt == 1) { $msg = addcolmr( addbold( b2ks1($col) ) ); } else { $msg = addcolmr( addbold( get_nn($col) ) ); } } else { # first column #print DSP "<TD><b>$col</b></TD>\n" $msg = addcolm( addbold($col) ); } } else { if ($ccnt) { if ($ccnt == 1 ) { $msg = addcolmr( b2ks1($col) ); } else { $msg = addcolmr( get_nn($col) ); } } else { $msg = addcolm( $col ); } } print DSP "$msg\n"; # shove it out the the HTML file $ccnt++; } print DSP "</TR>\n"; } print DSP "</TABLE>\n"; print DSP "</p>\n"; html_tail(\*DSP); close(DSP); } sub writeGraph { my ($fh) = @_; print $fh "<p>\n"; #print $fh "<TABLE>\n"; #print $fh "<TABLE class=sbfixed border=\"1\" width=\"" . $tab_width . "\">\n"; print $fh "<TABLE class=sbfixed border=\"1\">\n"; print $fh "<TR><TD><b>Graph</b></TD></TR>\n"; my $rcnt = 0; my $ccnt = 0; foreach $msg (@m_row2) { $rcnt++; # print $fh "$msg<BR>\n"; print $fh "<TR>\n"; $ccnt = 0; my (@mcols) = split( /\|/, $msg); foreach my $col (@mcols) { if($rcnt == $row_count) { # ***LAST ROW*** if ($ccnt) { # is column 1++ if ($ccnt == 1) { #$msg = addcolmr( addbold( b2ks1($col) ) ); $msg = addcolmr( addbold( get_nn($col) ) ); #} else { # $msg = addcolmr( addbold( get_nn($col) ) ); } #} else { # first column #print $fh "<TD><b>$col</b></TD>\n" # $msg = addcolm( addbold($col) ); } } else { if ($ccnt) { if ($ccnt == 1 ) { $msg = addcolmr( get_nn($col) ); #} else { # $msg = addcolmr( get_nn($col) ); } #} else { # $msg = addcolm( $col ); } } if ($ccnt == 1 ) { print $fh "$msg\n"; # shove it out the the HTML file } $ccnt++; } print $fh "</TR>\n"; } print $fh "</TABLE>\n"; print $fh "</p>\n"; } sub do_user_dir { my $dir = shift; print "Processing folder [$dir] ...\n" if $verbose; opendir(THEDIR, $dir) || die("Couldn't open [$dir] directory\n"); my @files = readdir(THEDIR); closedir(THEDIR); my $tsz = 0; print "Found " . scalar(@files) . " files and folders ...\n" if $verbose; my @dir_list; foreach my $dfile (@files) { my $df = $dir . '/' . $dfile; # get full name my $sb = stat($df); if ( -d $df ) { # if ($dfile eq '.' || $dfile eq '..') or if ($dfile =~ '^\.$' || $dfile =~ '^\.\.$') { # do nothing with DOT and DOUBLE DOT } else { push(@dir_list, $df); # save DIRECTORY print "$dfile <DIR> [$df]\n" if $verb2; if ($dbg) { printf "Folder is %s, size is %s, perm %04o, mtime %s\n", $dfile, $sb->size, $sb->mode & 07777, scalar localtime $sb->mtime; } $tot_dirs++; # tsz += $block; } } else { print "$dfile full [$df]\n" if $verb2; if ($dbg) { printf "File is %s, size is %s, perm %04o, mtime %s\n", $dfile, $sb->size, $sb->mode & 07777, scalar localtime $sb->mtime; } $tot_files++; $tsz += $sb->size; } } if ($fullname) { $msg = ("$dir is $tsz bytes ... done " . scalar @files . " files ($tot_files) and folders ($tot_dirs)..." ); } else { $msg = ( subactdir($dir) . " is $tsz bytes ... done " . scalar @files . " files ($tot_files) and folders ($tot_dirs)..." ); } print "$msg\n"; $g_tot_files = $tot_files; $g_tot_dirs = $tot_dirs; $msg = "$actdir|$tsz|$g_tot_dirs|$g_tot_files"; push(@m_rows,$msg); # have DONE root, now process each folder foreach $dir (@dir_list) { $tot_files = 0; $tot_dirs = 0; $tsz += do_sub_dir($dir,1); $g_tot_files += $tot_files; $g_tot_dirs += $tot_dirs; } return $tsz; } sub do_sub_dir { my ($dir,$level) = @_; if ($level == 1) { print ("Processing sub-folder [$dir] ... level $level\n") if $verb2; } opendir(THEDIR, $dir) || die("Couldn't open [$dir] directory\n"); my @files = readdir(THEDIR); closedir(THEDIR); my $tsz = 0; my $hdr = ""; for (my $i = 0; $i < $level ; $i++ ) { $hdr .= " "; } print ($hdr . "Found " . scalar(@files) . " files and folders ... (l=$level)\n") if $verb2; foreach my $dfile (@files) { my $df = $dir . '/' . $dfile; # get full name my $sb = stat($df); if ( -d $df ) { # if ($dfile eq '.' || $dfile eq '..') or if ($dfile =~ '^\.$' || $dfile =~ '^\.\.$') { # do nothing with DOT and DOUBLE DOT } else { print ($hdr . "$dfile <DIR> [$df]\n") if $verb2; if ($dbg) { printf "Folder is %s, size is %s, perm %04o, mtime %s\n", $dfile, $sb->size, $sb->mode & 07777, scalar localtime $sb->mtime; } $tsz += do_sub_dir($df,($level+1)); } $tot_dirs++; # count folders, and recurse into, except '.' & '..' ;=)) } else { print ($hdr . "$dfile full [$df]\n" ) if $verb2; if ($dbg) { printf "File is %s, size is %s, perm %04o, mtime %s\n", $dfile, $sb->size, $sb->mode & 07777, scalar localtime $sb->mtime; } $tot_files++; $tsz += $sb->size; } } if ($level == 1) { if ($fullname) { $msg = ("$dir is $tsz bytes ... done " . scalar @files . " files ($tot_files) and folders ($tot_dirs)..." ); } else { $msg = (subactdir($dir) . " is $tsz bytes ... done " . scalar @files . " files ($tot_files) and folders ($tot_dirs)..." ); } print "$msg\n" if $verbose; # print addbold($msg). "\n" if $verbose; $msg = (subactdir($dir) . "|${tsz}|$tot_dirs|$tot_files"); push(@m_rows,$msg); } return $tsz; } sub parse_arguments { my @av = @_; # take it off the passed stack while (@av) { if ($av[0] eq '-version') { print "Version 0.0.1\n"; } elsif ($av[0] eq '-verbose' || $av[0] eq '-v') { print "Setting verbose ...\n"; $verbose = 1; } elsif ($av[0] eq '-debug') { print "Setting debug output ...\n"; $dbg = 1; } elsif ($av[0] eq '-v2') { print "Setting verb2 ...\n"; $verb2 = 1; } elsif ($av[0] =~ /^-/) { die "$program: unrecognised option? `$av[0]'\nOnly -version, -verbose input_folders ...\n"; } else { print "Storing argument [$av[0]].\n"; push(@in_files, $av[0]); } shift @av; # move to next argument to [0] } if ( ! @in_files ) { print "WARNING: No folder argument found ...\n"; print "Using current work directory $cwdir ...\n"; push(@in_files, ".") # default to current folder } } sub dirname { # passed a path, './dir1/dir2/file.name' returns './dir1/dir2/ my ($file) = @_; my ($sub); ($sub = $file) =~ s,/+[^/]+$,,g; $sub = '.' if $sub eq $file; return $sub; } sub retfulldir { my ($d) = @_; if ($d =~ '^\.$') { $d = $cwdir; # set CURRENT WORK DIRECTORY } elsif ( $d =~ '^\.\.$') { $d = dirname( $cwdir ); # back up one ... } return $d; } sub subactdir { my ($d) = @_; my ($nd); #my $s = "s,^\$actdir,,"; #print ("rem $actdir frm $d use $s\n"); #($nd = $d) =~ s,^C:/GTools/perl,,; # ok #($nd = $d) =~ $s; # fails??? ($nd = $d) =~ s,^$actdir,,; if (length($nd) == 0) { $nd = $actdir; } else { $nd =~ s,^/,,; } # $nd = 'root' if length $nd == 0; return $nd; } sub addbold { return( "<B>@_</B>" ); } sub addcolm { return( " <TD>@_</TD>" ); } sub addcolmr { # string tdr = " <TD align=\"right\">"MEOS; return( " <TD align=\"right\">@_</TD>" ); } sub html_head { my ($fh, $hdr) = @_; print $fh <<"EOF"; <html> <head> <title>$hdr</title> </head> <body> <h1 align="center">$hdr</h1> EOF } sub html_head2 { my ($os, $hdr) = @_; print $os "<HTML>\n"; print $os "<!-- title " . $hdr . " -->\n"; print $os "<HEAD>\n"; print $os "<title>" . $hdr . "</title>\n"; print $os "<STYLE>\n"; print $os "BODY.blueform\n"; print $os "{\n"; print $os " BORDER-RIGHT: #4169e1 double;\n"; print $os " PADDING-RIGHT: 2px;\n"; print $os " BORDER-TOP: #4169e1 double;\n"; print $os " PADDING-LEFT: 2px;\n"; print $os " PADDING-BOTTOM: 2px;\n"; print $os " MARGIN: 3px;\n"; print $os " BORDER-LEFT: #4169e1 double;\n"; print $os " PADDING-TOP: 2px;\n"; print $os " BORDER-BOTTOM: #4169e1 double;\n"; print $os " BACKGROUND-COLOR: #add8e6\n"; print $os "}\n"; print $os ".sbfixed\n"; print $os "{\n"; print $os " COLOR: #00008b;\n"; print $os " FONT-FAMILY: 'Courier New';\n"; print $os " BACKGROUND-COLOR: #afeeee\n"; print $os "}\n"; print $os "</STYLE>\n"; print $os "</HEAD>\n"; print $os "<body class=\"blueform\">\n"; print $os "\n"; print $os "<h1 align=\"center\">" . $hdr . "</h1>\n"; } sub html_tail { my ($fh) = @_; print $fh <<"EOF"; </body> </html> EOF } #string dirghtml::b2ks1(double d) // b2ks1(double d) sub b2ks1 { my ($d) = @_; my $oss; my $kss; my $lg = 0; my $ks = ($d / 1024); #// get Ks my $div = 1; if( $ks < 1000 ) { $div = 1; $oss = "KB"; } elsif ( $ks < 1000000 ) { $div = 1000; $oss = "MB"; } elsif ( $ks < 1000000000 ) { $div = 1000000; $oss = "GB"; } else { $div = 1000000000; $oss = "TB"; } $kss = $ks / $div; $kss += 0.05; $kss *= 10; $lg = int($kss); return( ($lg / 10) . " " . $oss ); } sub get_nn { my ($n) = @_; if (length($n) > 3) { my $mod = length($n) % 3; my $ret = (($mod > 0) ? substr( $n, 0, $mod ) : ''); my $mx = int( length($n) / 3 ); for (my $i = 0; $i < $mx; $i++ ) { if ($mod || $i) { $ret .= ','; # add comma } $ret .= substr( $n, ($mod+(3*$i)), 3 ); } return $ret; } return $n; } # eof