#
# VimOutliner (OTL) XHTML pretty printer for mod_perl2/apache2.
#
# Copyright (c) 2006, Mahlon E. Smith <mahlon@martini.nu>
# All rights reserved.
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
# * Neither the name of Mahlon E. Smith nor the names of his
# contributors may be used to endorse or promote products derived
# from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY
# EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# DISCLAIMED. IN NO EVENT SHALL THE REGENTS AND CONTRIBUTORS BE LIABLE FOR ANY
# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
package Apache::OTL;
use strict;
use warnings;
use Apache2::Const qw/ DECLINED OK /;
use Apache2::Request;
use Apache2::RequestRec;
use Apache2::RequestUtil;
use Apache2::RequestIO;
use Apache2::Log;
use Time::HiRes 'gettimeofday';
sub handler
{
my $VERSION = '0.5';
my $ID = '$Id$';
my $r = shift;
my $t0 = Time::HiRes::gettimeofday;
my (
$file, # the absolute file path
$title, # the file's title
$uri, # the file uri
$data, # file contents
@blocks, # todo groupings
$mtime, # last modification time of otl file
$get, # get arguments (sorting, etc)
%opt, # options from otl file
);
# sanity checks
return DECLINED unless $r->method eq 'GET';
( $file, $uri ) = ( $r->filename, $r->uri );
return DECLINED unless -e $file;
$mtime = localtime( (stat(_))[9] );
my $req = Apache2::Request->new($r);
$get = $req->param || {};
my %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)/,
remove_tabs => qr/^(?:\t+)?(.+)/,
linetext => qr/^(?:\[.\] (?:\d+%)?)? (.+)/,
comma_sep => qr/(?:\s+)?\,(?:\s+)?/,
hideline => qr/(?:\t+)?\#/,
);
# snag file
open OTL, $file
or ( $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'} && $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};
# start html output
$r->content_type('text/html');
$r->print(<<EHTML);
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html>
<!--
generated by otl_handler $VERSION
Mahlon E. Smith <mahlon\@martini.nu>
http://www.martini.nu/
Get VimOutliner at: http://www.vimoutliner.org/
-->
<head>
<title>$title</title>
EHTML
# optional styles
if ( $opt{style} ) {
foreach ( split /$re{'comma_sep'}/, $opt{style} ) {
my $media = $_ =~ /print/ ? 'print' : 'screen';
print qq{\t<link href="$_" rel="stylesheet" media="$media" type="text/css" />\n};
}
}
# optional javascript
if ( $opt{js} ) {
$r->print( "\t<script type=\"text/javascript\" src=\"$_\"></script>\n" )
foreach split /$re{'comma_sep'}/, $opt{js};
$r->print( ' ' x 4, "</head>\n" );
$r->print( ' ' x 4, "<body>\n" );
} else {
$r->print(<<EHTML);
</head>
<body>
EHTML
}
# title, last modification times
$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">Item completed</span><br />
<span class="todo">Item is incomplete</span><br />
</div>
EHTML
}
# sorter
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");
}
foreach my $block ( sort { sorter(\%opt, \%re) } @blocks ) {
# separate outline items
my @lines = grep { $_ !~ /$re{'hideline'}/ } split /\n/, $block;
my $data = [];
# build structure and get item counts
my ( $subs, $comments, $subsubs ) = ( 0, 0, 0 );
foreach ( @lines ) {
if (/$re{comment}/) {
$comments++;
}
elsif (/$re{subitem}/) {
$subs++;
}
my $level = 0;
$level = $1 =~ tr/\t/\t/ if /^(\t+)/;
$level++;
s#$re{remove_tabs}#$1# unless $opt{'debug'};
push @$data, [ $level, $_ ];
}
$subsubs = ( scalar @lines - 1 ) - $subs - $comments;
# begin parsing structure
$r->print("<div class=\"outline\">\n");
$r->print("<ul>\n") unless $opt{'debug'};
my $i = 0;
foreach ( @$data ) {
my ( $level, $line ) = @$_;
if ( $opt{'debug'} ) {
my $in = " " x $level x 4;
$r->print( "$level:$in $line<br />\n" );
next;
}
my $next_level = $data->[ $i+1 ] ? $data->[ $i+1 ]->[0] : 0;
my $in = "\t" x $level;
$line =~ s#$re{'time'}#<span class="time">$1</span>#g;
$line =~ s#$re{date}#<span class="date">$1</span>#g;
$line =~ s#$re{percent}#$1 <span class="percent">$2%</span>#;
# append counts
if ( $i == 0 && $opt{counts} && $line !~ $re{comment} ) {
my $itmstr = $subs == 1 ? 'item' : 'items';
my $sitmstr = $subsubs == 1 ? 'subitem' : 'subitems';
$line .= " <span class=\"counts\">$subs $itmstr, $subsubs $sitmstr</span>";
}
my $li_class = '>';
$li_class = ' class="todo">' if $line =~ s#$re{todo}##;
$li_class = ' class="done">' if $line =~ s#$re{done}##;
$li_class = ' class="comment">' if $line =~ s#$re{comment}#$1#;
if ( $next_level == $level || $next_level == 0 ) {
$r->print( "$in<li" . $li_class . "$line</li>\n" );
}
elsif ( $next_level < $level ) {
$r->print( "$in<li" . $li_class . "$line</li>\n" );
for (my $x = $level - 1; $x >= $next_level; $x--) {
my $in = "\t" x $x;
$r->print( "$in</ul>\n$in</li>\n" );
}
}
else {
# implicit: $next_level > $level AND $next_level != 0
$r->print("$in<li" . $li_class . "$line\n$in<ul>\n");
}
$i++;
}
unless ( $opt{'debug'} ) {
for (my $x = $data->[ scalar @$data - 1]->[0] - 1; $x > 0; $x--) {
my $in = "\t" x $x;
$r->print( "$in</ul>\n$in</li>\n" );
}
$r->print( "</ul>\n" );
}
$r->print( "</div>\n\n" );
}
my $t1 = Time::HiRes::gettimeofday;
my $td = sprintf("%0.3f", $t1 - $t0);
$r->print(" <div class=\"timer\">OTL parsed in $td secs</div>\n") 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;