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'
  65         and $_->[1] =~ s{^(['"])(/?[a-z0-9_.]+\.(?:plp?|css|js))(?=\1$)}{}) {
  66                 printf '%s<a href="%s">%s</a>', $1, "/source/$2", $2;
  67         }
  68         if (!$_->[0] and $_->[1] =~ s/^(\s*)([A-Z]\w+(?:::\w+)+)(?![^;\s])//) {
  69                 printf '%s<a href="%s">%s</a>', $1, "/source/$2", $2;
  70         }
  71         print Text::VimColor::_xml_escape($_->[1]);
  72         print "</$tag>" if $tag;
  73 }
  74 print "</pre>\n";
  75 :>
  76 <p class="footer">
  77         <a href="/" rel="home">sheet.shiar.nl</a>/source
  78         <a href="git://git.shiar.nl/sheet" rel="vcs-git" title="Git repository"><:= $VERSION :></a>
  79         created by <a href="http://shiar.nl/" rel="author">Shiar</a> •
  80         <a title="Licensed under the GNU Affero General Public License, version 3" rel="copyright"
  81            href="http://www.fsf.org/licensing/licenses/agpl-3.0.html">AGPLv3</a>
  82 </p>
  83
  84 </html>