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