#!/usr/bin/perl

# display.pl - Script to display entry fragments

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

# And the root URL the world will see.
# (Normally set to "/")
# Should be used in all links in place of hard coded references.
$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...
# "Null" is there so that $month_name[1] corresponds to January, etc.
# (perl starts index numbers at 0, not 1)
@month_name = qw(Null January February March April May June
                 July August September October November December);

# Grab the command line options.
@options = @ARGV;

# 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";
    print "<div id=\"updates\">\n";
}

# For each option provided, take the appropriate action.
# most often there will only be one option
# but it's good to keep this open
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);
        }
    }

    # take care of trailing slashes
    # normally not an issue
    # same as:
    #   chop if (m'(^.*)/$');
    chop if (substr($_, -1, 1) eq "/");

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

# Finish up...
# Print a footer.
if ($print_footer) {
    print "</div>\n\n";
    fragment_print ("footer.html");
}

# Fini.

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

# dir_list:
# Return a $sort_order sorted list of files matching $pattern in a
# directory.  Called by year_print, month_print, and entry_print.

# calls $sort_order, which can be one of
#   alpha - alphabetical 
#   reverse_alpha - alphabetical, reversed (might not work yet)
#   high_to_low - numeric, high to low
#   low_to_high - numeric, low to high
sub dir_list {
    my ($dir, $sort_order, $file_pattern) = @_;
    my (@files);
    $file_pattern = "^[0-9]{1,2}\$" unless ($file_pattern);
    $sort_order = "high_to_low" unless ($sort_order);

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

# alphabetical, reversed
sub reverse_alpha {
    $b cmp $a;
}

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

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

# year_print: list out the updates for a year
# calls dir_list, entry_print
sub year_print {
    my ($option) = @_;
    my (@month_files, @update_files, $update_count);

    if (-d "$ROOT_DIR/$option") {
        if (-T "$ROOT_DIR/$option/index") {
            entry_print ($option, "index");
            print "<hr />\n\n";
        }

        @month_files = dir_list ("$ROOT_DIR/$option",
                                 "high_to_low",
                                 "^[0-9]{1,2}\$");

        foreach $month_file (@month_files) {
            @update_files = dir_list ("$ROOT_DIR/$option/$month_file",
                                      "low_to_high", "^[0-9]{1,2}\$");

            $update_count += @update_files;

        print "<h3 class=\"datelink\"><a href=\"$URL_ROOT$option/$month_file\">"
            . "$month_name[$month_file]"
            . "</a></h3>\n\n";

            print "<p class=\"datelink\" style=\"text-align: left;\"><small>";

            foreach $update_file (@update_files) {
                print "<a href=\"$URL_ROOT$option/$month_file/$update_file\">"
                    . "$update_file</a> \n";
            }
            print "</small></p>\n\n";
        }
        print "<p>($update_count entries)</p>";
    } elsif (-T "$ROOT_DIR/$option") {
        entry_print ($option, "index");
    }
}

# month_print: print the entries in a given month (nnnn/nn)
# calls dir_list
sub month_print {
    # If a directory exists for $month, use dir_list to grab
    # the entry files it contains into @entry_files, sorted
    # numerically.  Then send each entry to entry_print.
    my ($month) = @_;

    if (-d "$ROOT_DIR/$month") {
        if (-T "$ROOT_DIR/$month/index") {
            entry_print ($month, "index");
            print "<hr />\n\n";
        }

        my (@entry_files) = dir_list ("$ROOT_DIR/$month",
                                      "high_to_low",
                                      "^[0-9]{1,2}\$");

        foreach $entry_file (@entry_files) {
           $ds = "";
           $ds = datestamp ("$month/$entry_file");
           entry_print ("$month/$entry_file", "index");
           print $ds;
        }
    } elsif (-T "$ROOT_DIR/$month") {
        entry_print ($month, "index");
    }
}

# entry_print: print the contents of a given entry,
# along with any extra markup such as datestamps, icons, and headers
# calls datestamp, fragment_print, dir_list, and icon_markup
# recursively calls itself
sub entry_print {
    my ($entry, $level) = @_;
    my ($entry_loc, $entry_url, @sub_entries, $ico_markup);
    $entry_loc = "$ROOT_DIR/$entry"; # location of entry on local filesystem
    $entry_url = $URL_ROOT . $entry; # and its URL
    
    if (-T $entry_loc) {
        if (($ico_markup = icon_markup ($entry, ""))) {
            print "<p class=\"doodle\">\n" . $ico_markup . "</p>\n\n";
        }
        fragment_print ("$entry_loc");
    } elsif (-d $entry_loc) {
        @sub_entries = dir_list ($entry_loc, "alpha", "^[a-z_]+\$");

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

        if (($level eq "index") && (@sub_entries > 1)) {
            # if we're just supposed to print an index
            # and there're extra files
            # spit out icons or text links for them
            print "<p style=\"text-align: right; margin-right: 5%;\">"
                . "<strong>*</strong><br />\n";
            foreach $sub_entry (@sub_entries) {
                next if ($sub_entry eq "index");

                if ( ($ico_markup = icon_markup("$entry/$sub_entry",
                                                "[ $sub_entry ]")) ) { 
                    print "<a href=\"$URL_ROOT" . "$entry/$sub_entry\""
                        . "title=\"[ $sub_entry ]\">$ico_markup</a>\n";
                } else {
                    print "[ <a href=\"$URL_ROOT" . "$entry/$sub_entry\""
                        . "title=\"[ $sub_entry ]\">$sub_entry</a> ]\n";
                }
            }               
            print "</p>\n\n";
        } elsif ( ($level eq "all") && (@sub_entries > 1) ) {
            # but if we're supposed to print everything in the directory
            # and if there's more there than just the index file,
            # print a horizontal rule
            print "<hr />";
            foreach $sub_entry (@sub_entries) {
                # and, skipping the index file
                next if ($sub_entry eq "index");
                # each of the other files
                entry_print ("$entry/$sub_entry", "index");
            }
        }
    }
}

# icon_markup:
# check if an icon exists for a given entry
# if so, return markup to include it.
# icons are PNG or JPEG image files
# following a specific naming convention:
#   index.icon.[png|jp(e)g] for directories
#   [filename].icon.[png|jp(e)g] for flat text files
# called by entry_print
# calls image_size
# uses filename to determine type
sub icon_markup {
    my ($entry, $alt) = @_;
    my ($entry_loc) = $ROOT_DIR . "/$entry";
    my ($entry_url) = $URL_ROOT . "$entry";
    my ($icon_loc, $icon_url, $suffix);

    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") {
        $suffix = "png";
    } elsif (-e "$icon_loc.jpg") {
        $suffix = "jpg";
    } else {
        return 0;
    }

    my($width, $height) = image_size ("$icon_loc.$suffix");

    return "<img src=\"$icon_url.$suffix\"\n width=\"$width\""
         . "height=\"$height\"\n alt=\"$alt\" />";
}

# datestamp:
# returns a nice html datestamp for a given entry.
# called by entry_print
sub datestamp {
    my ($entry, $markup_start, $markup_end) = @_;
    my ($stamp);
    unless ($markup_start && $markup_end) {
        $markup_start = "\n\n<p class=\"datelink\">&mdash; ";
        $markup_end = "</p>\n\n";
    }
    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.

        $stamp = qq{<a href="$URL_ROOT$entry_year"
         title="$entry_year">$entry_year</a> / 
         <a href="$URL_ROOT$entry_year/$entry_month"
         title="$entry_year/$entry_month">$month_name[$entry_month]</a> /
         <a href="$URL_ROOT$entry_year/$entry_month/$entry_day"
         title="$entry_year/$entry_month/$entry_day">$entry_day</a>};
                
        return ($markup_start . $stamp . $markup_end);
    } else {
        return "";
    }
}

# fragment_print: print a text fragment - a header, footer, update, etc.
# called by main routines, entry_print, etc.
# calls line_parse to take care of special markup
# returns 1 on successful completion, 0 otherwise
sub fragment_print {

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

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

        @lines = <FRAGMENT>;
        $line_context = "body"; # set line context to make sure line_parse does
                                # what we want even if someone forgot an end tag

        my $count = 0;
        while ($lines[$count]) {
            # Process and spit out lines.
            print line_parse($lines[$count], $lines[$count + 1]);
            $count++;
        }

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

# line_parse: performs substitutions on lines
# called by fragment_print
# returns line with substitutions made
# parses some special markup, specifically:
#     <freeverse></freeverse>
#     <retcon></retcon>
# this is still a hack, but it works
# sort of
sub line_parse {
    my ($line, $nextline) = @_;
    $line_context = "body" unless ($line_context);

    if ($line =~ m/<freeverse>/) {
        $line_context = "freeverse";
    }

    if ($line =~ m/<\/freeverse>/) {
        $line_context = "body";
    }

    if ($line_context eq "freeverse") {
        unless (($line eq "<freeverse>\n")
                or ($nextline eq "\n")
                or ($line =~ m/.*\"$/)
                or ($line =~ m/.*<[a-zA-Z1-9=\"]+$/)
                or ($nextline =~ m/^<\/freeverse>/) ) {
            $line =~ s/(.+)\n/$1<br \/>\n/;
        }
        $line =~ s/^\n/<\/p>\n\n<p>/;
        $line =~ s/(\s?)--(\s?)/$1&mdash;$2/g;
    }

    $line =~ s/<retcon>/<div class=\"retcon\">/g;
    $line =~ s/<\/retcon>/<\/div>/g;
    $line =~ s/<freeverse>/<p>/;
    $line =~ s/<\/freeverse>/<\/p>\n\n/;

    if ($dash) {
        $line =~ s/(\s?)$dash(\s?)/$1&mdash;$2/g;
    }
    
    return $line;
}

# 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/
# any weirdness here is probably my fault, not theirs.

# called by icon_markup
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$/) { # it's a 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$/) { # it's a JPEG
            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);
    } 
}