view release on metacpan or  search on metacpan

lib/IO/Lambda.pm  view on Meta::CPAN

sub is_waiting  { not($_[0]->{stopped}) and @{$_[0]->{in}} }
sub is_passive  { not($_[0]->{stopped}) and not(@{$_[0]->{in}}) }
sub is_active   { $_[0]->{stopped} or @{$_[0]->{in}} }

# reset the state machine
sub reset
{
	my $self = shift;

	$self-> cancel_all_events;
	@{$self-> {last}} = ();
	delete $self-> {stopped};
	warn _d( $self, 'reset') if $DEBUG_LAMBDA;
}

# start the state machine
sub start
{
	my $self = shift;

	confess "can't start active lambda, call reset() first" if $self-> is_active;

	warn _d( $self, 'started') if $DEBUG_LAMBDA;
	@{$self->{last}} = $self-> {start}-> ($self, @{$self->{last}})
		if $self-> {start};
	warn $self-> _msg('initial') if $DEBUG_LAMBDA;

	unless ( @{$self->{in}}) {
		warn _d( $self, 'stopped') if $DEBUG_LAMBDA;
		$self-> {stopped} = 1;
	}
}

# peek into the current state
sub peek { wantarray ? @{$_[0]->{last}} : $_[0]-> {last}-> [0] }

# pass initial parameters to lambda
sub call 
{
	my $self = shift;

	confess "can't call active lambda" if $self-> is_active;

	@{$self-> {last}} = @_;
	$self;
}

# abandon all states and stop with constant message
sub terminate
{
	my ( $self, @error) = @_;

	$self-> {last} = \@error;
	$self-> cancel_all_events;
	warn $self-> _msg('terminate') if $DEBUG_LAMBDA;
}

# propagate event destruction on all levels
sub destroy
{
	shift-> cancel_all_events( cascade => 1);
}

# synchronisation

# drives objects dependant on the other objects until all of them
# are stopped
my ($drive_reentrancy_refresh, $drive_reentrancy_depth) = (0,0);
sub drive
{
	$drive_reentrancy_depth++;

	my $changed = 1;
	my $executed = 0;
	warn "IO::Lambda::drive --------\n" if $DEBUG_LAMBDA;
	eval {
		while ( $changed) {
			$changed = 0;

			# dispatch
			for my $rec ( map { @$_ } values %EVENTS) {
				next unless $rec->[WATCH_LAMBDA]-> {stopped};
				$changed = 1;
				$executed++;
				$rec->[WATCH_OBJ]-> lambda_handler( $rec);
				$drive_reentrancy_refresh = 0, last if $drive_reentrancy_refresh;
			}
			warn "IO::Lambda::drive .........\n" if $DEBUG_LAMBDA and $changed;
		}
	};
	die $@ if $@;
	warn "IO::Lambda::drive +++++++++\n" if $DEBUG_LAMBDA;

	$drive_reentrancy_depth--;
	$drive_reentrancy_refresh++ if $executed && $drive_reentrancy_depth;

	return $executed;
}

# do one quant
sub yield
{
	my $nonblocking = shift;
	my $more_events = 0;

	# custom loops must not wait
	for ( @LOOPS) {
		next if $_-> empty;
		$_-> yield;
		$more_events = 1;
	}

	if ( drive) {
		# some callbacks we called, don't let them wait in sleep
		return 1;
	}

	# main loop waits, if anything
	unless ( $LOOP-> empty) {
		$LOOP-> yield( $nonblocking);
		$more_events = 1;