view release on metacpan or  search on metacpan

Amethyst/Brain/Infobot/Module/Statement.pm  view on Meta::CPAN

package Amethyst::Brain::Infobot::Module::Statement;

use strict;
use vars qw(@ISA
		$RE_VERB $RE_QUESTION $RE_IGNORE $RE_PREAMBLE
		$RE_RMKPREFIX $RE_RMKSUFFIX
		$RE_RMVPREFIX $RE_RMVSUFFIX
		);
use Amethyst::Message;
use Amethyst::Store;
use Amethyst::Brain::Infobot;
use Amethyst::Brain::Infobot::Module;

@ISA = qw(Amethyst::Brain::Infobot::Module);
$RE_VERB = "is|are|has";
$RE_QUESTION = "what|who|where|which|when|wot|wtf";
$RE_IGNORE = "if|this|that|there|so|some|someone" .
				"|he|she|we|it|they|you|i" .
				"|$RE_QUESTION";
$RE_PREAMBLE = "think|thinks|note|notes|said|say|says|that";
$RE_RMKPREFIX = "but|and|or|btw|actually|well"; # |a|the
$RE_RMKSUFFIX = "really|actually";
$RE_RMVSUFFIX = "too|also|as well";

sub new {
	my $class = shift;
	my $self = $class->SUPER::new(
					Name		=> 'Statement',
					# Regex		=> qr/(?:karma|\+\+|--)/i,
					Usage		=> 'Make a statement. Ask a question.',
					Description	=> "Statement handler",
					@_
						);

	die "No FactoidWrite store in Infobot config"
					unless $self->{Infobot}->{FactoidWrite};

	$self->{WriteStore} = new Amethyst::Store(
					Source	=> $self->{Infobot}->{FactoidWrite},
						);

	my @stores = ($self->{WriteStore});
	foreach (@{ $self->{Infobot}->{FactoidRead} }) {
		my $store = new Amethyst::Store(
					Source	=> $_,
						);
		push(@stores, $store);
	}

	$self->{Stores} = \@stores;

	return bless $self, $class;
}

sub forget {
	my ($self, $message, $key) = @_;

	my $filter = qr/./;
	my $msg = undef;
	my $data = undef;

	print STDERR "Forget: $key\n";

	if ($key =~ m,^\s*(.*?)\s+/(.*)/\s*$,) {
		$key = $1;
		$filter = $2;
		print STDERR "Forget: key $key, filter $filter\n";
		eval { "x" =~ m/$filter/ };
		if ($@) {
			my $reply = $self->reply_to($message,
							"Invalid regexp $filter: $@");
			$reply->send;
			return 1;
		}
	}

	my $skey = $self->normalise($key);

	my $store = $self->{WriteStore};

	if ($data = $store->get($skey)) {
		foreach (keys %$data) {
			if (/$filter/) {
				# delete $data->{$_};
				$msg = "I forgot $skey.";
			}
		}
		if (%$data) {
			# $store->set($skey, $data);
		}
		else {
			# $store->unset($skey);
		}
	}

	foreach my $store (@{ $self->{Stores} }) {
		if ($data = $store->get($skey)) {
			foreach (keys %$data) {
				if (/$filter/) {
					$msg ="I have been instructed not to forget " .
							"$skey. It is in readonly store " .
							"$store->{Source}."
									unless $msg;
				}
			}
		}
	}

	unless ($msg) {
		if ($filter) {
			$msg = "I knew nothing about $skey matching $filter.";
		}