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!<br/>\n!gs; # use CSS white-space: pre
        $html =~ s!</(\w)><\1>!!gs;
        return '<div class="code">' . $html . '</div>';
}

1;
1	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	#$html =~ s!\n!<br/>\n!gs; # use CSS white-space: pre
61	$html =~ s!</(\w)><\1>!!gs;
62	return '<div class="code">' . $html . '</div>';
63	}
64
65	1;