File Coverage

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


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