Initial commit and migration to Mercurial.
#!/usr/bin/perl
package Apache::OTL;
use strict;
use Apache2::Const qw/ DECLINED OK /;
use Time::HiRes qw/ gettimeofday /;
sub handler
{
my $r = shift;
my $VERSION = '0.4';
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;
# just spit out the plain otl if requested.
if ($get{show} eq 'source') {
$r->content_type('text/plain');
$r->print( $data );
return OK;
}
# divide each outline into groups
# skip blocks that start with a comment '#'
@blocks = grep { $_ !~ /^\#/ } 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->content_type('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("<div class=\"header\">$opt{title}</div>\n") if $opt{title};
$r->print("<div class=\"last_mod\">Last modified: $mtime</div>\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
my @items = split /\n/, $block;
$r->print("<div class=\"group\">\n") if $opt{divs};
my $lc = 0;
# 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) {
next if /^\#/;
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;