#!/usr/bin/perl -T

use CGI::Carp;
use Sial::Webit;

use POSIX qw(strftime);

# page defaults
my $title       = 'Perl Code';
my $description = 'Various perl scripts and modules';
my @keywords    = qw:script perl module benchmark:;

# create the page header
my $sial = new Sial::Webit ($title, $description, \@keywords);

print "Content-Type: text/html\n";
print "Expires: ", strftime("%a, %d %b %Y %H:%M:%S %Z", gmtime (10800 + time)), "\n";
print "Last-Modified: ", strftime("%a, %d %b %Y %H:%M:%S %Z", gmtime ((stat $ENV{SCRIPT_FILENAME})[9])), "\n\n";

$sial->header ( '', {
    'UP' => { 'HREF' => '../', 'TITLE' => 'Up to Code' },
    'next' => { 'HREF' => 'bench/', 'TITLE' => 'Perl Benchmarks' }
});

print '<H2>', $title, '</H2>';
print '<P ALIGN=CENTER><SMALL><A HREF="bench/">Benchmarks</A> &nbsp; | &nbsp; <a href="docs/">Documentation</a> &nbsp; | &nbsp; <A HREF="modules/">Modules</A> &nbsp; | &nbsp; <A HREF="scripts/">Scripts</A> &nbsp; | &nbsp; <A HREF="#related">Related Links</A></SMALL></P>';

print '<P>I use <A HREF="http://www.perl.com/">perl</A> to dynamically serve out these pages, and to solve various administrative requirements to make my job easier. And just about everything else, as I mainly do text mangling, and haven\'t found any languages I like as much as perl.</P>';

print '<P><A HREF="http://www.cvshome.org/"><ACRONYM TITLE="Concurrent Versions System">CVS</ACRONYM></A> is used to ensure sanity on my part when dealing with such an eclectic gaggle of scripts and modules.</P>';

print '<H3><A HREF="bench/">Benchmarks</A></H3>';

print '<P>Some random benchmarks of common perl operations.</P>';

print '<h3><a href="docs/">Documentation</a></h3>';

print '<p>Documentation, though mainly supporting config files for some of my scripts at this point.</p>';

print '<H3><A HREF="modules/">Modules</A></H3>';
print '<P>A bunch of modules that mainly do specific things on this website; they should be informative to someone learning perl, or at least a warning of some kind.</P>';

print '<H3><A HREF="scripts/">Scripts</A></H3>';
print '<P>Various scripts that do a whole bunch of different things, some buggy, some not.  Enough hype, already...</P>';

print <<'RELATED';
<A NAME="related"></A><H3>Related Links</H3>
<ul>
    <LI><A HREF="http://www.barebones.com/">BareBones BBEdit</A> - A spiffy Mac OS text editor with great Perl integration</LI>
    <LI><A HREF="http://www.cpan.org/">CPAN</A> - Get your modules here!</LI>
    <LI><A HREF="http://www.mit.edu/people/wsanchez/software/">DropScript</A> - nifty Mac OS X utility to create GUI applications around command line scripts.</LI>
    <LI><A HREF="http://perl.apache.org/">mod_perl</A> - Apache/Perl Integration Project</LI>
    <LI><A HREF="http://www.perl.com/">Perl.com</A></LI>
    <LI><A HREF="http://use.perl.org/">use Perl</A></LI>
    <li><a href="http://books.perl.org/">Perl Books</a></li>
</UL>
RELATED

sub do_load {
    my $r_info = shift;
    my $dir = shift;
    
    my ($changes, $doc_text, $doc_pdf, $doc_html);
    
    # read 'info' tag from filename.info file
    open(F, "$dir/$_.info");
    my $info = <F>;
    close(F);
    
    if (-e "$dir/$_.log") {
    	$changes = "$dir/$_.log";
    }
    
    $doc_text = "$dir/$_.txt"  if -e "$dir/$_.txt";
    $doc_pdf  = "$dir/$_.pdf"  if -e "$dir/$_.pdf";
    $doc_html = "$dir/$_.html" if -e "$dir/$_.html";

    my $size = $r_info->{'size'};
    my $epoch = $r_info->{'mtime'};

    my (undef, $min, $hh, $dd, $mm, $yy) = localtime($epoch);
    $mm++; $yy += 1900;
    
    $size = humanize($size);

    print '<TR ';
    if ( ($now_time - $epoch) < 604800 ) {
	print 'BGCOLOR="#9999CC">';
    } else {
	print 'BGCOLOR="#CCCCFF">';
    }
    print '<TD><BIG><B><A HREF="', $dir, '/', $_, '"><IMG ALT="* " SRC="/imgs/file.gif" WIDTH=16 HEIGHT=16 BORDER=0> ', $_, '</A></B></BIG></TD>';

    print '<TD ALIGN=LEFT>', $size, '</TD><TD>';
    printf ("%04d-%02d-%02d", $yy, $mm, $dd);
    printf (", %02d:%02d", $hh, $min) if ( $now_time - $epoch ) < 604800;
    print '</TD></TR>';

    print '<TR BGCOLOR="#FFFFFF"><TD COLSPAN=3>', $info, '</TD></TR>' if defined $info;

    print '<TR BGCOLOR="#FFFFFF"><TD COLSPAN=3><SMALL>';
    if ($changes) {
	print ' <A HREF="', $changes, '">View Change Log</A> ';
    } else {
	print 'No Change Log';
    }
    print '</SMALL></TD></TR>';

    # docs?
    print '<TR BGCOLOR="#FFFFFF"><TD COLSPAN=3><SMALL>Documentation:';
    if ($doc_text || $doc_pdf || $doc_html) {
	print ' <A HREF="', $doc_html, '">HTML</A> ' if $doc_html;
	print ' <A HREF="', $doc_pdf,  '">PDF</A> '  if $doc_pdf;
	print ' <A HREF="', $doc_text, '">Text</A> ' if $doc_text;
    } else {
	print ' None Available';
    }
    
    print '</SMALL></TD></TR>';
#    print '<TR BGCOLOR="#FFFFFF"><TD COLSPAN=3><P></P></TD></TR>';

}

# clean up Enviro settings for Taint mode FIRST ( man perlsec )
sub BEGIN {
	delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
	$ENV{'PATH'} = '/bin:/usr/bin';
}

# and always finish off with a HTML footer
END {
	$sial->footer;
}

# Inspired from GNU's df -h output, which fixes 133456345 bytes
# Inspired from GNU's df -h output, which fixes 133456345 bytes
# to be something human readable.
#
# takes a number, returns formatted string.  Also takes optional
# hash containing various defaults that affect output style.
sub humanize {
    my $num = shift; # could also take a array ref or hash ref to parse thru?
    my %prefs = @_;

my %global_prefs = (
	     # include decimals in output? (e.g. 25.8 K vs. 26 K)
	     'decimal' => 0,
	     # include .0 in decmail output?
	     'decimal_zero' => 0,
	     # what to divide file sizes down by
	     'factor' => 1024,
	     # percentage above which will be bumped up
	     # (e.g. 999 bytes -> 1 K as within 5% of 1024)
	     # set to undef to turn off
	     'fudge' => 0.95,
	     # lengths above which decimals will not be included
	     # for better readability
	     'max_human_length' => 2,
	     # list of suffixes for human readable output
	     'suffix' => [ '', ' K', ' M', ' G', ' P', ' E', ' Z', ' Y' ],
	     );

    # inherit global prefs, but give preference to user supplied ones
    unless (keys %prefs) {
	%prefs = %global_prefs;
    } else {
	# benchmarking w/ 5.6.0 on Linux PPC & i386 showed this next
	# faster than direct merge method (p. 145 Perl Cookbook)
	while (my ($k, $v) = each (%global_prefs)) {
	    $prefs{$k} = $v unless exists $prefs{$k};
	}
    }

    # some local working variables
    my $count = 0;
    my $prefix = '';
    my $tmp = '';

    # handle negatives
    if ($num < 0 ) {
	$num = abs $num;
	$prefix = '-';
    }
    
    # reduce number to something readable by factor specified	
    while ($num > $prefs{'factor'}) {
	$num /= $prefs{'factor'};
	$count++;
    }
    
    # optionally fudge "near" values up to next higher level
    if(defined $prefs{'fudge'}) {
	if ($num > ($prefs{'fudge'} * $prefs{'factor'})) {
	    $count++;
	    $num /= $prefs{'factor'};
	}
    }
    
    # no .[1-9] decimal on longer numbers for easier reading
    # only show decimal if prefs say so
    if (length sprintf("%.f", $num) > $prefs{'max_human_length'} || 
	! $prefs{'decimal'}) {

	$tmp = sprintf("%.0f", $num);

    } else {
	$tmp = sprintf("%.1f", $num);
	
	# optionally hack trailing .0 as is not needed
	$tmp =~ s/\.0$// unless $prefs{'decimal_zero'};
    }
    
    # return number with proper style applied
    return $prefix . $tmp . $prefs{'suffix'}->[$count];
}