view release on metacpan or  search on metacpan

lib/App/KGB/Painter.pm  view on Meta::CPAN

use base 'Class::Accessor::Fast';

__PACKAGE__->mk_accessors( qw(item_colors color_codes simulate) );

our %color_codes = (
    bold      => "\002",     # ^B
    normal    => "\017",     # ^O
    underline => "\037",     # ^_
    reverse   => "\026",     # ^V
    black     => "\00301",
    navy      => "\00302",
    green     => "\00303",
    red       => "\00304",
    brown     => "\00305",
    purple    => "\00306",
    orange    => "\00307",
    yellow    => "\00308",
    lime      => "\00309",
    teal      => "\00310",
    aqua      => "\00311",
    blue      => "\00312",
    fuchsia   => "\00313",
    silver    => "\00314",
    white     => "\00316",
    reset     => "\017",
);

our %item_colors = (
    revision  => undef,
    path      => 'teal',
    author    => 'purple',
    branch    => 'brown',
    project   => 'blue',
    module    => 'green',
    web       => 'silver',
    separator => undef,

    addition     => 'green',
    modification => 'teal',
    deletion     => 'bold red',
    replacement  => 'brown',

    prop_change => 'underline',
);

=head1 CONSTRUCTOR

=head2 new

 my $p = App::KGB::Painter->new({ color_codes => { ... }, item_colors => { ... } } );

B<color_codes> is a hash with the special symbols interpreted as coloring
commands by IRC clients.

B<item_colors> is another hash describing what colors to apply to different parts of
the messages.

=cut

sub new {
    my $self = shift->SUPER::new(@_);

    # default colors
    $self->color_codes( \%color_codes ) unless $self->color_codes;
    my $c = $self->color_codes;
    while ( my ($k,$v) = each %color_codes ) {
        $c->{$k} = $v unless exists $c->{$k};
    }

    # default styles
    $self->item_colors( \%item_colors ) unless $self->item_colors;
    my $s = $self->item_colors;
    while ( my ($k,$v) = each %item_colors ) {
        $s->{$k} = $v unless exists $s->{$k};
    }

    return $self;
}

=head1 METHODS

=over

=item B<colorize> I<category> I<text>

Applies the colors of the style I<category> to the given I<text>.

=cut

sub colorize {
    my ( $self, $category, $text ) = @_;

    return $text if $self->simulate;

    my $color = $self->item_colors->{$category};

    unless ($color) {
        warn
            "Not coloring '$text' due to unknown color '$color' for category '$category'"
            if 0;
        return $text;
    }

    my $c = $self->color_codes;

    for ( split( /\s+/, $color ) ) {
        $text = $c->{$_} . $text if $c->{$_};
    }

    $text .= $c->{reset};

    warn "Colored ($category/$color): $text" if 0;
    return $text;
}

our %action_items = (
    A => 'addition',
    M => 'modification',
    D => 'deletion',
    R => 'replacement',
);