view release on metacpan or  search on metacpan

lib/App/CPAN2Pkg/Worker.pm  view on Meta::CPAN

    handles => {
        _clear_output => 'clear',
        _add_output   => 'append',
    },
);

# the event to fire once run_command() has finished.
has _result_event => ( rw, isa=>'Str', clearer=>'_clear_result_event' );

# some events need to be postponed to do other stuff before
# (initialization, etc). _next_event allows to store the event to be
# fired afterwards.
has _next_event => ( rw, isa=>'Str' );

# current worker state
has _state => ( rw, isa=>'Str', clearer=>'_clear_state', predicate=>'_has_state' );


# -- initialization

sub START {
    my $self = shift;
    $K->alias_set( $self->module->name );
    $K->post( main => new_module => $self->module );
    $K->yield( 'check_upstream_availability' );
}


# -- cpan2pkg logic implementation

{


    event check_upstream_availability => sub { };

    event _check_upstream_availability_result => sub {
        my ($self, $status) = @_[OBJECT, ARG0];
        my $module  = $self->module;
        my $modname = $module->name;

        my $upstream = $status == 0 ? 'available' : 'not available';
        $module->upstream->set_status( $upstream );

        # inform controller of availability
        $K->post( controller => module_ready_upstream => $modname )
            if $upstream eq "available";

        $K->post( main => log_result => $modname => "$modname is $upstream upstream." );
        $K->post( main => module_state => $module );
        $self->yield( "check_local_availability" );
    };
}

{


    event check_local_availability => sub {
        my $self    = shift;
        my $modname = $self->module->name;

        my $cmd = qq{ perl -M$modname -E 'say "$modname loaded successfully";' };
        $K->post( main => log_step => $modname => "Checking if module is installed" );
        $self->run_command( $cmd => "_check_local_availability_result" );
    };

    #
    # _check_local_availability_result( $status )
    #
    # result of the command to check if the module is available locally.
    #
    event _check_local_availability_result => sub {
        my ($self, $status) = @_[OBJECT, ARG0];
        my $module  = $self->module;
        my $modname = $module->name;

        my $local = $status == 0 ? 'available' : 'not available';
        $module->local->set_status( $local );
        $K->post( main => log_result => $modname => "$modname is $local locally." );
        $K->post( main => module_state => $module );

        # inform controller of availability
        $K->post( controller => module_ready_locally => $modname )
            if $local eq "available";

        if ( $module->upstream->status eq "available" ) {
            # nothing to do if available locally & upstream
            return if $module->local->status eq "available";

            # need to install the module from upstream
            $self->yield( "install_from_upstream" );

        } else {
            $self->yield( "cpanplus_find_prereqs" );
        }
    };
}

{


    event install_from_upstream => sub {
        my $self = shift;
        my $module  = $self->module;
        my $modname = $module->name;

        # change module state
        $module->local->set_status( 'installing' );
        $K->post( main => module_state => $module );
        $K->post( main => log_step => $modname => "Installing from upstream" );
    };

    #
    # _install_from_upstream_result( $status )
    #
    # Result of the command launched to install module from distribution
    # repository.
    #
    event _install_from_upstream_result => sub {
        my ($self, $status) = @_[OBJECT, ARG0];
        my $module  = $self->module;
        my $modname = $module->name;

lib/App/CPAN2Pkg/Worker.pm  view on Meta::CPAN

        # inform controller of availability
        $K->post( controller => module_ready_upstream => $modname );
    };

    event _upstream_build_package_failed => sub {
        my ($self, $details) = @_[OBJECT, ARG0];
        my $module  = $self->module;
        my $modname = $module->name;

        $module->upstream->set_status( "error" );
        $K->post( main => module_state => $module );
        $K->post( main => log_result => $modname => 'Error while building package' );
        $K->post( main => log_result => $modname => "details: $details" );
    };
}



# -- public methods


sub cpan2dist_flavour { die "should be overridden in child class!" }


{


    sub run_command {
        my ($self, $cmd, $event) = @_;

        $K->post( main => log_comment => $self->module->name => "Running: $cmd\n" );
        $ENV{LC_ALL} = 'C';
        my $child = POE::Wheel::Run->new(
            Program     => $cmd,
            Conduit     => "pty-pipe",
            StdoutEvent => "_child_stdout",
            StderrEvent => "_child_stderr",
            CloseEvent  => "_child_close",
        );

        $K->sig_child( $child->PID, "_child_signal" );
        $self->_set_wheel( $child );
        $self->_clear_output;
        $self->_set_result_event( $event );
        #print( "Child pid ", $child->PID, " started as wheel ", $child->ID, ".\n" );
    }

    event _child_stdout => sub {
        my ($self, $line, $wid) = @_[OBJECT, ARG0, ARG1];
        $self->_add_output( "$line\n" );
        $K->post( main => log_out => $self->module->name => $line );
    };

    event _child_stderr => sub {
        my ($self, $line, $wid) = @_[OBJECT, ARG0, ARG1];
        $K->post( main => log_err => $self->module->name => $line );
    };

    event _child_close => sub {
        my ($self, $wid) = @_[OBJECT, ARG0];
        #say "child closed all pipes";
    };

    event _child_signal => sub {
        my ($self, $pid, $status) = @_[OBJECT, ARG1, ARG2];
        $K->post( main => log_out => $self->module->name => "" );
        $status //=0;
        $self->yield( $self->_result_event, $status, $self->_output );
        $self->_clear_result_event;
    };
}


no Moose;
__PACKAGE__->meta->make_immutable;
1;

__END__

=pod

=head1 NAME

App::CPAN2Pkg::Worker - poe session to drive a module packaging

=head1 VERSION

version 3.004

=head1 DESCRIPTION

C<App::CPAN2Pkg::Worker> implements a POE session driving the whole
packaging process of a given module. It has different subclasses, used
to match the diversity of Linux distributions.

It is spawned by C<App::CPAN2Pkg::Controller> and uses a
C<App::CPAN2Pkg::Module> object to track module information.

=head1 CLASS ATTRIBUTES

=head2 cpanplus_init

A boolean to state whether CPANPLUS has been initialized with new index.

=head2 cpanplus_lock

A lock (L<App::CPAN2Pkg::Lock> object) to prevent more than one cpanplus
initialization at a time.

=head1 ATTRIBUTES

=head2 module

The name of the module to build / install / submit / whatever.

=head1 METHODS

=head2 cpan2dist_flavour

    my $backend = $worker->cpan2dist_flavour;