#!/usr/bin/perl

# display.pl - Script to output the contents of updates for a given date.

# Use the CGI module, specifically the bit that gets parameters.
# use CGI qw(param);

# Set the root directory for archive files.
$ROOT_DIR = "..";
$URL_ROOT = "/";

# Get the time, format the couple of variables I'll actually use.
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
++$mon;
$year += 1900;

# Handy for turning numeric dates into English...
@month_name = ("January", "February", "March", "April", "May", "June", "July",
               "August", "September", "October", "November", "December");
 
# Grab the command line options, and append any date set with ?date=blah when
# executing as a CGI script.
@options = @ARGV;
# @options[@options + 1] = param("date");

# We're sending some HTML down the pipe...
print "Content-type: text/html\n\n";

# Unless this is already in an HTML document or calling for
# the newest updates, spit out some default HTML...
$doc_uri = $ENV{'DOCUMENT_URI'};
$print_footer = 0;
unless (($doc_uri =~ m/html$/) || ($options[0] eq "new")) {
    fragment_print ("header.html");
    $print_footer = 1;
    print "<h2>Old Stuff: $options[0]</h2>\n\n";
}

# Take action!
# (for each option provided)

for (@options) {
    # This just provides a convenient alias for the most recent month.
    if ($_ eq "new") {
        $mon_minus = -1;
        # find that most recent month
        until (-d "$ROOT_DIR\/$_") {
            $mon_minus++;
	        $_ = "$year/" . ($mon - $mon_minus);
	    }
    }

    if ( m'^([0-9]{4}/[0-9]{1,2}/[0-9]{1,2})/([a-z_]+)$' ) {
        # It's a document within a date.  Send it to entry_print.
        entry_print ($_, "index");
    } elsif ( m'^[0-9]{4}/[0-9]{1,2}/[0-9]{1,2}$' ) {
        # It's a specific date.  Print it in full.
        entry_print ($_, "all");
    } elsif ( m'^[0-9]{4}/[0-9]{1,2}$' ) {
        # It's a month.  Print it.
        month_print ($_);
    } elsif ( m'^[0-9]{4}$' ) {
        # It's a year. Display a list of updates.
        year_print ($_);
    }
}

# For each entry in @entries, if it exists, read it and spit it out.
# Plus any extra stuff...

# Finish up...
# Print a footer.
if ($print_footer) {
    fragment_print ("footer.html");
}

# Fini.

# ---------------------------------------------------------------------
# | Subroutines...                                                    |
# ---------------------------------------------------------------------

sub dir_list {
    # Return a numerically sorted list of files matching $pattern in a
    # directory...

    my ($dir, $sort_order, $file_pattern) = @_;
    unless ($file_pattern) { $file_pattern = "^[0-9]{1,2}\$"; }
    unless ($sort_order) { $sort_order = "high_to_low"; }
    my (@files);

    opendir LIST_DIR, $dir;
    @files = grep /$file_pattern/, readdir LIST_DIR;
    closedir LIST_DIR;

    @files = sort $sort_order @files;

    return @files;
}

# various sorts for dir_list

# alphabetical
sub alpha {
    $a cmp $b;
}

# numeric, high to low
sub high_to_low {
    $b <=> $a;
}

# number, low to high
sub low_to_high {
    $a <=> $b;
}

# list out the updates for a year
sub year_print {
    my ($option) = @_;
    if (-d "$ROOT_DIR\/$option") {
        @month_files = dir_list ("$ROOT_DIR\/$option", "high_to_low", "^[1-9]{1,2}\$");
	    print "<h3>$option</h3>\n\n";
    	print "<ul class=\"datelink\">\n";

        foreach $month_file (@month_files) {
            @update_files = dir_list ("$ROOT_DIR\/$option\/$month_file", "low_to_high", "^[1-9]{1,2}\$");
            $update_count += @update_files;
	        print "<li><a href=\"/$option/$month_file\">$month_name[($month_file - 1)]" . "</a><br />\n"
                  . "&nbsp;&nbsp;&nbsp;&nbsp; <small>\n";
            foreach $update_file (@update_files) {
                print "<a href=\"/$option/$month_file\/$update_file\">$update_file</a> \n";
            }
            print "</small></li>\n";
        }
	    print "</ul>\n";
        print "<p>($update_count entries)</p>";
    }
}

sub month_print {
    # If a directory exists for that month, grab a list of
    # the entry files it contains and push them into @entries, sorted
    # numerically.  Then send each entry to entry_print.
    my ($month) = @_;

    if (-d "$ROOT_DIR\/$month") {
        my (@entry_files) = dir_list ("$ROOT_DIR\/$month", "high_to_low", "^[1-9]{1,2}\$");
        foreach $entry_file (@entry_files) {
            entry_print ("$month\/$entry_file", "index");
        }
    }
}

sub entry_print {
    my ($entry, $level) = @_;
    my ($entry_loc, $entry_url, $ds, @sub_entries, $ico_markup);
    
    # location of entry on local filesystem
    $entry_loc = "$ROOT_DIR/$entry";
    # and its URL
    $entry_url = $URL_ROOT . $entry;
    
    $ds = "";
    unless ($level eq "header") {
        $ds = datestamp ($entry);
    }

    if (-T $entry_loc) {
        if (($ico_markup = icon_markup ($entry, ""))) {
            print "<p class=\"doodle\">\n" . $ico_markup . "</p>\n\n";
        }

        fragment_print ("$entry_loc");
        if ($ds) { print $ds; }
    } elsif (-d $entry_loc) {
        # if (($ico_markup = icon_markup ("$entry/index", ""))) {
        #    print "<p class=\"doodle\">\n" . $ico_markup . "</p>\n\n";
        #}
        #fragment_print ("$entry_loc/index") or print "$entry_loc/index not found\n\n";
        entry_print ("$entry/index", "index");
        #if ($ds) { print $ds };
                
        @sub_entries = dir_list ($entry_loc, "alpha", "^[a-z_]+\$");
        
        if (($level eq "index") && (@sub_entries > 1)) {
            print "<p style=\"text-align: right; margin-right: 5%;\"><strong>*</strong><br />\n";
            foreach $sub_entry (@sub_entries) {
                if ($sub_entry eq "index") { next; } 

                $ico_markup = icon_markup("$entry/$sub_entry", "[ $sub_entry ]");
                if (!($ico_markup)) { 
                    print "[ <a href=\"/$entry/$sub_entry\">$sub_entry</a> ]\n";
                } else {
                    print "<a href=\"/$entry/$sub_entry\">$ico_markup</a>\n";
                }
            }               
            print "</p>\n\n";
        } elsif ($level eq "all") {
            print "<hr />";
            foreach $sub_entry (@sub_entries) {
                if ($sub_entry eq "index") { next; } 
                entry_print ("$entry/$sub_entry", "index");
                if ($ds) { print $ds; }
            }               
        }
    }    
}

sub icon_markup {
    my ($entry, $alt) = @_;
    my ($entry_loc) = $ROOT_DIR . "/$entry";
    my ($entry_url) = $URL_ROOT . "$entry";
    my ($icon, $icon_loc, $icon_url);
    if (-T $entry_loc) {
        $icon_loc = "$entry_loc.icon";
        $icon_url = "$entry_url.icon";
    } elsif (-d $entry_loc) {
        $icon_loc = "$entry_loc/index.icon";
        $icon_url = "$entry_url/index.icon";
    }

    if (-e $icon_loc . ".png") {
        my($width, $height) = image_size ("$icon_loc.png");
        $icon = $icon_url . ".png";
        return "<img src=\"$icon\"\n width=\"$width\" height=\"$height\"\n alt=\"$alt\" />";
    } elsif (-e "$icon_loc.jpg") {
        my($width, $height) = image_size ("$icon_loc.jpg");
        $icon = $icon_url . ".jpg";
        return "<img src=\"$icon\"\n width=\"$width\" height=\"$height\"\n alt=\"$alt\" />";
    } else {
        return 0;
    }
}

# returns a nice html datestamp for a given entry.
sub datestamp {
    my ($entry) = @_;
    if ($entry =~ m/(^[0-9]{4}\/[0-9]{1,2}\/[0-9]{1,2})/) {

        my ($entry_year, $entry_month, $entry_day) = split (/\//, $1);
            
        # return a fancy datestamp.
        return "\n\n<p class=\"datelink\">&mdash; <a href=\"/$entry_year\">$entry_year</a> / " 
                  . "<a href=\"/$entry_year/$entry_month\">$month_name[($entry_month - 1)]</a> / "
                  . "<a href=\"/$entry_year/$entry_month/$entry_day\">$entry_day</a></p>\n\n";
    } else {
        return 0;
    }
}


sub fragment_print {
    # print a text fragment - a header, footer, update, etc.
    # parses some special markup, specifically:
    #     <freeverse></freeverse>
    # returns 1 on successful completion, 0 otherwise

    my ($file) = @_;
    my ($line);

    if ((-T $file)) {
        open (FRAGMENT, $file) or print "Can't read {$file}.\n";

        while ($line = <FRAGMENT>) {
            # Process and spit out lines.
            if ($line =~ m/<freeverse>/) {
                $frontpiece = "<p>";
                while (($line !~ m/<\/freeverse>/) && !(eof)) {
                    chomp($line = <FRAGMENT>);

                    if ($line =~ m/<pre>/) {
                       print "\n\n";
                       until ($line =~ m/<\/pre>/) {
                           print $line;
                           chomp($line = <FRAGMENT>);
                       }
                       print $line;
                       chomp ($line = <FRAGMENT>);
                       next;
                    }
                       
                    # make sure front bit is ok
                    if ($line eq "") {
                        $frontpiece = "</p>";
                    }
                    # set end bit
                    $endpiece = "";

                    # print line

                    $modified_line = $line;
                    $modified_line =~ s/<\/freeverse>/<\/p>\n\n/;
                    $modified_line =~ s/(\s?)--(\s?)/$1&mdash;$2/g;

                    print $frontpiece . $modified_line . $endpiece;

                    # set front bit for next line
                    if ($line eq "") {
                        $frontpiece = "\n\n<p>";
                    } elsif ($line =~ m/\"$/) {
                        $frontpiece = " ";
                    } else {
                        unless (($line =~ m/<\/p>$/)
                                || ($line =~ m/<br \/>$/)
                                || ($line eq "")) {
                            $frontpiece = "<br \/>\n";
                        }
                    }
                }
            } else {
                print $line;
            }
        }

        print "\n";
        close (FRAGMENT);
        return 1;
    } else {
        return 0;
    }
}

# image_size : returns (width, height) of a PNG or JPEG file.
# munged together from pngsize and jpegsize
# in wwwis, by Alex Knowles and Andrew Tong
# see http://www.bloodyeck.com/wwwis/

sub image_size {
    my ($image_file) = @_;
    my ($size);

    if ( !open(IMAGE, "<$image_file") ) {
        print "can't open IMG $image_file"; 
        $size = "";
    } else {
        if ($image_file =~ m/\.png$/) {
            my ($a, $b, $c, $d, $e, $f, $g, $h) = 0;

            if (defined($image_file)
                && read(IMAGE, $head, 8) == 8
                && ($head eq "\x8a\x4d\x4e\x47\x0d\x0a\x1a\x0a" ||
                    $head eq "\x89\x50\x4e\x47\x0d\x0a\x1a\x0a")
                && read(IMAGE, $head, 4) == 4
                && read(IMAGE, $head, 4) == 4
                && ($head eq "MHDR" || $head eq "IHDR")
                && read(IMAGE, $head, 8) == 8) {
                # ($x,$y)=unpack("I"x2,$head);   # doesn't work on little-endian machines
                # return ($x,$y);
                    ($a,$b,$c,$d,$e,$f,$g,$h) = unpack ("C"x8,$head);
                    return ($a<<24|$b<<16|$c<<8|$d, $e<<24|$f<<16|$g<<8|$h);
                }
        } elsif ($image_file =~ m/\.jpe?g$/) {
            my($done)=0;
            my($c1,$c2,$ch,$s,$length, $dummy)=(0,0,0,0,0,0);
            my($a,$b,$c,$d);

            if (defined($image_file)
               && read(IMAGE, $c1, 1)
               && read(IMAGE, $c2, 1)
               && ord($c1) == 0xFF
               && ord($c2) == 0xD8) {
                    while (ord($ch) != 0xDA && !$done) {
                        # Find next marker (JPEG markers begin with 0xFF)
                        # This can hang the program!!
                        while (ord($ch) != 0xFF) { return(0,0) unless read(IMAGE, $ch, 1); }
                        # JPEG markers can be padded with unlimited 0xFF's
                        while (ord($ch) == 0xFF) { return(0,0) unless read(IMAGE, $ch, 1); }
                        # Now, $ch contains the value of the marker.
                        if ((ord($ch) >= 0xC0) && (ord($ch) <= 0xC3)) {
                            return(0,0) unless read (IMAGE, $dummy, 3);
                            return(0,0) unless read(IMAGE, $s, 4);
                            ($a,$b,$c,$d)=unpack("C"x4,$s);
                            return ($c<<8|$d, $a<<8|$b );
                        } else {
                            # We **MUST** skip variables, since FF's within variable names are
                            # NOT valid JPEG markers
                            return(0,0) unless read (IMAGE, $s, 2);
                            ($c1, $c2) = unpack("C"x2,$s);
                            $length = $c1<<8|$c2;
                            last if (!defined($length) || $length < 2);
                            read(IMAGE, $dummy, $length-2);
                        }
                    }        
                }
            } 

        return (0,0);
    } 
}