File Coverage

blib/lib/AnyEvent/FTP/Client/Role/FetchTransfer.pm
Criterion Covered Total %
statement 43 44 97.7
branch 13 16 81.2
condition n/a
subroutine 14 14 100.0
pod 0 3 0.0
total 70 77 90.9


line stmt bran cond sub pod time code
1             package AnyEvent::FTP::Client::Role::FetchTransfer;
2              
3 24     24   11410 use strict;
  24         47  
  24         590  
4 24     24   94 use warnings;
  24         39  
  24         471  
5 24     24   377 use 5.010;
  24         72  
6 24     24   99 use Moo::Role;
  24         45  
  24         171  
7              
8             # ABSTRACT: Fetch transfer interface for AnyEvent::FTP objects
9             our $VERSION = '0.19'; # VERSION
10              
11             sub xfer
12             {
13 21     21 0 63 my($self, $fh, $local) = @_;
14              
15 21         101 my $handle = $self->handle($fh);
16              
17 21 100       73 return unless defined $local;
18              
19             $handle->on_read(sub {
20             $handle->push_read(sub {
21 38         1390 $local->($_[0]{rbuf});
22 38         99 $_[0]{rbuf} = '';
23 19     19   1356 });
24 19         162 });
25             }
26              
27             sub convert_local
28             {
29 21     21 0 60 my($self, $local) = @_;
30              
31 21 100       56 return unless defined $local;
32 19 100       88 return $local if ref($local) eq 'CODE';
33              
34 15 100       71 if(ref($local) eq 'SCALAR')
    100          
    50          
35             {
36             return sub {
37 22     22   53 $$local .= shift;
38 11         93 };
39             }
40             elsif(ref($local) eq 'GLOB')
41             {
42             return sub {
43 4     4   11 print $local shift;
44 2         10 };
45             }
46             elsif(ref($local) eq '')
47             {
48 2         118 open my $fh, '>', $local;
49 2     2   30 $self->on_close(sub { close $fh });
  2         79  
50             return sub {
51 4     4   21 print $fh shift;
52 2         8 };
53             }
54             else
55             {
56 0         0 die 'unimplemented: ' . ref $local;
57             }
58             }
59              
60             sub push_command
61             {
62 21     21 0 37 my $self = shift;
63             my $cv = $self->{client}->push_command(
64 21         298 @_,
65             );
66              
67             $cv->cb(sub {
68 9     9   73 eval { $cv->recv };
  9         26  
69 9         46 my $err = $@;
70 9 50       24 $self->{cv}->croak($err) if $err;
71 21         171 });
72              
73             $self->on_eof(sub {
74             $cv->cb(sub {
75 21         188 my $res = eval { $cv->recv };
  21         75  
76 21 50       155 $self->{cv}->send($res) unless $@;
77 21     21   160 });
78 21         290 });
79             }
80              
81             1;
82              
83             __END__