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

package AnyEvent::FTP::Server::Role::Help;

use strict;
use warnings;
use 5.010;
use Moo::Role;

# ABSTRACT: Help role for FTP server
our $VERSION = '0.19'; # VERSION


my %cmds;

sub help_help { 'HELP [ command]' }

sub cmd_help
{
  my($self, $con, $req) = @_;

  my $topic = $req->args;
  $topic =~ s/^\s+//;
  $topic =~ s/\s+$//;
  $topic = lc $topic;

  if($topic eq '')
  {
    my $class = ref $self;
    unless(defined $cmds{$class})
    {
      no strict 'refs';
      $cmds{$class} = [
        sort map { my $x = $_; $x =~ s/^cmd_//; uc $x } grep /^cmd_/, keys %{$class . '::'}
      ];
    }

    $con->send_response(214, [
      'The following commands are recognized:',
      join(' ', @{ $cmds{$class} }),
      'Direct comments to devnull@bogus',
    ]);
  }
  elsif($self->can("cmd_$topic"))
  {
    my $method = "help_$topic";
    if($self->can("help_$topic"))
    {
      $con->send_response(214 => 'Syntax: ' . $self->$method)
    }
    else
    {
      $con->send_response(502 => uc($topic) . " is a command without help");
    }
  }
  else
  {
    $con->send_response(502 => 'Unknown command');
  }

  $self->done;
}

1;

__END__