#ElizaLovesYou v0.3 - Rogerian psychotherapist for Pidgin
#Copyright (C) 2004 Scott Wolchok
#This program 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#(You can find the GPL at http://www.gnu.org/copyleft/gpl.html)
#You'll need to install Chatbot::Eliza from CPAN before this will work.
#Run 'perl -MCPAN -e "shell"' and answer the questions, then type
#'install Chatbot::Eliza' at the prompt. That should do it!
#Please note that this plugin is just a hook for the Perl Chatbot::Eliza
#module - the credit for the actual "bot" goes to the John Nolan, the
#writer of that module.
#Superdug is great!!!!
use Pidgin;
use Purple;
use Chatbot::Eliza;
use strict;
my %bots;
my $plugin;
my $data = "";
#my @timeouts; #Pidgin segfaults if we leave the send_message timeout and unload the plugin
%::PLUGIN_INFO = (
perl_api_version => 2,
name => "ElizaLovesYou",
version => "0.3",
summary => "Rogerian psychotherapist for Pidgin",
description => "Automatically responds to incoming messages on all accounts using the Eliza algorithm",
author => "Scott Wolchok <evilsporkman\@gmail.com>",
url => "none",
load => "plugin_load",
unload => "plugin_unload"
);
sub plugin_init {
return %::PLUGIN_INFO;
}
sub do_eliza {
my $im;
Purple::Debug::info($::PLUGIN_INFO{name}, "tutorialplugin....Entering do_eliza\n");
Purple::Debug::info($::PLUGIN_INFO{name}, "tutorialplugin....value of data XXXX$_ XXXX\n");
my ($account, $sender, $message, $conv, $flags) = @_;
Purple::Debug::info($::PLUGIN_INFO{name}, "tutorialplugin....value of account $account\n");
Purple::Debug::info($::PLUGIN_INFO{name}, "tutorialplugin....value of protocl $account->get_protocol_id()\n");
Purple::Debug::info($::PLUGIN_INFO{name}, "tutorialplugin....value of sender $sender \n");
Purple::Debug::info($::PLUGIN_INFO{name}, "tutorialplugin....value of message $message \n");
Purple::Debug::info($::PLUGIN_INFO{name}, "tutorialplugin....value of conv $conv\n");
Purple::Debug::info($::PLUGIN_INFO{name}, "tutorialplugin....value of flags $flags\n");
Purple::Debug::info($::PLUGIN_INFO{name}, "tutorialpluginDisplayed: $message\n");
$bots{$sender} = new Chatbot::Eliza unless $bots{$sender};
while($message =~ s/<.*?>//)
{
}; #HTML si t3h sux0r!
if($conv)
{
Purple::Debug::info($::PLUGIN_INFO{name},"tutorialplugin 0000000000000000000inside conv999999999999999999999999\n");
my $theIM = $conv->get_im_data();
#Tried to use a queue to hold timeouts so we could remove them at plugin_unload - the thing segfaults if there's a timeout pending and you unload it
# push @timeouts, Pidgin::timeout_add($plugin,10,\&send_message,[$theIM,$bots{$sender}->transform($message)]);
Pidgin::timeout_add($plugin,1,\&send_message,[$theIM,$bots{$sender}->transform($message)]);
Purple::Debug::info($::PLUGIN_INFO{name}, "tutorialpluginLeaving do_eliza\n");
}
else
{
$conv = Pidgin::Conversation->new(1, $account, $sender);
if ($conv)
{
print "ok.\n";
$im = $conv->get_im_data();
if ($im) { print "tutorialplugin im ok.\n"; } else { print "tutorialplugin im fail.\n"; }
# Here we send messages to the conversation
print "Ttutorialplugin esting Pidgin::Conversation::IM::send()...\n";
$im->send("Hi $sender, The maniac is sleeping or eating or buzy doing some shit!!!.");
$im->send("I am his dumb slave bot :). You can speak to me if you want!!!");
}
else
{
print "tutorialplugin fail.\n";
}
print "tutorialplugin Testing Pidgin::Conversation->new()...";
}
}
sub send_message {
Purple::Debug::info($::PLUGIN_INFO{name}, "tutorialpluginEntering send_message\n");
my ($IM, $message) = @{$_[0]};
Purple::Debug::info($::PLUGIN_INFO{name}, "Shifting timeouts\n");
#shift @timeouts;
Purple::Debug::info($::PLUGIN_INFO{name}, "tutorialpluginSending message\n");
Pidgin::Conversation::IM::send($IM,$message);
return undef;
}
sub plugin_load {
$plugin = shift;
my $conversations_handle = Pidgin::Conversations::get_handle();
#my $conversations_handle = purple_conversations_get_handle();
Purple::Debug::info($::PLUGIN_INFO{name},"tutorialplugin entering plugin_load\n");
Purple::Debug::info($::PLUGIN_INFO{name},"tutorialplugin value of conversations_handle is $conversations_handle\n");
Purple::Signal::connect($conversations_handle, "received-im-msg", $plugin, \&do_eliza, $data);
}
sub plugin_unload {
my $plugin = shift;
# for my $timeout (@timeouts) {
# Pidgin::timeout_remove($timeout);
# }
Purple::Debug::info($::PLUGIN_INFO{name},"tutorialplugin entering plugin_unload\n");
}
#Note: I got this from forsaken in #gaim on FreeNode and renamed it to getIM, his original credit follows:
#From Split.pl and edited.
#Michael Wozniak <martianpenguin@hackermail.com> and Anthony Noto <agnoto1@yahoo.com>
sub getIM
{
my $thing = $_[0];
my @im_array = Pidgin::ims(); #get the array of IM's
foreach my $element (@im_array)
{
if ( Pidgin::Conversation::get_name( Pidgin::Conversation::IM::get_conversation ( $element ) ) eq $thing )
{
return $element; #return the correct IM
}
}
Purple::Debug::info($::PLUGIN_INFO{name},"tutorialplugin entering getIM\n");
return undef;
}
ERROR
(13:16:31) perl: Loading perl script
(13:16:31) ElizaLovesYou: tutorialplugin entering plugin_load
(13:16:31) ElizaLovesYou: tutorialplugin value of conversations_handle is Purple::Handle=HASH(0x94dda08)
(13:16:31) signals: Signal data for received-im-msg not found!
(13:16:31) prefs: /pidgin/plugins/loaded changed, scheduling save.
(13:16:32) util: Writing file prefs.xml to directory /home/temp/.purple