genfolderindex.pl to HTML.

index -|- end

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

index -|- top

checked by tidy  Valid HTML 4.01 Transitional