#!/usr/bin/perl

use strict;
use Cwd;
use File::stat;

my $start_time = time();
my $program = 'dirg.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 @rows;
my $out_name = 'tempdgpl.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 $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>" };
}

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 ! @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;
foreach $msg (@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";

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 {
	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 ) { # is directory?
			# 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 {
			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);

	# 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 (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) {
		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);

	}
	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 );
}

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
