lib/Gitalist/ContentMangler/Transformer/SyntaxHighlightRole.pm

   1 use MooseX::Declare;
   2
   3 role Gitalist::ContentMangler::Transformer::SyntaxHighlightRole {
   4     use Syntax::Highlight::Engine::Kate ();
   5     use Syntax::Highlight::Engine::Kate::Perl ();
   6
   7     use HTML::Entities qw(encode_entities);
   8
   9     method highlight(Str $blob, Str $lang) {
  10         # Don't bother with anything over 128kb, it'll be tragically slow.
  11         return encode_entities $blob if length $blob > 131_072;
  12
  13         my $ret;
  14         if ($lang) {
  15             # via http://github.com/jrockway/angerwhale/blob/master/lib/Angerwhale/Format/Pod.pm#L136
  16             $ret = eval {
  17                 no warnings 'redefine';
  18                 local *Syntax::Highlight::Engine::Kate::Template::logwarning
  19                      = sub { die @_ }; # i really don't care
  20                 my $hl = Syntax::Highlight::Engine::Kate->new(
  21                     language      => $lang,
  22                     substitutions => {
  23                         "<"  => "&lt;",
  24                         ">"  => "&gt;",
  25                         "&"  => "&amp;",
  26                         q{'} => "&apos;",
  27                         q{"} => "&quot;",
  28                     },
  29                     format_table => {
  30                         # convert Kate's internal representation into
  31                         # <span class="<internal name>"> value </span>
  32                         map {
  33                             $_ => [ qq{<span class="$_">}, '</span>' ]
  34                         }
  35                              qw/Alert BaseN BString Char Comment DataType
  36                                 DecVal Error Float Function IString Keyword
  37                                 Normal Operator Others RegionMarker Reserved
  38                                 String Variable Warning/,
  39                     },
  40                 );
  41
  42                 my $hltxt = $hl->highlightText($blob);
  43                 $hltxt =~ s/([^[:ascii:]])/encode_entities($1)/eg;
  44                 $hltxt;
  45             };
  46             warn $@ if $@;
  47         }
  48
  49         return $ret || encode_entities($blob);
  50     }
  51 }