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 <link rel="stylesheet" type="text/css" media="all" href="/base.css"><:
  18         my %styles = map {$_ => $_} qw(dark mono red);
  19         our $style = exists $get{style} && $styles{$get{style}} || 'light';
  20         printf(qq{\n<link rel="%s" type="text/css" media="all" href="%s" title="%s">},
  21                 $_ eq $style ? 'stylesheet' : 'alternate stylesheet', "/$_.css", $_
  22         ) for keys %styles;
  23 :>
  24 </head>
  25
  26 <body id="source">
  27 <:
  28
  29 my $source = $ENV{PATH_INFO};
  30 $source =~ s{^/}{};
  31 print "<h1>Source of $source</h1>\n";
  32
  33 if ($source =~ m{(?:/|^)\.}) {
  34         die "File request not permitted\n";
  35 }
  36 elsif ($source =~ s{::}{/}g or !-e $source) {
  37         $source .= '.pm';
  38         for (0 .. $#{@INC}) {
  39                 -e ($_ = "$INC[$_]/$source") or next;
  40                 $source = $_;
  41                 last;
  42         }
  43 }
  44 -r $source or die "Requested file not found\n";
  45
  46 require Text::VimColor;
  47 delete $Text::VimColor::SYNTAX_TYPE{Underlined};
  48 my %TYPETAG = (
  49         Statement => 'strong',
  50         Error     => 'em',
  51         Todo      => 'em',
  52 );
  53
  54 my $hl = Text::VimColor->new(
  55         file => $source,
  56         vim_options => [@Text::VimColor::VIM_OPTIONS, '+:set enc=utf-8'],
  57 );
  58 my $parsed = $hl->marked;
  59 print "<pre>\n";
  60 foreach (@$parsed) {
  61         my $tag = $_->[0] && ($TYPETAG{ $_->[0] } || 'span');
  62         my $arg = '';
  63         print "<$tag$arg class=\"sy-\l$_->[0]\">" if $tag;
  64         if ($_->[0] eq 'Constant' and $_->[1] =~ s/^(')([a-z0-9_.]+\.plp?)(?=\1$)//) {
  65                 printf '%s<a href="%s">%s</a>', $1, "/source/$2", $2;
  66         }
  67         if (!$_->[0] and $_->[1] =~ s/^(\s*)([A-Z]\w+(?:::\w+)+)(?![^;\s])//) {
  68                 printf '%s<a href="%s">%s</a>', $1, "/source/$2", $2;
  69         }
  70         print Text::VimColor::_xml_escape($_->[1]);
  71         print "</$tag>" if $tag;
  72 }
  73 print "</pre>\n";
  74 :>
  75 <p class="footer">
  76         <a href="/" rel="home">sheet.shiar.nl</a>/source
  77         <a href="git://git.shiar.nl/sheet" rel="vcs-git" title="Git repository"><:= $VERSION :></a>
  78         created by <a href="http://shiar.nl/" rel="author">Shiar</a> •
  79         <a title="Licensed under the GNU Affero General Public License, version 3" rel="copyright"
  80            href="http://www.fsf.org/licensing/licenses/agpl-3.0.html">AGPLv3</a>
  81 </p>
  82
  83 </html>