| 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; |