view release on metacpan or  search on metacpan

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

package App::KGB::Painter;

=head1 NAME

App::KGB::Painter -- add color to KGB notifications

=head1 DESCRIPTION

B<App::KGB::Painter> is a simple class encapsulating coloring of KGB messages.

=cut

use strict;
use warnings;

our $VERSION = 1.27;

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;