Class-Publisher

 view release on metacpan or  search on metacpan

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

390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
name/object an additional parameter before the publisher item
 
=over 4
 
=item Class subscribers
 
Class subscribers are notified of events via the class's C<update()> method:
 
    package My::Subscriber;
 
    sub update {
        my ($class, $publisher, $event, @args) = @_;
        if ($event eq 'reload') {
            # ...
        } elsif ($event eq 'refresh') {
        }
        # ...
    }
 
Class notifications can be routed to other methods. See C<add_subscriber()>.
 
=item Object subscribers
 
Object subscribers are notified of events via the object's C<update()> method:
 
    package My::Subscriber;
 
    sub update {
        my ($self, $publisher, $event, @args) = @_;
        # ...
    }
 
Object notifications can be routed to other methods. See C<add_subscriber()>.
 
=item Subroutine subscribers
 
    package My::Subscriber;

t/Telephone.pm  view on Meta::CPAN

82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
    $self->{hangup} = $reason;
}
 
sub speak {
    my $self = shift;
    my ($words) = @_;
    TRACE($self->{number} . " saying '$words'");
    $self->notify_subscribers('communicate', words => $words);
}
 
sub update {
    my $self = shift;
    my ($other_party, $action, %params) = @_;
 
    if ($action eq 'communicate') {
        TRACE($self->{number} . " heard '$params{words}'");
        push @{$self->{listened_to}}, $params{words};
    }
}
 
sub TRACE {$DEBUG && print STDERR @_, $/ }

t/publisher.t  view on Meta::CPAN

22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
 
eval {Mini_Publisher->add_subscriber('test', [])};
ok($@, 'subscriber reference should be a blessed object');
 
eval {Mini_Publisher->add_subscriber('test', '')};
ok($@, 'subscriber cant be empty string');
 
# Test class subscription
sub catch_all        { $event{all}++ }
sub catch_specific   { $event{specific}++ }
sub update           { $event{update}++ }
sub catch_all_again  {}
sub catch_all_object {}
 
$rv = Mini_Publisher->add_subscriber(undef, \&catch_all);
is ($rv, 1, 'class->add_subscriber(undef, \&code)');
@s = Mini_Publisher->get_subscribers();
is_deeply (\@s, [\&catch_all], 'class->get_subscribers()');
 
$rv = Mini_Publisher->add_subscriber('*', \&catch_all_again);
is ($rv, 2, 'class->add_subscriber("*", \&code)');

t/publisher.t  view on Meta::CPAN

76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
$rv = Mini_Publisher->add_subscriber('specific_event', 'main');
is ($rv, 2, 'class->add_subscriber("specific_event", Class)');
 
Mini_Publisher->notify_subscribers('specific_event');
is_deeply(\%event, {all => 1, specific => 1, update => 1},
          'class->notify_subscribers(specific_event) notified "*" as well');
 
# Test object subscription
package Mini_Subscriber;
sub new { bless {}, shift };
sub update {shift->{update}++};
sub custom_update {shift->{custom_update}++};
package main;
 
my $subscriber = new Mini_Subscriber;
$rv = Mini_Publisher->add_subscriber('custom_event', $subscriber);
is ($rv, 1, 'class->add_subscriber("specific_event", object)');
 
Mini_Publisher->notify_subscribers('custom_event');
is($subscriber->{update}, 1, 'object subscriber notified via object->update');