line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# You may distribute under the terms of either the GNU General Public License |
2
|
|
|
|
|
|
|
# or the Artistic License (the same terms as Perl itself) |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# (C) Paul Evans, 2011-2021 -- leonerd@leonerd.org.uk |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
package IO::Async::Internals::FunctionWorker; |
7
|
|
|
|
|
|
|
|
8
|
10
|
|
|
10
|
|
78
|
use strict; |
|
10
|
|
|
|
|
20
|
|
|
10
|
|
|
|
|
327
|
|
9
|
10
|
|
|
10
|
|
51
|
use warnings; |
|
10
|
|
|
|
|
19
|
|
|
10
|
|
|
|
|
3714
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = '0.79'; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
# Called directly by IO::Async::Function::Worker when used in "code" mode, |
14
|
|
|
|
|
|
|
# or by run_worker() below. |
15
|
|
|
|
|
|
|
sub runloop |
16
|
|
|
|
|
|
|
{ |
17
|
1
|
|
|
1
|
0
|
5
|
my ( $code, $arg_channel, $ret_channel ) = @_; |
18
|
|
|
|
|
|
|
|
19
|
1
|
|
|
|
|
7
|
while( my $args = $arg_channel->recv ) { |
20
|
1
|
|
|
|
|
4
|
my @ret; |
21
|
1
|
|
|
|
|
2
|
my $ok = eval { @ret = $code->( @$args ); 1 }; |
|
1
|
|
|
|
|
19
|
|
|
0
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
|
23
|
0
|
0
|
|
|
|
|
if( $ok ) { |
|
|
0
|
|
|
|
|
|
24
|
0
|
|
|
|
|
|
$ret_channel->send( [ r => @ret ] ); |
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
elsif( ref $@ ) { |
27
|
|
|
|
|
|
|
# Presume that $@ is an ARRAYref of error results |
28
|
0
|
|
|
|
|
|
$ret_channel->send( [ e => @{ $@ } ] ); |
|
0
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
else { |
31
|
0
|
|
|
|
|
|
chomp( my $e = "$@" ); |
32
|
0
|
|
|
|
|
|
$ret_channel->send( [ e => $e, error => ] ); |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# Called by IO::Async::Function::Worker via the module+func arguments to its |
38
|
|
|
|
|
|
|
# IO::Async::Routine superclass when used in "module+func" mode |
39
|
|
|
|
|
|
|
sub run_worker |
40
|
|
|
|
|
|
|
{ |
41
|
0
|
|
|
0
|
0
|
|
my ( $arg_channel, $ret_channel ) = @_; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# Setup args |
44
|
0
|
|
|
|
|
|
my ( $module, $func, $init_func, @init_args ) = @{ $arg_channel->recv }; |
|
0
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
|
46
|
0
|
|
|
|
|
|
( my $file = "$module.pm" ) =~ s{::}{/}g; |
47
|
0
|
|
|
|
|
|
require $file; |
48
|
|
|
|
|
|
|
|
49
|
0
|
0
|
|
|
|
|
my $code = $module->can( $func ) or |
50
|
|
|
|
|
|
|
die "Module $module does not provide a function called $func\n"; |
51
|
|
|
|
|
|
|
|
52
|
0
|
0
|
|
|
|
|
if( defined $init_func ) { |
53
|
0
|
0
|
|
|
|
|
my $init = $module->can( $init_func ) or |
54
|
|
|
|
|
|
|
die "Module $module does not provide a function called $init_func\n"; |
55
|
|
|
|
|
|
|
|
56
|
0
|
|
|
|
|
|
$init->( @init_args ); |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
0
|
|
|
|
|
|
runloop( $code, $arg_channel, $ret_channel ); |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
0x55AA; |