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 == $#tokens 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;
}