source.plp

   1 <:
   2 use utf8;
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = 'v1.0';
   7
   8 $header{content_type} = "text/html; charset=utf-8";
   9
  10 :><!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
  11  "http://www.w3.org/TR/html4/loose.dtd">
  12 <html>
  13
  14 <head>
  15 <meta http-equiv="content-type" content="<:= $header{content_type} :>">
  16 <title>sheet page source code</title>
  17 <style type="text/css">
  18         body           { color: #000; background: #FFF }
  19         .synComment    { color: #888 }
  20         .synConstant   { color: #008 }
  21         .synType,
  22         .synIdentifier { color: #804 }
  23         .synStatement  { }
  24         .synPreProc    { }
  25         .synSpecial    { color: #408 }
  26         .synError      { font-weight: bold; background-color: #F00; color: #FFF }
  27         .synTodo       { background-color: #FF0 }
  28 </style>
  29 </head>
  30
  31 <body id="source">
  32 <:
  33
  34 my $source = $ENV{PATH_INFO};
  35 $source =~ s{^/}{};
  36 print "<h1>Source of $source</h1>\n";
  37
  38 if ($source =~ m{(?:/|^)\.}) {
  39         die "File request not permitted\n";
  40 }
  41 elsif ($source =~ s{::}{/}g or !-e $source) {
  42         $source .= '.pm';
  43         for (0 .. $#{@INC}) {
  44                 -e ($_ = "$INC[$_]/$source") or next;
  45                 $source = $_;
  46                 last;
  47         }
  48 }
  49 -r $source or die "Requested file not found\n";
  50
  51 require Text::VimColor;
  52 delete $Text::VimColor::SYNTAX_TYPE{Underlined};
  53 my %TYPETAG = (
  54         Statement => 'strong',
  55         Error     => 'em',
  56         Todo      => 'em',
  57 );
  58
  59 my $hl = Text::VimColor->new(
  60         file => $source,
  61         vim_options => [@Text::VimColor::VIM_OPTIONS, '+:set enc=utf-8'],
  62 );
  63 my $parsed = $hl->marked;
  64 print "<pre>\n";
  65 foreach (@$parsed) {
  66         my $tag = $_->[0] && ($TYPETAG{ $_->[0] } || 'span');
  67         my $arg = '';
  68         print "<$tag$arg class=\"syn$_->[0]\">" if $tag;
  69         if ($_->[0] eq 'Constant' and $_->[1] =~ s/^(')([a-z0-9_.]+\.plp?)(?=\1$)//) {
  70                 printf '%s<a href="%s">%s</a>', $1, "/source/$2", $2;
  71         }
  72         if (!$_->[0] and $_->[1] =~ s/^([A-Z]\w+(?:::\w+)+)(?![^;\s])//) {
  73                 printf '<a href="%s">%s</a>', "/source/$1", $1;
  74         }
  75         print Text::VimColor::_xml_escape($_->[1]);
  76         print "</$tag>" if $tag;
  77 }
  78 print "</pre>\n";
  79 :>
  80 <p class="footer">
  81         <a href="/" rel="home">sheet.shiar.nl</a>/source
  82         <a href="git://git.shiar.nl/sheet" rel="vcs-git" title="Git repository"><:= $VERSION :></a>
  83         created by <a href="http://shiar.nl/" rel="author">Shiar</a> •
  84         <a title="Licensed under the GNU Affero General Public License, version 3" rel="copyright"
  85            href="http://www.fsf.org/licensing/licenses/agpl-3.0.html">AGPLv3</a>
  86 </p>
  87
  88 </html>