package PPI::Prettify; use strict; use warnings; use PPI::Document; use Carp 'croak'; use HTML::Entities; use Perl::Critic::Utils qw/is_method_call is_subroutine_name is_package_declaration/; use B::Keywords; use List::MoreUtils 'any'; # ABSTRACT: A Perl HTML pretty printer to use with Google prettify CSS skins, no JavaScript required! BEGIN { require Exporter; use base qw(Exporter); our @EXPORT = qw(prettify $MARKUP_RULES); our @EXPORT_OK = ('getExampleHTML'); } # The mapping of PPI::Token class to span attribute type. Is exported and overridable our $MARKUP_RULES = { 'PPI::Token::ArrayIndex' => 'var', 'PPI::Token::Attribute' => 'atn', 'PPI::Token::BOM' => 'pln', 'PPI::Token::Cast' => 'var', 'PPI::Token::Comment' => 'com', 'PPI::Token::DashedWord' => 'pln', 'PPI::Token::Data' => 'com', 'PPI::Token::End' => 'com', 'PPI::Token::Function' => 'kwd', 'PPI::Token::HereDoc' => 'str', 'PPI::Token::Keyword' => 'lit', 'PPI::Token::KeywordFunction' => 'kwd', 'PPI::Token::Label' => 'lit', 'PPI::Token::Magic' => 'typ', 'PPI::Token::Number' => 'atv', 'PPI::Token::Number::Binary' => 'atv', 'PPI::Token::Number::Exp' => 'atv', 'PPI::Token::Number::Float' => 'atv', 'PPI::Token::Number::Hex' => 'atv', 'PPI::Token::Number::Octal' => 'atv', 'PPI::Token::Number::Version' => 'atv', 'PPI::Token::Operator' => 'pun', 'PPI::Token::Pod' => 'com', 'PPI::Token::Pragma' => 'kwd', 'PPI::Token::Prototype' => 'var', 'PPI::Token::Quote' => 'str', 'PPI::Token::Quote::Double' => 'str', 'PPI::Token::Quote::Interpolate' => 'str', 'PPI::Token::Quote::Literal' => 'str', 'PPI::Token::Quote::Single' => 'str', 'PPI::Token::QuoteLike' => 'str', 'PPI::Token::QuoteLike::Backtick' => 'fun', 'PPI::Token::QuoteLike::Command' => 'fun', 'PPI::Token::QuoteLike::Readline' => 'str', 'PPI::Token::QuoteLike::Regexp' => 'str', 'PPI::Token::QuoteLike::Words' => 'str', 'PPI::Token::Regexp' => 'str', 'PPI::Token::Regexp::Match' => 'str', 'PPI::Token::Regexp::Substitute' => 'str', 'PPI::Token::Regexp::Transliterate' => 'str', 'PPI::Token::Separator' => 'kwd', 'PPI::Token::Structure' => 'pun', 'PPI::Token::Symbol' => 'typ', 'PPI::Token::Unknown' => 'pln', 'PPI::Token::Whitespace' => 'pln', 'PPI::Token::Word' => 'pln', 'PPI::Token::Word::Package' => 'atn', }; sub prettify { my ($args) = @_; croak "Missing mandatory code argument in args passed to prettify()." unless exists $args->{code} and defined $args->{code}; my $doc = eval { return PPI::Document->new( \$args->{code} ) }; croak "Error creating PPI::Document" unless $doc or $@; return _decorate( $doc, $args->{debug} || 0 ); } sub get_example_html { my $htmlStart = <<'EOF'; Example PPI::Prettify Output using the vim Desert scheme EOF my $htmlEnd = <<'EOF'; EOF my $code = <<'EOF'; package Test::Package; use strict; use warnings; use feature 'say'; use Example::Module; BEGIN { require Exporter; use base qw(Exporter); our @EXPORT = ('example_sub'); } sub example_sub { my $self = shift; $self->length; return $self->do_something; } # this is a comment for do_something, an example method sub do_something { my ($self) = @_; if ('dog' eq "cat") { say 1 * 564; } else { say 100 % 101; } return 'a string'; } # example variables my @array = qw/1 2 3/; my $scalar = 'a plain string'; print STDOUT $scalar; example_sub({ uc => 'test uc is string not BIF'}); 1; __END__ This is just sample code to demo the markup EOF my $markup = prettify( { code => $code, debug => 1 } ); return $htmlStart . $markup . $htmlEnd; } sub _decorate { my $prettyPrintedCode = '
';
    foreach my $token ( $_[0]->tokens ) {
        $prettyPrintedCode .= _to_html( $token, $_[1] );
    }
    return $prettyPrintedCode .= '
'; } sub _to_html { my ( $token, $debug ) = @_; my $type = _determine_token($token); my $title = ""; $title = qq( title="$type") if $debug; return qq() . encode_entities( $token->content ) . qq(); } # code adapted from PPI::HTML and Perl::Critic::Utils sub _determine_token { my ($token) = @_; if ( ref($token) eq 'PPI::Token::Word' ) { if ( $token->snext_sibling and $token->snext_sibling->content eq '=>' ) { return 'PPI::Token::Quote'; } my $parent = $token->parent; my $content = $token->content; if ( $parent->isa('PPI::Statement::Include') ) { return 'PPI::Token::Pragma' if $content eq $parent->pragma; } elsif ( $parent->isa('PPI::Statement::Variable') ) { if ( $content =~ /^(?:my|local|our)$/ ) { return 'PPI::Token::KeywordFunction'; } } elsif ( $parent->isa('PPI::Statement::Compound') ) { if ( $content =~ /^(?:if|else|elsif|unless|for|foreach|while|my)$/ ) { return 'PPI::Token::KeywordFunction'; } } elsif ( $parent->isa('PPI::Statement::Given') ) { if ( $content eq 'given' ) { return 'PPI::Token::KeywordFunction'; } } elsif ( $parent->isa('PPI::Statement::When') ) { if ( $content =~ /^(?:when|default)$/ ) { return 'PPI::Token::KeywordFunction'; } } elsif ( $parent->isa('PPI::Statement::Scheduled') ) { return 'PPI::Token::KeywordFunction'; } return 'PPI::Token::Symbol' if is_method_call($token); return 'PPI::Token::Symbol' if is_subroutine_name($token); return 'PPI::Token::Keyword' if grep /^$token$/, @B::Keywords::Barewords; return 'PPI::Token::Symbol' if grep /^$token$/, @B::Keywords::Filehandles; return 'PPI::Token::Word::Package' if is_package_declaration($token); # get next significant token if ( $token->next_token ) { my $next_token = $token->next_token; while ( !$next_token->significant and $next_token->next_token ) { $next_token = $next_token->next_token; } return 'PPI::Token::Quote' if $next_token->content eq '}' and !$token->sprevious_sibling; } return 'PPI::Token::Function' if grep /^$token$/, @B::Keywords::Functions; } return ref($token); } 1; __END__ =pod =encoding UTF-8 =head1 NAME PPI::Prettify - A Perl HTML pretty printer to use with Google prettify CSS skins, no JavaScript required! =head1 VERSION version 0.07 =head1 SYNOPSIS use PPI::Prettify 'prettify'; my $codeSample = q! # get todays date in Perl use Time::Piece; print Time::Piece->new; !; my $html = prettify({ code => $codeSample }); # every Perl token wrapped in a span e.g. for "use PPI::Prettify;": use PPI::Prettify ; my $htmlDebug = prettify({ code => $codeSample, debug => 1 }); # with PPI::Token class, e.g. for "use PPI::Prettify;": use PPI::Prettify ; =head1 DESCRIPTION This module takes a string Perl code sample and returns the tokens of the code surrounded with tags. The class attributes are the same used by the L. Using L you can generate the prettified code for use in webpages without using JavaScript but you can use all L developed for prettify.js. Also, because this module uses L to tokenize the code, it's more accurate than prettify.js. L exports prettify() and the $MARKUP_RULES hashref which is used to match PPI::Token classes to the class attribute given to that token's tag. You can modify $MARKUP_RULES to tweak the mapping if you require it. I wrote an article with more detail about the module for: L. =head1 MOTIVATION I wanted to generate marked-up Perl code without using JavaScript for L. I was dissatisfied with prettify.js as it doesn't always tokenize Perl correctly and won't run if the user has disabled JavaScript. I considered L but it embeds the CSS in the generated code, and I wanted to use the same markup class attributes as prettify.js so I could reuse the existing CSS developed for it. =head1 BUGS AND LIMITATIONS =over =item * What constitutes a function and a keyword is somewhat arbitrary in Perl. L mostly uses L to help distinguish functions and keywords. However, some words such as "if", "my" and "BEGIN" are given a special class of "PPI::Token::KeywordFunction" which can be overridden in $MARKUP_RULES, should you wish to display these as keywords instead of functions. =item * This module does not yet process Perl code samples with heredocs correctly. =item * Line numbering needs to be added. =back =head1 SUBROUTINES/METHODS =head2 prettify Takes a hashref consisting of $code and an optional debug flag. Every Perl code token is given a tag that corresponds to the tags used by Google's prettify.js library. If debug => 1, then every token's span tag will be given a title attribute with the value of the originating PPI::Token class. This can help if you want to override the mappings in $MARKUP_RULES. See L for examples. =head2 getExampleHTML Returns an HTML document as a string with built-in CSS to demo the syntax highlighting capabilites of PPI::Prettify. At the command line: $ perl -MPPI::Prettify -e 'print PPI::Prettify::getExampleHTML()' > example.html =head1 INTERNAL FUNCTIONS =head2 _decorate Iterates through the tokens of a L, marking up each token with a tag. =head2 _to_html Marks up a token with a span tag with the appropriate class attribute and the PPI::Token class. =head2 _determine_token Determines the PPI::Token type. =head1 REPOSITORY L =head1 SEE ALSO L is another prettifier for Perl code samples that allows the embedding of CSS directly into the HTML generation. =head1 THANKS Thanks to Adam Kennedy for developing L, without which this module would not be possible. =head1 AUTHOR David Farrell L =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by David Farrell. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut