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   15300 use strict;
  24         76  
  24         822  
4 24     24   139 use warnings;
  24         53  
  24         637  
5 24     24   462 use 5.010;
  24         95  
6 24     24   130 use Moo::Role;
  24         62  
  24         208  
7              
8             # ABSTRACT: Fetch transfer interface for AnyEvent::FTP objects
9             our $VERSION = '0.18'; # VERSION
10              
11             sub xfer
12             {
13 21     21 0 77 my($self, $fh, $local) = @_;
14              
15 21         129 my $handle = $self->handle($fh);
16              
17 21 100       75 return unless defined $local;
18              
19             $handle->on_read(sub {
20             $handle->push_read(sub {
21 38         2055 $local->($_[0]{rbuf});
22 38         204 $_[0]{rbuf} = '';
23 19     19   2065 });
24 19         185 });
25             }
26              
27             sub convert_local
28             {
29 21     21 0 94 my($self, $local) = @_;
30              
31 21 100       84 return unless defined $local;
32 19 100       109 return $local if ref($local) eq 'CODE';
33              
34 15 100       96 if(ref($local) eq 'SCALAR')
    100          
    50          
35             {
36             return sub {
37 22     22   77 $$local .= shift;
38 11         209 };
39             }
40             elsif(ref($local) eq 'GLOB')
41             {
42             return sub {
43 4     4   16 print $local shift;
44 2         16 };
45             }
46             elsif(ref($local) eq '')
47             {
48 2         144 open my $fh, '>', $local;
49 2     2   39 $self->on_close(sub { close $fh });
  2         82  
50             return sub {
51 4     4   27 print $fh shift;
52 2         10 };
53             }
54             else
55             {
56 0         0 die 'unimplemented: ' . ref $local;
57             }
58             }
59              
60             sub push_command
61             {
62 21     21 0 62 my $self = shift;
63             my $cv = $self->{client}->push_command(
64 21         128 @_,
65             );
66              
67             $cv->cb(sub {
68 9     9   96 eval { $cv->recv };
  9         35  
69 9         54 my $err = $@;
70 9 50       33 $self->{cv}->croak($err) if $err;
71 21         238 });
72              
73             $self->on_eof(sub {
74             $cv->cb(sub {
75 21         283 my $res = eval { $cv->recv };
  21         91  
76 21 50       210 $self->{cv}->send($res) unless $@;
77 21     21   205 });
78 21         396 });
79             }
80              
81             1;
82              
83             __END__