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
   9 use HTML::Entities qw(encode_entities);
  10
  11 sub process {
  12     my($self, $c) = @_;
  13
  14     $c->res->body($self->render($c, $c->res->body, $c->stash));
  15 }
  16
  17 sub render {
  18     my ($self, $c, $blob, $args) = @_;
  19
  20     # Don't bother with anything over 64kb, it'll be tragically slow.
  21     return encode_entities $blob if length $blob > 65536;
  22
  23     my $lang = $args->{language};
  24
  25     my $ret;
  26     if($lang) {
  27         # via http://github.com/jrockway/angerwhale/blob/master/lib/Angerwhale/Format/Pod.pm#L136
  28         $ret = eval {
  29             no warnings 'redefine';
  30             local *Syntax::Highlight::Engine::Kate::Template::logwarning
  31               = sub { die @_ }; # i really don't care
  32             my $hl = Syntax::Highlight::Engine::Kate->new(
  33                 language      => $lang,
  34                 substitutions => {
  35                     "<"  => "&lt;",
  36                     ">"  => "&gt;",
  37                     "&"  => "&amp;",
  38                     q{'} => "&apos;",
  39                     q{"} => "&quot;",
  40                 },
  41                 format_table => {
  42                     # convert Kate's internal representation into
  43                     # <span class="<internal name>"> value </span>
  44                     map {
  45                         $_ => [ qq{<span class="$_">}, '</span>' ]
  46                     }
  47                       qw/Alert BaseN BString Char Comment DataType
  48                          DecVal Error Float Function IString Keyword
  49                          Normal Operator Others RegionMarker Reserved
  50                          String Variable Warning/,
  51                 },
  52             );
  53
  54             my $hltxt = $hl->highlightText($blob);
  55
  56             # Line numbering breaks <span class="Other">#define foo\nbar</span>
  57             # So let's fix that by closing all spans at end-of-line and opening
  58             # new ones on the next, if needed.
  59
  60             my @lines = split(/\n/, $hltxt);
  61             my $last_class = undef;
  62             map {
  63                 unless($_ =~ s/^<\/span>//) {
  64                     if($last_class) {
  65                         $_ = "<span class=\"$last_class\">" . $_;
  66                     }
  67                 }
  68                 $last_class = undef;
  69                 if($_ =~ /<span class="(.*?)">(?!.*<\/span>)/) {
  70                     $last_class = $1;
  71                 }
  72                 if($_ !~ /<\/span>$/) {
  73                     $_ .= "</span>";
  74                 }
  75                 $_;
  76             } @lines;
  77
  78             $hltxt = join("\n", @lines);
  79             $hltxt =~ s/([^[:ascii:]])/encode_entities($1)/eg;
  80             $hltxt;
  81         };
  82         warn $@ if $@;
  83     }
  84
  85     return $ret || encode_entities($blob);
  86 }
  87
  88 __PACKAGE__->meta->make_immutable;
  89
  90 __END__
  91
  92 =head1 NAME
  93
  94 Gitalist::View::SyntaxHighlight - Responsible for syntax highlighting code
  95
  96 =head1 DESCRIPTION
  97
  98 Catalyst View for Syntax highlighting.
  99
 100 =head1 METHODS
 101
 102 =head2 process
 103
 104 =head2 highlight
 105
 106 =head1 AUTHORS
 107
 108 See L<Gitalist> for authors.
 109
 110 =head1 LICENSE
 111
 112 See L<Gitalist> for the license.
 113
 114 =cut