#!/usr/bin/perl

package Apache::OTL;
use strict;
use Apache::Constants qw/ :common  /;
use Time::HiRes qw/ gettimeofday /;

sub handler
{
    my $r = shift;
    my $VERSION = '0.3';
    my $t0 = Time::HiRes::gettimeofday;
    my (
        $file,          # the absolute file path
        $title,         # the file's title
        $uri,           # the file uri
        %re,            # a hash of pre compiled regular expressions
        $data,          # file contents
        %opt,           # options from the otl file
        @blocks,        # todo groupings
        $mtime,         # last modification time of otl file
        %get,           # get arguments (sorting, etc)
    );

    return DECLINED unless $r->method() eq 'GET';
    ($file, $uri) = ($r->filename, $r->uri);
    return DECLINED unless -e $file;
    $mtime = localtime( (stat(_))[9] );

    %get = $r->args;

    %re =
    (
      title   => qr/(?:.+)?\/(.+).otl$/i,
      percent => qr/(\[.\]) (\d+)%/,
      todo    => qr/(\[_\]) /,
      done    => qr/(\[X\]) /,
      comment => qr/^(?:\t+)?:(.+)/,
      time    => qr/(\d{2}:\d{2}:\d{2})/,
      date    => qr/(\d{2,4}-\d{2}-\d{2})/,
      subitem => qr/^\t(?!\t)/,
      line_wo_tabs => qr/^(?:\t+)?(.+)/,
      linetext => qr/^(?:\[.\] (?:\d+%)?)? (.+)/,
    );

    open OTL, "$file"
      || ( $r->log_error("Unable to read $file: $!") && return DECLINED );
    do {
        local $/ = undef;
        $data = <OTL>;  # shlorp
    };
    close OTL;

    # divide each outline into groups
    @blocks = split /\n\n+/, $data;

    # get optional settings and otl title
    {
        my $settings = shift @blocks;
        if ($settings =~ $re{comment}) {
            %opt = map { split /=/ } split /\s?:/, $settings;
        }
        
        # if the first group wasn't a comment,
        # we probably just aren't using a settings
        # line.  push the group back into place.
        else {
            unshift @blocks, $settings;
        }
    }

    # GET args override settings
    $opt{$_} = $get{$_} foreach keys %get;

    # set title (fallback to file uri)
    $title =
        $opt{title}
      ? $opt{title}
      : $1 if $uri =~ $re{title};

    $opt{style} ||= '/otl_style.css';

    $r->send_http_header('text/html');
    $r->print(<<EHTML);
<html>
    <!--
        generated by otl_handler $VERSION
        Mahlon E. Smith <mahlon\@spime.net>

        http://www.vimoutliner.org/
    -->
    <head>
        <title>$title</title>
        <link href="$opt{style}" rel="stylesheet" media="screen" type="text/css">
EHTML

    if ($opt{js}) {
        $r->print(
            ' ' x 8,
            "<script type=\"text/javascript\" language=\"JavaScript\" src=\"$opt{js}\"></script>\n",
            ' ' x 4, "</head>\n",
            "<body onLoad=\"init_page()\">\n",
        );
    } else {
        $r->print(<<EHTML);
    </head>
    <body>
EHTML
    }

    $r->print("<span class=\"header\">$opt{title}</span><br />\n") if $opt{title};
    $r->print("<span class=\"last_mod\">Last modified: $mtime</span><br />\n") if $opt{last_mod};
    if ($opt{legend}) {
        $r->print(<<EHTML);
<div class="legend">
<span class="done">&nbsp;</span> Item completed<br />
<span class="todo">&nbsp;</span> Item is incomplete<br />
</div>
EHTML
    }
    if ($opt{sort}) {
        my %sorts = (
            alpha => 'alphabetical',
            percent => 'percentages',
        );
        $r->print("<div class=\"sort\">Sort: \n");
        foreach (sort keys %sorts) {
            if ($opt{sorttype} eq $_ && $opt{sortrev}) {
                $r->print("<a href=\"$uri?sorttype=$_\">$sorts{$_}</a>&nbsp;");
            } elsif ($opt{sorttype} eq $_ && ! $opt{sortrev}) {
                $r->print("<a href=\"$uri?sorttype=$_&sortrev=1\">$sorts{$_}</a>&nbsp;");
            } else {
                $r->print("<a href=\"$uri?sorttype=$_\">$sorts{$_}</a>&nbsp;");
            }
        }
        $r->print("</div>\n");
    }

    my $bc = 0;
    foreach my $block ( sort { sorter(\%opt, \%re) } @blocks ) {
        # separate outline items
        $r->print("<div class=\"group\">\n") if $opt{divs};
        my $lc = 0;
        my @items = split /\n/, $block;
        
        # get item counts
        my ($subs, $comments, $subsubs);
        if ($opt{counts}) {
            foreach (@items) {
                if (/$re{comment}/) {
                    $comments++;
                } elsif (/$re{subitem}/) {
                    $subs++;
                }
            }
            $subsubs = (scalar @items - 1) - $subs - $comments;;
        }

        # parse
        foreach (@items) {
            my $level = tr/\t/\t/ || 0;
            next unless /\w/;

            # append counts
            if ($lc == 0 && $opt{counts} && $_ !~ $re{comment}) {
                my $itmstr  = $subs == 1    ? 'item'    : 'items';
                my $sitmstr = $subsubs == 1 ? 'subitem' : 'subitems';
                $_ .= " <span class=\"counts\">$subs $itmstr, $subsubs $sitmstr</span>";
            }
            s/^:// if ! $level;

            if ($opt{js}) { 
                s#(.+)#<span id=\"itemtoplevel_$bc\">$1</span># if $lc == 0;
                $r->print("<span id=\"itemgroup_$bc\">\n")      if $lc == 1;
            }

            s#$re{'time'}#<span class="time">$1</span>#g        if /$re{'time'}/;
            s#$re{date}#<span class="date">$1</span>#g          if /$re{date}/;
            s#$re{percent}#$1 <span class="percent">$2%</span># if /$re{percent}/;
            s#$re{todo}#<span class="todo">&nbsp;</span>#       if /$re{todo}/;
            s#$re{done}#<span class="done">&nbsp;</span>#       if /$re{done}/;
            s#$re{comment}#<span class="comment">$1</span>#     if /$re{comment}/;
            s#$re{line_wo_tabs}#<span class="level$level">$1</span>#;

            $r->print("$_\n");
            $lc++;
        }
        $r->print("</span>\n")            if $opt{js};
        $r->print("</div>\n")             if $opt{divs};
        $r->print("<br /><hr /><br />\n") if $opt{dividers};
        $r->print("<br /><br />\n") unless $opt{divs} || $opt{dividers};
        $bc++;
    }

    my $t1 = Time::HiRes::gettimeofday;
    my $td = sprintf("%0.3f", $t1 - $t0);
    $r->print("<div class=\"timer\">OTL parsed in $td secs</div>") if $opt{timer};
    $r->print(<<EHTML);
    </body>
</html>
EHTML

    return OK;
}

sub sorter
{
    my ($opt, $re) = @_;
    return 0 unless $opt->{sorttype};
    my ($sa, $sb);
    if ($opt->{sorttype} eq 'percent') {
        $sa = $2 if $a =~ $re->{percent};
        $sb = $2 if $b =~ $re->{percent};
        return $opt->{sortrev} ? $sb <=> $sa : $sa <=> $sb;
    }
    else {
        $sa = $1 if $a =~ $re->{linetext};
        $sb = $1 if $b =~ $re->{linetext};
        return $opt->{sortrev} ? $sb cmp $sa : $sa cmp $sb;
    }
}

1;
