indexone.pl to HTML.

index -|- end

Generated: Mon Aug 16 14:14:25 2010 from indexone.pl 2010/05/05 7.6 KB.

#!/perl -w
# NAME: indexone.pl
# AIM: Using the file input, create a HTML table item
# 05/05/2010 geoff mclane http://geoffair.net/mperl
use strict;
use warnings;
use File::Basename;  # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[.]*/] )
use Cwd;
use Digest::MD5  qw(md5 md5_hex md5_base64);
use File::stat; # to get the file date and size
unshift(@INC, 'C:\GTools\perl');
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 $perl_dir = 'C:\GTools\perl';
my $outfile = $perl_dir."\\temp.$pgmname.txt";
open_log($outfile);

# user variables
my $debug_on = 0;   # should be OFF for release
my $verbose = 0;
my $def_file = 'temp.zip';
my $load_log = 0;
my $in_file = '';
my $full_table = 0;
my $out_file = '';

### program variables
my @warnings = ();
my $cwd = cwd();
my $os = $^O;
my ($in_name,$in_folder);

sub pgm_exit($$) {
    my ($val,$msg) = @_;
    if (length($msg)) {
        $msg .= "\n" if (!($msg =~ /\n$/));
        prt($msg) if ($val || $verbose);
    }
    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 u2d($) {
   my ($f) = shift;
   $f =~ s/\//\\/g;
   return $f;
}

sub d2u($) {
   my ($f) = shift;
   $f =~ s/\\/\//g;
   return $f;
}


sub sub_common_folder_dos {
   my ($f1, $f2) = @_;
    my $df1 = u2d($f1);
    my $df2 = u2d($f2);
    if ($os eq 'MSWin32') {
        $df1 = lc($df1);
        $df2 = lc($df2);
    }
    # paddle across, stopping at first difference
   my $off = 0;
   while ( substr($df1,$off,1) && substr($df2,$off,1) &&
         ( substr($df1,$off,1) eq substr($df2,$off,1) ) ) {
      $off++;
   }
   return substr($f1,$off);
}

sub sub_in_folder($) {
    my ($path) = shift;
    $path = sub_common_folder_dos($path,$in_folder);
    $path =~ s/^(\\|\/)//; # kick off any leading '\' or '/' - 2010-04-02
    return $path;
}

# My particular time 'translation' - replaced date_string
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 get_table_begin() {
    my $table = <<EOF;
  <table align="center"
         border="1"
         cellpadding="1"
         cellspacing="2"
         summary="table of zips">
   <tr>
    <th>
     Date
    </th>
    <th>
     Link
    </th>
    <th>
     Size
    </th>
    <th>
     MD5
    </th>
   </tr>

EOF
    return $table;
}


sub process_file($) {
    my ($fil) = shift;
    my ($sb,$md5,$dtt,$nn,$sf);
    my $htm = '';
    if ($sb = stat($fil)) {
        open(FILE, $fil) or mydie( "Can't open '$fil': $!" );
        binmode(FILE);
        my $md5 = Digest::MD5->new->addfile(*FILE)->hexdigest;
        close(FILE);
        $dtt = YYYYMMDD($sb->mtime);
        $nn = get_nn($sb->size);
        $sf = sub_in_folder($fil);
        $sf = d2u($sf);
        $htm .= " <tr>\n";
        # date
        $htm .= "  <td>\n";
        $htm .= "   $dtt\n";
        $htm .= "  </td>\n";
        # link
        $htm .= "  <td>\n";
        $htm .= "   <a href=\"$sf\">$sf</a>\n";
        $htm .= "  </td>\n";
        # size
        $htm .= "  <td align=\"right\">\n";
        $htm .= "   $nn\n";
        $htm .= "  </td>\n";
        # MD5
        $htm .= "  <td>\n";
        $htm .= "   <tt>$md5</tt>\n";
        $htm .= "  </td>\n";

        $htm .= " </tr>\n";

        if ($full_table) {
            $htm = get_table_begin().$htm."</table>\n";
        }

        prt($htm);
        if (length($out_file)) {
            write2file($htm,$out_file);
            prt("Written to file [$out_file].\n") if ($verbose);
        }
    } else {
        prt("ERROR: stat failed on file [$fil]!\n");
    }
}

#########################################
### MAIN ###
parse_args(@ARGV);
prt("$pgmname: in [$cwd]: processing [$in_file]\n" ) if ($verbose);
process_file($in_file);
pgm_exit(0,"Normal exit(0)");
########################################
sub give_help {
    prt("$pgmname: version 0.0.1 2010-05-05\n");
    prt("Usage: $pgmname [options] input_file\n");
    prt("Options:\n");
    prt(" -h (or -?) = This help and exit 0\n");
    prt(" -v         = Increase verbosity. (Def=$verbose).\n");
    prt(" -f         = Full HTML table code.\n");
    prt(" -l         = Load log at end.\n");
    prt(" -o <file>  = Output HTML to file.\n");
    prt("Purpose: To prepare a HTML table line containing this item.\n");
}
sub need_arg {
    my ($arg,@av) = @_;
    pgm_exit(1,"ERROR: [$arg] must have follwoing argument!\n")
        if (!@av);
}
sub precheck_verb {
    my (@av) = @_;
    while (@av) {
        my $arg = $av[0];
        if ($arg =~ /^-v/i) {
            $verbose++;
            prt("Set verbose to $verbose\n");
        }
        shift @av;
    }
}
sub parse_args {
    my (@av) = @_;
    precheck_verb(@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 =~ /^v/i) {
                # already done
            } elsif ($sarg =~ /^l/i) {
                $load_log = 1;
                prt("Set to load log at end.\n") if ($verbose);
            } elsif ($sarg =~ /^f/i) {
                $full_table = 1;
                prt("Set to output full HTML table.\n") if ($verbose);
            } elsif ($sarg =~ /^o/i) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $out_file = $sarg;
                prt("Set to output file to [$out_file].\n") if ($verbose);
            } else {
                pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n");
            }
        } else {
            $in_file = $arg;
            prt("Set input to [$in_file]\n") if ($verbose);
        }
        shift @av;
    }
    if (length($in_file)) {
        if (! -f $in_file) {
            pgm_exit(1,"ERROR: Unable to find file [$in_file]\n");
        }
    } else {
        if ($debug_on && (-f $def_file)) {
            $in_file = $def_file;
            prt("Set input to DEFAULT [$in_file]\n") if ($verbose);
        } else {
            pgm_exit(1,"ERROR: No input file found. Try -?\n");
        }
    }
    ($in_name,$in_folder) = fileparse($in_file);
}

# eof - indexone.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional