File Coverage

blib/lib/Bot/BasicBot/CommandBot.pm

Criterion	Covered	Total	%
statement	42	69	60.8
branch	4	16	25.0
condition	2	13	15.3
subroutine	10	17	58.8
pod	8	8	100.0
total	66	123	53.6

package Bot::BasicBot::CommandBot;

use strict;
use warnings;
use 5.014;

our $VERSION = 0.05;

use Tie::RegexpHash 0.16;
use List::Util qw(any);

use Exporter 'import';
use base qw/Bot::BasicBot/;

our @EXPORT_OK = qw(command autocommand);

my %command;
my %autocommand;

sub command {
    (caller)[0]->declare_command(@_);
}

sub autocommand {
    (caller)[0]->declare_autocommand(@_);
}

sub declare_autocommand {
    my ($package, $sub) = @_;
    $autocommand{$package} = $sub;
}

sub declare_command {
    my $package = shift;
    my $sub = pop;
    my $command = pop;

    my %options = @_;

    $options{events} //= ['said'];

    if (not exists $command{$package}) {
        $command{$package} = {};
        tie %{$command{$package}}, 'Tie::RegexpHash';
    }

    $command{$package}{$command} = {
        sub => $sub,
        %options,
    };
}


sub new {
    my $class = shift;
    my %opts = @_;

    my $address = delete $opts{address};
    my $trigger = delete $opts{trigger};
    my $bark    = delete $opts{bark} // 1;

    my $self = $class->SUPER::new(%opts);
    $self->{trigger} = $trigger if defined $trigger;
    $self->{address} = $address if defined $address;
    $self->{bark}    = $bark;

    return $self;
}

sub said {
    my $self = shift;
    my ($data) = @_;

    $self->{command} = $data;
    my $package = ref $self;

    my ($cmd, $message) = split ' ', $data->{body}, 2;

    my $autosay = $self->_auto($data->{body});

    if ($self->{address} and not $data->{address}) {
        return $autosay;
    }

    if ($self->{trigger} and $data->{body} !~ s/^\Q$self->{trigger}//) {
        return $autosay;
    }

    my $found = $command{$package}{$cmd};

    if (!$found) {
        return "What is $cmd?" if $self->{bark};
        return $autosay;
    }

    my $say;
    if (any { $_ eq 'said' } @{$found->{events}}) {
        $say = $found->{sub}->($self, $cmd, $message);
    }

    return $say // $autosay;
}

sub emoted {
}

sub noticed {
}

sub _auto {
    my ($self, $message) = @_;
    join ' ', map $_->($self, $message), values %autocommand;
}

1;

__END__