File Coverage

blib/lib/PPI/Prettify.pm
Criterion Covered Total %
statement 53 79 67.0
branch 28 48 58.3
condition 9 17 52.9
subroutine 12 15 80.0
pod 1 2 50.0
total 103 161 63.9


line stmt bran cond sub pod time code
1             package PPI::Prettify;
2 1     1   23722 use strict;
  1         3  
  1         50  
3 1     1   5 use warnings;
  1         2  
  1         34  
4 1     1   1142 use PPI::Document;
  1         163823  
  1         31  
5 1     1   9 use Carp 'croak';
  1         1  
  1         57  
6 1     1   731 use HTML::Entities;
  1         8864  
  1         120  
7             use Perl::Critic::Utils
8 1     1   1475 qw/is_method_call is_subroutine_name is_package_declaration/;
  1         68838  
  1         26  
9 1     1   469 use B::Keywords;
  1         2  
  1         49  
10 1     1   4 use List::MoreUtils 'any';
  1         1  
  1         83  
11              
12             # ABSTRACT: A Perl HTML pretty printer to use with Google prettify CSS skins, no JavaScript required!
13              
14             BEGIN {
15 1     1   4 require Exporter;
16 1     1   4 use base qw(Exporter);
  1         2  
  1         109  
17 1         3 our @EXPORT = qw(prettify $MARKUP_RULES);
18 1         1053 our @EXPORT_OK = ('getExampleHTML');
19             }
20              
21             # The mapping of PPI::Token class to span attribute type. Is exported and overridable
22             our $MARKUP_RULES = {
23             'PPI::Token::ArrayIndex' => 'var',
24             'PPI::Token::Attribute' => 'atn',
25             'PPI::Token::BOM' => 'pln',
26             'PPI::Token::Cast' => 'var',
27             'PPI::Token::Comment' => 'com',
28             'PPI::Token::DashedWord' => 'pln',
29             'PPI::Token::Data' => 'com',
30             'PPI::Token::End' => 'com',
31             'PPI::Token::Function' => 'kwd',
32             'PPI::Token::HereDoc' => 'str',
33             'PPI::Token::Keyword' => 'lit',
34             'PPI::Token::KeywordFunction' => 'kwd',
35             'PPI::Token::Label' => 'lit',
36             'PPI::Token::Magic' => 'typ',
37             'PPI::Token::Number' => 'atv',
38             'PPI::Token::Number::Binary' => 'atv',
39             'PPI::Token::Number::Exp' => 'atv',
40             'PPI::Token::Number::Float' => 'atv',
41             'PPI::Token::Number::Hex' => 'atv',
42             'PPI::Token::Number::Octal' => 'atv',
43             'PPI::Token::Number::Version' => 'atv',
44             'PPI::Token::Operator' => 'pun',
45             'PPI::Token::Pod' => 'com',
46             'PPI::Token::Pragma' => 'kwd',
47             'PPI::Token::Prototype' => 'var',
48             'PPI::Token::Quote' => 'str',
49             'PPI::Token::Quote::Double' => 'str',
50             'PPI::Token::Quote::Interpolate' => 'str',
51             'PPI::Token::Quote::Literal' => 'str',
52             'PPI::Token::Quote::Single' => 'str',
53             'PPI::Token::QuoteLike' => 'str',
54             'PPI::Token::QuoteLike::Backtick' => 'fun',
55             'PPI::Token::QuoteLike::Command' => 'fun',
56             'PPI::Token::QuoteLike::Readline' => 'str',
57             'PPI::Token::QuoteLike::Regexp' => 'str',
58             'PPI::Token::QuoteLike::Words' => 'str',
59             'PPI::Token::Regexp' => 'str',
60             'PPI::Token::Regexp::Match' => 'str',
61             'PPI::Token::Regexp::Substitute' => 'str',
62             'PPI::Token::Regexp::Transliterate' => 'str',
63             'PPI::Token::Separator' => 'kwd',
64             'PPI::Token::Structure' => 'pun',
65             'PPI::Token::Symbol' => 'typ',
66             'PPI::Token::Unknown' => 'pln',
67             'PPI::Token::Whitespace' => 'pln',
68             'PPI::Token::Word' => 'pln',
69             'PPI::Token::Word::Package' => 'atn',
70             };
71              
72             sub prettify {
73 1     1 1 23254 my ($args) = @_;
74 1 50 33     210 croak "Missing mandatory code argument in args passed to prettify()."
75             unless exists $args->{code} and defined $args->{code};
76 0         0 my $doc = eval { return PPI::Document->new( \$args->{code} ) };
  0         0  
77 0 0 0     0 croak "Error creating PPI::Document" unless $doc or $@;
78 0   0     0 return _decorate( $doc, $args->{debug} || 0 );
79             }
80              
81             sub get_example_html {
82 0     0 0 0 my $htmlStart = <<'EOF';
83             <!DOCTYPE html>
84             <html>
85             <head><title>Example PPI::Prettify Output using the vim Desert scheme</title></head>
86             <body>
87             <style>
88             /* desert scheme ported from vim to google prettify */
89             pre.prettyprint { display: block; background-color: #333; color: #fff }
90             pre .str { color: #ffa0a0 } /* string - pink */
91             pre .kwd { color: #f0e68c; font-weight: bold }
92             pre .com { color: #87ceeb } /* comment - skyblue */
93             pre .typ { color: #98fb98 } /* type - lightgreen */
94             pre .lit { color: #cd5c5c } /* literal - darkred */
95             pre .pun { color: #fff } /* punctuation */
96             pre .pln { color: #fff } /* plaintext */
97             pre .tag { color: #f0e68c; font-weight: bold } /* html/xml tag - lightyellow */
98             pre .atn { color: #bdb76b; font-weight: bold } /* attribute name - khaki */
99             pre .atv { color: #ffa0a0 } /* attribute value - pink */
100             pre .dec { color: #98fb98 } /* decimal - lightgreen */
101              
102             pre.prettyprint {
103             -moz-border-radius: 8px;
104             -webkit-border-radius: 8px;
105             -o-border-radius: 8px;
106             -ms-border-radius: 8px;
107             -khtml-border-radius: 8px;
108             border-radius: 8px;
109             width: 95%;
110             margin: 0 auto 10px;
111             padding: 1em;
112             white-space: pre-wrap;
113             border: 0px solid #888;
114             }
115              
116             </style>
117             <body>
118             EOF
119 0         0 my $htmlEnd = <<'EOF';
120             </body></html>
121             EOF
122              
123 0         0 my $code = <<'EOF';
124             package Test::Package;
125             use strict;
126             use warnings;
127             use feature 'say';
128             use Example::Module;
129              
130             BEGIN {
131             require Exporter;
132             use base qw(Exporter);
133             our @EXPORT = ('example_sub');
134             }
135              
136             sub example_sub {
137             my $self = shift;
138             $self->length;
139             return $self->do_something;
140             }
141              
142             # this is a comment for do_something, an example method
143              
144             sub do_something {
145             my ($self) = @_;
146             if ('dog' eq "cat") {
147             say 1 * 564;
148             }
149             else {
150             say 100 % 101;
151             }
152             return 'a string';
153             }
154              
155             # example variables
156             my @array = qw/1 2 3/;
157             my $scalar = 'a plain string';
158              
159             print STDOUT $scalar;
160             example_sub({ uc => 'test uc is string not BIF'});
161             1;
162             __END__
163             This is just sample code to demo the markup
164             EOF
165 0         0 my $markup = prettify( { code => $code, debug => 1 } );
166 0         0 return $htmlStart . $markup . $htmlEnd;
167             }
168              
169             sub _decorate {
170 0     0   0 my $prettyPrintedCode = '<pre class="prettyprint">';
171 0         0 foreach my $token ( $_[0]->tokens ) {
172 0         0 $prettyPrintedCode .= _to_html( $token, $_[1] );
173             }
174 0         0 return $prettyPrintedCode .= '</pre>';
175             }
176              
177             sub _to_html {
178 0     0   0 my ( $token, $debug ) = @_;
179 0         0 my $type = _determine_token($token);
180 0         0 my $title = "";
181 0 0       0 $title = qq( title="$type") if $debug;
182             return
183 0         0 qq(<span class="$MARKUP_RULES->{$type}"$title>)
184             . encode_entities( $token->content )
185             . qq(</span>);
186             }
187              
188             # code adapted from PPI::HTML and Perl::Critic::Utils
189              
190             sub _determine_token {
191 21     21   736 my ($token) = @_;
192 21 100       62 if ( ref($token) eq 'PPI::Token::Word' ) {
193 15 100 100     44 if ( $token->snext_sibling and $token->snext_sibling->content eq '=>' )
194             {
195 1         41 return 'PPI::Token::Quote';
196             }
197 14         687 my $parent = $token->parent;
198 14         64 my $content = $token->content;
199 14 100       315 if ( $parent->isa('PPI::Statement::Include') ) {
    50          
    50          
    50          
    50          
    100          
200 3 100       10 return 'PPI::Token::Pragma' if $content eq $parent->pragma;
201             }
202             elsif ( $parent->isa('PPI::Statement::Variable') ) {
203 0 0       0 if ( $content =~ /^(?:my|local|our)$/ ) {
204 0         0 return 'PPI::Token::KeywordFunction';
205             }
206             }
207             elsif ( $parent->isa('PPI::Statement::Compound') ) {
208 0 0       0 if ( $content =~ /^(?:if|else|elsif|unless|for|foreach|while|my)$/ )
209             {
210 0         0 return 'PPI::Token::KeywordFunction';
211             }
212             }
213             elsif ( $parent->isa('PPI::Statement::Given') ) {
214 0 0       0 if ( $content eq 'given' ) {
215 0         0 return 'PPI::Token::KeywordFunction';
216             }
217             }
218             elsif ( $parent->isa('PPI::Statement::When') ) {
219 0 0       0 if ( $content =~ /^(?:when|default)$/ ) {
220 0         0 return 'PPI::Token::KeywordFunction';
221             }
222             }
223             elsif ( $parent->isa('PPI::Statement::Scheduled') ) {
224 1         5 return 'PPI::Token::KeywordFunction';
225             }
226 11 100       63 return 'PPI::Token::Symbol' if is_method_call($token);
227 10 50       240 return 'PPI::Token::Symbol' if is_subroutine_name($token);
228 10 100       285 return 'PPI::Token::Keyword'
229             if grep /^$token$/, @B::Keywords::Barewords;
230 8 100       830 return 'PPI::Token::Symbol'
231             if grep /^$token$/, @B::Keywords::Filehandles;
232 7 100       158 return 'PPI::Token::Word::Package' if is_package_declaration($token);
233              
234             # get next significant token
235 6 50       149 if ( $token->next_token ) {
236 6         239 my $next_token = $token->next_token;
237 6   66     176 while ( !$next_token->significant and $next_token->next_token ) {
238 3         64 $next_token = $next_token->next_token;
239             }
240 6 100 100     65 return 'PPI::Token::Quote'
241             if $next_token->content eq '}' and !$token->sprevious_sibling;
242             }
243 5 50       59 return 'PPI::Token::Function'
244             if grep /^$token$/, @B::Keywords::Functions;
245             }
246 6         33 return ref($token);
247             }
248              
249             1;
250              
251             __END__
252              
253             =pod
254              
255             =encoding UTF-8
256              
257             =head1 NAME
258              
259             PPI::Prettify - A Perl HTML pretty printer to use with Google prettify CSS
260             skins, no JavaScript required!
261              
262             =head1 VERSION
263              
264             version 0.07
265              
266             =head1 SYNOPSIS
267              
268             use PPI::Prettify 'prettify';
269              
270             my $codeSample = q! # get todays date in Perl
271             use Time::Piece;
272             print Time::Piece->new;
273             !;
274              
275             my $html = prettify({ code => $codeSample });
276              
277             # every Perl token wrapped in a span e.g. for "use PPI::Prettify;":
278             <span class="kwd">use</span>
279             <span class="pln"> </span>
280             <span class="atn">PPI::Prettify</span>
281             <span class="pln">;</span>
282              
283             my $htmlDebug = prettify({ code => $codeSample, debug => 1 });
284             # with PPI::Token class, e.g. for "use PPI::Prettify;":
285             <span class="kwd" title="PPI::Token::Function">use</span>
286             <span class="pln" title="PPI::Token::Whitespace"> </span>
287             <span class="atn" title="PPI::Token::Word">PPI::Prettify</span>
288             <span class="pln" title="PPI::Token::Structure">;</span>
289              
290             =head1 DESCRIPTION
291              
292             This module takes a string Perl code sample and returns the tokens of the code
293             surrounded with <span> tags. The class attributes are the same used by the
294             L<prettify.js|https://code.google.com/p/google-code-prettify/>. Using
295             L<PPI::Prettify> you can generate the prettified code for use in webpages
296             without using JavaScript but you can use all L<the CSS
297             skins|https://google-code-prettify.googlecode.com/svn/trunk/styles/index.html>
298             developed for prettify.js. Also, because this module uses L<PPI::Document> to
299             tokenize the code, it's more accurate than prettify.js.
300              
301             L<PPI::Prettify> exports prettify() and the $MARKUP_RULES hashref which is used
302             to match PPI::Token classes to the class attribute given to that token's <span>
303             tag. You can modify $MARKUP_RULES to tweak the mapping if you require it.
304              
305             I wrote an article with more detail about the module for:
306             L<PerlTricks.com|http://perltricks.com/article/60/2014/1/13/Display-beautiful-Perl-code-in-HTML-without-JavaScript>.
307              
308             =head1 MOTIVATION
309              
310             I wanted to generate marked-up Perl code without using JavaScript for
311             L<PerlTricks.com|http://perltricks.com>. I was dissatisfied with prettify.js as
312             it doesn't always tokenize Perl correctly and won't run if the user has
313             disabled JavaScript. I considered L<PPI::HTML> but it embeds the CSS in the
314             generated code, and I wanted to use the same markup class attributes as
315             prettify.js so I could reuse the existing CSS developed for it.
316              
317             =head1 BUGS AND LIMITATIONS
318              
319             =over
320              
321             =item *
322              
323             What constitutes a function and a keyword is somewhat arbitrary in Perl.
324             L<PPI::Prettify> mostly uses L<B::Keywords> to help distinguish functions and
325             keywords. However, some words such as "if", "my" and "BEGIN" are given a
326             special class of "PPI::Token::KeywordFunction" which can be overridden in
327             $MARKUP_RULES, should you wish to display these as keywords instead of
328             functions.
329              
330             =item *
331              
332             This module does not yet process Perl code samples with heredocs correctly.
333              
334             =item *
335              
336             Line numbering needs to be added.
337              
338             =back
339              
340             =head1 SUBROUTINES/METHODS
341              
342             =head2 prettify
343              
344             Takes a hashref consisting of $code and an optional debug flag. Every Perl code
345             token is given a <span> tag that corresponds to the tags used by Google's
346             prettify.js library. If debug => 1, then every token's span tag will be given a
347             title attribute with the value of the originating PPI::Token class. This can
348             help if you want to override the mappings in $MARKUP_RULES. See L</SYNOPSIS>
349             for examples.
350              
351             =head2 getExampleHTML
352              
353             Returns an HTML document as a string with built-in CSS to demo the syntax
354             highlighting capabilites of PPI::Prettify. At the command line:
355              
356             $ perl -MPPI::Prettify -e 'print PPI::Prettify::getExampleHTML()' > example.html
357              
358             =head1 INTERNAL FUNCTIONS
359              
360             =head2 _decorate
361              
362             Iterates through the tokens of a L<PPI::Document>, marking up each token with a
363             <span> tag.
364              
365             =head2 _to_html
366              
367             Marks up a token with a span tag with the appropriate class attribute and the
368             PPI::Token class.
369              
370             =head2 _determine_token
371              
372             Determines the PPI::Token type.
373              
374             =head1 REPOSITORY
375              
376             L<https://github.com/sillymoose/ppi-prettify>
377              
378             =head1 SEE ALSO
379              
380             L<PPI::HTML> is another prettifier for Perl code samples that allows the
381             embedding of CSS directly into the HTML generation.
382              
383             =head1 THANKS
384              
385             Thanks to Adam Kennedy for developing L<PPI::Document>, without which this
386             module would not be possible.
387              
388             =head1 AUTHOR
389              
390             David Farrell <sillymoos@cpan.org> L<PerlTricks.com|http://perltricks.com>
391              
392             =head1 COPYRIGHT AND LICENSE
393              
394             This software is copyright (c) 2014 by David Farrell.
395              
396             This is free software; you can redistribute it and/or modify it under the same
397             terms as the Perl 5 programming language system itself.
398              
399             =cut