view release on metacpan or  search on metacpan

lib/Bot/BasicBot/Pluggable/Module/MetaSyntactic.pm  view on Meta::CPAN

package Bot::BasicBot::Pluggable::Module::MetaSyntactic;
{
  $Bot::BasicBot::Pluggable::Module::MetaSyntactic::VERSION = '1.004';
}

use strict;
use warnings;
use Carp;
use Bot::BasicBot::Pluggable::Module;
use Acme::MetaSyntactic ();
use Text::Wrap;

our @ISA     = qw(Bot::BasicBot::Pluggable::Module);

my $META = Acme::MetaSyntactic->new()
    or carp "fatal: Can't create new Acme::MetaSyntactic object";

sub init {
    my $self = shift;

    $self->{meta} = {
        limit => 100,
        wrap  => 256,
    };

    $Text::Wrap::columns = $self->{meta}{wrap};
}

sub told {
    my ( $self, $mess ) = @_;
    my $bot = $self->bot();

    # we must be directly addressed
    return
        if !(   (   defined $mess->{address}
                    && $mess->{address} eq $bot->nick()
                )
                || $mess->{channel} eq 'msg'
        );

    # ignore people we ignore
    return if $bot->ignore_nick( $mess->{who} );

    # only answer to our command (which can be our name too)
    my $src = $bot->nick() eq 'meta' ? 'raw_body' : 'body';
    return if $mess->{$src} !~ /^\s*meta(.*)/i;

    # ignore the noise
    ( my $command = "$1" ) =~ s/^\W*//;

    # pick up the commands
    ( $command, my @args ) = split /\s+/, $command;
    return if !$command || !length $command;

    # it's a theme
    if ( $command =~ /^[-\w\/]+$/ ) {
        my ( $theme, $category ) = split m'/', $command, 2;
        $self->{meta}{theme}{$command} //= _load_theme($theme, $category);
        return "No such theme: $theme"
            if !$META->has_theme($theme);
        if ( $category && $self->{meta}{theme}{$command}
            ->isa('Acme::MetaSyntactic::MultiList')
            && !grep { $_ eq $category }
            $self->{meta}{theme}{$command}->categories )
        {
            delete $self->{meta}{theme}{$command};
            return "No such theme/category: $theme/$category";
        }

        # compute the list of items
        my ( $num, $re );
        for my $arg (@args) {
            if ( $arg =~ /^[0-9]+$/ ) { $num //= $arg; }
            elsif ( $arg =~ m{^/([^\/]*)/$} ) {
                $re = eval {qr/$1/}
                    or do { ( my $err = $@ ) =~ s/ at .*//s; return $err; }
            }
            else {return}    # can't parse this argument
        }

        # enforce the limit if explicitely asked for more
        $num //= 1;
        $num = $self->{meta}{limit} if $num > $self->{meta}{limit};

        my $meta  = $self->{meta}{theme}{$command};
        my @items = $meta->name( $re ? 0 : $num );
        if ($re) {    # NOTE: the extra loop is never run if $num == 0
            @items = grep /$re/, @items;
            splice @items, $num if $num && @items > $num;
            push @items, grep /$re/, $meta->name(0)
                while @items && @items < $num;
        }
        splice @items, $self->{meta}{limit}    # enforce the limit
            if @items > $self->{meta}{limit};
        return join ' ', @items;
    }

    # it's a command
    elsif ( $command eq 'themes?' ) {
        my @themes = $META->themes();
        return join ' ', scalar @themes, 'themes available:', @themes;
    }
    elsif ( $command eq 'categories?' ) {
        return if !@args;
        my $theme = shift @args;
        $self->{meta}{theme}{$theme} //= _load_theme($theme);
        return "No such theme: $theme"
            if !$META->has_theme($theme);
        return "Theme $theme does not have any categories"
            if !$self->{meta}{theme}{$theme}
                ->isa('Acme::MetaSyntactic::MultiList');
        return join ' ', "Categories for $theme:",
            sort $self->{meta}{theme}{$theme}->categories;
    }
}

sub _load_theme {