1# ====================================================================== 2# 3# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger@yahoo.com) 4# SOAP::Lite is free software; you can redistribute it 5# and/or modify it under the same terms as Perl itself. 6# 7# $Id: POP3.pm 414 2012-07-15 09:18:42Z kutterma $ 8# 9# ====================================================================== 10 11package SOAP::Transport::POP3; 12 13use strict; 14 15our $VERSION = 0.715; 16 17use Net::POP3; 18use URI; 19 20# ====================================================================== 21 22package SOAP::Transport::POP3::Server; 23 24use Carp (); 25use vars qw(@ISA $AUTOLOAD); 26@ISA = qw(SOAP::Server); 27 28sub DESTROY { my $self = shift; $self->quit if $self->{_pop3server} } 29 30sub new { 31 my $class = shift; 32 return $class if ref $class; 33 34 my $address = shift; 35 Carp::carp "URLs without 'pop://' scheme are deprecated. Still continue" 36 if $address =~ s!^(pop://)?!pop://!i && !$1; 37 my $server = URI->new($address); 38 my $self = $class->SUPER::new(@_); 39 $self->{_pop3server} = Net::POP3->new($server->host_port) 40 or Carp::croak "Can't connect to '@{[$server->host_port]}': $!"; 41 my $method = ! $server->auth || $server->auth eq '*' 42 ? 'login' 43 : $server->auth eq '+APOP' 44 ? 'apop' 45 : Carp::croak "Unsupported authentication scheme '@{[$server->auth]}'"; 46 $self->{_pop3server}->$method( split m{:}, $server->user() ) 47 or Carp::croak "Can't authenticate to '@{[$server->host_port]}' with '$method' method" 48 if defined $server->user; 49 return $self; 50} 51 52sub AUTOLOAD { 53 my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2); 54 return if $method eq 'DESTROY'; 55 56 no strict 'refs'; 57 *$AUTOLOAD = sub { shift->{_pop3server}->$method(@_) }; 58 goto &$AUTOLOAD; 59} 60 61sub handle { 62 my $self = shift->new; 63 my $messages = $self->list or return; 64 # fixes [ 1416700 ] POP3 Processes Messages Out of Order 65 foreach my $msgid (sort { $a <=> $b } (keys(%{$messages}) ) ) { 66 # foreach my $msgid (keys %$messages) { 67 $self->SUPER::handle(join '', @{$self->get($msgid)}); 68 } continue { 69 $self->delete($msgid); 70 } 71 return scalar keys %$messages; 72} 73 74sub make_fault { return } 75 76# ====================================================================== 77 781; 79 80__END__ 81 82=head1 NAME 83 84SOAP::Transport::POP3 - Server side POP3 support for SOAP::Lite 85 86=head1 SYNOPSIS 87 88 use SOAP::Transport::POP3; 89 90 my $server = SOAP::Transport::POP3::Server 91 -> new('pop://pop.mail.server') 92 # if you want to have all in one place 93 # -> new('pop://user:password@pop.mail.server') 94 # or, if you have server that supports MD5 protected passwords 95 # -> new('pop://user:password;AUTH=+APOP@pop.mail.server') 96 # specify list of objects-by-reference here 97 -> objects_by_reference(qw(My::PersistentIterator My::SessionIterator My::Chat)) 98 # specify path to My/Examples.pm here 99 -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method') 100 ; 101 # you don't need to use next line if you specified your password in new() 102 $server->login('user' => 'password') or die "Can't authenticate to POP3 server\n"; 103 104 # handle will return number of processed mails 105 # you can organize loop if you want 106 do { $server->handle } while sleep 10; 107 108 # you may also call $server->quit explicitly to purge deleted messages 109 110=head1 DESCRIPTION 111 112=head1 COPYRIGHT 113 114Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved. 115 116This library is free software; you can redistribute it and/or modify 117it under the same terms as Perl itself. 118 119=head1 AUTHOR 120 121Paul Kulchenko (paulclinger@yahoo.com) 122 123=cut 124