File Coverage

blib/lib/AnyEvent/FTP/Server/Role/Help.pm
Criterion Covered Total %
statement 35 36 97.2
branch 7 8 87.5
condition n/a
subroutine 7 7 100.0
pod 0 2 0.0
total 49 53 92.4


line stmt bran cond sub pod time code
1             package AnyEvent::FTP::Server::Role::Help;
2              
3 25     25   17145 use strict;
  25         59  
  25         834  
4 25     25   140 use warnings;
  25         51  
  25         650  
5 25     25   477 use 5.010;
  25         103  
6 25     25   136 use Moo::Role;
  25         75  
  25         185  
7              
8             # ABSTRACT: Help role for FTP server
9             our $VERSION = '0.18'; # VERSION
10              
11              
12             my %cmds;
13              
14 6     6 0 25 sub help_help { 'HELP [ command]' }
15              
16             sub cmd_help
17             {
18 108     108 0 235 my($self, $con, $req) = @_;
19              
20 108         279 my $topic = $req->args;
21 108         299 $topic =~ s/^\s+//;
22 108         250 $topic =~ s/\s+$//;
23 108         217 $topic = lc $topic;
24              
25 108 100       555 if($topic eq '')
    100          
26             {
27 6         19 my $class = ref $self;
28 6 100       30 unless(defined $cmds{$class})
29             {
30 25     25   13365 no strict 'refs';
  25         91  
  25         7090  
31             $cmds{$class} = [
32 4         13 sort map { my $x = $_; $x =~ s/^cmd_//; uc $x } grep /^cmd_/, keys %{$class . '::'}
  70         123  
  70         148  
  70         196  
  4         219  
33             ];
34             }
35              
36             $con->send_response(214, [
37             'The following commands are recognized:',
38 6         39 join(' ', @{ $cmds{$class} }),
  6         68  
39             'Direct comments to devnull@bogus',
40             ]);
41             }
42             elsif($self->can("cmd_$topic"))
43             {
44 99         208 my $method = "help_$topic";
45 99 50       394 if($self->can("help_$topic"))
46             {
47 99         378 $con->send_response(214 => 'Syntax: ' . $self->$method)
48             }
49             else
50             {
51 0         0 $con->send_response(502 => uc($topic) . " is a command without help");
52             }
53             }
54             else
55             {
56 3         15 $con->send_response(502 => 'Unknown command');
57             }
58              
59 108         458 $self->done;
60             }
61              
62             1;
63              
64             __END__