← Back to branch summary

~ubuntu-branches/ubuntu/utopic/libparallel-runner-perl/utopic

« back to all changes in this revision

Viewing changes to .pc/spelling-errors.patch/lib/Parallel/Runner.pm

  • Committer: Package Import Robot
  • Author(s): Xavier Guimard
  • Date: 2013-05-12 07:49:11 UTC
  • mfrom: (1.1.1)
  • Revision ID: package-import@ubuntu.com-20130512074911-cn0basiy7umk8b6s
Tags: 0.013-1
* Imported Upstream version 0.013
* Update patch offset
* Update Module::Build version dependency
* Replace git.debian.org by anonscm.debian.org in Vcs fields

Show diffs side-by-side

added added

removed removed

Lines of Context:
.pc/spelling-errors.patch/lib/Parallel/Runner.pm
7
7
use Carp;
8
8
use Child qw/child/;
9
9
 
10
 
our $VERSION = '0.012';
 
10
our $VERSION = '0.013';
11
11
 
12
12
for my $accessor (qw/ exit_callback data_callback iteration_callback _children pid max iteration_delay reap_callback pipe/) {
13
13
    my $sub = sub {
14
14
        my $self = shift;
15
 
        ($self->{ $accessor }) = @_ if @_;
16
 
        return $self->{ $accessor };
 
15
        ( $self->{$accessor} ) = @_ if @_;
 
16
        return $self->{$accessor};
17
17
    };
18
18
    no strict 'refs';
19
19
    *$accessor = $sub;
23
23
    my $self = shift;
24
24
    my @active;
25
25
 
26
 
    for my $proc ( @{ $self->_children || [] }, @_ ) {
 
26
    for my $proc ( @{$self->_children || []}, @_ ) {
27
27
        if ( defined $proc->exit_status ) {
28
 
            if ($self->data_callback) {
 
28
            if ( $self->data_callback ) {
29
29
                my $data = $proc->read();
30
 
                $self->data_callback->($data)
 
30
                $self->data_callback->($data);
31
31
            }
32
32
 
33
33
            $self->reap_callback->( $proc->exit_status, $proc->pid, $proc->pid, $proc )
60
60
sub run {
61
61
    my $self = shift;
62
62
    my ( $code, $force_fork ) = @_;
63
 
    croak( "Called run() in child process" )
 
63
    croak("Called run() in child process")
64
64
        unless $self->pid == $$;
65
65
 
66
 
    my $fork = $self->max > 1;
67
 
    return $self->_fork( $code, $fork ? 0 : $force_fork )
68
 
        if $fork || $force_fork;
 
66
    my $fork = $force_fork || $self->max > 1;
 
67
    return $self->_fork($code)
 
68
        if $fork;
69
69
 
70
70
    my ($data) = $code->();
71
 
    $self->data_callback->( $data )
 
71
    $self->data_callback->($data)
72
72
        if $self->data_callback;
73
73
 
74
74
    return;
76
76
 
77
77
sub _fork {
78
78
    my $self = shift;
79
 
    my ( $code, $forced ) = @_;
 
79
    my ($code) = @_;
80
80
 
81
81
    # Wait for a slot
82
 
    $self->_iterate( sub {
83
 
        $self->children >= $self->max
84
 
    }) unless $forced;
85
 
 
86
 
    my $proc = Child->new( sub {
87
 
        my $parent = shift;
88
 
        $self->_children([]);
89
 
 
90
 
        my @return = $code->($parent);
91
 
 
92
 
        $self->exit_callback->( @return )
93
 
            if $self->exit_callback;
94
 
 
95
 
        $parent->write( $return[0] )
96
 
            if $self->data_callback;
97
 
 
98
 
    }, $self->pipe || $self->data_callback ? (pipe => $self->pipe) : ())->start();
99
 
 
100
 
    $self->_iterate( sub {
101
 
        !defined $proc->exit_status
102
 
    }) if $forced;
103
 
 
104
 
    $self->children( $proc )
105
 
        unless defined $proc->exit_status;
 
82
    $self->_iterate(
 
83
        sub {
 
84
            $self->children >= $self->max;
 
85
        }
 
86
    );
 
87
 
 
88
    my $proc = Child->new(
 
89
        sub {
 
90
            my $parent = shift;
 
91
            $self->_children( [] );
 
92
 
 
93
            my @return = $code->($parent);
 
94
 
 
95
            $self->exit_callback->(@return)
 
96
                if $self->exit_callback;
 
97
 
 
98
            $parent->write( $return[0] )
 
99
                if $self->data_callback;
 
100
 
 
101
        },
 
102
        $self->pipe || $self->data_callback ? ( pipe => $self->pipe ) : ()
 
103
    )->start();
 
104
 
 
105
    $self->_iterate( sub { !defined $proc->exit_status } )
 
106
        if $self->max == 1;
 
107
 
 
108
    $self->children($proc);
106
109
 
107
110
    return $proc;
108
111
}
109
112
 
110
113
sub finish {
111
114
    my $self = shift;
112
 
    $self->_iterate( sub { $self->children } , @_ );
 
115
    $self->_iterate( sub { $self->children }, @_ );
113
116
}
114
117
 
115
118
sub _iterate {
117
120
    my ( $condition, $timeout, $timeoutsub ) = @_;
118
121
    my $counter = 0;
119
122
 
120
 
    while( $condition->() ) {
121
 
        $self->iteration_callback->( $self )
 
123
    while ( $condition->() ) {
 
124
        $self->iteration_callback->($self)
122
125
            if $self->iteration_callback;
123
126
 
124
127
        $counter += $self->iteration_delay;
127
130
        sleep $self->iteration_delay;
128
131
    }
129
132
 
130
 
    $timeoutsub->() if $timeout && $timeoutsub
131
 
                    && $counter >= $timeout;
 
133
    $timeoutsub->()
 
134
        if $timeout
 
135
        && $timeoutsub
 
136
        && $counter >= $timeout;
132
137
    1;
133
138
}
134
139
 
136
141
    my $self = shift;
137
142
    my ( $sig, $warn ) = @_;
138
143
 
139
 
    if ( $warn ) {
140
 
        warn time . " - Killing: $_ - $sig\n"
141
 
            for grep { $_->pid } $self->children;
 
144
    if ($warn) {
 
145
        warn time . " - Killing: $_ - $sig\n" for grep { $_->pid } $self->children;
142
146
    }
143
147
 
144
 
    $_->kill( $sig ) for $self->children;
 
148
    $_->kill($sig) for $self->children;
145
149
}
146
150
 
147
151
sub DESTROY {
148
152
    my $self = shift;
149
 
    return unless $self->pid == $$
150
 
               && $self->children;
 
153
    return
 
154
        unless $self->pid == $$
 
155
        && $self->children;
151
156
    warn <<EOT;
152
157
Parallel::Runner object destroyed without first calling finish(), This will
153
158
terminate all your child processes. This either means you forgot to call
157
162
    return $self->finish()
158
163
        if $^O eq 'MSWin32';
159
164
 
160
 
    $self->finish( 1, sub {
161
 
        $self->killall(15, 1);
162
 
        $self->finish(4, sub {
163
 
            $self->killall(9, 1);
164
 
            $self->finish(10);
165
 
        });
166
 
    });
 
165
    $self->finish(
 
166
        1,
 
167
        sub {
 
168
            $self->killall( 15, 1 );
 
169
            $self->finish(
 
170
                4,
 
171
                sub {
 
172
                    $self->killall( 9, 1 );
 
173
                    $self->finish(10);
 
174
                }
 
175
            );
 
176
        }
 
177
    );
167
178
}
168
179
 
169
180
1;