File Coverage

blib/lib/AnyEvent/FTP/Server/Context.pm
Criterion Covered Total %
statement 43 46 93.4
branch 9 10 90.0
condition n/a
subroutine 10 11 90.9
pod 7 7 100.0
total 69 74 93.2


line stmt bran cond sub pod time code
1             package AnyEvent::FTP::Server::Context;
2              
3 25     25   18332 use strict;
  25         68  
  25         884  
4 25     25   165 use warnings;
  25         56  
  25         826  
5 25     25   589 use 5.010;
  25         97  
6 25     25   235 use Moo;
  25         148  
  25         186  
7              
8             # ABSTRACT: FTP Server client context class
9             our $VERSION = '0.17'; # VERSION
10              
11             with 'AnyEvent::FTP::Role::Event';
12             with 'AnyEvent::FTP::Server::Role::Context';
13              
14             __PACKAGE__->define_events(qw( auth ));
15              
16             has ready => (
17             is => 'rw',
18             default => sub { 1 },
19             );
20              
21             has ascii_layer => (
22             is => 'rw',
23             default => ':raw:eol(CRLF-Native)'
24             );
25              
26             sub push_request
27             {
28 674     674 1 1662 my($self, $con, $req) = @_;
29              
30 674         1089 push @{ $self->{request_queue} }, [ $con, $req ];
  674         2536  
31              
32 674 100       3528 $self->process_queue if $self->ready;
33              
34 674         1562 $self;
35             }
36              
37             sub process_queue
38             {
39 1264     1264 1 2287 my($self) = @_;
40              
41 1264 100       1980 return $self unless @{ $self->{request_queue} } > 0;
  1264         4072  
42              
43 674         1644 $self->ready(0);
44              
45 674         1167 my($con, $req) = @{ shift @{ $self->{request_queue} } };
  674         994  
  674         1839  
46              
47 674         2304 my $command = lc $req->command;
48              
49 674 50       3604 if($self->can('auth_command_check_hook'))
50             {
51 674 100       2300 return unless $self->auth_command_check_hook($con, $command);
52             }
53              
54 650         2590 my $method = join '_', 'cmd', $command;
55              
56 650 100       3524 if($self->can($method))
57             {
58 649         3271 $self->$method($con, $req);
59             }
60             else
61             {
62 1         7 $self->invalid_command($con, $req);
63             }
64              
65 650         16473 $self;
66             }
67              
68             sub invalid_command
69             {
70 1     1 1 24 my($self, $con, $req) = @_;
71 1         15 $con->send_response(500 => $req->command . ' not understood');
72 1         5 $self->done;
73             }
74              
75             sub invalid_syntax
76             {
77 0     0 1 0 my($self, $con, $raw) = @_;
78 0         0 $con->send_response(500 => 'Command not understood');
79 0         0 $self->done;
80             }
81              
82 1     1 1 6 sub help_quit { "QUIT" }
83              
84             sub cmd_quit
85             {
86 41     41 1 109 my($self, $con, $req) = @_;
87 41         173 $con->send_response(221 => 'Goodbye');
88 41         256 $con->close;
89 41         163 $self;
90             }
91              
92             sub done
93             {
94 631     631 1 1575 my($self) = @_;
95 631         1998 $self->ready(1);
96 631         2026 $self->process_queue;
97 631         1911 $self;
98             }
99              
100             1;
101              
102             __END__