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

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

Initial revision

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