view release on metacpan or  search on metacpan

lib/Class/Publisher.pm  view on Meta::CPAN

# $Id: Publisher.pm,v 1.3 2005/03/25 13:20:21 simonflack Exp $
package Class::Publisher;
use strict;
use Carp;
use Class::ISA;
use Scalar::Util qw/blessed reftype weaken/;
use vars '$VERSION';

$VERSION = '0.2';
my (%S, %P) = ();


# Add one or more subscribers (class name, object or subroutine) to a
# subscribed item (class or object). Return new number of subscribers.
sub add_subscriber {
    my ($item, $event, $subscriber, $use_method) = @_;
    $event = '*' unless defined $event && length $event;
    croak "Invalid subscriber - $subscriber, expected a coderef, object or class name"
        unless _valid_subscriber($subscriber);

    my $subscriber_list = $S {$item} {$event} ||= {};
    weaken($subscriber) if blessed($subscriber);
    my $new_subscriber;
    if ($use_method && (!ref $subscriber || blessed($subscriber))) {
        $new_subscriber = [ $subscriber, $use_method ];
    } else {
        $new_subscriber = $subscriber;
    }

    TRACEF("Adding subscriber [%s] of '%s' on [%s]",
           $subscriber, _event_name($event), _item_name($item));
    $subscriber_list->{$subscriber} = $new_subscriber;

    return scalar keys %$subscriber_list;
}


# Remove one or more subscribers from a subscribed item. Return new
# number of subscribers.
# TODO: Will this work with subroutines?
sub delete_subscriber {
    my ($item, $event, $subscriber) = @_;
    return 0 unless ref $S { $item };
    $event = '*' unless defined $event && length $event;

    if ($subscriber) {
        my @events;
        if (defined $event && length $event) {
            @events = ($event);
        } else {
            @events = _get_registered_events($item);
        }

        foreach my $subscribed_event (@events) {
            TRACEF("Removing subscriber [%s] of '%s' on [%s]",
                   $subscriber,
                   _event_name($subscribed_event),
                   _item_name($item));

            my $removed = delete $S {$item} {$subscribed_event} {$subscriber};
            TRACEF("Found subscriber [%s]; removing", $subscriber);
        }
    }
    return defined wantarray ? 0 + $item -> get_subscribers($event) : undef;
}


# Remove all subscribers from a subscribed item. Return number of
# subscribers removed.
sub delete_all_subscribers {
    my ($item) = @_;
    TRACEF("Removing all subscribers from [%s]", _item_name($item));
    my $rv = defined wantarray ? 0 + $item -> get_subscribers : undef;
    return 0 unless ref $S {$item};
    $S {$item} = {};
    return $rv;
}


# Tell all subscribers that a event-change has occurred. No return
# value.
sub notify_subscribers {