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   12606 use strict;
  25         48  
  25         691  
4 25     25   120 use warnings;
  25         39  
  25         578  
5 25     25   391 use 5.010;
  25         67  
6 25     25   119 use Moo;
  25         109  
  25         136  
7              
8             # ABSTRACT: FTP Server client context class
9             our $VERSION = '0.19'; # 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 1209 my($self, $con, $req) = @_;
29              
30 674         852 push @{ $self->{request_queue} }, [ $con, $req ];
  674         1723  
31              
32 674 100       2697 $self->process_queue if $self->ready;
33              
34 674         1087 $self;
35             }
36              
37             sub process_queue
38             {
39 1264     1264 1 1644 my($self) = @_;
40              
41 1264 100       1480 return $self unless @{ $self->{request_queue} } > 0;
  1264         3052  
42              
43 674         1525 $self->ready(0);
44              
45 674         759 my($con, $req) = @{ shift @{ $self->{request_queue} } };
  674         786  
  674         1309  
46              
47 674         1592 my $command = lc $req->command;
48              
49 674 50       2414 if($self->can('auth_command_check_hook'))
50             {
51 674 100       1684 return unless $self->auth_command_check_hook($con, $command);
52             }
53              
54 650         2002 my $method = join '_', 'cmd', $command;
55              
56 650 100       2391 if($self->can($method))
57             {
58 649         2246 $self->$method($con, $req);
59             }
60             else
61             {
62 1         5 $self->invalid_command($con, $req);
63             }
64              
65 650         10198 $self;
66             }
67              
68             sub invalid_command
69             {
70 1     1 1 2 my($self, $con, $req) = @_;
71 1         3 $con->send_response(500 => $req->command . ' not understood');
72 1         4 $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 3 sub help_quit { "QUIT" }
83              
84             sub cmd_quit
85             {
86 41     41 1 87 my($self, $con, $req) = @_;
87 41         136 $con->send_response(221 => 'Goodbye');
88 41         133 $con->close;
89 41         87 $self;
90             }
91              
92             sub done
93             {
94 631     631 1 1112 my($self) = @_;
95 631         1407 $self->ready(1);
96 631         1356 $self->process_queue;
97 631         1429 $self;
98             }
99              
100             1;
101              
102             __END__