view release on metacpan or  search on metacpan

lib/AnyEvent/Worker.pm  view on Meta::CPAN

		#my $murder_timer = AnyEvent->timer (
		#	after => 2,
		#	cb    => sub {
		#		kill 9, $child_pid
		#			and delete $TERM{$child_pid};
		#	},
		#);
		
		# reap process
		#print STDERR "start reaper $child_pid\n";
		$KIDW{$child_pid} = AnyEvent->child (
			pid => $child_pid,
			cb  => sub {
				# just hold on to this so it won't go away
				#print STDERR "reaped $child_pid\n";
				delete $TERM{$child_pid};
				delete $KIDW{$child_pid};
				# cancel SIGKILL
				#undef $murder_timer;
			},
		);
		
		close $self->{fh};
	}
}
sub END {
	my $GD = 0;
	{
		local $SIG{__WARN__} = sub { $GD = 1 if $_[0] =~ / during global destruction\.\s*$/ };
		warn 'test';
	}
	#print STDERR "END $!/$? GD=$GD\n";
	for (keys %TERM) {
		delete $KIDW{$_};
		#print STDERR "END kill $_\n";
		kill 0 => $_ and do {
			kill KILL => $_ or warn "kill $_ failed: $!";
			#print STDERR "END waitpid $_\n";
			my $wp = waitpid $_,0;
			#print STDERR "END waitpid $_ = $wp\n";
		};
		#print STDERR "END $_ ($!/$?/${^CHILD_ERROR_NATIVE})\n";
	}
	undef $!;undef $?;
}

sub DESTROY {
	shift->kill_child;
}

sub _error {
	my ($self, $error, $filename, $line, $fatal) = @_;
	my $caller = '';
	my @caller = ($filename,$line);
	if ($fatal) {
		delete $self->{tw};
		delete $self->{rw};
		delete $self->{ww};
		delete $self->{fh};
		
		# for fatal errors call all enqueued callbacks with error
		while (my $req = shift @{$self->{queue}}) {
			@caller = ($req->[1],$req->[2]) unless $caller;
			$caller ||= " after $req->[1] line $req->[2],";
			local $@ = "$error at $req->[1] line $req->[2].\n";
			$req->[0]->($self);
		}
		$self->kill_child;
	}
	
	local $@ = $error;
	
	if ($self->{on_error}) {
		$self->{on_error}($self, $error, $fatal, @caller);
	}
	else {
		my $e = "$error$caller";
		if ($fatal) {
			die "$e at $filename, line $line\n";
		} else {
			warn "$e at $filename, line $line\n";
		}
	}
}

=item $worker->on_error ($cb->($worker, $filename, $line, $fatal))

Sets (or clears, with C<undef>) the C<on_error> handler.

=cut

sub on_error {
	$_[0]{on_error} = $_[1];
}

=item $worker->timeout ($seconds)

Sets (or clears, with C<undef>) the database timeout. Useful to extend the
timeout when you are about to make a really long query.

=cut

sub timeout {
	my ($self, $timeout) = @_;
	
	$self->{timeout} = $timeout;
	
	# reschedule timer if one was running
	$self->{tw_cb}->();
}

=item $worker->do ( @args, $cb->( $worker, @response ) )

Executes worker code and execure the callback, when response is ready

=cut

sub do {
	my $self = shift;
	my $cb = pop;
	my ($filename,$line) = (caller)[1,2];