view release on metacpan or  search on metacpan

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

            return;
        }

        # now we need to wait for the build to finish...
        $K->post( main => log_comment => $modname => "$modname has been submitted" );
        $self->yield( "_upstream_build_wait" );
    };

    #
    # _upstream_build_wait( )
    #
    # check on a regular basis whether the build has been finished.
    #
    event _upstream_build_wait => sub { };

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

        $module->upstream->set_status( "available" );
        $K->post( main => module_state => $module );
        $K->post( main => log_result => $modname => 'Package successfully built' );

        # 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.