| 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 |  |  |  |  |  |  |  |