# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
################################
# Magic Eight Ball             #
################################

package BotModules::MagicEightBall;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;

sub Help {
    my $self = shift;
    my ($event) = @_;
    return {
        '' => 'The all knowing magic eight ball, in electronic form. Ask a question and the answer shall be provided.',
        $self->{'prefix'}.'ball' => "Ask the Magic Eight Ball a question. Syntax: '$self->{'prefix'}ball: will it happen?'",
    };
}

# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
    my $self = shift;
    $self->SUPER::RegisterConfig(@_);
    $self->registerVariables(
      # [ name, save?, settable? ]
      ['prefix', 1, 1, '!8'], # the prefix to put before the 'ball' command
      ['responses-positive', 1, 1, ['It is possible.', 'Yes!', 'Of course.', 'Naturally.', 'Obviously.',
                                    'One would be wise to think so.', 'The outlook is good.', 'It shall be.',
                                    'The answer is certainly yes.', 'It is so.']],
      ['responses-negative', 1, 1, ['In your dreams.', 'No.', 'No chance.', 'Unlikely.', 'About as likely as pigs flying.',
                                    'You\'re kidding, right?', 'The outlook is poor.', 'I doubt it very much.',
                                    'The answer is a resounding no.', 'NO!', 'NO.']],
      ['responses-unknown', 1, 1, ['Maybe...', 'The outlook is hazy, please ask again later.', 'No clue.',
                                   'What are you asking me for?', '_I_ don\'t know.', 'Come again?',
                                   'You know the answer better than I.', 'The answer is def-- oooh! shiny thing!']],
    );
}

sub Told {
    my $self = shift;
    return ($self->CheckTheBall(@_) and $self->SUPER::Told(@_));
}

sub Heard {
    my $self = shift;
    return ($self->CheckTheBall(@_) and $self->SUPER::Told(@_));
}

sub CheckTheBall {
    my $self = shift;
    my ($event, $message) = @_;
    if ($message =~ m/$self->{'prefix'}ball[\s:,]+(\S.+\w.+)$/si) {

        # -- #buncs was here --
        #        <Kam> !8ball: are you a fish?
        #    <oopsbot> Kam: About as likely as pigs flying.
        #        <Kam> !8ball: is the world flat?
        #    <oopsbot> Kam: The answer is a resounding no.
        #        <Kam> !8ball: is the world round?
        #    <oopsbot> Kam: _I_ don't know.
        #        <Kam> !8ball: is the world spherical?
        #    <oopsbot> Kam: The answer is certainly yes.
        #        <Kam> how DOES it do that? :)
        #      <Hixie> it's gooood :-)

        # trim the fat from the question
        $message =~ s/\W//gos;
        # pick a reply category that will always be the same for this exact question
        my $response = $self->{['responses-positive', 'responses-negative', 'responses-unknown']->[(length($message) % 3)]};
        # pick a specific reply that will be different to recent ones
        $response = $response->[$event->{'time'} % @$response];
        $self->say($event, "$event->{'from'}: $response");
    } else {
        return 1;
    }
    return 0;
}