File Coverage

blib/lib/AnyEvent/FTP/Client/Role/FetchTransfer.pm
Criterion Covered Total %
statement 39 44 88.6
branch 12 16 75.0
condition n/a
subroutine 13 14 92.8
pod 0 3 0.0
total 64 77 83.1


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