lib/Perly/SyntaxHighlight.pm

package Perly::SyntaxHighlight;

use strict;
use warnings;

use Syntax::Highlight::Perl;

=head1 NAME

Perly::SyntaxHighlight

=head1 DESCRIPTION

Perl syntax highlighter which tries to produce same coloring as
L<Jifty::Plugin::CodePress> to provide html rendering if you just want to
display code and not edit.

=head1 METHODS

=cut

my $codepress_tags = {
    'Variable_Scalar'   => 'a',
    'Variable_Array'    => 'a',
    'Variable_Hash'     => 'a',
    'Variable_Typeglob' => 'a',
    'Subroutine'        => 'b',
    'Quote'             => 's',
    'String'            => 's',
    'Comment_Normal'    => 'i',
    'Comment_POD'       => 'i',
#    'Bareword'          => 'xx',
#    'Package'           => undef,
#    'Number'            => undef,
#    'Operator'          => undef,
    'Symbol'            => 'u',
    'Keyword'           => 'b',
    'Builtin_Operator'  => 'b',
    'Builtin_Function'  => 'b',
#    'Character'         => 'em',
#    'Directive'         => 'em',
#    'Label'             => undef,
#    'Line'              => 'em',
};

my $formatter = Syntax::Highlight::Perl->new();
$formatter->define_substitution(
        '<' => '&lt;', 
        '>' => '&gt;', 
        '&' => '&amp;',
); # HTML escapes.

while ( my ( $type, $tag ) = each %{$codepress_tags} ) {
    $formatter->set_format($type, [ "<$tag>", "</$tag>" ] ) if $tag;
}

sub color {
        my $self = shift;
        my $html = $formatter->format_string( shift );

        $html =~ s/[\n\r]+$//s;

        # we use CSS white-space: pre, and yet we have to insert <br>s into html
        # because copy/paste would squash code in single line
        $html =~ s!\r?\n!\n<br/>!gs;

        # Internet Explorer is so broken that <br/><br/> won't produce empty line
        # without &nbsp;
#       $html =~ s!<br/><br/>!<br/>&nbsp;<br/>!gs;

        $html =~ s!</(\w)><\1>!!gs;
        return '<div class="code">' . $html . '</div>';
}

1;
1	dpavlin	41	package Perly::SyntaxHighlight;
2
3			use strict;
4			use warnings;
5
6			use Syntax::Highlight::Perl;
7
8			=head1 NAME
9
10			Perly::SyntaxHighlight
11
12			=head1 DESCRIPTION
13
14			Perl syntax highlighter which tries to produce same coloring as
15			L<Jifty::Plugin::CodePress> to provide html rendering if you just want to
16			display code and not edit.
17
18			=head1 METHODS
19
20			=cut
21
22			my $codepress_tags = {
23			'Variable_Scalar' => 'a',
24			'Variable_Array' => 'a',
25			'Variable_Hash' => 'a',
26			'Variable_Typeglob' => 'a',
27			'Subroutine' => 'b',
28			'Quote' => 's',
29			'String' => 's',
30			'Comment_Normal' => 'i',
31			'Comment_POD' => 'i',
32			# 'Bareword' => 'xx',
33			# 'Package' => undef,
34			# 'Number' => undef,
35			# 'Operator' => undef,
36			'Symbol' => 'u',
37			'Keyword' => 'b',
38			'Builtin_Operator' => 'b',
39			'Builtin_Function' => 'b',
40			# 'Character' => 'em',
41			# 'Directive' => 'em',
42			# 'Label' => undef,
43			# 'Line' => 'em',
44			};
45
46			my $formatter = Syntax::Highlight::Perl->new();
47			$formatter->define_substitution(
48			'<' => '<',
49			'>' => '>',
50			'&' => '&',
51			); # HTML escapes.
52
53			while ( my ( $type, $tag ) = each %{$codepress_tags} ) {
54			$formatter->set_format($type, [ "<$tag>", "</$tag>" ] ) if $tag;
55			}
56
57			sub color {
58			my $self = shift;
59			my $html = $formatter->format_string( shift );
60	dpavlin	43
61	dpavlin	46	$html =~ s/[\n\r]+$//s;
62
63	dpavlin	43	# we use CSS white-space: pre, and yet we have to insert <br>s into html
64			# because copy/paste would squash code in single line
65			$html =~ s!\r?\n!\n<br/>!gs;
66
67			# Internet Explorer is so broken that <br/><br/> won't produce empty line
68			# without
69			# $html =~ s!<br/><br/>!<br/> <br/>!gs;
70
71	dpavlin	41	$html =~ s!</(\w)><\1>!!gs;
72			return '<div class="code">' . $html . '</div>';
73			}
74
75			1;