view release on metacpan or  search on metacpan

t/TestBot.pm  view on Meta::CPAN

    if ($dirs) { $dirs .= ":$t_dir" }
    else       { $dirs = $t_dir }
    $ENV{PERL5LIB} = $dirs;

    system( $bot_script,
        '--config', $conf_file, '--simulate', $self->output_file,
        '--simulate-color' ) == 0
        or die "bot exec error";

    # wait for the PID file to appear and to have content
    while ( ( not -e $self->pid_file ) or ( not -s _ ) ) {
        sleep 0.1;
    }
    my $pid = do {
        open( my $fh, $self->pid_file );
        my $pid = <$fh>;
        chomp($pid);
        close $fh;
        $pid;
    };

    $self->addr($addr);
    $self->port($port);

    warn "# test bot listening on $addr:$port, pid: $pid ";

    my $client_config_file = File::Spec->catfile($dir, 'client.conf');
    $self->client_config_file($client_config_file);

    open( $fh, '>', $client_config_file );
    print $fh <<EOF;
---
repo-id: test
branch-and-module-re:
 - "/(trunk|tags|apps|attic)/([^/]+)"
 - "/branches/([^/]+)/([^/]+)"
web-link: "http://scm.host.org/\${module}/\${branch}/?commit=\${commit}"
use-irc-notices: 0
use-color: 1
password: "truely secret"
timeout: 15
servers:
 - uri: http://$addr:$port/
message-template: "\${{project}/}\${{module}}\${ {branch}}\${ {commit}}\${ {author-name}}\${ ({author-login})}\${ {changes}}\${ {log-first-line}}\${ * {web-link}}"
status-dir: $dir
batch-messages: 1
EOF

    close $fh;

    $self->dir($dir);

    return $self;
}

sub get_output {
    my $self = shift;

    my $fh;
    eval { open( $fh, $self->output_file ); 1 } or return '';
    binmode( $fh, ':utf8' );
    local $/ = undef;
    return <$fh>;
}

sub stop {
    my $self = shift;

    if ( not -e $self->pid_file ) {
        warn "# " . $self->pid_file . " doesn't exist\n";
        return;
    }

    open my $fh, $self->pid_file;
    my $pid = <$fh>;
    chomp($pid);
    close($fh);

    warn "# stopping test bot, pid $pid\n";
    kill SIGTERM, $pid;

    while ( -e $self->pid_file ) {
        sleep 0.1;
    }
}

sub clean {
    my $self = shift;

    if( my $dir = $self->dir ) {
        warn "# Removing directory $dir\n";
        remove \1, $dir;
    }
}

sub DESTROY {
    my $self = shift;

    $self->stop;
    $self->clean;
}

my $expected = '';

sub expect {
    my $class = shift;
    $expected .= shift . "\n";
}

sub expected_output {
    return $expected;
}

1;