view release on metacpan or  search on metacpan

t/TestBot.pm  view on Meta::CPAN

package TestBot;

use strict;
use warnings;

use autodie;
use Cwd qw(abs_path getcwd);
use File::Remove 'remove';
use File::Spec;
use POSIX qw(SIGTERM);
use Socket;
use Symbol;

use base 'Class::Accessor::Fast';
__PACKAGE__->mk_accessors(
    qw( dir pid_file output_file addr port client_config_file )
);

my @info = getpwnam( $ENV{USER} = getpwuid($>) );

our $USER = $info[0];

( our $USER_NAME = $info[6] ) =~ s/,.*//;

our $COMMIT_USER
    = $USER_NAME
    ? "06${USER_NAME} (06${USER})"
    : "06${USER} (06${USER})";

sub start {
    my $class = shift;
    my $self  = $class->new();

    my $dir = abs_path( File::Spec->catdir( 't', 'bot' ) );
    $self->pid_file( File::Spec->catfile( $dir, 'kgb-bot.pid' ) );
    $self->output_file( File::Spec->catfile( $dir, 'output' ) );
    unlink $self->output_file if -e $self->output_file;

    my $proto = getprotobyname('tcp');
    my $srv = gensym;

    socket( $srv, PF_INET, SOCK_STREAM, $proto ) or die "socket: $!";
    setsockopt( $srv, SOL_SOCKET, SO_REUSEADDR, pack( "l", 1 ) )
        or die "setsockopt: $!";

    #use Carp;
    #local $SIG{__WARN__} = \&Carp::cluck;
    #local $SIG{__DIE__} = \&Carp::confess;

    my $addr = INADDR_LOOPBACK;
    my $port = 5392;
    my $tries = 1;

    while(1) {
        warn "# trying port $port\n";
        warn("# port $port is available\n"), last
            if eval { bind( $srv, pack_sockaddr_in( $port, $addr ) ) };

        warn "# port $port is busy\n";

        $port++;
        $tries++;
        die "Unable to find free port" if $tries > 1000;
    }

    close($srv);

    mkdir $dir unless -d $dir;

    $addr = inet_ntoa($addr);

    my $conf_file   = File::Spec->catfile( $dir, 'test-bot.conf' );
    open( my $fh, '>', $conf_file);
    print $fh <<EOF;
---
soap:
  server_addr: $addr
  server_port: $port
  service_name: KGB