File Coverage

blib/lib/Test/FTP/Server.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 Test::FTP::Server;
2              
3 4     4   61180 use strict;
  4         8  
  4         148  
4 4     4   20 use warnings;
  4         8  
  4         163  
5              
6             our $VERSION = '0.012';
7              
8 4     4   17 use Carp;
  4         6  
  4         298  
9              
10 4     4   20 use File::Find;
  4         7  
  4         233  
11 4     4   19 use File::Spec;
  4         7  
  4         93  
12 4     4   3726 use File::Copy;
  4         17265  
  4         262  
13 4     4   2718 use File::Temp qw/ tempfile tempdir /;
  4         53508  
  4         267  
14              
15 4     4   2274 use Test::FTP::Server::Server;
  0            
  0            
16              
17             sub new {
18             my $class = shift;
19             my (%opt) = @_;
20              
21             my @args = ();
22              
23             if (my $users = $opt{'users'}) {
24             foreach my $u (@$users) {
25             if (my $base = $u->{'sandbox'}) {
26              
27             croak($base . ' is not directory.') unless -d $base;
28              
29             my $dir = tempdir(CLEANUP => 1);
30             File::Find::find({
31             'wanted' => sub {
32             my $src = my $dst = $_;
33             $dst =~ s/^$base//;
34             $dst = File::Spec->catfile($dir, $dst);
35              
36             if (-d $_) {
37             mkdir($dst);
38             }
39             else {
40             File::Copy::copy($src, $dst);
41             }
42              
43             chmod((stat($src))[2], $dst);
44             utime((stat($src))[8,9], $dst);
45             },
46             'no_chdir' => 1,
47             }, $base);
48              
49             $u->{'root'} = $dir;
50             }
51              
52             croak(
53             'It\'s necessary to specify parameter that is ' .
54             '"root" or "sandbox" for each user.'
55             ) unless $u->{'root'};
56              
57             croak($u->{'root'} . ' is not directory.') unless -d $u->{'root'};
58             croak('"user" is required.') unless $u->{'user'};
59             croak('"pass" is required.') unless $u->{'pass'};
60              
61             $u->{'root'} =~ s{/+$}{};
62             }
63             push(@args, '_test_users', $users);
64             }
65              
66             if ($opt{'ftpd_conf'}) {
67             if (ref $opt{'ftpd_conf'}) {
68             my ($fh, $filename) = tempfile();
69             while (my ($k, $v) = each %{ $opt{'ftpd_conf'} }) {
70             print($fh "$k: $v\n");
71             }
72             close($fh);
73              
74             push(@args, '-C', $filename);
75             }
76             else {
77             push(@args, '-C', $opt{'ftpd_conf'});
78             }
79             }
80              
81             my $self = bless({ 'args' => \@args }, $class);
82             }
83              
84             sub run {
85             my $self = shift;
86             Test::FTP::Server::Server->run($self->{'args'});
87             }
88              
89             1;
90             __END__