File Coverage

blib/lib/Mail/Box/POP3/Test.pm
Criterion Covered Total %
statement 21 39 53.8
branch 0 6 0.0
condition 0 2 0.0
subroutine 7 10 70.0
pod 0 2 0.0
total 28 59 47.4


line stmt bran cond sub pod time code
1             # Copyrights 2001-2023 by [Mark Overmeer].
2             # For other contributors see ChangeLog.
3             # See the manual pages for details on the licensing terms.
4             # Pod stripped from pm file by OODoc 2.03.
5             # This code is part of distribution Mail-Box-POP3. Meta-POD processed with
6             # OODoc into POD and HTML manual-pages. See README.md
7             # Copyright Mark Overmeer. Licensed under the same terms as Perl itself.
8              
9             package Mail::Box::POP3::Test;
10 4     4   2040 use vars '$VERSION';
  4         23  
  4         412  
11             $VERSION = '3.006';
12              
13 4     4   35 use base 'Exporter';
  4         4  
  4         571  
14              
15 4     4   37 use strict;
  4         7  
  4         86  
16 4     4   17 use warnings;
  4         8  
  4         186  
17              
18 4     4   1920 use Mail::Transport::POP3;
  4         10  
  4         247  
19              
20 4     4   30 use List::Util 'first';
  4         9  
  4         465  
21 4     4   31 use File::Spec;
  4         9  
  4         1579  
22              
23             our @EXPORT = qw/start_pop3_server start_pop3_client/;
24              
25             #
26             # Start POP3 server for tests
27             #
28              
29             sub start_pop3_server($;$)
30 0     0 0   { my $popbox = shift;
31 0   0       my $setting = shift || '';
32              
33 0           my $serverscript = File::Spec->catfile('t', 'server');
34              
35             # Some complications to find-out $perl, which must be absolute and
36             # untainted for perl5.6.1, but not for the other Perl's.
37 0           my $perl = $^X;
38 0 0         unless(File::Spec->file_name_is_absolute($perl))
39 0           { my @path = split /\:|\;/, $ENV{PATH};
40 0     0     $perl = first { -x $_ }
41 0           map { File::Spec->catfile($_, $^X) }
  0            
42             @path;
43             }
44              
45 0           $perl =~ m/(.*)/;
46 0           $perl = $1;
47              
48 0           %ENV = ();
49              
50 0 0         open(my $server, "$perl $serverscript $popbox $setting|")
51             or die "Could not start POP3 server\n";
52              
53 0           my $line = <$server>;
54 0 0         my $port = $line =~ m/(\d+)/ ? $1
55             : die "Did not get port specification, but '$line'";
56              
57 0           ($server, $port);
58             }
59              
60             #
61             # START_POP3_CLIENT PORT, OPTIONS
62             #
63              
64             sub start_pop3_client($@)
65 0     0 0   { my ($port, @options) = @_;
66            
67 0           Mail::Transport::POP3->new
68             ( hostname => '127.0.0.1'
69             , port => $port
70             , username => 'user'
71             , password => 'password'
72             , @options
73             );
74             }
75              
76             1;