File Coverage

blib/lib/POE/Component/Client/POP3.pm
Criterion Covered Total %
statement 16 264 6.0
branch 1 106 0.9
condition 0 21 0.0
subroutine 6 41 14.6
pod 2 35 5.7
total 25 467 5.3


line stmt bran cond sub pod time code
1             # ==================================================================
2             # POE::Component::Client::POP3
3             # Author : Scott Beck
4             # $Id: POP3.pm,v 1.6 2002/03/15 19:14:45 bline Exp $
5             # ==================================================================
6             #
7             # Description: Impliment a POP3 client for POE
8             #
9              
10             package POE::Component::Client::POP3;
11             # ==================================================================
12              
13 1     1   202549 use strict;
  1         3  
  1         39  
14 1     1   7 use vars qw($VERSION);
  1         2  
  1         43  
15              
16 1     1   5 use Carp;
  1         7  
  1         66  
17              
18 1     1   10 use Socket;
  1         2  
  1         857  
19 1     1   5 use POE qw( Wheel::SocketFactory Wheel::ReadWrite );
  1         3  
  1         6  
20              
21 1 50   1   35557 BEGIN { eval 'sub DEBUG () { 0 };' unless defined &DEBUG }
22              
23             sub EOL () { "\015\012" }
24             sub STATE_AUTH () { 0 }
25             sub STATE_TRANS () { 1 }
26              
27             $VERSION = 0.02;
28              
29             # Start things off
30              
31             sub spawn {
32 0     0 1   my $class = shift;
33 0           my $sender = $poe_kernel->get_active_session;
34              
35 0 0         croak "$class->spawn requires an event number of argument" if @_ & 1;
36            
37 0           my %params = @_;
38              
39 0           my $alias = delete $params{Alias};
40 0 0         croak "$class->spawn requires an alias to start" unless defined $alias;
41              
42 0           my $user = delete $params{Username};
43 0           my $pass = delete $params{Password};
44 0           my $auth = delete $params{AuthMethod};
45 0 0         $auth = 'PASS' unless defined $auth;
46              
47 0           my $remote_addr = delete $params{RemoteAddr};
48 0 0         croak "$class->spawn requires a RemoteAddr parameter"
49             unless defined $remote_addr;
50              
51 0           my $remote_port = delete $params{RemotePort};
52 0 0         $remote_port = 110 unless defined $remote_port;
53            
54 0           my $bind_addr = delete $params{BindAddr};
55 0           my $bind_port = delete $params{BindPort};
56              
57 0           my $events = delete $params{Events};
58 0 0 0       $events = [] unless defined $events and ref( $events ) eq 'ARRAY';
59 0           my %register;
60 0           for my $opt ( @$events ) {
61 0 0         if ( ref $opt eq 'HASH' ) {
62 0           @register{keys %$opt} = values %$opt;
63             }
64             else {
65 0           $register{$opt} = $opt;
66             }
67             }
68             POE::Session->create(
69 0           inline_states => {
70             _start => \&handler_start,
71             input => \&handler_input,
72             login => \&handler_login,
73             connected => \&handler_connected,
74             connect_error => \&handler_connect_error,
75             ioerror => \&handler_ioerror,
76             retr => \&handler_retr,
77             list => \&handler_list,
78             uidl => \&handler_uidl,
79             top => \&handler_top,
80             dele => \&handler_dele,
81             noop => \&handler_noop,
82             rset => \&handler_rset,
83             quit => \&handler_quit,
84             stat => \&handler_stat
85             },
86             heap => {
87             alias => $alias,
88             user => $user,
89             pass => $pass,
90             auth => $auth,
91             remote_addr => $remote_addr,
92             remote_port => $remote_port,
93             bind_addr => $bind_addr,
94             bind_port => $bind_port,
95             state => STATE_AUTH,
96             stack => [ [ 'init' ] ],
97             events => { $sender => \%register }
98             }
99             );
100             }
101              
102             # Setup our socket connection
103              
104             sub handler_start {
105 0     0 0   my ( $kernel, $heap ) = @_[KERNEL, HEAP];
106            
107 0           $heap->{sock_wheel} = POE::Wheel::SocketFactory->new(
108             SocketDomain => AF_INET,
109             SocketType => SOCK_STREAM,
110             SocketProtocol => 'tcp',
111             BindAddress => $heap->{bind_addr},
112             BindPort => $heap->{bind_port},
113             RemotePort => $heap->{remote_port},
114             RemoteAddress => $heap->{remote_addr},
115             SuccessEvent => 'connected',
116             FailureEvent => 'connect_error'
117             );
118              
119 0           warn "$heap->{alias}: Setting up alias $heap->{alias}" if DEBUG;
120 0           $kernel->alias_set( $heap->{alias} );
121             }
122              
123             # After connection we start getting input events with Wheel::ReadWrite
124              
125             sub handler_connected {
126 0     0 0   my ( $kernel, $heap, $socket ) = @_[KERNEL, HEAP, ARG0];
127              
128 0           warn "$heap->{alias}: Connected with $socket" if DEBUG;
129 0           $heap->{rw_wheel} = POE::Wheel::ReadWrite->new(
130             Handle => $socket,
131             Filter => POE::Filter::Line->new( Literal => EOL ),
132             InputEvent => 'input',
133             ErrorEvent => 'ioerror'
134             );
135             }
136              
137             # read/write errors
138              
139             sub handler_ioerror {
140 0     0 0   my ( $kernel, $heap, $op, $errnum, $errstr, $wheel_id) =
141             @_[KERNEL, HEAP, ARG0..ARG3];
142              
143 0 0         if ( $errnum == 0 ) {
144 0           send_event( 'disconnected' );
145             }
146             else {
147 0           warn "$heap->{alias}: IO error for $op $errstr ($errnum) from $wheel_id" if DEBUG;
148 0           send_event( 'error', $heap->{current_action}, $op, $errnum, $errstr );
149             }
150 0           stop();
151             }
152              
153             # connection errors
154              
155             sub handler_connect_error {
156 0     0 0   my ( $kernel, $heap, $op, $errnum, $errstr, $wheel_id) =
157             @_[KERNEL, HEAP, ARG0..ARG3];
158              
159 0           warn "$heap->{alias}: Connect error for $op $errstr ($errnum) from $wheel_id" if DEBUG;
160 0           send_event( 'error', 'connect', $op, $errnum, $errstr );
161 0           stop();
162             }
163              
164             # The switch on input
165              
166             sub handler_input {
167 0     0 0   my ( $kernel, $heap, $input ) = @_[KERNEL, HEAP, ARG0];
168              
169              
170 0   0       my $event = pop( @{$heap->{stack}} ) || ['none', {}];
171 0           my ( $action, $args ) = @$event;
172 0           $action = lc $action;
173 0           $heap->{current_action} = $action;
174 0           warn "$heap->{alias}: Input from $action: ($input)" if DEBUG;
175              
176 0 0         if ( defined &{"comm_$action"} ) {
  0            
177 0           $POE::Component::Client::POP3::{"comm_$action"}->(
178             $action,
179             $input,
180             $args
181             );
182             }
183             else {
184 0           send_trans_event( $action, $input );
185             }
186             }
187              
188             # When we havn't send any request (before auth)
189              
190             sub comm_init {
191 0     0 0   my ( $action, $input, $args ) = @_;
192 0           my $heap = $poe_kernel->get_active_session()->get_heap();
193              
194 0 0         $heap->{apop_id} = $1 if $input =~ /<([^>]+)>/;
195 0           send_trans_event( 'connected', $input );
196              
197 0 0 0       if ( defined $heap->{user} and defined $heap->{pass} ) {
198 0           $poe_kernel->yield( 'login' );
199             }
200             }
201              
202             # responce to APOP
203              
204             sub comm_apop {
205 0     0 0   my ( $action, $input, $args ) = @_;
206 0           my $heap = $poe_kernel->get_active_session()->get_heap();
207              
208 0 0         if ( trans_error( $input ) ) {
209 0           send_trans_error( 'auth', $action, $input );
210 0           return;
211             }
212 0           send_trans_event( 'authenticated' );
213 0           $heap->{state} = STATE_TRANS;
214             }
215              
216             # responce to USER
217              
218             sub comm_user {
219 0     0 0   my ( $action, $input, $args ) = @_;
220 0           my $heap = $poe_kernel->get_active_session()->get_heap();
221              
222 0 0         if ( trans_error( $input ) ) {
223 0           send_trans_error( 'auth', $action, $input );
224 0           return;
225             }
226             # We send the password
227 0           command( [ 'PASS', $heap->{pass} ] );
228             # delete it!
229 0           delete $heap->{pass};
230             }
231              
232             # responce to PASS
233              
234             sub comm_pass {
235 0     0 0   my ( $action, $input, $args ) = @_;
236 0           my $heap = $poe_kernel->get_active_session()->get_heap();
237              
238 0 0         if ( trans_error( $input ) ) {
239 0           send_trans_error( 'auth', $action, $input );
240 0           return;
241             }
242 0           send_trans_event( 'authenticated' );
243 0           $heap->{state} = STATE_TRANS;
244             }
245              
246             # responce to STAT
247              
248             sub comm_stat {
249 0     0 0   my ( $action, $input, $args ) = @_;
250              
251 0 0         if ( trans_error( $input ) ) {
252 0           send_trans_error( 'trans', $action, $input );
253 0           return;
254             }
255 0           send_event( $action, ( split( ' ', $input ) )[1, 2] );
256             }
257              
258             # responce to LIST or UIDL
259              
260             *comm_uidl = \&comm_list;
261             sub comm_list {
262 0     0 0   my ( $action, $input, $args ) = @_;
263 0           my $heap = $poe_kernel->get_active_session()->get_heap();
264              
265 0 0 0       if (
266             $args->{listing_one} or
267             !$args->{got_first_line}
268             )
269             {
270 0 0         if ( trans_error( $input ) ) {
271 0           send_trans_error( 'trans', $action, $input );
272 0           return;
273             }
274             }
275 0 0         if ( delete $args->{listing_one} ) {
276 0           send_event( $action, { ( split( ' ', $input ) )[1, 2] } );
277             }
278             else {
279 0 0         if ( !$args->{got_first_line} ) {
    0          
280 0           $args->{got_first_line} = 1;
281 0           push @{$heap->{stack}}, [ $action, $args ];
  0            
282             }
283             elsif ( $input eq '.' ) {
284 0   0       $args->{lines} ||= {};
285 0           send_event( $action, $args->{lines} );
286             }
287             else {
288 0           my ( $num, $data ) = ( split( ' ', $input ) )[0, 1];
289 0           $args->{lines}{$num} = $data;
290 0           push @{$heap->{stack}}, [ $action, $args ];
  0            
291             }
292             }
293             }
294              
295             # responce to either RETR or TOP
296              
297             *comm_top = \&comm_retr;
298             sub comm_retr {
299 0     0 0   my ( $action, $input, $args ) = @_;
300 0           my $heap = $poe_kernel->get_active_session()->get_heap();
301              
302 0 0         if ( !$args->{got_first_line} ) {
    0          
303 0 0         if ( trans_error( $input ) ) {
304 0           send_trans_error( 'trans', $action, $input );
305 0           return;
306             }
307 0           $args->{got_first_line} = 1;
308 0           push @{$heap->{stack}}, [ $action, $args ];
  0            
309             }
310             elsif ( $input eq '.' ) {
311 0 0         if ( defined $args->{handle} ) {
312 0           send_event(
313             $action,
314             $args->{handle},
315             $args->{number}
316             );
317             }
318             else {
319 0   0       $args->{lines} ||= {};
320 0           send_event(
321             $action,
322             $args->{lines},
323             $args->{number}
324             );
325             }
326             }
327             else {
328              
329             # Expecting more lines
330 0           push @{$heap->{stack}}, [ $action, $args ];
  0            
331 0 0         if ( defined $args->{handle} ) {
332 0           print {$args->{handle}} $input . EOL;
  0            
333             }
334             else {
335 0           push @{$args->{lines}}, $input;
  0            
336             }
337             }
338             }
339              
340             # responce to DELE, NOOP, or RSET
341              
342             *comm_noop = \&comm_dele;
343             *comm_rset = \&comm_dele;
344             sub comm_dele {
345 0     0 0   my ( $action, $input, $args ) = @_;
346              
347 0 0         if ( trans_error( $input ) ) {
348 0           send_trans_error( 'trans', $action, $input );
349 0           return;
350             }
351 0           send_trans_event( $action, $input, values %$args );
352             }
353              
354             # responce to QUIT
355              
356             sub comm_quit {
357 0     0 0   my ( $action, $input, $args ) = @_;
358              
359 0           send_trans_event( $action, $input, values %$args );
360 0           send_event( 'disconnected', $input );
361 0           stop();
362             }
363              
364             # Authenticate, public event
365              
366             sub handler_login {
367 0     0 0   my ( $kernel, $heap, $user, $pass, $type ) =
368             @_[KERNEL, HEAP, ARG0 .. ARG2];
369              
370 0           warn "$heap->{alias}: login event called from ".
371             "$_[CALLER_FILE] on line $_[CALLER_LINE]\n" if DEBUG;
372              
373 0           assert_auth();
374              
375 0 0         $heap->{auth} = $type if defined $type;
376 0 0         $heap->{auth} = 'PASS' unless defined $heap->{auth};
377              
378 0 0         $heap->{user} = $user unless defined $heap->{user};
379 0 0         croak "No username defined in login" unless defined $heap->{user};
380 0 0         $heap->{pass} = $pass unless defined $heap->{pass};
381 0 0         croak "No password defined in login" unless defined $heap->{pass};
382              
383 0 0         if ( $heap->{auth} eq 'APOP' ) {
    0          
384 0 0         if (!defined $heap->{apop_id} ) {
385 0           send_event(
386             'trans_error',
387             'auth',
388             'apop',
389             "Server does not support APOP authentication"
390             );
391 0           return;
392             }
393 0           eval {
394 0           require Digest::MD5;
395             };
396 0 0         croak "Unable to do APOP authentication; Digest::MD5 not installed"
397             if $@;
398 0           my $hex = Digest::MD5::md5_hex( "<$heap->{apop_id}>$heap->{pass}" );
399 0           command( [ 'APOP', $heap->{user}, $hex ] );
400 0           delete $heap->{pass};
401 0           delete $heap->{user};
402             }
403             elsif ( $heap->{auth} eq 'PASS' ) {
404 0           command( [ 'USER', $heap->{user} ] );
405 0           delete $heap->{user};
406             }
407             else {
408 0           croak "Unknown authentication method: $heap->{auth}";
409             }
410             }
411              
412             # Get the status of all messages
413              
414             sub handler_stat {
415 0     0 0   my ( $kernel, $heap ) = @_[KERNEL, HEAP];
416              
417 0           warn "$heap->{alias}: stat event called from ".
418             "$_[CALLER_FILE] on line $_[CALLER_LINE]\n" if DEBUG;
419              
420 0           assert_trans();
421            
422 0           command( 'STAT' );
423             }
424              
425             # List one or more message
426              
427             sub handler_list {
428 0     0 0   my ( $kernel, $heap, $num ) = @_[KERNEL, HEAP, ARG0];
429              
430 0           warn "$heap->{alias}: list event called from ".
431             "$_[CALLER_FILE] on line $_[CALLER_LINE]\n" if DEBUG;
432              
433 0           assert_trans();
434              
435 0 0         if ( $num ) {
436 0           command( [ 'LIST', $num ], { listing_one => 1 } );
437             }
438             else {
439 0           command( 'LIST' );
440             }
441             }
442              
443             # Retrieve a message
444              
445             sub handler_retr {
446 0     0 0   my ( $kernel, $heap, $num, $handle ) = @_[KERNEL, HEAP, ARG0, ARG1];
447              
448 0           warn "$heap->{alias}: retr event called from ".
449             "$_[CALLER_FILE] on line $_[CALLER_LINE]\n" if DEBUG;
450              
451 0 0         croak "Must specify a number for retr"
452             unless defined $num;
453              
454 0           assert_trans();
455              
456 0           command( [ 'RETR', $num ], {
457             number => $num,
458             handle => $handle
459             } );
460             }
461              
462             # Delete a message
463              
464             sub handler_dele {
465 0     0 0   my ( $kernel, $heap, $num ) = @_[KERNEL, HEAP, ARG0];
466              
467 0           warn "$heap->{alias}: dele event called from ".
468             "$_[CALLER_FILE] on line $_[CALLER_LINE]\n" if DEBUG;
469              
470 0 0         croak "Must specify a number for dele"
471             unless defined $num;
472              
473 0           assert_trans();
474              
475 0           command( [ 'DELE', $num ], {
476             number => $num
477             } );
478             }
479              
480             # Keep us from idling
481              
482             sub handler_noop {
483 0     0 0   my ( $kernel, $heap ) = @_[KERNEL, HEAP];
484              
485 0           warn "$heap->{alias}: noop event called from ".
486             "$_[CALLER_FILE] on line $_[CALLER_LINE]\n" if DEBUG;
487              
488 0           assert_trans();
489              
490 0           command( 'NOOP' );
491             }
492              
493             # Reset status of deletes
494              
495             sub handler_rset {
496 0     0 0   my ( $kernel, $heap ) = @_[KERNEL, HEAP];
497              
498 0           warn "$heap->{alias}: rset event called from ".
499             "$_[CALLER_FILE] on line $_[CALLER_LINE]\n" if DEBUG;
500              
501 0           assert_trans();
502              
503 0           command( 'RSET' );
504             }
505              
506             # End the session
507              
508             sub handler_quit {
509 0     0 0   my ( $kernel, $heap ) = @_[KERNEL, HEAP, ARG0];
510              
511 0           warn "$heap->{alias}: quit event called from ".
512             "$_[CALLER_FILE] on line $_[CALLER_LINE]\n" if DEBUG;
513              
514 0           command( 'QUIT' );
515             }
516              
517             # Get the header and n lines from the body
518              
519             sub handler_top {
520 0     0 0   my ( $kernel, $heap, $msg_num, $lines, $handle ) =
521             @_[KERNEL, HEAP, ARG0 .. ARG2];
522              
523 0 0         croak "Must specify a number for top"
524             unless defined $msg_num;
525              
526 0           warn "$heap->{alias}: top event called from ".
527             "$_[CALLER_FILE] on line $_[CALLER_LINE]\n" if DEBUG;
528              
529 0           assert_trans();
530              
531 0 0         if ( defined $lines ) {
532 0           command( [ 'TOP', $msg_num, $lines ], {
533             number => $msg_num,
534             handle => $handle
535             } );
536             }
537             else {
538 0           command( [ 'TOP', $msg_num ], {
539             number => $msg_num,
540             handle => $handle
541             } );
542             }
543             }
544              
545             # Get a list of uidls
546              
547             sub handler_uidl {
548 0     0 0   my ( $kernel, $heap, $num ) = @_[KERNEL, HEAP, ARG0];
549              
550 0           warn "$heap->{alias}: uidl event called from ".
551             "$_[CALLER_FILE] on line $_[CALLER_LINE]\n" if DEBUG;
552              
553 0           assert_trans();
554              
555 0 0         if ( $num ) {
556 0           command( [ 'UIDL', $num ], {
557             listing_one => 1
558             } );
559             }
560             else {
561 0           command( 'UIDL' );
562             }
563             }
564              
565             # Register an event to start recieveing
566              
567             sub handler_register {
568 0     0 0   my ( $heap, $sender, @params ) = @_[HEAP, SENDER, ARG0 .. $#_];
569              
570 0           warn "$heap->{alias}: register event called from ".
571             "$_[CALLER_FILE] on line $_[CALLER_LINE]\n" if DEBUG;
572              
573 0           my %register;
574 0           for my $opt ( @params ) {
575 0 0         if ( ref $opt eq 'HASH' ) {
576 0           @register{keys %$opt} = values %$opt;
577             }
578             else {
579 0           $register{$opt} = $opt;
580             }
581             }
582 0           for ( keys %register ) {
583 0           $heap->{events}{$sender}{$_} = $register{$_};
584             }
585             }
586              
587             # Unregister events
588              
589             sub handler_unregister {
590 0     0 0   my ( $heap, $sender, @params ) = @_[HEAP, SENDER, ARG0 .. $#_];
591              
592 0           warn "$heap->{alias}: unregister event called from ".
593             "$_[CALLER_FILE] on line $_[CALLER_LINE]\n" if DEBUG;
594              
595 0           my %register;
596 0           for ( @params ) {
597 0           delete $heap->{events}{$sender}{$_};
598             }
599 0 0         delete $heap->{events}{$sender} if !keys %{$heap->{events}{$sender}};
  0            
600             }
601              
602             # Make assertions
603              
604             sub assert_trans {
605 0     0 0   my $heap = $poe_kernel->get_active_session()->get_heap();
606              
607 0 0         if ( $heap->{state} != STATE_TRANS ) {
608 0           (my $trans = (caller(1))[3]) =~ s/^.+handler_//;
609 0           croak "Must be in transaction state to call '$trans'";
610             }
611             }
612              
613             sub assert_auth {
614 0     0 0   my $heap = $poe_kernel->get_active_session()->get_heap();
615              
616 0 0         if ( $heap->{state} != STATE_AUTH ) {
617 0           (my $trans = (caller(1))[3]) =~ s/^.+handler_//;
618 0           croak "Must be in authentication state to call '$trans'";
619             }
620             }
621              
622             sub trans_error {
623 0     0 1   return( index( $_[0], '-ERR' ) == 0 );
624             }
625              
626             # Send a command and push the return onto the stack
627              
628             sub command {
629 0     0 0   my ( $cmd_args, $state ) = @_;
630              
631 0           my $heap = $poe_kernel->get_active_session()->get_heap();
632 0 0         return unless defined $heap->{rw_wheel};
633            
634 0 0         $cmd_args = [$cmd_args] unless ref( $cmd_args ) eq 'ARRAY';
635 0           my $command = uc shift( @$cmd_args );
636 0 0         $state = {} unless defined $state;
637 0           unshift @{$heap->{stack}}, [$command, $state];
  0            
638 0           warn "$heap->{alias}: Output: ", join( ' ', $command, @$cmd_args ) if DEBUG;
639 0           $heap->{rw_wheel}->put( join ' ', $command, @$cmd_args );
640             }
641              
642             # Send events to interested sessions
643              
644             sub send_event {
645 0     0 0   my ( $event, @args ) = @_;
646 0           my $heap = $poe_kernel->get_active_session()->get_heap();
647              
648 0           for my $session ( keys %{$heap->{events}} ) {
  0            
649 0 0 0       if (
650             exists $heap->{events}{$session}{$event} or
651             exists $heap->{events}{$session}{all}
652             )
653             {
654 0   0       $poe_kernel->post(
655             $session,
656             ( $heap->{events}{$session}{$event} || $event ),
657             @args
658             );
659             }
660             }
661             }
662              
663             # Format input for a trans_error event and send it
664              
665             sub send_trans_error {
666 0     0 0   my ( $state, $command, $input ) = @_;
667 0 0         $input =~ s/^-ERR\s*//i if $input;
668 0           send_event( 'trans_error', $state, $command, $input );
669             }
670              
671             # Format input for a normal trans event and send it
672              
673             sub send_trans_event {
674 0     0 0   my ( $event, $input, @args ) = @_;
675 0 0         $input =~ s/^\+OK\s*//i if $input;
676 0           send_event( $event, $input, @args );
677             }
678              
679             # Stop everything so we get GCed
680              
681             sub stop {
682 0     0 0   my $heap = $poe_kernel->get_active_session()->get_heap();
683 0           $poe_kernel->alias_remove( $heap->{alias} );
684 0           delete $heap->{rw_wheel};
685 0           delete $heap->{sock_wheel};
686             }
687              
688             1;
689              
690             =head1 NAME
691              
692             POE::Component::Client::POP3 - Impliment a POP3 client POE component
693              
694             =head1 SYNOPSIS
695              
696             use POE::Component::Client::POP3;
697              
698             POE::Component::Client::POP3->spawn(
699             Alias => 'pop_client',
700             Username => 'bob',
701             Password => 'my password',
702             AuthMethod => 'APOP', # Other possible is PASS
703             RemoteAddr => '192.168.1.101',
704             RemotePort => 110, # Default
705             BindPort => 1000, # Default 0
706             BindAddr => INADDR_ANY, # Default
707             Events => [
708             'connected', # when we get connected
709             'authenticated', # after authentication happens
710             'error', # write/read error happens
711             'trans_error', # The server returned an -ERR for a transaction
712             'disconnected', # we are disconnected
713             'list', # a list is retrieved
714             'retr' # a message is retrieved
715             ]
716             );
717              
718             # We are connected
719             sub connected {
720             my $msg = $_[ARG0];
721             print "Connection message: $msg\n";
722             }
723              
724             # We were disconnected
725             sub disconnected {
726             my $msg = $_[ARG0];
727             print "Diconnected\n";
728             print "Messgae: $msg\n" if defined $msg;
729             }
730              
731             # We are authenticated
732             sub authenticated {
733             my $msg = $_[ARG0];
734             print "Authenticated with message $msg\n";
735             }
736              
737             # Catch errors
738             sub error {
739             my ( $state, $operation, $errnum, $errstr ) = @_[ARG0..ARG3];
740             print "In state $state operation $operation".
741             "error $errnum: $errstr\n";
742             $poe_kernel->post( 'pop_client', 'quit' );
743             }
744             sub trans_error {
745             my ( $state, $command, $input ) = @_[ARG0..ARG2];
746             print "In state $state command $command we got input $input\n";
747             }
748              
749             # Get a list of messages
750             $poe_kernel->post(
751             'pop_client', # The session we are posting to
752             'list' # Post to our list state
753             );
754             sub list {
755             my $list = $_[ARG0]; # An hash ref
756              
757             for ( sort keys %$list ) {
758             print "Message number $_ is $list->{$_} bytes\n";
759             }
760             }
761              
762             # Retrieve message 1
763             $poe_kernel->post(
764             'pop_client', # The session to post to
765             'retr', # retr state
766             1, # message 1
767             );
768             sub retr {
769             # array ref of lines and message number
770             my ( $msg, $msg_num ) = @_[ARG0, ARG1];
771              
772             print "Message number $msg_num is:\n", join( "\n", @$msg ), "\n";
773             }
774              
775             # Retrieve the header and the first 10 lines of the
776             # body of message 2
777             $poe_kernel->post(
778             'pop_client', # The session
779             'top', # The state
780             2, # message 2
781             10 # header and 10 lines of the body
782             );
783             sub top {
784             my ( $lines, $msg_num ) = @_[ARG0, ARG1];
785              
786             print "Message number $msg_num is:\n", join( "\n", @$msg ), "\n";
787             }
788              
789             # Retrieve message 2 and write it to a file
790             open my $handle, "/tmp/msg2" or die "Could not open /tmp/msg2; Reason: $!";
791             $poe_kernel->post(
792             'pop_client', # The session
793             'retr', # The state
794             2, # Message 2
795             $handle # The file handle to write it to
796             );
797             sub retr {
798             my ( $handle, $msg_num ) = @_[ARG0, ARG1];
799              
800             print "Message $msg_num written to fileno ", fileno( $handle ), "\n";
801             close $handle; @ Not really needed, it will go out of scope after this
802             }
803              
804             =head1 DESCRIPTION
805              
806             POE::Component::Client::POP3 is a POE component for interacting with a POP3
807             server. This means it is an event driven way to communicate with a server that
808             impliments Post Office Protocol Version 3 see rfc 1939 for details on the
809             protocol.
810              
811             =head1 CAVEATS
812              
813             You should have a full understanding of POE, and atleast a familiarity with
814             POP3 in order to grok this document.
815              
816             Throughout this document POE::Component::Client::POP3 will be refered to as
817             Client::POP3 for obvious reasons.
818              
819             =head1 METHODS
820              
821             Client::POP3 only has one public method. All other actions are performed by
822             posting events back to the session that was created. This is similar to
823             POE::Component::IRC and many other POE components
824              
825             =head2 spawn
826              
827             This method's arguments look like a hash but are really a list. You will call
828             this method to get everything going, it is similar to most modules new()
829             method but it does not return an object but creats a session for you to post
830             events to.
831              
832             The following is a list of the arguments it takes.
833              
834             =over
835              
836             =item Alias
837              
838             Name of the kernel alias Client::POP3 will make for it's session. You must
839             supply this. This is what you will be posting events to.
840              
841             =item Events
842              
843             An array reference of the events you wish posted back to you when certain
844             things happen. See L<"register"> elsewhere in the document for a description
845             of what the array reference should contain.
846              
847             =item Username
848              
849             This is the username to login as once we get connected. If you do not specify
850             this no attempt to login will be made once we connect.
851              
852             =item Password
853              
854             The password to use for authentication. If not specified no attempt will be
855             made to authenticate once we are connected. You will need to catch the
856             connection event and do the authentication yourself by posting a login
857             event with the proper username and password see L<"login"> elsewhere in
858             this document.
859              
860             =item AuthMethod
861              
862             This is the type of authentication we will attempt on the remote server. There
863             are two type APOP and PASS. PASS method use the USER and PASS command to send
864             the username and password in the clear. The APOP method used the APOP command
865             to send the username and password. The password is md5 encoded with a string
866             from the server before it is sent. The remote server must support APOP in
867             order for this to work, see RFC1932 page 15 for further description of how this
868             works. This method requires Digest::MD5 be installed.
869              
870             =item RemoteAddr
871              
872             This is the hostname or ip address of the remote POP3 server we are connecting
873             to, it is required.
874              
875             =item RemotePort
876              
877             This is the port on the remote machine we are connecting to. It will default
878             to 110 if not defined.
879              
880             =item BindAddr
881              
882             This supplies the address where the socket will be bound to. BindAddr may
883             contain a string or a packed Internet address. The string form should hold
884             either an ip address or a hostname. This defaults to INADDR_ANY.
885              
886             =item BindPort
887              
888             This contains a port on the BindAddr to bind to. It defaults to zero. BindPort
889             may be either a port number or a named service. See perldoc -f bind for more
890             information.
891              
892             =back
893              
894             =head1 INPUT
895              
896             Client::POP3 receives events from the session or sessions that want it to
897             perform actions. These events are posted to the Alias you specified when you
898             called spawn(). For example:
899              
900             $poe_kernel->post( 'alias_i_set', 'list' );
901              
902             Assuming you set Alias to 'alias_i_set', this will tell Client::POP3 to send
903             a LIST command to the server, when the data is received Client::POP3 will then
904             send you a 'list' event or whatever you aliased the 'list' event to.
905              
906             This is a list of all the events you should post to the Client::POP3 session.
907              
908             =over
909              
910             =item register
911              
912             In order to tell Client::POP3 what events you would like and would not like
913             you need to regester them or unregister them. The event register takes a list
914             of arguments. If an argument is a hash, the key will be the event Client::POP3
915             has to post and the value will be the event you would like posted in to your
916             session. If the argument is a scalar it will register that event to post to
917             your session by it's own name. For example:
918              
919             $kernel->post(
920             'pop_client',
921             'register'
922             'list',
923             { error => 'oops' }
924             );
925              
926             Will tell Client::POP3 to post 'list' to you when that event happens and to
927             post 'oops' to you when the error event happens. The order of the arguments
928             does not matter.
929              
930             =item unregister
931              
932             To unregister an event (Client::POP3 stops posting it to you) simply post an
933             event unregister with the list of event you no longer care about and they
934             will not be sent to you any longer. For example:
935              
936             $poe_kernel->post( 'pop_client', 'unregister', 'error', 'list' );
937              
938             Would unregister the events 'error' and 'list'.
939              
940             =item login
941              
942             This is the event that causes Client::POP3 to attempt to login to the remote
943             server. This event should only be posted after the connection is established.
944             Arguments to this event are username, password, auth type. In that order. Here
945             is an example
946              
947             $poe_kernel->post(
948             'pop_client',
949             'login',
950             "bob",
951             "bob's password",
952             "PASS"
953             );
954              
955             This will tell Client::POP3 to login as USER 'bob' with PASS 'bob's password'
956             using the PASS method. The third argument is not manditory and if omited will
957             default to PASS.
958              
959             You will generally not need to send this event unless an error happens during
960             login and you wish to resubmit a different username and password to the
961             server, as this event is fired automaticly when you specify the Username and
962             Password parameters to spawn().
963              
964              
965             =item stat
966              
967             Send a STAT command to the server. This gets the size and number of messages
968             on the remote server. A 'stat' event is posted back to you when the
969             information is retrieved. This event takes no arguments.
970              
971             $poe_kernel->post( 'pop_client', 'stat' );
972              
973              
974             =item list
975              
976             Send a LIST command to the server. This event can take either one or no
977             arguments. In the no argument for a list of all the messages on the remote
978             server is posted back to you, with there sizes. If a single argument is
979             given it is expected to be the number of the message you wish to list,
980             in this case just that messages size and number is posted back to you.
981              
982             $poe_kernel->post( 'pop_client', 'list' );
983             -or-
984             $poe_kernel->post( 'pop_client', 'list', $message_number );
985              
986              
987             =item uidl
988              
989             This event is very similar to 'list' in what it does and takes. You can
990             post this event with no arguments to get a list of all the messages and
991             there uidl (unique id) or you can send an argument that is expected to
992             be the message number you with the uidl for.
993              
994             $poe_kernel->post( 'pop_client', 'uidl' );
995             -or-
996             $poe_kernel->post( 'pop_client', 'uidl', $msg_number );
997              
998              
999             =item retr
1000              
1001             This events is to get an email off the remote server. The arguments are
1002             the message number to get and an optional filehandle to write the message
1003             to. If no filehandle is given, when the message is retrieved, the 'retr'
1004             event will be posted to you with an array reference of all the lines in the
1005             email. If given with a filehandle, after the message is written to the handle,
1006             the 'retr' event posted to you will contain the filehandle that it was written
1007             to instead of the lines in an array.
1008              
1009             $poe_kernel->post( 'pop_client', 'retr', $msg_number );
1010             -or-
1011             $poe_kernel->post( 'pop_client', 'retr', $msg_number, \*FH );
1012              
1013              
1014             =item top
1015              
1016              
1017             This event acts the same as the 'retr' however there is one additional
1018             argument, the number of lines from the body to retrieve. If the number
1019             of lines if not defined the entire body is retrieved.
1020              
1021             $poe_kernel->post( 'pop_client', 'top', $msg_number, $num_lines );
1022             -or-
1023             $poe_kernel->post( 'pop_client', 'top', $msg_number, $num_lines, \*FH );
1024              
1025              
1026             =item dele
1027              
1028             This is how you delete messages from the remote server. The messages are
1029             not actually deleted until you post a 'quit' event. The only argument to this
1030             event is the number message to delete. You would get this message number from
1031             a 'list' event.
1032              
1033             $poe_kernel->post( 'pop_client', 'dele', $msg_number );
1034              
1035              
1036             =item noop
1037              
1038             This event tells Client::POP3 to send a NOOP command to the server, this is good
1039             for servers that have a timeout on connection in that it usually resets the
1040             timeout. This event takes no arguments.
1041              
1042             $poe_kernel->post( 'pop_client', 'noop' );
1043              
1044              
1045             =item rset
1046              
1047             This event tells Client::POP3 to send a RSET command to the server. This tells
1048             the server to reset all delete flags. This event takes no arguments.
1049              
1050             $poe_kernel->post( 'pop_client', 'rset' );
1051              
1052              
1053             =item quit
1054              
1055             This event causes Client::POP3 to call quit on the remote server and to
1056             disconnect. This event takes no arguments.
1057              
1058             $poe_kernel->post( 'pop_client', 'quit' );
1059              
1060             =back
1061              
1062             =head1 OUTPUT
1063              
1064             These are events that you may request to be posted to your session. You do
1065             this by specifing them when you call spawn() with the 'Events' argument or by
1066             posting the event 'register'.
1067              
1068             =over
1069              
1070             =item trans_error
1071              
1072             This event is posted when the server send us an error reply to a command.
1073             e.i. -ERR Command not implimented. The -ERR part of the message is stripped
1074             off before it is sent to you. The arguments to the event handler are state,
1075             command, and server input. State will be one of auth or trans. auth means we
1076             were not authenticated yet and trans means we were.
1077              
1078             sub trans_error {
1079             my ( $state, $command, $server_input ) = @_[ARG0..ARG2];
1080             ...
1081             }
1082              
1083              
1084             =item error
1085              
1086             This event is fired when Wheel::ReadWrite sends us an error, usually either a
1087             read or write error. Four arguments are passed to this event handler. The
1088             first one is the state we were in, 'connect', 'auth' or 'trans'. 'auth'
1089             meaning were are in the authentication state, 'trans' meaning we were in
1090             the transaction state and 'connect' meaning we have yet to connect. The second
1091             argument is the operation that failed, probably 'read' or 'write', the third
1092             argument is the error number, this corresponds to Errno, see L for
1093             details on what this number means. The last argument is the error string, e.g.
1094             "Socket is not connected".
1095              
1096             sub error {
1097             my ( $state, $operation, $errnum, $errstr ) = @_[ARG0..ARG3];
1098             ...
1099             }
1100              
1101              
1102             =item connected
1103              
1104             This event is fired after the socket has been connected but before
1105             authentication. If you didn't specify the 'Username' and 'Password' parameters
1106             you would want to post a 'login' event to Clinet::POP3 now.
1107              
1108             sub connected {
1109             my $server_input = $_[ARG0];
1110             ...
1111             }
1112              
1113              
1114             =item disconnected
1115              
1116             This event is fired when the socket is disconnected. You will not get this
1117             event if the socket was diconnected with an error, you will get the 'error'
1118             event instead. You should also expect this event after you post a 'quit'
1119             event. One argument is posted to this event's handler, and that is what the
1120             server said, if the server closes the connection without saying goodbye :(
1121             the argument will be undefined.
1122              
1123             sub disconnected {
1124             my $server_input = defined( $_[ARG0] ) ? $_[ARG0] : 'None';
1125             ...
1126             }
1127              
1128              
1129             =item authenticated
1130              
1131             This event is fired after athentication succeeds. You will want to catch this
1132             event in order to start performing operations like listing messages and
1133             whatnot. No arguments are passed to this events handler.
1134              
1135             sub authenticated {
1136             ...
1137             }
1138              
1139              
1140             =item stat
1141              
1142             This event is fired when we receive the return of a stat request done on the
1143             server. The arguments to this events handler is the number of messages and
1144             the total size of all messages.
1145              
1146             sub stat {
1147             my ( $num_msgs, $size_msgs ) = @_[ARG0, ARG1];
1148             ...
1149             }
1150              
1151              
1152             =item list
1153              
1154             Fired when we receive the output from a list command. The only argument is
1155             a hash reference, the keys are the message numbers and the values are the
1156             sizes of the messages.
1157              
1158             sub list {
1159             my $list_href = $_[ARG0];
1160             ...
1161             }
1162              
1163              
1164             =item uidl
1165              
1166             Fired when we receive the output from a uidl command. The only argument is
1167             a hahs reference, the keys are the message numbers and the values are the
1168             unique uidl's.
1169              
1170             sub uidl {
1171             my $uidl_href = $_[ARG0];
1172             ...
1173             }
1174              
1175              
1176             =item retr
1177              
1178             This event is fired when we finish receiving a an email requested by a retr
1179             command. If you requested the message be written to a filehandle then the
1180             first argument is the filehandle else the first argument is an array reference
1181             of the lines of the message with no EOL character on them. The second argument
1182             is the message number retrieved.
1183              
1184             sub retr {
1185             my ( $msg_aref, $msg_num ) = @_[ARG0, ARG1];
1186             ...
1187             }
1188             -or-
1189             sub retr {
1190             my ( $msg_fh, $msg_num ) = @_[ARG0, ARG1];
1191             ...
1192             }
1193              
1194              
1195             =item top
1196              
1197              
1198             This event is fired when we have finished getting the output from a top
1199             command. If you requesed to have the output written to a filehandle, the
1200             first argument to this event's handler is the filehandle it was written to
1201             else the first argument is an array of lines without an EOL. The second
1202             argument if the message number retrieved.
1203              
1204             sub top {
1205             my ( $msg_aref, $msg_num ) = @_[ARG0, ARG1];
1206             ...
1207             }
1208             -or-
1209             sub top {
1210             my ( $msg_fh, $msg_num ) = @_[ARG0, ARG1];
1211             ...
1212             }
1213              
1214              
1215             =item dele
1216              
1217             Fired when the responce to a dele command is returned. The event's handler
1218             receives two arguments. The first is the response from the server without
1219             the +OK at the beginning. The second is the message number marked for
1220             deletion.
1221              
1222             sub dele {
1223             my ( $server_input, $msg_num ) = @_[ARG0, ARG1];
1224             ...
1225             }
1226              
1227              
1228             =item noop
1229              
1230             Fired when the responce from a noop command is returned. The only argument is
1231             the responce from the server without the +OK at the start of it.
1232              
1233             sub noop {
1234             my $server_input = $_[ARG0];
1235             ...
1236             }
1237              
1238              
1239             =item rset
1240              
1241             Fired when the responce from a rset command is returned. The only argument is
1242             the responce from the server without the +OK at the start of it.
1243              
1244             sub rset {
1245             my $server_input = $_[ARG0];
1246             ...
1247             }
1248              
1249              
1250             =item quit
1251              
1252             Fired when the responce from a quit command is returned. The only argument is
1253             the responce from the server without the +OK at the start of it. NOTE: You may
1254             never get this event when you quit, many servers do not send a responce to a
1255             quit command.
1256              
1257             sub quit {
1258             my $server_input = $_[ARG0];
1259             ...
1260             }
1261              
1262             =back
1263              
1264             =head1 SEE ALSO
1265              
1266             L, L, RFC1939, RFC1957, RFC1725
1267              
1268             =head1 BUGS
1269              
1270             Plenty I'm sure.
1271              
1272             =head1 AUTHORS & COPYRIGHTS
1273              
1274             Except where otherwise noted, POE::Component::Client::POP3 is Copyright
1275             2002-2003 Scott Beck . All rights reserved.
1276             POE::Component::Client::POP3 is free software; you may redistribute it and/or
1277             modify it under the same terms as Perl itself.
1278              
1279