File Coverage

blib/lib/NG/EMail.pm
Criterion Covered Total %
statement 22 24 91.6
branch n/a
condition n/a
subroutine 8 8 100.0
pod n/a
total 30 32 93.7


line stmt bran cond sub pod time code
1             package EMail;
2 1     1   5 use warnings;
  1         3  
  1         39  
3 1     1   6 use strict;
  1         2  
  1         33  
4 1     1   5 use base 'Object';
  1         3  
  1         85  
5 1     1   6 use Hashtable;
  1         2  
  1         21  
6 1     1   5 use Array;
  1         3  
  1         20  
7 1     1   973 use Net::SMTP;
  1         32482  
  1         66  
8 1     1   1308 use Net::POP3;
  1         4971  
  1         59  
9 1     1   521 use Email::MIME;
  0            
  0            
10             use Encode;
11              
12             =head2 send
13             send 'smtp.host.com', \%headers, $body;
14             =cut
15              
16             sub send {
17             my ( $host, $headers, $body ) = @_;
18             my $smtp = Net::SMTP->new($host);
19             if ( $headers->{username} and $headers->{password} ) {
20             $smtp->auth( $headers->{username}, $headers->{password} );
21             }
22             my $dataheader;
23             for my $i (qw/to cc bcc/) {
24             next unless $headers->{$i};
25             eval $smtp->$i( $headers->{bcc} );
26             $dataheader .= uc($i) . ': ' . $headers->{$i} . "\n";
27             }
28              
29             $smtp->data();
30             $smtp->datasend($dataheader);
31             $smtp->datasend("$body\n");
32             $smtp->dataend();
33              
34             $smtp->quit;
35             }
36              
37             =head2 get
38             get 'pop3.host.com', $user, $password, sub {
39             my ( $headers, $body, $num, $pop ) = @_;
40             say $headers->get('Subject');
41             say $body->get(0);
42             $pop->delete($num);
43             };
44             =cut
45              
46             sub get {
47             my $cb = pop;
48             my ( $host, $user, $pass ) = @_;
49             my $pop = Net::POP3->new($host);
50             return unless $pop->login( $user, $pass ) > 0;
51              
52             my $msgnums = $pop->list;
53             for my $msgnum ( keys %$msgnums ) {
54             my $parsed = Email::MIME->new( join( '', @{ $pop->get($msgnum) } ) );
55              
56             my $headers = Hashtable->new( @{ $parsed->{header}->{headers} } );
57             $headers->each(
58             sub {
59             $headers->put( $_[0], Encode::decode( 'MIME-Header', $_[1] ) );
60             }
61             );
62              
63             my $body = new Array;
64             $body->push( $_->body ) for $parsed->parts;
65              
66             $cb->( $headers, $body, $msgnum, $pop );
67             }
68              
69             $pop->quit;
70             }
71              
72             1;