view release on metacpan or  search on metacpan

lib/App/Prove/Plugin/Distributed.pm  view on Meta::CPAN

    #LSF: Start up.
    if ( $app->{start_up} ) {
        unless ( $class->_do( $app->{start_up} ) ) {
            die "start server error with error [$error].\n";
        }
    }

    while (1) {

        #LSF: The is the server to serve the test.
        $class->start_server(
            app  => $app,
            spec => $app->{manager},
            ( $app->{error_log} ? ( error_log => $app->{error_log} ) : () ),
            ( $app->{detach}    ? ( detach    => $app->{detach} )    : () ),

        );
    }

    #LSF: Anything below here might not be called.
    #LSF: Tear down
    if ( $app->{tear_down} ) {
        unless ( $class->_do( $app->{tear_down} ) ) {
            die "tear down error with error [$error].\n";
        }
    }
    $ENV{PER5LIB} = $original_perl_5_lib;
    @INC = @original_include;
    return 1;
}

=head3 C<extra_used_libs>

Return a list of paths in @INC that are not part of the compiled-in lsit of paths

=cut

my @initial_compiled_inc;

BEGIN {
    use Config;

    my @var_list = (
        'updatesarch', 'updateslib',     'archlib',      'privlib',
        'sitearch',    'sitelib',        'sitelib_stem', 'vendorarch',
        'vendorlib',   'vendorlib_stem', 'extrasarch',   'extraslib',
    );

    for my $var_name (@var_list) {
        if ( $var_name =~ /_stem$/ && $Config{$var_name} ) {
            my @stem_list = ( split( ' ', $Config{'inc_version_list'} ), '' );
            push @initial_compiled_inc,
              map { $Config{$var_name} . "/$_" } @stem_list;
        }
        else {
            push @initial_compiled_inc, $Config{$var_name}
              if $Config{$var_name};
        }
    }

    # . is part of the initial @INC unless in taint mode
    push @initial_compiled_inc, '.' if ( ${^TAINT} == 0 );

    map { s/\/+/\//g } @initial_compiled_inc;
    map { s/\/+$// } @initial_compiled_inc;
}

sub extra_used_libs {
    my $class = shift;

    my @extra;
    my @compiled_inc = @initial_compiled_inc;
    my @perl5lib = split( ':', $ENV{PERL5LIB} );
    map { $_ =~ s/\/+$// }
      ( @compiled_inc, @perl5lib );    # remove trailing slashes
    map { $_ = Cwd::abs_path($_) || $_ } ( @compiled_inc, @perl5lib );
    for my $inc (@INC) {
        $inc =~ s/\/+$//;
        my $abs_inc = Cwd::abs_path($inc)
          || $inc;                     # should already be expanded by UR.pm
        next if ( grep { $_ =~ /^$abs_inc$/ } @compiled_inc );
        next if ( grep { $_ =~ /^$abs_inc$/ } @perl5lib );
        push @extra, $inc;
    }

#unshift @extra, ($ENV{PERL_USED_ABOVE} ? split(":", $ENV{PERL_USED_ABOVE}) : ());

    map { $_ =~ s/\/+$// } @extra;     # remove trailing slashes again
                                       #@extra = _unique_elements(@extra);

    return @extra;
}

=head3 C<start_server>

Start a server to serve the test.

Parameter is the contoller peer address.

=cut

sub start_server {
    my $class = shift;
    my %args  = @_;
    my ( $app, $spec, $error_log, $detach ) =
      @args{ 'app', 'spec', 'error_log', 'detach' };

    my $socket = IO::Socket::INET->new(
        PeerAddr => $spec,
        Proto    => 'tcp'
    );
    unless ($socket) {
        die "failed to connect to controller with address : $spec.\n";
    }

    #LSF: Waiting for job from controller.
    my $job_info = <$socket>;
    chomp($job_info);

    #LSF: Run job.
    my $pid = fork();