--- a/Apache/OTL.pm Fri Jul 24 07:39:57 2009 -0700
+++ b/Apache/OTL.pm Fri Jul 24 07:49:06 2009 -0700
@@ -1,50 +1,89 @@
-#!/usr/bin/perl
+#
+# 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 Time::HiRes qw/ gettimeofday /;
+use Apache2::Request;
+use Apache2::RequestRec;
+use Apache2::RequestUtil;
+use Apache2::RequestIO;
+use Apache2::Log;
+use Time::HiRes 'gettimeofday';
sub handler
{
- my $r = shift;
- my $VERSION = '0.4';
- my $t0 = Time::HiRes::gettimeofday;
+ 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
- %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)
+ $get, # get arguments (sorting, etc)
+ %opt, # options from otl file
);
- return DECLINED unless $r->method() eq 'GET';
- ($file, $uri) = ($r->filename, $r->uri);
+ # sanity checks
+ 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;
+ my $req = Apache2::Request->new($r);
+ $get = $req->param || {};
- %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+%)?)? (.+)/,
+ 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+)?\#/,
);
- open OTL, "$file"
- || ( $r->log_error("Unable to read $file: $!") && return DECLINED );
+ # snag file
+ open OTL, $file
+ or ( $r->log_error("Unable to read $file: $!") && return DECLINED );
do {
local $/ = undef;
$data = <OTL>; # shlorp
@@ -52,7 +91,7 @@
close OTL;
# just spit out the plain otl if requested.
- if ($get{show} eq 'source') {
+ if ( $get->{'show'} && $get->{show} eq 'source' ) {
$r->content_type('text/plain');
$r->print( $data );
return OK;
@@ -78,7 +117,7 @@
}
# GET args override settings
- $opt{$_} = $get{$_} foreach keys %get;
+ $opt{$_} = $get->{$_} foreach keys %$get;
# set title (fallback to file uri)
$title =
@@ -86,29 +125,36 @@
? $opt{title}
: $1 if $uri =~ $re{title};
- $opt{style} ||= '/otl_style.css';
-
+ # 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\@spime.net>
+ Mahlon E. Smith <mahlon\@martini.nu>
+ http://www.martini.nu/
- http://www.vimoutliner.org/
+ Get VimOutliner at: 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",
- );
+ # 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>
@@ -116,16 +162,19 @@
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"> </span> Item completed<br />
-<span class="todo"> </span> Item is incomplete<br />
+<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',
@@ -144,66 +193,95 @@
$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++;
- }
+ 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++;
}
- $subsubs = (scalar @items - 1) - $subs - $comments;;
+
+ 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;
- # parse
- foreach (@items) {
- next if /^\#/;
- my $level = tr/\t/\t/ || 0;
- next unless /\w/;
+ # 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 ($lc == 0 && $opt{counts} && $_ !~ $re{comment}) {
+ if ( $i == 0 && $opt{counts} && $line !~ $re{comment} ) {
my $itmstr = $subs == 1 ? 'item' : 'items';
my $sitmstr = $subsubs == 1 ? 'subitem' : 'subitems';
- $_ .= " <span class=\"counts\">$subs $itmstr, $subsubs $sitmstr</span>";
+ $line .= " <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;
+ 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" );
}
- 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>#;
+ 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" );
+ }
+ }
- $r->print("$_\n");
- $lc++;
+ else {
+ # implicit: $next_level > $level AND $next_level != 0
+ $r->print("$in<li" . $li_class . "$line\n$in<ul>\n");
+ }
+
+ $i++;
}
- $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++;
+
+ 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>") if $opt{timer};
+ $r->print(" <div class=\"timer\">OTL parsed in $td secs</div>\n") if $opt{timer};
$r->print(<<EHTML);
</body>
</html>
@@ -230,3 +308,4 @@
}
1;
+