File Coverage

blib/lib/SOAP/Transport/POP3.pm
Criterion Covered Total %
statement 18 48 37.5
branch 0 18 0.0
condition 0 9 0.0
subroutine 6 12 50.0
pod n/a
total 24 87 27.5


line stmt bran cond sub pod time code
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             # ======================================================================
8              
9             package SOAP::Transport::POP3;
10              
11 1     1   2480 use strict;
  1         2  
  1         55  
12              
13             our $VERSION = 1.11;
14              
15 1     1   4274 use Net::POP3;
  1         52564  
  1         64  
16 1     1   13 use URI;
  1         2  
  1         35  
17              
18             # ======================================================================
19              
20             package SOAP::Transport::POP3::Server;
21              
22 1     1   6 use Carp ();
  1         3  
  1         19  
23 1     1   6 use vars qw(@ISA $AUTOLOAD);
  1         3  
  1         578  
24             @ISA = qw(SOAP::Server);
25              
26 0 0   0     sub DESTROY { my $self = shift; $self->quit if $self->{_pop3server} }
  0            
27              
28             sub new {
29 0     0     my $class = shift;
30 0 0         return $class if ref $class;
31              
32 0           my $address = shift;
33 0 0 0       Carp::carp "URLs without 'pop://' scheme are deprecated. Still continue"
34             if $address =~ s!^(pop://)?!pop://!i && !$1;
35 0           my $server = URI->new($address);
36 0           my $self = $class->SUPER::new(@_);
37 0 0         $self->{_pop3server} = Net::POP3->new($server->host_port)
38 0           or Carp::croak "Can't connect to '@{[$server->host_port]}': $!";
39 0 0 0       my $method = ! $server->auth || $server->auth eq '*'
    0          
40             ? 'login'
41             : $server->auth eq '+APOP'
42             ? 'apop'
43 0           : Carp::croak "Unsupported authentication scheme '@{[$server->auth]}'";
44 0 0 0       $self->{_pop3server}->$method( split m{:}, $server->user() )
45 0           or Carp::croak "Can't authenticate to '@{[$server->host_port]}' with '$method' method"
46             if defined $server->user;
47 0           return $self;
48             }
49              
50             sub AUTOLOAD {
51 0     0     my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
52 0 0         return if $method eq 'DESTROY';
53              
54 1     1   8 no strict 'refs';
  1         3  
  1         232  
55 0     0     *$AUTOLOAD = sub { shift->{_pop3server}->$method(@_) };
  0            
56 0           goto &$AUTOLOAD;
57             }
58              
59             sub handle {
60 0     0     my $self = shift->new;
61 0 0         my $messages = $self->list or return;
62             # fixes [ 1416700 ] POP3 Processes Messages Out of Order
63 0           foreach my $msgid (sort { $a <=> $b } (keys(%{$messages}) ) ) {
  0            
  0            
64             # foreach my $msgid (keys %$messages) {
65 0           $self->SUPER::handle(join '', @{$self->get($msgid)});
  0            
66             } continue {
67 0           $self->delete($msgid);
68             }
69 0           return scalar keys %$messages;
70             }
71              
72 0     0     sub make_fault { return }
73              
74             # ======================================================================
75              
76             1;
77              
78             __END__