#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 ", 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 and Anthony Noto 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