root/POE-Component-YahooMessenger/trunk/lib/POE/Component/YahooMessenger.pm

Revision 767 (checked in by miyagawa, 18 years ago)

0.02

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1 package POE::Component::YahooMessenger;
2
3 use strict;
4 use vars qw($VERSION);
5 $VERSION = 0.02;
6
7 use POE qw(Wheel::SocketFactory Wheel::ReadWrite Driver::SysRW
8            Filter::YahooMessengerPacket Component::YahooMessenger::Constants);
9 use Socket;
10 use Net::YahooMessenger::CRAM;
11
12 sub spawn {
13     my($class, %args) = @_;
14     $args{Alias} ||= 'ym';
15     POE::Session->create(
16         inline_states => {
17             _start     => \&_start,
18             _stop      => \&_stop,
19             _sock_up   => \&_sock_up,
20             _sock_down => \&_sock_down,
21
22             # API
23             register   => \&register,
24             unregister => \&unregister,
25             connect    => \&connect,
26             send_message     => \&send_message,
27             change_my_status => \&change_my_status,
28             buddies          => \&buddies,
29
30             # internals
31             login             => \&login,
32             notify            => \&notify,
33             _unregister       => \&_unregister,
34             handle_event      => \&handle_event,
35
36             # own callbacks
37             goes_online         => \&goes_online,
38             goes_offline        => \&goes_offline,
39             change_status       => \&_handle_common,
40             receive_message     => \&receive_message,
41             new_friend_alert    => \&_handle_common,
42             toggle_typing       => \&_handle_common,
43             server_is_alive     => \&_handle_common,
44             cram_auth_fail      => \&_handle_common,
45             receive_buddy_list  => \&receive_buddy_list,
46             challenge_start     => \&challenge_start,
47         },
48         args => [ \%args ],
49     );
50 }
51
52 sub _start {
53     my($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
54     $kernel->alias_set($args->{Alias});
55 }
56
57 sub _stop { }
58
59 sub register {
60     my($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
61     $kernel->refcount_increment($sender->ID, __PACKAGE__);
62     $heap->{listeners}->{$sender->ID} = 1;
63 }
64
65 sub unregister {
66     my($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
67     $kernel->yield(_unregister => $sender->ID);
68 }
69
70 sub _unregister {
71     my($kernel, $heap, $session) = @_[KERNEL, HEAP, ARG0];
72     $kernel->refcount_decrement($session, __PACKAGE__);
73     delete $heap->{listeners}->{$session};
74 }
75
76 sub notify {
77     my($kernel, $heap, $name, $event) = @_[KERNEL, HEAP, ARG0, ARG1];
78     $event ||= POE::Component::YahooMessenger::Event::Null->new;
79     $kernel->post($_ => "ym_$name" => $event) for keys %{$heap->{listeners}};
80 }
81
82 sub connect {
83     my($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
84
85     # set up parameters
86     $heap->{$_} = $args->{$_}
87         for qw(id password);
88     $heap->{$_} = $args->{$_} || $Default->{$_}
89         for qw(hostname port);
90
91     return if $heap->{sock};
92     $heap->{sock} = POE::Wheel::SocketFactory->new(
93         SocketDomain   => AF_INET,
94         SocketType     => SOCK_STREAM,
95         SocketProtocol => 'tcp',
96         RemoteAddress  => $heap->{hostname},
97         RemotePort     => $heap->{port},
98         SuccessEvent   => '_sock_up',
99         FailureEvent   => '_sock_failed',
100     );
101 }
102
103 sub _sock_up {
104     my($kernel, $heap, $socket) = @_[KERNEL, HEAP, ARG0];
105
106     # new ReadWrite wheel for the socket
107     $heap->{sock} = POE::Wheel::ReadWrite->new(
108         Handle => $socket,
109         Driver => POE::Driver::SysRW->new,
110         Filter  => POE::Filter::YahooMessengerPacket->new,
111         ErrorEvent => '_sock_down',
112     );
113     $heap->{sock}->event(InputEvent => 'handle_event');
114     $heap->{connected} = 1;
115     $kernel->yield(notify => connected => ());
116     $kernel->yield(login => ());
117 }
118
119 sub _sock_down {
120     my($kernel, $heap) = @_[KERNEL, HEAP];
121     delete $heap->{sock};
122     $heap->{connected} = 0;
123     $kernel->yield(notify => disconnected => ());
124     for my $session (keys %{$heap->{listeners}}) {
125         $kernel->yield(_unregister => $session);
126     }
127 }
128
129 sub handle_event {
130     my($kernel, $heap, $event) = @_[KERNEL, HEAP, ARG0];
131     # check if event is implemented
132     if ($event->name) {
133         $kernel->yield($event->name, $event);
134     }
135 }
136
137 sub login {
138     my($kernel, $heap) = @_[KERNEL, HEAP];
139     $heap->{sock}->put(
140         POE::Component::YahooMessenger::Event->new(
141             'challenge_start', 0, {
142                 my_id => $heap->{id},
143             },
144         ),
145     );
146 }
147
148 sub _handle_common {
149     $_[KERNEL]->yield(notify => $_[ARG0]->name, $_[ARG0]);
150 }
151
152 sub challenge_start {
153     my($kernel, $heap, $event) = @_[KERNEL, HEAP, ARG0];
154
155     # calculate CRAM
156     my $cram = Net::YahooMessenger::CRAM->new;
157     $cram->set_id($heap->{id});
158     $cram->set_password($heap->{password});
159     $cram->set_challenge_string($event->challenge_string);
160     my($response_password, $response_crypt) = $cram->get_response_strings;
161
162     $heap->{sock}->event(InputEvent => 'handle_event');
163     $heap->{sock}->put(
164         POE::Component::YahooMessenger::Event->new(
165             'challenge_response', 0, {
166                 my_id  => $heap->{id},
167                 crypt_salt => $response_password,
168                 crypted_response => $response_crypt,
169                 login_nickname  => 1,
170                 id => $heap->{id},
171             },
172         ),
173     );
174     $kernel->yield(notify => $event->name, $event);
175 }
176
177 sub receive_buddy_list {
178     my($kernel, $heap, $event) = @_[KERNEL, HEAP, ARG0];
179     my $buddy_list = $event->buddy_list;
180     while ($buddy_list =~ /([^:]+):([^\x0a]+)\x0a/g) {
181         my $group = $1;
182         $heap->{buddies}->{$group} = [ split /,/, $2 ];
183     }
184     $kernel->yield(notify => $event->name, $event);
185 }
186
187 sub goes_online {
188     my($kernel, $heap, $event) = @_[KERNEL, HEAP, ARG0];
189     my $number = $event->number_of_online_buddies;
190     $number = 1 unless defined $number;
191     for my $num (0..$number-1) {
192         $heap->{online}->{$event->buddy_id($num)} = 1;
193         my $goes_online = POE::Component::YahooMessenger::Event->new(
194             'goes_online', 0, {
195                 buddy_id => $event->buddy_id($num),
196                 status_code => $event->status_code($num),
197                 status_message => $event->status_message($num),
198                 busy_code => $event->busy_code($num),
199             },
200         );
201         $kernel->yield(notify => $goes_online->name, $goes_online);
202     }
203 }
204
205 sub goes_offline {
206     my($kernel, $heap, $event) = @_[KERNEL, HEAP, ARG0];
207     delete $heap->{online}->{$event->buddy_id};
208     $kernel->yield(notify => $event->name, $event);
209 }
210
211 sub receive_message {
212     my($kernel, $heap, $event) = @_[KERNEL, HEAP, ARG0];
213     my $code = $event->status_code;
214     unless (defined $code && $code == 99) {
215         $kernel->yield(notify => $event->name, $event);
216     }
217 }
218
219 sub send_message {
220     my($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
221     my $option = _is_buddy($heap, $args->{to})
222         ? $Options->{to_buddies} : $Options->{to_non_buddies};
223     $heap->{sock}->put(
224         POE::Component::YahooMessenger::Event->new(
225             'send_message', $option, {
226                 from => $heap->{id},
227                 to   => $args->{to},
228                 message => $args->{message},
229             },
230         ),
231     );
232 }
233
234 sub _is_buddy {
235     my($heap, $buddy_id) = @_;
236     my %buddies = map $_ => 1, map @$_, values %{$heap->{buddies}};
237     return $buddies{$buddy_id};
238 }
239
240 sub change_my_status {
241     my($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
242     $heap->{sock}->put(
243         POE::Component::YahooMessenger::Event->new(
244             'change_status', 0, {
245                 status_code => 99, # XXX custom status
246                 busy_code => $args->{busy} || 0,
247                 status_message => $args->{message},
248             },
249         ),
250     );
251 }
252
253 sub buddies {
254     my($kernel, $heap, $sender, $reply) = @_[KERNEL, HEAP, SENDER, ARG0];
255     $kernel->post($sender => $reply => $heap->{buddies});
256 }
257
258 1;
259 __END__
260
261 =head1 NAME
262
263 POE::Component::YahooMessenger - POE component for Yahoo! Messenger
264
265 =head1 SYNOPSIS
266
267   use POE qw(Component::YahooMessenger);
268
269   # spawn YM session
270   POE::Component::YahooMessenger->spawn(Alias => 'ym');
271
272   # register your session for callbacks
273   $kernel->post(ym => 'register');
274
275   # tell YM how to connect
276   $kernel->post(ym => connect => {
277       id       => 'your_id',
278       password => 'xxxxxxx',
279   });
280
281   # associate this callback with 'ym_goes_online'
282   sub goes_online {
283       my $event = $_[ARG0];
284       printf "buddy %s goes online\n", $event->buddy_id;
285   }
286
287   # send message
288   $kernel->post(ym => send_message => {
289       to => $buddy_id,
290       message => "Hello World",
291   });
292
293   # change your status
294   $kernel->post(ym => change_my_status => {
295       busy => 0, # 0 = not busy
296       message => "going for lunch now!",
297   });
298
299   # retrieve your buddies list
300   $kernel->post(ym => buddies => 'retrieve_buddies');
301   sub retrieve_buddies {
302       my $buddies = $_[ARG0];
303       for my $group (keys %$buddies) {
304           print "$group:\n", map "  $_\n", @{$buddies->{$group}};
305       }
306   }
307
308   $poe_kernel->run();
309
310 =head1 DESCRIPTION
311
312 POE::Component::YahooMessenger is a POE component to connect Yahoo!
313 Messener. This module ripoffs a lot of code from Net::YahooMessenger
314 for protocol implementations.
315
316 API is intentionally made similar to that of PoCo::IRC.
317
318 =head1 EVENTS
319
320 TBD.
321
322 =head1 CAVEATS
323
324 B<This is ALPHA SOFTWARE>: There maybe some bugs. API might change.
325
326 =head1 AUTHOR
327
328 Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
329
330 YahooMessenger protocol implementation is based on Net::YahooMessenger
331 by Hiroyuki Oyama E<lt>oyama[cpan.orgE<gt>.
332
333 This library is free software; you can redistribute it and/or modify
334 it under the same terms as Perl itself.
335
336 =head1 SEE ALSO
337
338 L<POE>, L<POE::Component::IRC>, L<Net::YahooMessenger>, http://ymca.infoware.ne.jp/
339
340 =cut
Note: See TracBrowser for help on using the browser.