view release on metacpan or  search on metacpan

lib/App/perlhl.pm  view on Meta::CPAN

package App::perlhl;
use strict;
use warnings;
use v5.10.1;
no if ($] >= 5.017010), warnings => 'experimental::smartmatch';
use Syntax::Highlight::Perl::Improved 1.01 ();
use Term::ANSIColor 3.00 ();

# ABSTRACT: application class for syntax highlighting Perl source code
our $VERSION = '0.007'; # VERSION


sub new {
    my $class = shift;
    my $output= shift || 'ansi';

    my $formatter = Syntax::Highlight::Perl::Improved->new();
    given ($output) {
        when ('html') {
            my $color_table = {
                'Variable_Scalar'   => 'color:#080;',
                'Variable_Array'    => 'color:#f70;',
                'Variable_Hash'     => 'color:#80f;',
                'Variable_Typeglob' => 'color:#f03;',
                'Subroutine'        => 'color:#980;',
                'Quote'             => 'color:#00a;',
                'String'            => 'color:#00a;',
                'Comment_Normal'    => 'color:#069;font-style:italic;',
                'Comment_POD'       => 'color:#014;font-family:garamond,serif;font-size:11pt;',
                'Bareword'          => 'color:#3A3;',
                'Package'           => 'color:#900;',
                'Number'            => 'color:#f0f;',
                'Operator'          => 'color:#000;',
                'Symbol'            => 'color:#000;',
                'Keyword'           => 'color:#000;',
                'Builtin_Operator'  => 'color:#300;',
                'Builtin_Function'  => 'color:#001;',
                'Character'         => 'color:#800;',
                'Directive'         => 'color:#399;font-style:italic;',
                'Label'             => 'color:#939;font-style:italic;',
                'Line'              => 'color:#000;',
            };
            # HTML escapes.
            $formatter->define_substitution('<' => '&lt;',
                                            '>' => '&gt;',
                                            '&' => '&amp;');

            # install the formats set up above
            while ( my($type, $style) = each %{$color_table} ) {
                $formatter->set_format($type, [ qq{<span style="$style">}, qq{</span>} ]);
            }
        }
        when ('ansi') {
            my $color_table = { # Readability is not so good -- play with it more
                'Bareword'          => 'bright_green',
                'Builtin_Function'  => 'blue',
                'Builtin_Operator'  => 'bright_red',
                'Character'         => 'bold bright_red',
                'Comment_Normal'    => 'bright_blue',
                'Comment_POD'       => 'bright_black',
                'Directive'         => 'bold bright_black',
                'Keyword'           => 'white',
                'Label'             => 'bright_magenta',
                'Line'              => 'white',
                'Number'            => 'bright_red',
                'Operator'          => 'white',
                'Package'           => 'bold bright_red',
                'Quote'             => 'blue',
                'String'            => 'blue',
                'Subroutine'        => 'yellow',
                'Symbol'            => 'white',
                'Variable_Array'    => 'cyan',
                'Variable_Hash'     => 'magenta',
                'Variable_Scalar'   => 'green',
                'Variable_Typeglob' => 'bright_red',
            };

            # install the formats set up above
            while ( my ( $type, $style ) = each %{$color_table} ) {
                $formatter->set_format($type, [ Term::ANSIColor::color($style), Term::ANSIColor::color('reset') ]);
            }
        }
    }

    return bless { formatter => $formatter }, $class;
}


sub run {
    my $self  = shift;
    my $mode  = shift;
    my @files = @_;

    given ($mode) {
        when ('version')    { $self->_do_version(); }
        when ('highlight')  { $self->_do_highlighting(@files); }
        default             { $self->_do_highlighting(@files); }
    }
}

sub _do_version {
    my $this = __PACKAGE__;
    my $this_ver = (defined __PACKAGE__->VERSION ? __PACKAGE__->VERSION : 'dev');
    say "$this version $this_ver" and exit;
}

sub _do_highlighting {
    my $self  = shift;
    my @files = @_;

    if (@files) {
        foreach my $filename (@files) {
            open my $in, '<', $filename;
            # Use a separate object for each file - otherwise,
            # highlighting for anything after the first file
            # will be suboptimal.
            my $formatter = $self->{formatter}->new();
            while (<$in>) {
                print $formatter->format_string;
            }
        }
    }
    else {
        while (<STDIN>) {
            print $self->{formatter}->format_string while (<STDIN>);
        }
    }