view release on metacpan or  search on metacpan

lib/Test/AnyEventFTPServer.pm  view on Meta::CPAN

  state $temp;
  state $counter = 0;
  my $method = 'diag';
  #$method = 'note' if $tb->todo;

  unless(defined $temp)
  {
    $temp = tempdir(CLEANUP => 1);
  }

  my $file = $temp->file(sprintf("data.%d", $counter++));
  $file->spew($_[0]);

  my $ctx = context();

  if(-T $file)
  {
    $ctx->$method("  $_") for split /\n/, $_[0];
  }
  else
  {
    if(eval { require Data::HexDump })
    {
      $ctx->$method("  $_") for grep !/^$/, split /\n/, Data::HexDump::HexDump($_[0]);
    }
    else
    {
      $ctx->$method("  binary content");
    }
  }

  $ctx->release;

  $file->remove;
}

sub content_is
{
  my($self, $string, $message) = @_;

  $message ||= 'content matches';

  my $ok = $self->content eq $string;

  my $ctx = context();
  $ctx->ok($ok, $message);
  unless($ok)
  {
    $ctx->diag("content:");
    _display_content($self->content);
    $ctx->diag("expected:");
    _display_content($string);
  }

  $ctx->release;

  $self;
}


sub global_timeout_ok (;$$)
{
  my($timeout, $message) = @_;

  $timeout //= 120;
  $message //= "global timeout of $timeout seconds";

  my $ctx = context();

  state $timers = [];

  eval {
    push @$timers, AnyEvent->timer(
      after => $timeout,
      cb    => sub { $ctx->diag("GLOBAL TIMEOUT"); exit },
    );
  };
  my $error = $@;

  my $ok = $error eq '';

  $ctx->ok($ok, $message);
  $ctx->diag($error) if $error;

  $ctx->release;

  $ok;
}

sub import
{
  my $caller = caller;
  no strict 'refs';
  *{join '::', $caller, 'create_ftpserver_ok'} = \&create_ftpserver_ok;
  *{join '::', $caller, 'global_timeout_ok'} = \&global_timeout_ok;
}

BEGIN { eval 'use EV' }

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Test::AnyEventFTPServer - Test (non-blocking) ftp clients against a real FTP server

=head1 VERSION

version 0.20

=head1 SYNOPSIS

 use Test2:V0;
 use Test::AnyEventFTPServer;
 
 # exit this script after 30s to avoid hung test
 global_timeout_ok;
 
 # $test_server isa AnyEvent::FTP::Server
 # and          isa Test::AnyEventFTPServer
 my $test_server = create_ftpserver_ok;
 
 $test_server->command_ok('HELP')
             ->code_is(214)
             ->message_like(qr{the following commands are recognize});
 
 # $res isa AnyEvent::FTP::Client::Response
 # from that last HELP command
 my $res = $test_server->res;
 
 # $client isa AnyEvent::FTP::Client
 my $client = $test_server->connect_ftpclient_ok;
 
 # check to make sure that all FTP commands have help
 $test_server->help_coverage_ok;
 
 done_testing;

=head1 DESCRIPTION

This module makes it easy to test ftp clients against a real
L<AnyEvent::FTP> FTP server.  The FTP server is non-blocking in
and does not C<fork>, so if you are testing a FTP client that
blocks then you will need to do it in a separate process.
L<AnyEvent::FTP::Client> is a client that doesn't block and so
is safe to use in testing against the server.

=head1 ATTRIBUTES

=head2 test_uri

 my $uri = $test_server->test_uri

The full URL (including host, port, username and password) of the
test ftp server.  This is returned as L<URI>.

=head2 res

 my $res = $test_server->res

The last L<AnyEvent::FTP::Client::Response> object returned from the
server after calling the C<command_ok> method.

=head2 content

 my $content = $test_server->content

The last content retrieved from a C<list_ok>, C<nlst_ok> or C<transfer_ok>
test.

=head2 auto_login

 my $bool = $test_server->auto_login

If true (the default) automatically login using the correct credentials.
Normally if you are testing file transfers you want to keep this to the
default value, if you are testing the authentication of a server context

lib/Test/AnyEventFTPServer.pm  view on Meta::CPAN

Verifies that the status code of the last command executed matches
the given code exactly.

=head2 code_like

 $test_server->code_like($regex);
 $test_server->code_like($regex, $test_name);

Verifies that the status code of the last command executed matches
the given regular expression..

=head2 message_like

 $test_server->message_like($regex);
 $test_server->message_like($regex, $test_name);

Verifies that the message portion of the response of the last command executed matches
the given regular expression.

=head2 message_is

 $test_server->message_is($string);
 $test_server->message_is($string, $test_name);

Verifies that the message portion of the response of the last command executed matches
the given string.

If the response message has multiple lines, then only one of the lines needs to match
the given string.

=head2 list_ok

 $test_server->list_ok;
 $test_server->list_ok($location);
 $test_server->list_ok($location, $test_name)

Execute a the C<LIST> command on the given C<$location>
and wait for the results.  You can see the result using
the C<content> attribute or test it with the C<content_is>
method.

=head2 nlst_ok

 $test_server->nlst_ok;
 $test_server->nlst_ok( $location );
 $test_server->nlst_ok( $location, $test_name );

Execute a the C<NLST> command on the given C<$location>
and wait for the results.  You can see the result using
the C<content> attribute or test it with the C<content_is>
method.

=head2 content_is

 $test_server->content_is($string);
 $test_server->content_is($string, $test_name);

Test that the given C<$string> matches the content
returned by the last C<list_ok> or C<nlst_ok> method.

=head2 global_timeout_ok

 global_timeout_ok;
 global_timeout_ok($timeout);
 global_timeout_ok($timeout, $test_name)

Set a global timeout on the entire test script.  If the timeout
is exceeded the test will exit.  Handy if you have test automation
and your test automation doesn't handle hung tests.

The default timeout is 120 seconds.

=head1 AUTHOR

Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>

Contributors:

Ryo Okamoto

Shlomi Fish

José Joaquín Atria

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2017-2022 by Graham Ollis.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut