0: #!/usr/bin/perl
1: 
2: #===[ MonkBot ]===============================================================
3: #
4: # Jabber bot that serves as an IM gateway to the perlmonks.org chatterbox.
5: # Homepage: http://hutta.com/perl/jabberbots/monkbot.html
6: #
7: # Note that this requires Net::Jabber, Net::Jabber::Bot and PerlMonks::Chat
8: # http://download.jabber.org/perl/
9: # http://hutta.com/perl/jabberbots/
10: # http://www.cerias.purdue.edu/homes/zamboni/perlmonks.html
11: #
12: # My personal MonkBot is on jabber as MonkBot@jabber.icgcorp.net.
13: # Add him to your roster and you can test this out.
14: #
15: #===[ TODO ]==================================================================
16: #
17: # - Let MonkBot take user/pass to allow people to send messages as themselves.
18: # - More integration with PM... New nodes, etc, etc, etc.
19: #
20: #=============================================================================
21: 
22: use Net::Jabber::Bot;
23: use PerlMonks::Chat;
24: 
25: #===[ Initialize ]============================================================
26: 
27: my $pm = new PerlMonks::Chat;
28: $pm->add_cookies;
29: 
30: my $bot = new Net::Jabber::Bot(
31:         client  => 'MonkBot',
32:         verbos  => '2',
33:         logfile => '/tmp/monkbot.log',
34:         version => '1.0',
35:         status  => 'Meditating',
36: );
37: 
38: $bot->connect(
39:         hostname => 'jabber.com',
40:         port     => '5222'
41: ) || die "Can't connect"; 
42: 
43: $bot->auth(
44:         username => 'MonkBot',
45:         password => 'passwordhere',
46:         resource => 'bot',
47:         digest   => '1'
48: );
49: 
50: $bot->send_presence();
51: 
52: #===[ Defining Callbacks ]====================================================
53: 
54: $bot->set_callback( "hello" => \&SayHello );
55: $bot->set_callback( "hi"    => \&SayHello );
56: $bot->set_callback( "help"  => \&SayHello );
57: $bot->set_callback( "all"   => \&SendAll );
58: 
59: sub SayHello {
60:         my $user = shift;
61:         $user->write("Greetings.");
62:         $user->write("Add me to your roster/buddylist and I'll send you every" . 
63:                      "thing that happens on the chatterbox automatically.  " .
64:                      "Send the command 'all' to get all lines currently " . 
65:                      "available.");
66: }
67: 
68: sub SendAll {
69:         my $user = shift;
70:         my ($lines) = ($pm->getalllines(1,1));
71:         foreach (@{$lines}) {
72:                 $user->write("$_");
73:         }
74: }
75: 
76: #===[ The main loop. ]========================================================
77: #
78: # This is where the bot will spend most of its time.  Looping and looping,
79: # waiting for new chatterbox messages.  When we get them, we'll send them
80: # out to anyone subscribed to our presence.
81: #
82: #=============================================================================
83: 
84: while (1) {
85:         $bot->Process(5);
86: 
87:         foreach ($pm->getnewlines(1,1)) { 
88:                 $bot->broadcast(body=>"$_", type=>'chat');
89:         }
90: 
91:         $bot->Connected() || die "Lost my connection!";
92: }
93: # Edited: Sun Oct 14 06:52:45 2001 (GMT), by [footpad]
94: # Fixed formatting by adding line line breaks.