Generated: Tue Feb 2 17:54:39 2010 from genfolderindex.pl 2007/10/17 15.7 KB.
#!/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 - $off </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