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   16401 use strict;
  25         67  
  25         835  
4 25     25   140 use warnings;
  25         58  
  25         736  
5 25     25   499 use 5.010;
  25         89  
6 25     25   140 use Moo;
  25         172  
  25         169  
7              
8             # ABSTRACT: FTP Server client context class
9             our $VERSION = '0.18'; # 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 1599 my($self, $con, $req) = @_;
29              
30 674         1136 push @{ $self->{request_queue} }, [ $con, $req ];
  674         2498  
31              
32 674 100       3688 $self->process_queue if $self->ready;
33              
34 674         1495 $self;
35             }
36              
37             sub process_queue
38             {
39 1264     1264 1 2228 my($self) = @_;
40              
41 1264 100       1944 return $self unless @{ $self->{request_queue} } > 0;
  1264         4283  
42              
43 674         1696 $self->ready(0);
44              
45 674         1067 my($con, $req) = @{ shift @{ $self->{request_queue} } };
  674         1014  
  674         1679  
46              
47 674         2356 my $command = lc $req->command;
48              
49 674 50       3729 if($self->can('auth_command_check_hook'))
50             {
51 674 100       2517 return unless $self->auth_command_check_hook($con, $command);
52             }
53              
54 650         2687 my $method = join '_', 'cmd', $command;
55              
56 650 100       3122 if($self->can($method))
57             {
58 649         3151 $self->$method($con, $req);
59             }
60             else
61             {
62 1         8 $self->invalid_command($con, $req);
63             }
64              
65 650         14937 $self;
66             }
67              
68             sub invalid_command
69             {
70 1     1 1 5 my($self, $con, $req) = @_;
71 1         6 $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 5 sub help_quit { "QUIT" }
83              
84             sub cmd_quit
85             {
86 41     41 1 136 my($self, $con, $req) = @_;
87 41         209 $con->send_response(221 => 'Goodbye');
88 41         177 $con->close;
89 41         130 $self;
90             }
91              
92             sub done
93             {
94 631     631 1 1525 my($self) = @_;
95 631         1998 $self->ready(1);
96 631         1957 $self->process_queue;
97 631         1871 $self;
98             }
99              
100             1;
101              
102             __END__