Apache-Backend-POE

 view release on metacpan or  search on metacpan

examples/server.pl  view on Meta::CPAN

}


# -obj methods
#
sub alias {

}

sub add {
	my $self = shift;
	my $id = shift;
	$self->{map}->{$id} = 'new';
}

sub remove {
	my $self = shift;
	my $id = shift;
	$self->{map}->{$id} = 'decay';

	$self->{decay}->{$id} = {
		cmd => 'remove',
		delay => 10,
		alarm => $poe_kernel->call(matrix => delay => del => 11 => $id),
	};
	
	$poe_kernel->call(matrix => delay => decay => 1 => $id);
}

sub add_decay {
	my ($self,$id,$cmd,$delay) = @_;

	$self->{decay}->{$id} = {
		cmd => $cmd,
		delay => $delay,
	};
	
	$poe_kernel->call(matrix => delay => decay => 1 => $id);
}

sub act {
	my $self = shift;
	my $id = shift;
	
	$self->{map}->{$id} = shift;
	$self->add_decay($id => inactive => 10);
}

sub matrix {
	my $self = shift;

	my %out;
	foreach my $id (sort { $a <=> $b } keys %{$self->{map}}) {
		$out{$id} = "-";
		my $act;
		AGAIN:
		$act = $self->{map}->{$id};
#		print "\naction: $act for $id\n";
		if (defined($self->{decay}->{$id})) {
			my $d = $self->{decay}->{$id};
#			require Data::Dumper;
#			print "\n".Data::Dumper->Dump([$d]);
			if ($d->{delay} > 0) {
				if ($act eq 'delay') {
					if (exists($decay{$d->{delay}})) {
						$out{$id} = $decay{$d->{delay}};
					} else {
						$out{$id} = "[$d->{delay}]";
					}
				}
			} else {
				if ($d->{cmd} eq 'remove') {
					delete $self->{decay}->{$id};
					delete $self->{map}->{$id};
				} elsif ($self->{map}->{$id} ne $d->{cmd}) {
					$self->{map}->{$id} = $d->{cmd};
#					print "$id is now $d->{cmd}\n";
					goto AGAIN;
				}
			}
		}
		if ($self->{actions} && ref($self->{actions}) eq 'HASH') {
			#$out{$id} = (exists($self->{actions}->{$act})) ? $self->{actions}->{$act} : $self->{actions}->{unknown};
			$out{$id} = (exists($self->{actions}->{$act})) ? $self->{actions}->{$act} : $self->{actions}->{disconnected};
			#foreach my $a (keys %{$self->{actions}}) {
			#	next unless ($act eq $a);
			#	$out{$id} = $self->{actions}->{$a};
			#}
		}
		if ($act eq 'new') {
			$out{$id} = $self->{actions}->{$act};
		}
	}
	return join('',(map { defined $out{$_} ? $out{$_} : "" } (sort { $a <=> $b } keys %{$self->{map}}) ))."|";
}



( run in 1.110 second using v1.01-cache-2.11-cpan-39bf76dae61 )