File Coverage

blib/lib/AnyEvent/FTP/Client/Role/StoreTransfer.pm
Criterion Covered Total %
statement 39 40 97.5
branch 13 14 92.8
condition n/a
subroutine 12 12 100.0
pod 0 3 0.0
total 64 69 92.7


line stmt bran cond sub pod time code
1             package AnyEvent::FTP::Client::Role::StoreTransfer;
2              
3 24     24   14704 use strict;
  24         63  
  24         799  
4 24     24   135 use warnings;
  24         55  
  24         603  
5 24     24   429 use 5.010;
  24         92  
6 24     24   134 use Moo::Role;
  24         65  
  24         185  
7              
8             # ABSTRACT: Store transfer interface for AnyEvent::FTP objects
9             our $VERSION = '0.18'; # VERSION
10              
11             sub xfer
12             {
13 25     25 0 103 my($self, $fh, $local) = @_;
14              
15 25         190 my $handle = $self->handle($fh);
16              
17 25 100       138 return unless defined $local;
18              
19             $handle->on_drain(sub {
20 46     46   3157 my $data = $local->();
21 46 100       219 if(defined $data)
22             {
23 23         120 $handle->push_write($data);
24             }
25             else
26             {
27 23         139 $handle->push_shutdown;
28             }
29 23         255 });
30             }
31              
32             sub convert_local
33             {
34 25     25 0 112 my($self, $local) = @_;
35              
36 25 100       139 return unless defined $local;
37 23 100       133 return $local if ref($local) eq 'CODE';
38              
39 21 100       163 if(ref($local) eq '')
    100          
    50          
40             {
41 4         169 open my $fh, '<', $local;
42 4     4   135 $self->on_close(sub { close $fh });
  4         105  
43             return sub {
44 8     8   49 local $/;
45 8         408 <$fh>;
46 4         35 };
47             }
48             elsif(ref($local) eq 'SCALAR')
49             {
50 13         41 my $buffer = $$local;
51             return sub {
52 26     26   63 my $tmp = $buffer;
53 26         58 undef $buffer;
54 26         71 $tmp;
55 13         144 };
56             }
57             elsif(ref($local) eq 'GLOB')
58             {
59             sub {
60             # TODO: for big files, maybe
61             # break this up into batches
62 8     8   59 local $/;
63 8         456 <$local>;
64 4         40 };
65             }
66             else
67             {
68 0         0 die 'bad local type';
69             }
70             }
71              
72             sub push_command
73             {
74 25     25 0 79 my $self = shift;
75             $self->{client}->push_command(
76 25         719 @_,
77             $self->cv,
78             );
79             }
80              
81             1;
82              
83             __END__