Generated: Tue Feb 2 17:54:30 2010 from dirg2.pl 2007/01/27 14.3 KB.
#!/Perl # AIM: Scan a directory, and suggest CD-ROM write # limits ... fill CD-ROM to below ORANGE(warn) level # by skipping FOLDER that put it OVER this limit. # Present limit = 700MB CD-ROM assumed, so # LIMIT set to 650MB ... use strict; use Cwd; use File::stat; my $start_time = time(); my $program = 'dirg2.pl'; my $max_cd = 650 * 1024 * 1024; # set at 650MB my $tot_all = 0; my $tot_sub = 0; my $no_max = 0; # set failed on FIRST - no more checking my $had_sub = 0; # count of SUB-TOTALS issued 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 @rows; # hold the FINAL table ROWS x COLS my $out_name = 'tempdgpl.htm'; my $in_file = ''; my $def_file = "C:\\HOMEPAGE"; 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 $excl_dir = "Temporary Internet Files"; # should these be EXCLUDED??? my @undefd = (); # seems we need to 'skip' some, quietly 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>" }; } if (@ARGV) { parse_arguments(@ARGV); } else { push(@in_files, $def_file); } 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 ! @rows; # set header line $msg = ("Totals|$tot|$g_tot_dirs|$g_tot_files"); push(@rows,$msg); $row_count = scalar @rows; # 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); 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; my $bold_row = 0; foreach $msg (@rows) { $rcnt++; # print DSP "$msg<BR>\n"; print DSP "<tr>\n"; $ccnt = 0; $bold_row = 0; # start as NOT a bold row my (@mcols) = split( /\|/, $msg); foreach my $col (@mcols) { # process EACH column if($rcnt == $row_count) { # ***LAST ROW*** $bold_row = 1; # set BOLD 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 { # is NOT LAST ROW } if ($ccnt) { if ($ccnt == 1 ) { # 2nd column ###$msg = addcolmr( b2ks1($col) ); $msg = b2ks1($col); } else { ###$msg = addcolmr( get_nn($col) ); $msg = get_nn($col); } if ($bold_row > 0) { $msg = addbold( $msg ); } $msg = addcolmr( $msg ); } else { # is FIRST column = TEXT if ($col =~ /^Sub-Total/i) { $bold_row = 1; # set BOLD for each COLUMN ###$msg = addcolm( addbold( $col ) ); $msg = $col; } else { ###$msg = addcolm( $col ); $msg = $col; } if ($bold_row > 0) { $msg = addbold( $msg ); } ###$msg = addcolm( $col ); $msg = addcolm( $msg ); } # } print DSP "$msg\n"; # shove it out the the HTML file $ccnt++; } print DSP "</tr>\n"; } print DSP "</table>\n"; print DSP "</p>\n"; if (scalar @undefd > 0) { print DSP "<p>Skipped following ...<br>\n"; foreach $msg (@rows) { print DSP "$msg<br>\n"; } print DSP "</p>\n"; } else { print DSP "<p>NONE skipped ...\n"; } html_tail(\*DSP); close(DSP); print "$program: Ended on " . localtime(time()) . ".\n" if $shwtm; system $out_name; # start HTML file print "Results written to $out_name ...\n"; ################################## # end of program ################################# ### subs ################################# sub do_user_dir { # ONLY called for ROOT scan of USER FOLDER my $dir = shift; # get the passed FOLDER print "Processing folder [$dir] ...\n" if $verbose; opendir(THEDIR, $dir) || die("Couldn't open [$dir] directory\n"); my @files = readdir(THEDIR); # slurp in ALL directories, and file, (and . & ..!) closedir(THEDIR); my $tsz = 0; # start a TOTAL for this FOLDER 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 ) { # is directory? # if ($dfile eq '.' || $dfile eq '..') or if ($dfile =~ '^\.$' || $dfile =~ '^\.\.$') { # do nothing with DOT and DOUBLE DOT } else { push(@dir_list, $df); # save local DIRECTORY LIST 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 { # it is a FILE if (defined $sb) { 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; } else { push(@undefd,$df); } } } 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(@rows,$msg); # build up the ROW of informatiom, for the ROOT FOLDER only $tot_all += $tsz; # add to ALL total $tot_sub += $tsz; # add to sub-total if ($tot_sub > $max_cd) { $no_max = 1; # set failed on FIRST - no more checking } # have DONE root, now process each folder ######################################### foreach $dir (@dir_list) { $tot_files = 0; $tot_dirs = 0; my $sub_tot = do_sub_dir($dir,1); $tot_all += $sub_tot; # add to ALL total ### CHECK FIRST - $tot_sub += $sub_tot; # add to sub-total if ( ! $no_max ) { # $no_max = 0 - set if failed on FIRST - no more checking if (($tot_sub + $sub_tot) > $max_cd) { $msg = ("Sub-Total|$tot_sub|$g_tot_dirs|$g_tot_files"); push(@rows,$msg); $tot_sub = 0; # restart total $had_sub++; } } $tot_sub += $sub_tot; # add to sub-total $tsz += $sub_tot; # add to cumulative ###$tsz += do_sub_dir($dir,1); $g_tot_files += $tot_files; $g_tot_dirs += $tot_dirs; } ######################################### if ( ! $no_max ) { if (($tot_sub > $max_cd) || ($had_sub > 0)) { ### $no_max = 1; # set failed on FIRST - no more checking $msg = ("Sub-Total|$tot_sub|$g_tot_dirs|$g_tot_files"); push(@rows,$msg); $tot_sub = 0; # restart total $had_sub++; } } 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 (defined $sb) { 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; } else { push (@undefd, $df); } } } if ($level == 1) { # iteration COMPLETE - we are exiting to the ROOT ################################################# 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(@rows,$msg); # build up the ROW of informatiom ################################################### } 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] } push(@in_files, ".") if ! @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 ); ###return( ($lg / 10) . $oss ); } sub get_nn { # perl nice number nicenum add commas 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 == 0) && ($i == 0)) { $ret .= substr( $n, ($mod+(3*$i)), 3 ); } else { $ret .= ',' . substr( $n, ($mod+(3*$i)), 3 ); } } return $ret; } return $n; } sub english_date_from_iso_style_date{ my $date=shift; $date=~/(\d{4})(\d{2})(\d{2})/; my $d=Date::Handler->new({date=>{year=>$1, month=>$2,day=>$3}}); return $d->MonthName().' '.$d->Day().', '.$d->Year(); } # eof