/usr/local/CPAN/Net-PSYC/Net/PSYC/Hook.pm

• package Net::PSYC::Hook
  • trigger
  • hook
  • rmhook
• EOF

package Net::PSYC::Hook;

sub trigger {
    my $self = shift;
    my $hook = shift;

    return 1 if (!exists $self->{'hooks'}->{$hook});
    foreach (@{$self->{'hooks'}->{$hook}}) {
	unless ($_->[0]->(@_)) {
	    return 0;
	}
    }
    return 1;
}

sub hook {
    my $self = shift;
    my $hook = shift;
    my $obj = shift;
    my $prio = shift;
    
    unless (ref $obj) {
	$obj = eval "$hook->new(\$self);";
	return 0 if (!ref $obj);
    }
    return 0 unless ($obj->can($hook));
    unless (exists $self->{'hooks'}->{$hook}) {
	$self->{'hooks'}->{$hook} = [];
    }
    my $sub = eval "sub { \$obj->$hook(\@_) }";
    return 0 unless $sub;

    if ($prio > 0) {
	unshift(@{$self->{'hooks'}->{$hook}}, [$sub, $obj]);
    } else {
	push(@{$self->{'hooks'}->{$hook}}, [$sub, $obj] );
    }
    return 1;
}

sub rmhook {
    my $self = shift;
    my $hook = shift;
    my $obj = shift;
    my $i = 0;
    return 1 unless (exists $self->{'hooks'}->{$hook});

    foreach (@{$self->{'hooks'}->{$hook}}) {
	if ($_->[1] eq $obj) {
	    splice(@{$self->{'hooks'}->{$hook}}, $i, 1);
	    return 1;
	}
	$i++;
    }
    return 0;
}


1;