#!/perl -w
# NAME: genfolderindex.pl
# AIM: Scan all the files in a FOLDER, and generate a HTML index file,
# containing links to all the files in the FOLDER, both in alphabetic order,
# and in date order, showing the date, name and size of the file.
# 28/06/2007  geoff mclane - geoffair.net/mperl
#
use strict;
use warnings;
use File::Basename;
use File::stat; # to get the file date
require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
# log file stuff
my ($LF);
my $pgmname = $0;
if ($pgmname =~ /\w{1}:\\.*/) {
	my @tmpsp = split(/\\/,$pgmname);
	$pgmname = $tmpsp[-1];
}
my $outfile = 'temp.'.$pgmname.'.txt';
open_log($outfile);
prt( "$0 ... Hello, World ...\n" );
my $in_folder = 'C:\Documents and Settings\Geoff McLane\My Documents\Tidy';
###my $in_folder = 'C:\Documents and Settings\Geoff McLane\My Documents\MISC\HKFlat\img4';
###my $in_folder = 'C:\Documents and Settings\Geoff McLane\My Documents\Hommage';
my $out_file = 'fileindex.htm';
my $out_path = $in_folder."\\".$out_file;
my $overwrite = 1;
my $recursive = 1;
my $writesubs = 1;
my $maxlines = 22;	# put a LINK line

my @html_ext = qw( .htm .html .shtml .php );
my @graf_ext = qw( .jpg .jpeg .gif .png .bmp .ico .mpg );
my @css_ext  = qw( .css );
my @script_ext = qw( .js .class .cgi );
my @docs_ext = qw( .doc .txt );
my @fpfolders = qw( _vti_cnf _vti_pvt _private _derived );

my @in_files = ();
my @skipped = ();
my @in_counts = ( 0, 0, 0, 0, 0, 0, 0, 0 );
# DEBUG
my $dbg1 = 1;	# show folder being scanned
my $dbg2 = 0;	# show what we GOT
my $dbg3 = 1;	# show SKIPPED files.

# HTML stuff
my $m_doctype = '<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"'."\n".
'"http://www.w3.org/TR/html4/loose.dtd">';

if (-f $out_path) {
	if (!$overwrite) {
		mydie( "WARNING: $out_file already exists in $in_folder ... DELETE OR RENAME first ...\n" );
	}
}
if (! -d $in_folder) {
	mydie( "WARNING: $in_folder DOES NOT EXIST ...\n" );
}

scan_folder( $in_folder, 0, "" );
my $cnt = scalar @in_files;
prt( "Got $cnt files ... " );
my $num = 0;
foreach $cnt (@in_counts) {
	prt( "$num $cnt " );
	$num++;
}
prt("\n");

if (gen_findex($out_path)) {
	system($out_path);
}
if (@skipped && $dbg3) {
	prt( "WARNING: Skipped following ". scalar @skipped." FILES found ...\n" );
	foreach my $sk (@skipped) {
		prt( "$sk\n" );
	}
}

close_log($outfile,0);
exit(0);

#########################################################
# Passed an array of extensions,
# check if this is one of them?
#########################################################
sub is_my_ext {
	my ($fil, @exts) = @_;
	my ($nm,$dir,$ext) = fileparse( $fil, qr/\.[^.]*/ );
	foreach my $ex (@exts) {
		if (lc($ex) eq lc($ext)) {
			return 1;
		}
	}
	return 0;
}

############################################
# only looking for HTM, HTML, PHP,
# could be extended to others maybe ...
############################################
sub is_htm_ext {
	my ($fil) = shift;
	return( is_my_ext($fil, @html_ext) );
}
sub is_graphic_ext {
	my ($fil) = shift;
	return( is_my_ext($fil, @graf_ext) );
}
sub is_zip_ext {
	my ($fil) = shift;
	my @arr = qw( .zip );
	return( is_my_ext($fil, @arr) );
}
sub is_css_ext {
	my ($fil) = shift;
	return( is_my_ext($fil, @css_ext) );
}
sub is_txt_ext {
	my ($fil) = shift;
	my @arr = qw( .txt .htm .html .csv );
	return( is_my_ext($fil, @arr) );
}
sub is_doc_ext {
	my ($fil) = shift;
	my @arr = qw( .doc .pdf .xls .wmv );
	return( is_my_ext($fil, @arr) );
}
sub is_script_ext {
	my ($fil) = shift;
	return( is_my_ext($fil, @script_ext) );
}

sub get_ext_type {
	my ($fil) = shift;
	if (is_htm_ext($fil)) {
		return 1;
	} elsif (is_graphic_ext($fil)) {
		return 2;
	} elsif (is_zip_ext($fil)) {
		return 3;
	} elsif (is_css_ext($fil)) {
		return 4;
	} elsif (is_txt_ext($fil)) {
		return 5;
	} elsif (is_doc_ext($fil)) {
		return 6;
	} elsif (is_script_ext($fil)) {
		return 7;
	}
	return 0;
}

sub scan_folder {
	my ($inf, $lev, $rel) = @_;
	prt( "Processing $inf folder ... Lev $lev, Rel [$rel]\n" ) if ($dbg1);
	if ( opendir( DIR, $inf ) ) {
		my @files = readdir(DIR);
		closedir DIR;
		foreach my $fil (@files) {
			if (($fil eq ".")||($fil eq "..")) {
				next;
			}
			my $ff = $inf."\\".$fil;
			my $msg = "NOT FOLDER OR FILE!!!";
			if ( -d $ff) {
				$msg = "FOLDER";
			} elsif ( -f $ff ) {
				$msg = "FILE";
			}
			prt( "Got [$fil] [$ff] ... $msg\n" ) if ($dbg2);
			if ( -d $ff ) {
				if ($recursive && !is_fp_folder($fil) ) {
					my $nrel = $fil;
					if (length($rel)) {
						$nrel = $rel.'/'.$fil;
					}
					scan_folder( $ff, ($lev + 1), $nrel );
				}
			} else {
			# if ( -f $ff ) {
				if (($fil =~ /^temp/i)||($fil eq $out_file)) {
					next;	# ignore TEMP... and fileindex.htm files ...
				}
				my $exn = get_ext_type($fil);
				###if (($exn == 2)||($exn == 3)||($exn == 5)||($exn == 6)) {
				if ($exn > 0) {
					my $sb = stat($ff);
					my $in_size = $sb->size;
					my $in_date = $sb->mtime; # keep DATE unchanged, so a SORT can be done
					push(@in_files, [$fil, $inf, $exn, $in_size, $in_date, $lev, $rel]);
					if ($exn < scalar @in_counts) {
						$in_counts[$exn]++;
					}
				} else {
					$in_counts[$exn]++;
					push(@skipped, $ff);
				}
			}
		}
	} else {
		prt( "ERROR: FAILED TO OPEN [$inf] ... $! ...\n" );
	}
}

sub add_link_line {
	my ($fl, $val) = @_;
	print $fl "<a href=\"#bm_top\">top</a> \n" if ($val != 1);
	print $fl "<a href=\"#files\">files</a> \n" if ($val != 2);
	print $fl "<a href=\"#images\">images</a> \n" if ($val != 3);
	print $fl "<a href=\"#links\">subs</a> \n" if ($val != 5);
	print $fl "<a href=\"#bm_end\">end</a> \n" if ($val != 4);
}

sub add_sub_table {
	my ($f, $sub) = @_;
	my $icnt = scalar @in_files;
	if ($icnt == 0) {
		print $f "<p><a name=\"files\"\n";
		print $f "   id=\"files\"></a>NO FILES in [$in_folder/$sub]!</p>\n";
		return;
	}
	my $imgcnt = 0;
	my $lnkcnt = 0;
	print $f "<p><a name=\"files\"\n";
	print $f "   id=\"files\"></a>Files in [$in_folder/$sub] are :-</p>\n";
	print $f "\n<table align=\"center\" border=\"1\" summary=\"list of files\">\n";
	print $f "<tr>\n";
	print $f "<th>Name</th>\n";
	print $f "<th>Date</th>\n";
	print $f "<th>Size</th>\n";
	print $f "</tr>\n\n";
	for (my $i = 0; $i < $icnt; $i++) {
		# push(@in_files, [$fil, $inf, $exn, $in_size, $in_date, $lev, $rel]);
		my $fil = $in_files[$i][0];
		my $dir = $in_files[$i][1];
		my $exn = $in_files[$i][2];
		my $sz = get_nn($in_files[$i][3]);
		my $tm = YYYYMMDD($in_files[$i][4]);
		my $lev = $in_files[$i][5];
		my $rel = $in_files[$i][6];
		if ($rel ne $sub) {
			next;
		}
		print $f "<tr>\n";
		my $nfil = $fil;
		#if (length($rel)) {
		#	$nfil = $rel.'/'.$fil;
		#}
		print $f "<td><a href=\"$nfil\">$nfil</a></td>\n";
		print $f "<td>$tm</td>\n";
		print $f "<td align=\"right\">$sz</td>\n";
		print $f "</tr>\n\n";
		$imgcnt++ if ($exn == 2);
		$lnkcnt++;
		if ($lnkcnt > $maxlines) {
			if (($icnt - $i) > $maxlines) {
				print $f "<tr>\n";
				print $f "<td colspan=\"3\" align=\"center\">";
				add_link_line($f, 0);
				print $f "</td>\n";
				print $f "</tr>\n\n";
			}
			$lnkcnt = 0;
		}
	}
	print $f "</table>\n";

	if ($imgcnt) {
		print $f "\n<p align=\"center\">";
		add_link_line($f, 3);
		print $f "</p>\n";

		print $f "\n<p><a name=\"images\"\n";
		print $f "   id=\"images\"></a>Table of $imgcnt IMAGE files.</p>\n";

		print $f "\n<table align=\"center\" border=\"1\" summary=\"table of image\">\n";
		print $f "<tr>\n";
		print $f "<th>Image</th>\n";
		print $f "<th>Name</th>\n";
		print $f "<th>Date</th>\n";
		print $f "<th>Size</th>\n";
		print $f "</tr>\n\n";
		for (my $i = 0; $i < $icnt; $i++) {
			# push(@in_files, [$fil, $inf, $exn, $in_size, $in_date, $lev, $rel]);
			my $fil = $in_files[$i][0];
			my $dir = $in_files[$i][1];
			my $exn = $in_files[$i][2];
			my $sz = get_nn($in_files[$i][3]);
			my $tm = YYYYMMDD($in_files[$i][4]);
			my $lev = $in_files[$i][5];
			my $rel = $in_files[$i][6];
			if ($rel ne $sub) {
				next;
			}
			if ($exn == 2) {
				print $f "<tr>\n";
				my $nfil = $fil;
				#if (length($rel)) {
				#	$nfil = $rel.'/'.$fil;
				#}
				print $f "<td><a href=\"$nfil\"><img src=\"$nfil\" width=\"256\" height=\"256\"></a></td>\n";
				print $f "<td align=\"center\"><a href=\"$nfil\">$nfil</a>\n";
				print $f "<br>\n";
				add_link_line($f, 0);
				print $f "</td>\n";
				print $f "<td>$tm</td>\n";
				print $f "<td align=\"right\">$sz</td>\n";
				print $f "</tr>\n\n";
			}
		}
		print $f "</table>\n\n";
	} else {
		print $f "\n<p><a name=\"images\"\n";
		print $f "   id=\"images\"></a>No IMAGE files found!</p>\n";
	}
}

sub add_file_table {
	my ($f) = shift;
	my $icnt = scalar @in_files;
	if ($icnt == 0) {
		print $f "<p><a name=\"files\"\n";
		print $f "   id=\"files\"></a>NO FILES in [$in_folder]!</p>\n";
		return;
	}
	my $imgcnt = 0;
	my $lnkcnt = 0;
	print $f "<p><a name=\"files\"\n";
	print $f "   id=\"files\"></a>Files in [$in_folder] are :-</p>\n";
	###print $f "<p>Files in [$in_folder] are :-</p>\n";
	print $f "\n<table align=\"center\" border=\"1\" summary=\"list of files\">\n";
	print $f "<tr>\n";
	print $f "<th>Name</th>\n";
	print $f "<th>Date</th>\n";
	print $f "<th>Size</th>\n";
	print $f "</tr>\n\n";
	for (my $i = 0; $i < $icnt; $i++) {
		# push(@in_files, [$fil, $inf, $exn, $in_size, $in_date, $lev, $rel]);
		my $fil = $in_files[$i][0];
		my $dir = $in_files[$i][1];
		my $exn = $in_files[$i][2];
		my $sz = get_nn($in_files[$i][3]);
		my $tm = YYYYMMDD($in_files[$i][4]);
		my $lev = $in_files[$i][5];
		my $rel = $in_files[$i][6];
		print $f "<tr>\n";
		my $nfil = $fil;
		if (length($rel)) {
			$nfil = $rel.'/'.$fil;
		}
		print $f "<td><a href=\"$nfil\">$nfil</a></td>\n";
		print $f "<td>$tm</td>\n";
		print $f "<td align=\"right\">$sz</td>\n";
		print $f "</tr>\n\n";
		$imgcnt++ if ($exn == 2);
		$lnkcnt++;
		if ($lnkcnt > $maxlines) {
			if (($icnt - $i) > $maxlines) {
				print $f "<tr>\n";
				print $f "<td colspan=\"3\" align=\"center\">";
				add_link_line($f, 0);
				print $f "</td>\n";
				print $f "</tr>\n\n";
			}
			$lnkcnt = 0;
		}
	}
	print $f "</table>\n";

	if ($imgcnt) {
		print $f "<p align=\"center\">";
		add_link_line($f, 3);	# no images link
		print $f "</p>\n";
		print $f "\n<p><a name=\"images\"\n";
		print $f "   id=\"images\"></a>Table of $imgcnt IMAGE files.</p>\n";
		print $f "\n<table align=\"center\" border=\"1\" summary=\"table of image\">\n";
		print $f "<tr>\n";
		print $f "<th>Image</th>\n";
		print $f "<th>Name</th>\n";
		print $f "<th>Date</th>\n";
		print $f "<th>Size</th>\n";
		print $f "</tr>\n\n";
		for (my $i = 0; $i < $icnt; $i++) {
			# push(@in_files, [$fil, $inf, $exn, $in_size, $in_date, $lev, $rel]);
			my $fil = $in_files[$i][0];
			my $dir = $in_files[$i][1];
			my $exn = $in_files[$i][2];
			my $sz = get_nn($in_files[$i][3]);
			my $tm = YYYYMMDD($in_files[$i][4]);
			my $lev = $in_files[$i][5];
			my $rel = $in_files[$i][6];
			if ($exn == 2) {
				print $f "<tr>\n";
				my $nfil = $fil;
				if (length($rel)) {
					$nfil = $rel.'/'.$fil;
				}
				print $f "<td><a href=\"$nfil\"><img src=\"$nfil\" width=\"256\" height=\"256\"></a></td>\n";
				print $f "<td align=\"center\"><a href=\"$nfil\">$nfil</a>\n";
				print $f "<br>\n";
				add_link_line($f, 0);
				print $f "</td>\n";
				print $f "<td>$tm</td>\n";
				print $f "<td align=\"right\">$sz</td>\n";
				print $f "</tr>\n\n";
			}
		}
		print $f "</table>\n\n";
	} else {
		print $f "\n<p><a name=\"images\"\n";
		print $f "   id=\"images\"></a>No IMAGE files found!</p>\n";
	}
}

sub write_html_head { # ($OF)
	my ($f) = shift;
	print $f "$m_doctype\n";
	print $f <<"EOF";
<html>
<head>
<title>Index to Files</title>
<meta http-equiv="Content-Language" content="en-au">
<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
</head>

<body>
<h1 align="center"><a name="bm_top"
   id="bm_top"></a>Index to Files</h1>


EOF

	print $f "<p align=\"center\">";
	add_link_line($f, 1);
	print $f "</p>\n\n";

}

sub write_html_tail {	# ($OF);
	my ($f, $of) = @_;
	my ($msg);

	print $f <<"EOF";

<p><a name="bm_end"
   id="bm_end">EOF - $of
</p>

EOF

	print $f "<p align=\"center\">";
	add_link_line($f, 4);
	print $f "</p>\n\n";

	$msg = "<!-- generated by $pgmname -->\n";
	$msg .= "<!-- ". scalar time() . " -->\n";
	print $f $msg;

	print $f "</body>\n";
	print $f "</html>\n";
}


sub gen_sub_index {
	my ($rel, $lev) = @_;
	my $out = $in_folder."\\".$rel.'/'.$out_file;	# = 'fileindex.htm';
	my ($OUTF, $msg);
	if (!open $OUTF, ">$out") {
		prt( "WARNING: Failed to create [$out] ...\n" );
		return 0;	# quietly ignore failure
	}

	write_html_head($OUTF);

	add_sub_table($OUTF, $rel);

	# add a RETURN to INDEX
	$msg = '';
	while ($lev) {
		$msg .= '/' if (length($msg));
		$msg .= '..';
		$lev--;
	}
	$msg .= '/' if (length($msg));
	$msg .= $out_file;
	print $OUTF "<p align=\"center\"><a href=\"$msg\">$msg</a></p>\n";

	write_html_tail($OUTF, $out);

	close $OUTF;
	return 1;
}

sub in_list {
	my ($itm, @list) = @_;
	foreach my $it (@list) {
		if ($itm eq $it) {
			return 1;
		}
	}
	return 0;
}

sub gen_findex {
	my ($of) = shift;
	my $icnt = scalar @in_files;
	my ($msg);
	my $scnt = 0;
	my $dcnt = 0;
	my @subs = ();
	if ($icnt == 0) {
		prt( "No index, since NO FILES ...\n" );
		return 0;
	}
	if ($writesubs) {
		for (my $i = 0; $i < $icnt; $i++) {
			# push(@in_files, [$fil, $inf, $exn, $in_size, $in_date, $lev, $rel]);
			#my $fil = $in_files[$i][0];
			#my $dir = $in_files[$i][1];
			#my $exn = $in_files[$i][2];
			#my $sz = get_nn($in_files[$i][3]);
			#my $tm = YYYYMMDD($in_files[$i][4]);
			my $lev = $in_files[$i][5];
			my $rel = $in_files[$i][6];
			if (length($rel) && ($lev > 0)) {
				if (!in_list($rel, @subs)) {
					if (gen_sub_index( $rel, $lev )) {
						push(@subs, $rel);	
					}
				}
			}
		}
	}

	open my $OF, ">$of" or mydie("ERROR: Unable to generate $of file ...aborting ...\n");
	prt( "Writing [$of] HTML with $icnt files ...\n" );

	write_html_head($OF);

	add_file_table($OF);

	if (@subs) {
		$scnt = scalar @subs;
		$dcnt = 0;
		print $OF "<p align=\"center\"><a name=\"links\"\n";
		print $OF "    id=\"links\"></a>Links to $scnt subs:<br>\n";
		foreach $msg (@subs) {
			print $OF "<a href=\"$msg/$out_file\">$msg</a>";
			$dcnt++;
			if ($dcnt < $scnt) {
				print $OF "<br>";
			}
			print $OF "\n";
		}
	}

	write_html_tail($OF, $of);

	close($OF);
	prt( "Done file [$of] with $icnt files ... and $scnt subs ...\n" );

	return 1;
}

################################################
# My particular time 'translation'
sub YYYYMMDD {
	#  0    1    2     3     4    5     6     7     8
	my ($tm) = shift;
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($tm);
	$year += 1900;
	$mon += 1;
	my $ymd = "$year/";
	if ($mon < 10) {
		$ymd .= '0'.$mon.'/';
	} else {
		$ymd .= "$mon/";
	}
	if ($mday < 10) {
		$ymd .= '0'.$mday;
	} else {
		$ymd .= "$mday";
	}
	return $ymd;
}

##################################################
# My particular 'nice number'
sub get_nn { # perl nice number nicenum add commas
	my ($n) = shift;
	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 is_fp_folder {
	my ($inf) = shift;
	foreach my $fil (@fpfolders) {
		if (lc($inf) eq lc($fil)) {
			return 1;
		}
	}
	return 0;
}

# eof
