view release on metacpan or  search on metacpan

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

sub create_ftpserver_ok (;$$)
{
  my($context, $message) = @_;

  my $ctx = context();

  my $uri = URI->new("ftp://127.0.0.1");

  $context //= 'Memory';
  $context = "AnyEvent::FTP::Server::Context::$context"
    unless $context =~ /::/;
  my $name = (split /::/, $context)[-1];

  my $user = join '', map { chr(ord('a') + int rand(26)) } (1..10);
  my $pass = join '', map { chr(ord('a') + int rand(26)) } (1..10);
  $uri->userinfo(join(':', $user, $pass));

  my $server;
  eval {
    $server = Test::AnyEventFTPServer->new(
      default_context => $context,
      hostname        => '127.0.0.1',
      port            => undef,
      test_uri        => $uri,
    );

    if($ENV{AEF_DEBUG})
    {
      $server->on_connect(sub {
        my $con = shift;
        $ctx->note("CONNECT");

        $con->on_request(sub {
          my $raw = shift;
          $ctx->note("CLIENT: $raw");
        });

        $con->on_response(sub {
          my $raw = shift;
          $ctx->note("SERVER: $raw");
        });

        $con->on_close(sub {
          $ctx->note("DISCONNECT");
        });
      });
    }

    $server->on_connect(sub {
      shift->context->authenticator(sub {
        return $_[0] eq $user && $_[1] eq $pass;
      });
    });

    my $cv = AnyEvent->condvar;
    my $timer = AnyEvent->timer(
      after => 5,
      cb    => sub { $cv->croak("timeout creating ftp server") },
    );
    $server->on_bind(sub {
      $uri->port(shift);
      $cv->send;
    });
    $server->start;
    $cv->recv;
  };
  my $error = $@;

  $message //= "created FTP ($name) server at $uri";

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

  $server;
}


sub connect_ftpclient_ok
{
  my($self, $message) = @_;
  my $client;
  eval {
    require AnyEvent::FTP::Client;
    $client = AnyEvent::FTP::Client->new;
    my $cv = AnyEvent->condvar;
    my $timer = AnyEvent->timer(
      after => 5,
      cb    => sub { $cv->croak("timeout connecting with ftp client") },
    );
    if($self->auto_login)
    {
      $client->connect($self->test_uri)
             ->cb(sub { $cv->send });
    }
    else
    {
      $client->connect($self->tesT_uri->host, $self->test_uri->port)
             ->cb(sub { $cv->send });
    }
    $cv->recv;
  };
  my $error = $@;

  $message //= "connected to FTP server at " . $self->test_uri;

  my $ctx = context();
  $ctx->ok($error eq '', $message);
  $ctx->diag($error) if $error;
  $ctx->release;

  $client;
}


sub help_coverage_ok
{
  my($self, $class, $message) = @_;

  $class //= $self->default_context;