#!/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 = "..";

# 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)
foreach $option (@options) {
    # This just provides a convenient alias for the most recent month.
    if ($option eq "new") {
        $mon_minus = -1;
        until (-d "$ROOT_DIR\/$option") {
            # find that most recent month
            $mon_minus++;
	        $option = "$year/" . ($mon - $mon_minus);
	    }
    }

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

# 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;
}

sub alpha {
    $a cmp $b;
}

sub high_to_low {
    $b <=> $a;
}

sub low_to_high {
    $a <=> $b;
}

sub year_print {
    # list out the updates for a year
    if (-d "$ROOT_DIR\/$option") {
        @month_files = dir_list ("$ROOT_DIR\/$option", "high_to_low");
	    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");
            $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.
    my ($option) = @_;

    if (-d "$ROOT_DIR\/$option") {
        my (@entry_files) = dir_list ("$ROOT_DIR\/$option", "high_to_low");
        foreach $entry_file (@entry_files) {
            day_print ("$option\/$entry_file", "index");
        }
    }
}

sub day_print {
    my ($entry, $doc_level) = @_;
    my ($entry_file, @sub_entries, @sub_entry);
    my ($e_year, $e_month, $e_day) = split(/\//,$entry);

    $entry_file = "$ROOT_DIR\/$entry";

    if (-d $entry_file) {
        # Stuff for entry directories (instead of flat text files)
        doc_print ($entry_file, "index", "/$entry");
        @sub_entries = dir_list ($entry_file, "alpha", '^[a-z_]+$');

        if ($doc_level eq "index") {

            print "<p>";

            foreach $sub_entry (@sub_entries) {
                # display a link, using an icon if one exists
                # for each sub entry
                
                # skip 'index' when listing sub-entries.
                if ($sub_entry eq "index") { next; } 

                $ico_markup = icon_markup(("$entry_file/$sub_entry" . ".icon"), $sub_entry, "/$entry", $sub_entry);
                unless ($ico_markup) { $ico_markup = $sub_entry; }              
                print "<a href=\"/$entry/$sub_entry\">$ico_markup</a>\n";
            }
        } elsif ($doc_level eq "all") {
            foreach $sub_entry (@sub_entries) {
                unless ($sub_entry eq "index") {
                    print "<hr />\n\n";
                    doc_print ($entry_file, $sub_entry, "/$entry");
                }
            }
        }
        print "</p>\n\n";
    } else {
        # Flat text file
        fragment_print ($entry_file) or print "$entry ain't there. \n";
    }

    # Print a fancy datestamp at the bottom of the entry.
    print "\n\n<p class=\"datelink\">&mdash; <a href=\"/$e_year\">$e_year</a> / " 
          . "<a href=\"/$e_year/$e_month\">$month_name[($e_month - 1)]</a> / "
          . "<a href=\"/$entry\">$e_day</a></p>\n\n";
}

sub doc_print {
    my ($dir, $doc, $url) = @_;
    my ($icon);

    $icon = "$dir/$doc" . ".icon";
    if (($ico_markup = icon_markup ($icon, $doc, $url, ""))) {
        print "<p class=\"doodle\">\n" . $ico_markup . "</p>\n\n";
    }
    
    fragment_print ("$dir/$doc") or print "$doc ain't there. \n";
}

sub icon_markup {
    my ($icon, $doc, $url, $alt) = @_;
    if (-e "$icon.png") {
        my($width, $height) = image_size ("$icon.png");
        $icon = "$url/$doc" . ".icon.png";
        return "<img src=\"$icon\"\n width=\"$width\" height=\"$height\"\n alt=\"$alt\" />";
    } elsif (-e "$icon.jpg") {
        my($width, $height) = image_size ("$icon.jpg");
        $icon = "$url/$doc" . ".icon.jpg";
        return "<img src=\"$icon\"\n width=\"$width\" height=\"$height\"\n alt=\"$alt\" />";
    } 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>);
                       
                    # 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/;
                    # preserve whitespace
                    unless ($line =~ m/<\/freeverse>/) {
                      $modified_line =~ s/(\s{3})/&nbsp;&nbsp;&nbsp;/;
                      $modified_line =~ s/(\s{2})/&nbsp;&nbsp;/;
                    }  
                    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);
    } 
}