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