lib/Gitalist/View/SyntaxHighlight.pm

   1 package Gitalist::View::SyntaxHighlight;
   2 use Moose;
   3 use namespace::autoclean;
   4
   5 extends 'Catalyst::View';
   6
   7 use Syntax::Highlight::Engine::Kate ();
   8 use Syntax::Highlight::Engine::Kate::Perl ();
   9
  10 use HTML::Entities qw(encode_entities);
  11
  12 sub process {
  13     my($self, $c) = @_;
  14
  15     $c->res->body($self->render($c, $c->res->body, $c->stash));
  16 }
  17
  18 sub render {
  19     my ($self, $c, $blob, $args) = @_;
  20
  21     # Don't bother with anything over 64kb, it'll be tragically slow.
  22     return encode_entities $blob if length $blob > 8192;
  23
  24     my $lang = $args->{language};
  25
  26     my $ret;
  27     if($lang) {
  28         # via http://github.com/jrockway/angerwhale/blob/master/lib/Angerwhale/Format/Pod.pm#L136
  29         $ret = eval {
  30             no warnings 'redefine';
  31             local *Syntax::Highlight::Engine::Kate::Template::logwarning
  32               = sub { die @_ }; # i really don't care
  33             my $hl = Syntax::Highlight::Engine::Kate->new(
  34                 language      => $lang,
  35                 substitutions => {
  36                     "<"  => "&lt;",
  37                     ">"  => "&gt;",
  38                     "&"  => "&amp;",
  39                     q{'} => "&apos;",
  40                     q{"} => "&quot;",
  41                 },
  42                 format_table => {
  43                     # convert Kate's internal representation into
  44                     # <span class="<internal name>"> value </span>
  45                     map {
  46                         $_ => [ qq{<span class="$_">}, '</span>' ]
  47                     }
  48                       qw/Alert BaseN BString Char Comment DataType
  49                          DecVal Error Float Function IString Keyword
  50                          Normal Operator Others RegionMarker Reserved
  51                          String Variable Warning/,
  52                 },
  53             );
  54
  55             my $hltxt = $hl->highlightText($blob);
  56             $hltxt =~ s/([^[:ascii:]])/encode_entities($1)/eg;
  57             $hltxt;
  58         };
  59         warn $@ if $@;
  60     }
  61
  62     return $ret || encode_entities($blob);
  63 }
  64
  65 __PACKAGE__->meta->make_immutable;
  66
  67 __END__
  68
  69 =head1 NAME
  70
  71 Gitalist::View::SyntaxHighlight - Responsible for syntax highlighting code
  72
  73 =head1 DESCRIPTION
  74
  75 Catalyst View for Syntax highlighting.
  76
  77 =head1 METHODS
  78
  79 =head2 process
  80
  81 =head2 highlight
  82
  83 =head1 AUTHORS
  84
  85 See L<Gitalist> for authors.
  86
  87 =head1 LICENSE
  88
  89 See L<Gitalist> for the license.
  90
  91 =cut