This file is indexed.

/usr/share/perl5/IO/Async/DetachedCode.pm is in libio-async-perl 0.51-4.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2007-2011 -- leonerd@leonerd.org.uk

package IO::Async::DetachedCode;

use strict;
use warnings;

our $VERSION = '0.51';

use Carp;

use IO::Async::Function;

=head1 NAME

C<IO::Async::DetachedCode> - execute code asynchronously in child processes

=head1 SYNOPSIS

This object is used indirectly via the C<IO::Async::Loop>'s C<detach_code>
method.

 use IO::Async::Loop;
 my $loop = IO::Async::Loop->new;

 my $code = $loop->detach_code(
    code => sub {
       my ( $number ) = @_;
       return is_prime( $number );
    }
 );

 $code->call(
    args => [ 123454321 ],
    on_return => sub {
       my $isprime = shift;
       print "123454321 " . ( $isprime ? "is" : "is not" ) . " a prime number\n";
    },
    on_error => sub {
       print STDERR "Cannot determine if it's prime - $_[0]\n";
    },
 );

 $loop->run;

=head1 DESCRIPTION

This object class provides a legacy compatibility layer for existing code
that tries to construct such an object. It should not be used for new code;
see instead the L<IO::Async::Function> object, for which this is now a
wrapper.

=cut

=head1 CONSTRUCTOR

=cut

=head2 $code = $loop->detach_code( %params )

This function returns a new instance of a C<IO::Async::DetachedCode> object.
The C<%params> hash takes the following keys:

=over 8

=item code => CODE

A block of code to call in the child process. 

=item stream

=item marshaller

These arguments are no longer used; any values passed will be ignored.

=item workers => INT

Optional integer, specifies the number of parallel workers to create.

If not supplied, 1 is used.

=item exit_on_die => BOOL

=item setup => ARRAY

Passed through to the underlying C<IO::Async::Function> object.

=back

=cut

sub new
{
   my $class = shift;
   my ( %params ) = @_;

   my $loop = delete $params{loop} or croak "Expected a 'loop'";

   # No-longer supported args
   delete $params{marshaller};
   delete $params{stream};

   my $workers = delete $params{workers} || 1;

   my $function = IO::Async::Function->new(
      min_workers => $workers,
      max_workers => $workers,
      %params,
   );

   $loop->add( $function );

   return bless {
      function => $function,
   }, $class;
}

sub DESTROY
{
   my $self = shift;

   my $function = $self->{function};
   $function->loop->remove( $function );
}

=head1 METHODS

=cut

=head2 $code->call( %params )

Calls one invocation of the contained function code block. See the C<call>
method on C<IO::Async::Function> for more detail.

=cut

sub call
{
   my $self = shift;
   $self->{function}->call( @_ );
}

=head2 $code->shutdown

This method requests that the detached worker processes stop running.

=cut

sub shutdown
{
   my $self = shift;
   $self->{function}->stop;
}

=head2 $n_workers = $code->workers

This method in scalar context returns the number of workers currently running.

=head2 @worker_pids = $code->workers

This method in list context returns a list of the PID numbers of all the
currently running worker processes.

=cut

sub workers
{
   my $self = shift;

   # Lots of cheating here
   # Works in scalar or list
   return keys %{ $self->{function}{workers} };
}

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

=cut

0x55AA;