The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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    => 'green',
    branch    => 'brown',
    project   => 'blue',
    module    => 'purple',
    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',
);

=item B<colorize_change> I<change>

Given a change, applies colors to its files depending on the type of the change
-- update, addition, deletion or property change.

=cut

sub colorize_change {
    my $self = shift;
    my $c = shift;

    my $action_item = $action_items{ $c->action };
    unless ($action_item) {
        warn $c->action . " is an unknown action\n";
        return $c->path;
    }

    my $text = $self->colorize( $action_item, $c->path );

    $text = $self->colorize( 'prop_change', $text ) if $c->prop_change;

    return $text;
}

=back

=head1 COPYRIGHT & LICENSE

Copyright (c) 2013, 2018, Damyan Ivanov L<dmn@debian.org>.

This module is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any later
version.

This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
details.

You should have received a copy of the GNU General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 51
Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.

=cut

1;