Generated: Sun Apr 15 11:46:18 2012 from genfileindex.pl 2011/12/26 33.3 KB.
#!/perl -w # NAME: genfileindex.pl (see also 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. # 26/12/2011 - Prepare to also run in Ubuntu # 21/07/2010 - checked and fixed - put in DATE order - seems best # 02/02/2010 - update # 21/08/2007 - use ImageMagick 'indentify.exe' (now installed) to get the IMAGE sizes, # thus improving the bottom image display ... # # 28/06/2007 geoff mclane - geoffair.net/mperl # use strict; use warnings; use File::Basename; use File::stat; # to get the file date use Digest::MD5; use Cwd; my $os = $^O; my $perl_base = '/home/geoff/bin'; my $PATH_SEP = '/'; my $util_lib = 'lib_utils.pl'; if ($os =~ /win/i) { $perl_base = 'C:\GTools\perl'; $PATH_SEP = "\\"; } unshift(@INC,$perl_base); require $util_lib or die "Unable to load '$util_lib' ...\n"; # log file stuff our ($LF); my $pgmname = $0; if ($pgmname =~ /(\\|\/)/) { my @tmpsp = split(/(\\|\/)/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $perl_base.'\temp.'.$pgmname.'.txt'; open_log($outfile); #prt( "$0 ... Hello, World ...\n" ); my $in_folder = ''; my $debug_on = 0; my $def_root_folder = 'C:\HOMEPAGE\GA'; ###my $def_folder = $def_root_folder.'\fg\srczips'; ###my $def_folder = 'C:\Documents and Settings\Geoff McLane\My Documents\Uwe\imgs1'; ###my $def_folder = 'C:\Documents and Settings\Geoff McLane\My Documents\MISC\HKFlat'; ###my $def_folder = 'C:\Documents and Settings\Geoff McLane\My Documents\tidy'; my $def_folder = 'C:\Documents and Settings\Geoff McLane\My Documents\Hommage'; my $output_file = 'fileindex.htm'; my $out_path = $in_folder."\\".$output_file; my $minimage = 1; # adjust $targwid to less, if no images exceed it. my $targwid = 200; my $load_log = 0; my $overwrite = 1; # set to 1 to *** OVERWRITE *** existing fileindex.htm my $recursive = 0; # set to do folder recursively my $writesubs = 1; my $makelinkblank = 0; # use target="_blank" my $addcattable = 1; # group by extension my $simplelinks = 1; # links in one line my $adddate = 1; my $addsize = 1; my $adjusttd = 1; my $addmd5digest = 0; my $maxlines = 20; # was 22 =# put a LINK line my $imgSx = 0; my $imgSy = 0; my @html_ext = qw( .htm .html .shtml .php ); ###my @graf_ext = qw( .jpg .jpeg .gif .png .bmp .ico .mpg .tif ); # BUT browser does NOT display TIF my @graf_ext = qw( .jpg .jpeg .gif .png .bmp .ico ); my @special_ext = qw( .tif .mpg .mov .wmv ); my @css_ext = qw( .css ); my @script_ext = qw( .js .class .cgi ); my @text_ext = qw( .txt .htm .html .csv .bat .xls ); my @docs_ext = qw( .doc .pdf ); my @zips_ext = qw( .zip .gz .7z ); my @fpfolders = qw( _vti_cnf _vti_pvt _private _derived ); my @skipped = (); my @in_counts = ( 0, 0, 0, 0, 0, 0, 0, 0 ); my @exclude_ext = qw( .bak .old ); my @in_files = (); # @in_files offsets my $if_fnm = 0; # file name my $if_dir = 1; # directory my $if_ext = 2; # extension type my $if_siz = 3; # size my $if_dat = 4; # date/time my $if_lev = 5; # level my $if_rel = 6; # relative my $if_isz = 7; # images SIZE my $if_ffn = 8; # FULL FILE NAME my %file_types = (); # list via file TYPE, per folder, as 'folder*extension' => file list, '*' separated # extension types my $ex_unk = 0; # uncased extension my $ex_htm = 1; # htm, html, ... my $ex_grf = 2; # jpg, gif, ... my $ex_zip = 3; # zip my $ex_css = 4; # css my $ex_txt = 5; # text file my $ex_doc = 6; # word doc my $ex_scr = 7; # script file my $ex_spl = 8; # special file, like TIF # DEBUG my $dbg1 = 0; # show folder being scanned my $dbg2 = 0; # show what we GOT, as it is 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">'; my $def_tdattr = "align=\"center\" valign=\"center\""; my $href = 'href'; # FUNCTIONS ### program variables my @warnings = (); my $cwd = cwd(); sub pgm_exit($$) { my ($val,$msg) = @_; if (length($msg)) { $msg .= "\n" if (!($msg =~ /\n$/)); prt($msg) } close_log($outfile,$load_log); exit($val); } sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } sub show_warnings() { if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS...\n" ); foreach my $itm (@warnings) { prt("$itm\n"); } prt("\n"); } else { prt( "\nNo warnings issued.\n\n" ); } } sub get_hex_digest($) { my ($fil) = shift; if (open FILE, "<$fil") { binmode FILE; my $md5 = Digest::MD5->new; while (<FILE>) { $md5->add($_); } close FILE; return $md5->hexdigest; } else { print "Error: Unable to open file [$fil]\n"; exit(1); } } sub mycmp_decend_date { return 1 if (${$a}[$if_dat] < ${$b}[$if_dat]); return -1 if (${$a}[$if_dat] > ${$b}[$if_dat]); return 0; } # sort Aa - Zz sub mycmp_nocase { return 1 if (lc($a) gt lc($b)); return -1 if (lc($a) lt lc($b)); return 0; } ######################################################### # Passed an array of extensions, # check if this is one of them? ######################################################### sub is_my_ext { my ($fil, $rexts) = @_; my ($nm,$dir,$ext) = fileparse( $fil, qr/\.[^.]*/ ); my $lcext = lc($ext); foreach my $ex (@{$rexts}) { return 1 if (lc($ex) eq $lcext); } 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_zips_ext { my ($fil) = shift; return( is_my_ext($fil, \@zips_ext) ); } sub is_css_ext { my ($fil) = shift; return( is_my_ext($fil, \@css_ext) ); } sub is_txt_ext { my ($fil) = shift; return( is_my_ext($fil, \@text_ext) ); } sub is_doc_ext { my ($fil) = shift; return( is_my_ext($fil, \@docs_ext) ); } sub is_script_ext { my ($fil) = shift; return( is_my_ext($fil, \@script_ext) ); } sub is_special_ext { my ($fil) = shift; return( is_my_ext($fil, \@special_ext) ); # like TIF - is graphic but NOT browser supported } sub is_exclude_ext { my ($fil) = shift; return( is_my_ext($fil, \@exclude_ext) ); # like TIF - is graphic but NOT browser supported } # extension types #my $ex_unk = 0; # uncased extension #my $ex_htm = 1; # htm, html, ... #my $ex_grf = 2; # jpg, gif, ... #my $ex_zip = 3; # zip, .gz, .7z #my $ex_css = 4; # css #my $ex_txt = 5; # text file #my $ex_doc = 6; # word doc #my $ex_scr = 7; # script file #my $ex_spl = 8; # special file, like TIF sub get_ext_type { my ($fil) = shift; if (is_htm_ext($fil)) { return $ex_htm; } elsif (is_graphic_ext($fil)) { return $ex_grf; } elsif (is_zips_ext($fil)) { return $ex_zip; } elsif (is_css_ext($fil)) { return $ex_css; } elsif (is_txt_ext($fil)) { return $ex_txt; } elsif (is_doc_ext($fil)) { return $ex_doc; } elsif (is_script_ext($fil)) { return $ex_scr; } elsif (is_special_ext($fil)) { return $ex_spl; } return $ex_unk; } sub scan_folder { my ($inf, $lev, $rel) = @_; prt( "Processing $inf folder ... Lev $lev, Rel [$rel]\n" ) if ($dbg1 || ($lev == 0)); my ($relkey, $relfil); if ( !opendir( DIR, $inf ) ) { pgm_exit(1, "ERROR: FAILED TO OPEN [$inf] ... $! ...\n" ); return; } my @files = readdir(DIR); closedir DIR; foreach my $fil (@files) { next if (($fil eq ".")||($fil eq "..")); 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 ); } } elsif ( -f $ff ) { if (($fil =~ /^temp/i)||($fil =~ /^~\$/)||($fil eq $output_file)) { next; # ignore TEMP???..., ~$???..., and fileindex.htm files ... } my $exn = get_ext_type($fil); my ($nm,$dir,$ext) = fileparse( $fil, qr/\.[^.]*/ ); $relfil = $fil; if (length($rel)) { $relkey = $rel.'*'.lc($ext); } else { $relkey = '.*'.lc($ext); } ###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 my $isz = ''; $isz = get_image_size($ff) if ($exn == $ex_grf); # my $if_ fnm dir ext siz dat lev rel isz ffn # 0 1 2 3 4 5 6 7 8 push(@in_files, [$fil, $inf, $exn, $in_size, $in_date, $lev, $rel, $isz, $ff]); if ($exn < scalar @in_counts) { $in_counts[$exn]++; } #my %file_types = (); # list via file TYPE, per folder, as 'folder*extension' => file list, '*' separated if (defined $file_types{$relkey}) { $file_types{$relkey} .= '*'.$relfil; } else { $file_types{$relkey} = $relfil; } } else { $in_counts[$exn]++; push(@skipped, $ff); } } else { prt( "WARNING: CHECK ME: NOT DIR OR FILE [$ff] - WHAT IS THIS?\n" ); } } @in_files = sort mycmp_decend_date @in_files; } sub add_link_line { my ($fl, $val) = @_; print $fl "<span class=\"smfnt\">"; 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=\"#extension\">exts</a> \n" if ($addcattable); print $fl "<a href=\"#links\">subs</a> \n" if ($val != 5); print $fl "<a href=\"#bm_end\">end</a> \n" if ($val != 4); print $fl "</span>\n"; } sub add_sub_table { my ($f, $sub) = @_; my ($i, $fil, $dir, $exn, $sz, $tm, $lev, $rel, $nfil); 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 class=\"ctr\">Name</th>\n"; print $f "<th class=\"ctr\">Date</th>\n"; print $f "<th class=\"ctr\">Size</th>\n"; print $f "</tr>\n\n"; for ($i = 0; $i < $icnt; $i++) { # my $if_ fnm dir ext siz dat lev rel isz ffn # push(@in_files, [$fil, $inf, $exn, $in_size, $in_date, $lev, $rel, $isz, $ff]); $fil = $in_files[$i][$if_fnm]; $dir = $in_files[$i][$if_dir]; $exn = $in_files[$i][$if_ext]; $sz = get_nn($in_files[$i][$if_siz]); $tm = YYYYMMDD($in_files[$i][$if_dat]); $lev = $in_files[$i][$if_lev]; $rel = $in_files[$i][$if_rel]; if ($rel ne $sub) { next; } print $f "<tr>\n"; $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 == $ex_grf); $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 class=\"ctr\">Image</th>\n"; print $f "<th class=\"ctr\">Name</th>\n"; if ($adddate) { print $f "<th class=\"ctr\">Date</th>\n"; } if ($addsize) { print $f "<th class=\"ctr\">Size</th>\n"; } print $f "</tr>\n\n"; for ($i = 0; $i < $icnt; $i++) { # my $if_ fnm dir ext siz dat lev rel isz ffn # push(@in_files, [$fil, $inf, $exn, $in_size, $in_date, $lev, $rel, $isz, $ff]); $fil = $in_files[$i][$if_fnm]; $dir = $in_files[$i][$if_dir]; $exn = $in_files[$i][$if_ext]; $sz = get_nn($in_files[$i][$if_siz]); $tm = YYYYMMDD($in_files[$i][$if_dat]); $lev = $in_files[$i][$if_lev]; $rel = $in_files[$i][$if_rel]; if ($rel ne $sub) { next; } if ($exn == $ex_grf) { # GRAPHIC FILE print $f "<tr>\n"; $nfil = $fil; #if (length($rel)) { # $nfil = $rel.'/'.$fil; #} my $tdattr = "width=\"$targwid\" height=\"$targwid\""; my $attr = $tdattr; $tdattr .= " $def_tdattr"; my $isz = $in_files[$i][$if_isz]; my $iw = get_image_width($isz); my $ih = get_image_height($isz); if (($iw > 0) && ($ih > 0)) { if (($iw > $targwid) || ($ih > $targwid)) { my $ratio = $iw / $ih; if($ratio > 1) { $imgSx = $targwid; $imgSy = int( ($targwid / $ratio) + 0.5 ); } else { $imgSx = int( ($targwid * $ratio) + 0.5 ); $imgSy = $targwid; } $attr = "width=\"$imgSx\" height=\"$imgSy\""; } else { $attr = "width=\"$iw\" height=\"$ih\""; } } print $f "<td $tdattr><a $href=\"$nfil\"><img src=\"$nfil\" $attr></a></td>\n"; print $f "<td align=\"center\"><a href=\"$nfil\">$nfil</a>\n"; print $f "<br>\n"; print $f "$isz\n"; #print $f "<br>\n"; #add_link_line($f, 0); print $f "</td>\n"; if ($adddate) { print $f "<td>$tm</td>\n"; } if ($addsize) { 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"; } } # Output the table list # ===================== sub add_file_table { my ($f) = shift; my $icnt = scalar @in_files; my ($i, $fil, $dir, $exn, $sz, $tm, $lev, $rel, $nfil, $ff); prt("Adding main file table... "); if ($adddate || $addsize || $addmd5digest) { prt("with "); prt("Date ") if ($adddate); prt("Size ") if ($addsize); prt("MD5 ") if ($addmd5digest); } prt("\n"); 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; my $colspan = 1; my $maxlns = $maxlines; # minimum for inserting 'menu' 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"; # HEADER line, and get column span print $f "<tr>\n"; print $f "<th class=\"ctr\">Name</th>\n"; if ($adddate) { print $f "<th class=\"ctr\">Date</th>\n"; $colspan++; } if ($addsize) { print $f "<th class=\"ctr\">Size</th>\n"; $colspan++ } if ($addmd5digest) { print $f "<th class=\"ctr\">MD5</th>\n"; $colspan++; } print $f "</tr>\n\n"; for ($i = 0; $i < $icnt; $i++) { # my $if_ fnm dir ext siz dat lev rel isz ffn # push(@in_files, [$fil, $inf, $exn, $in_size, $in_date, $lev, $rel, $isz, $ff]); $fil = $in_files[$i][$if_fnm]; $dir = $in_files[$i][$if_dir]; $exn = $in_files[$i][$if_ext]; $sz = get_nn($in_files[$i][$if_siz]); $tm = YYYYMMDD($in_files[$i][$if_dat]); $lev = $in_files[$i][$if_lev]; $rel = $in_files[$i][$if_rel]; $ff = $in_files[$i][$if_ffn]; $imgcnt++ if ($exn == $ex_grf); $lnkcnt++; print $f "<tr>\n"; $nfil = $fil; if (length($rel)) { $nfil = $rel.'/'.$fil; } print $f "<td><a $href=\"$nfil\">$nfil</a></td>\n"; if ($adddate) { print $f "<td>$tm</td>\n"; } if ($addsize) { print $f "<td align=\"right\">$sz</td>\n"; } if ($addmd5digest) { print $f "<td><tt class=\"xsmfnt\">".get_hex_digest($ff)."</tt></td>\n"; } print $f "</tr>\n\n"; if ($lnkcnt > $maxlns) { if (($icnt - $i) > $maxlns) { print $f "<tr>\n"; print $f "<td colspan=\"".$colspan."\" 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 "<hr>\n"; print $f "\n<a name=\"images\"\n"; print $f " id=\"images\"></a>\n"; print $f "<p><b>Table of $imgcnt IMAGE files.</b></p>\n"; print $f "\n<table align=\"center\" border=\"1\" summary=\"table of image\">\n"; print $f "<tr>\n"; print $f "<th class=\"ctr\">Image</th>\n"; print $f "<th class=\"ctr\">Name</th>\n"; if ($adddate) { print $f "<th class=\"ctr\">Date</th>\n"; } if ($addsize) { print $f "<th class=\"ctr\">Size</th>\n"; } print $f "</tr>\n\n"; for ($i = 0; $i < $icnt; $i++) { # my $if_ fnm dir ext siz dat lev rel isz ffn # push(@in_files, [$fil, $inf, $exn, $in_size, $in_date, $lev, $rel, $isz, $ff]); $fil = $in_files[$i][$if_fnm]; $dir = $in_files[$i][$if_dir]; $exn = $in_files[$i][$if_ext]; $sz = get_nn($in_files[$i][$if_siz]); $tm = YYYYMMDD($in_files[$i][$if_dat]); $lev = $in_files[$i][$if_lev]; $rel = $in_files[$i][$if_rel]; if ($exn == $ex_grf) { # GRAPHIC FILE print $f "<tr>\n"; $nfil = $fil; if (length($rel)) { $nfil = $rel.'/'.$fil; } my $tdattr = "width=\"$targwid\" height=\"$targwid\""; my $attr = $tdattr; $tdattr .= " $def_tdattr"; my $isz = $in_files[$i][$if_isz]; my $iw = get_image_width($isz); my $ih = get_image_height($isz); if (($iw > 0) && ($ih > 0)) { if (($iw > $targwid) || ($ih > $targwid)) { my $ratio = $iw / $ih; if($ratio > 1) { $imgSx = $targwid; $imgSy = int( ($targwid / $ratio) + 0.5 ); } else { $imgSx = int( ($targwid * $ratio) + 0.5 ); $imgSy = $targwid; } ###$attr = "width=\"$imgSx\" height=\"$imgSy\""; } else { $imgSx = $iw; $imgSy = $ih; ###$attr = "width=\"$iw\" height=\"$ih\""; } $attr = "width=\"$imgSx\" height=\"$imgSy\""; if ($adjusttd) { $tdattr = $attr; $tdattr .= " $def_tdattr"; } } print $f "<td $tdattr><a href=\"$nfil\"><img src=\"$nfil\" $attr></a></td>\n"; print $f "<td align=\"center\"><a $href=\"$nfil\">$nfil</a>\n"; print $f "<br>\n"; print $f "$isz\n"; print $f "<br>\n"; add_link_line($f, 0); print $f "</td>\n"; if ($adddate) { print $f "<td>$tm</td>\n"; } if ($addsize) { 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 get_fg_srczips_head { my $szhead = <<EOF; <!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> <html> <head> <meta http-equiv="Content-Language" content="en-us"> <meta name="GENERATOR" content="Microsoft FrontPage 5.0"> <meta name="ProgId" content="FrontPage.Editor.Document"> <meta http-equiv="Content-Type" content="text/html; charset=us-ascii"> <meta name="author" content="geoff mclane"> <meta name="keywords" content= "geoff, mclane, geoffmclane, computer, consultant, programmer, FlightGear, SimGear, PLIB, zlib, openal, pthreads, freeglut, openscenegraph"> <meta name="description" content="flightgear build - various source file"> <title> Source Zip Index </title> <link rel="stylesheet" type="text/css" href="../fgcode.css"> <!-- <script type="text/javascript" src="../qlfgmenu.js"> </script> --> <style type="text/css"> <!-- /* additional styles */ .xsmfnt { font-size : x-small; } .nh2 { font-size: 160%; font-weight: bold; background-color: #CCCCFF } .nh3 { font-size: 130%; font-weight: bold; background-color: #eCeCFF } /* light orange */ .nh4 { font-size: 110%; font-weight: bold; background-color: #FFc080 } --> </style> <base target="_self"> </head> EOF return $szhead; } sub write_html_head { # ($OF) my ($f) = shift; my $htm = get_fg_srczips_head(); print $f $htm; print $f <<EOF; <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_head_2 { # ($OF) my ($f) = shift; print $f "$m_doctype\n"; print $f <<EOF; <html> <head> <title> Index to Files in Folder </title> <meta http-equiv="Content-Language" content="en-au"> <meta http-equiv="Content-Type" content="text/html; charset=windows-1252"> <style type="text/css"> <!-- /* Style Definitions */ body { margin: 0cm 1cm 1cm 1cm; background: #efefff; text-align: justify; } h1 { background:#dfdfff; border-style: solid solid solid solid; border-color:#d9e2e2; border-width:1px; padding:2px 2px 2px 2px; font-size:200%; text-align:center; } .ctr { text-align: center; } .cn { font-family : "Courier New"; } hr.mini { margin : 0; border-style : none; padding : 0; width : 20%; text-align : center; } p.top { margin : 0; border-style : none; padding : 0; text-align : center; } .smfnt { font-size : small; } .xsmfnt { font-size : x-small; } --> </style> </head> <body> <h1 align="center"><a name="bm_top" id="bm_top"></a>Index to Files in Folder</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 on " . localtime(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.'/'.$output_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_type_table($OUTF, $rel) if ($addcattable); # add a RETURN to INDEX $msg = ''; while ($lev) { $msg .= '/' if (length($msg)); $msg .= '..'; $lev--; } $msg .= '/' if (length($msg)); $msg .= $output_file; print $OUTF " <p align=\"center\"><a name=\"links\"\n id=\"links\">\n <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; } # if ($addcattable) - process # my %file_types = (); # list via file TYPE, per folder, as 'folder*extension' => file list, '*' separated sub add_type_table { my ($of, $actfld) = @_; my ($key, $fld, $ext, $flist, @files, $file, $cnt, $acnt, $wcnt); my @ar = (); $cnt = 0; foreach $key (keys %file_types) { @ar = split(/\*/,$key); $fld = $ar[0]; if ($fld eq $actfld) { $cnt++; } } print $of "<hr>\n"; print $of "<a name=\"extension\"\n id=\"extension\"></a>\n"; print $of "<p><b>File list by extension</b> - Count: $cnt types.\n"; if ($cnt) { $cnt = 0; foreach $key (sort keys(%file_types)) { @ar = split(/\*/,$key); $fld = $ar[0]; if ($fld eq $actfld) { $cnt++; $ext = $ar[1]; $flist = $file_types{$key}; @files = split(/\*/,$flist); $acnt = "$cnt"; $wcnt = $acnt; while (length($acnt) < 4) { $acnt .= ' '; $wcnt .= ' '; } print $of "<br>$wcnt <b>$ext</b> = \n"; foreach $file (sort mycmp_nocase @files) { print $of " [<a $href=\"$file\">$file</a>]\n"; } } } } else { print $of " COUNT IS ZERO!"; } print $of "</p>\n"; } sub gen_findex { my ($of) = shift; my $icnt = scalar @in_files; my ($msg); my $scnt = 0; my $dcnt = 0; my @subs = (); my ($i, $lev, $rel, $isz, $iw, $ih, $exn, $max); if ($icnt == 0) { prt( "No index, since NO FILES ...\n" ); return 0; } if ($minimage) { # adjust $targwid to less, if no images exceed it. $max = 0; for ($i = 0; $i < $icnt; $i++) { $exn = $in_files[$i][$if_ext]; if ($exn == $ex_grf) { $isz = $in_files[$i][$if_isz]; $iw = get_image_width($isz); $ih = get_image_height($isz); if( ( $iw > $targwid ) || ( $ih > $targwid ) ) { $max = 0; last; } $max = $iw if ($iw > $max); $max = $ih if ($ih > $max); } } if ($max > 0) { $targwid = $max; } } if ($writesubs && $recursive) { for ($i = 0; $i < $icnt; $i++) { # 0 1 2 3 4 5 6 # my $if_ fnm dir ext siz dat lev rel isz ffn # push(@in_files, [$fil, $inf, $exn, $in_size, $in_date, $lev, $rel, $isz, $ff]); $lev = $in_files[$i][$if_lev]; $rel = $in_files[$i][$if_rel]; if (length($rel) && ($lev > 0)) { if ( !in_list($rel, @subs) ) { if ( gen_sub_index( $rel, $lev ) ) { push(@subs, $rel); } } } } } local_rename2oldbak($of); open my $OF, ">$of" or mydie("ERROR: Unable to generate $of file ...aborting ...\n"); prt( "Writing [$of] HTML with $icnt files... " ); if ($addmd5digest) { prt(" with MD5... takes time (on large files)..."); } prt("\n"); write_html_head($OF); add_file_table($OF); add_type_table($OF, ".") if ($addcattable); if (@subs) { $scnt = scalar @subs; $dcnt = 0; if ($simplelinks) { print $OF "<hr>\n"; print $OF "<a name=\"links\"\n"; print $OF " id=\"links\"></a>\n"; print $OF "<p><b>Links to $scnt subs:</b> \n"; foreach $msg (@subs) { print $OF " [<a href=\"$msg/$output_file\">$msg</a>] \n"; } print $OF "</p>\n"; } else { 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/$output_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; } # RENAME A FILE TO .OLD, or .BAK # 0 - do nothing if file does not exist. # 1 - rename to .OLD if .OLD does NOT exist # 2 - rename to .BAK, if .OLD already exists, # 3 - deleting any previous .BAK ... sub local_rename2oldbak { my ($fil) = shift; my $ret = 0; # assume NO SUCH FILE if ( -f $fil ) { # is there? my ($nm,$dir,$ext) = fileparse( $fil, qr/\.[^.]*/ ); my $nmbo = $dir . $nm . '.old'; $ret = 1; # assume renaming to OLD if ( -f $nmbo) { # does OLD exist $ret = 2; # yes - rename to BAK $nmbo = $dir . $nm . '.bak'; if ( -f $nmbo ) { $ret = 3; unlink $nmbo; } } rename $fil, $nmbo; } return $ret; } ################################################## # My particular 'nice number' sub local_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; } ##################################################### ### grace ImageMagick 'indentify' installed on PATH sub get_image_width { my ($is) = shift; my $wid = 0; my @arr = split(/x/,$is); if (scalar @arr == 2) { $wid = $arr[0]; } return $wid; } sub get_image_height { my ($is) = shift; my $hgt = 0; my @arr = split(/x/,$is); if (scalar @arr == 2) { $hgt = $arr[1]; } return $hgt; } sub get_image_size { my ($if) = shift; my $is = ''; if (open (IDT, "identify \"$if\"|")) { my @arr2 = <IDT>; close IDT; foreach my $ln (@arr2) { chomp $ln; ##prt( "[$ln]\n" ); if (substr($ln,0,length($if)) eq $if) { my $ln2 = substr($ln,length($if)); $ln2 =~ s/^\s//; ##prt( "$ln2\n" ); if ($ln2 =~ /\s(\d+x\d+)\s/) { $is = $1; } } } } else { prt( "ERROR: I can't open [$if]\n" ); } return $is; } #################################################### ### MAIN ### parse_args(@ARGV); if ($in_folder eq '.') { $in_folder = $cwd; } $out_path = $in_folder."\\".$output_file; if (-f $out_path) { if (!$overwrite) { prt( "WARNING: $output_file already exists in $in_folder ... DELETE OR RENAME first ...\n" ); $out_path = 'tempfileindex.htm'; prt( "Switched output to [$out_path]...\n" ); } } $href = 'target="_blank" href' if ($makelinkblank); 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) ) { prt("Loading [$out_path] into a browser...\n"); system($out_path); } if (@skipped) { prt( "WARNING: Skipped following ". scalar @skipped." FILES found ...\n" ); if ($dbg3) { foreach my $sk (@skipped) { prt( "$sk\n" ); } } } pgm_exit(0,""); #################################################### sub give_help { prt("$pgmname: version 0.0.1 2010-05-05\n"); prt("Usage: $pgmname [options] folder\n"); prt("Options:\n"); prt(" --help (-h or -?) = This help and exit 0\n"); prt(" --load-log (-l) = Load log file at end.\n"); prt(" --md5 (-m) = Add MD5 index column.\n"); prt(" --new (-n) = Make file/image links to a new window.\n"); prt(" --recursive (-r) = Recurse into sub-directories.\n"); #prt(" --out <file> = Specify the OUTPUT file name."); } sub need_arg { my ($arg,@av) = @_; pgm_exit(1,"ERROR: [$arg] must have following argument!\n") if (!@av); } sub parse_args { my (@av) = @_; while (@av) { my $arg = $av[0]; if ($arg =~ /-/) { my $sarg = substr($arg,1); $sarg = substr($sarg,1) while ($sarg =~ /-/); if (($sarg =~ /h/i)||($sarg eq '?')) { give_help(); pgm_exit(0,"Help exit(0)"); } elsif ($sarg =~ /^l/i) { $load_log = 1; } elsif ($sarg =~ /^r/i) { $recursive = 1; } elsif ($sarg =~ /^m/i) { $addmd5digest = 1; } elsif ($sarg =~ /^n/i) { $makelinkblank = 1; } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { $in_folder = $arg; prt("Set input to [$in_folder]\n"); } shift @av; } if ($debug_on && (length($in_folder) == 0)) { $in_folder = $def_folder; } if (length($in_folder) == 0) { pgm_exit(1,"ERROR: NO input folder found in command!\n"); } if (! -d $in_folder) { pmg_exit(1, "WARNING: $in_folder DOES NOT EXIST ...\n" ); } } # eof - genfileindex.pl