genfileindex.pl to HTML.

index -|- end

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 .= '&nbsp;';
            }
            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

index -|- top

checked by tidy  Valid HTML 4.01 Transitional