#!/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"> </span> Item completed<br /> <span class="todo"> </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> "); } elsif ($opt{sorttype} eq $_ && ! $opt{sortrev}) { $r->print("<a href=\"$uri?sorttype=$_&sortrev=1\">$sorts{$_}</a> "); } else { $r->print("<a href=\"$uri?sorttype=$_\">$sorts{$_}</a> "); } } $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"> </span># if /$re{todo}/; s#$re{done}#<span class="done"> </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;