Coloring Perl in XHTML with PPI
Update: this is very out of date and ha a couple of bugs. Prefer PPI::HTML.
I hope to update this with some descriptions but this is a perfectly working sample.
use strict; use warnings; use PPI; use HTML::Entities; use CGI qw(style header start_html end_html pre); my $script = shift or die "Give a script to markup as XHTML!\n"; my $doc = PPI::Document->new($script); my ( $line, @lines ); my @tokens = $doc->tokens; for ( my $i = 0; $i < @tokens; $i++ ) { my $token = $tokens[$i]; my ( $class ) = $token->class =~ /\APPI::Token::(.+)\z/; $class =~ s/::/_/g; $class = lc $class; if ( $class eq "comment" ) { if ( $line ) { $line .= xhtml_code($class, $token->content); } else { for my $line ( split /\n/, $token->content ) { push @lines, xhtml_code($class, $line); } } } elsif ( $token->class eq "PPI::Token::Whitespace" ) { if ( $token->content =~ /\r?\n/ ) { push @lines, $line ? $line : ""; $line = ''; } else { $line .= xhtml_code($class, $token->content); } } else { $line .= xhtml_code($class, $token->content); } if ( $i == and $line ) { push @lines, $line; } } print start_html (-title => $script, -head => style({-type => 'text/css'}, join('', <DATA>), # slurp __DATA__ ) ), pre({-class => "perl"}, join("\n", @lines), ), end_html(); exit 0; sub xhtml_code { my ( $class, $content ) = @_; return qq|<span class="$class">| . encode_entities($content) . "</span>"; } __END__ .perl .data, .perl .pod, .perl .end { color:#335; } .perl .arrayindex { color:#005; } .perl .attribute { color:#009; } .perl .cast { color:#0a0; } .perl .comment { color:#889; border:0; } .perl .dashedword { color:#606; } .perl .data { white-space:pre; color:#007; } .perl .end { color:#003; } .perl .heredoc { color:#446; } .perl .label { color:#450; } .perl .magic { color:#900; } .perl .number { color:#040; } .perl .operator { color:#a00; font-weight:bold; } .perl .prototype { color:#632; } .perl .quote { color:#00a; } .perl .quote_double { color:#606; } .perl .quote_interpolate { color:#093; } .perl .quote_literal { color:#333; } .perl .quote_single { color:#422; } .perl .quotelike { color:#240; } .perl .quotelike_backtick { color:#530; } .perl .quotelike_command { color:#034; } .perl .quotelike_readline { color:#237; } .perl .quotelike_regexp { color:#367; } .perl .quotelike_words { color:#305; } .perl .regexp { color:#f9f; background-color:#432; } .perl .regexp_match { color:#099; } .perl .regexp_substitute { color:#052; } .perl .regexp_transliterate { color:#906; } .perl .separator { color:#093; } .perl .structure { color:#090; } .perl .symbol { color:#a40; } .perl .unknown { color:#fff; background-color:black; } .perl .whitespace { white-space:pre; color:#000; border-bottom:1px dotted #dca; } .perl .word { color:#349; }





