| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | # Copyright (c) 2011-17, Mitchell Cooper | 
| 2 |  |  |  |  |  |  | # | 
| 3 |  |  |  |  |  |  | # Evented::Object: a simple yet featureful base class event framework. | 
| 4 |  |  |  |  |  |  | # | 
| 5 |  |  |  |  |  |  | # Evented::Object is based on the libuic UIC::Evented::Object: | 
| 6 |  |  |  |  |  |  | # ... which is based on Evented::Object from foxy-java IRC Bot, | 
| 7 |  |  |  |  |  |  | # ... which is based on Evented::Object from Arinity IRC Services, | 
| 8 |  |  |  |  |  |  | # ... which is based on Evented::Object from ntirc IRC Client, | 
| 9 |  |  |  |  |  |  | # ... which is based on IRC::Evented::Object from libirc IRC Library. | 
| 10 |  |  |  |  |  |  | # | 
| 11 |  |  |  |  |  |  | # Evented::Object and its very detailed documentation can be found | 
| 12 |  |  |  |  |  |  | # in their latest versions at https://github.com/cooper/evented-object. | 
| 13 |  |  |  |  |  |  | # | 
| 14 |  |  |  |  |  |  | package Evented::Object; | 
| 15 |  |  |  |  |  |  |  | 
| 16 | 13 |  |  | 13 |  | 841465 | use warnings; | 
|  | 13 |  |  |  |  | 139 |  | 
|  | 13 |  |  |  |  | 443 |  | 
| 17 | 13 |  |  | 13 |  | 70 | use strict; | 
|  | 13 |  |  |  |  | 24 |  | 
|  | 13 |  |  |  |  | 249 |  | 
| 18 | 13 |  |  | 13 |  | 8185 | use utf8; | 
|  | 13 |  |  |  |  | 191 |  | 
|  | 13 |  |  |  |  | 69 |  | 
| 19 | 13 |  |  | 13 |  | 663 | use 5.010; | 
|  | 13 |  |  |  |  | 44 |  | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | # these must be set before loading EventFire. | 
| 22 |  |  |  |  |  |  | our ($events, $props, %monitors); | 
| 23 |  |  |  |  |  |  | BEGIN { | 
| 24 | 13 |  |  | 13 |  | 39 | $events = 'eventedObject.events'; | 
| 25 | 13 |  |  |  |  | 305 | $props  = 'eventedObject.props'; | 
| 26 |  |  |  |  |  |  | } | 
| 27 |  |  |  |  |  |  |  | 
| 28 | 13 |  |  | 13 |  | 84 | use Scalar::Util qw(weaken blessed); | 
|  | 13 |  |  |  |  | 49 |  | 
|  | 13 |  |  |  |  | 728 |  | 
| 29 | 13 |  |  | 13 |  | 6018 | use Evented::Object::EventFire; | 
|  | 13 |  |  |  |  | 31 |  | 
|  | 13 |  |  |  |  | 400 |  | 
| 30 | 13 |  |  | 13 |  | 6077 | use Evented::Object::Collection; | 
|  | 13 |  |  |  |  | 45 |  | 
|  | 13 |  |  |  |  | 22430 |  | 
| 31 |  |  |  |  |  |  |  | 
| 32 |  |  |  |  |  |  | our $VERSION = '5.67'; | 
| 33 |  |  |  |  |  |  |  | 
| 34 |  |  |  |  |  |  | # creates a new evented object. | 
| 35 |  |  |  |  |  |  | sub new { | 
| 36 | 15 |  |  | 15 | 1 | 1164 | my ($class, %opts) = @_; | 
| 37 | 15 |  |  |  |  | 74 | bless \%opts, $class; | 
| 38 |  |  |  |  |  |  | } | 
| 39 |  |  |  |  |  |  |  | 
| 40 |  |  |  |  |  |  | ############################# | 
| 41 |  |  |  |  |  |  | ### REGISTERING CALLBACKS ### | 
| 42 |  |  |  |  |  |  | ############################# | 
| 43 |  |  |  |  |  |  |  | 
| 44 |  |  |  |  |  |  | # ->register_callback() | 
| 45 |  |  |  |  |  |  | # | 
| 46 |  |  |  |  |  |  | # aliases: ->register_event(), ->on() | 
| 47 |  |  |  |  |  |  | # attaches an event callback. | 
| 48 |  |  |  |  |  |  | # | 
| 49 |  |  |  |  |  |  | # $eo->register_callback(myEvent => sub { | 
| 50 |  |  |  |  |  |  | #     ... | 
| 51 |  |  |  |  |  |  | # }, 'some.callback.name', priority => 200); | 
| 52 |  |  |  |  |  |  | # | 
| 53 |  |  |  |  |  |  | sub register_callback { | 
| 54 | 35 |  |  | 35 | 1 | 345 | my ($eo, $event_name, $code, @opts_) = @_; | 
| 55 |  |  |  |  |  |  |  | 
| 56 |  |  |  |  |  |  | # if there is an odd number of options, the first is the callback name. | 
| 57 |  |  |  |  |  |  | # this also implies with_eo. | 
| 58 | 35 |  |  |  |  | 53 | my %opts; | 
| 59 | 35 | 50 |  |  |  | 113 | if (@opts_ % 2) { | 
| 60 | 0 |  |  |  |  | 0 | %opts = ( | 
| 61 |  |  |  |  |  |  | name    => shift @opts_, | 
| 62 |  |  |  |  |  |  | with_eo => 1, | 
| 63 |  |  |  |  |  |  | @opts_ | 
| 64 |  |  |  |  |  |  | ); | 
| 65 |  |  |  |  |  |  | } | 
| 66 |  |  |  |  |  |  | else { | 
| 67 | 35 |  |  |  |  | 89 | %opts = @opts_; | 
| 68 |  |  |  |  |  |  | } | 
| 69 |  |  |  |  |  |  |  | 
| 70 |  |  |  |  |  |  | # no name was provided, so we shall construct one using pure hackery. | 
| 71 |  |  |  |  |  |  | # this is one of the most criminal things I've ever done. | 
| 72 | 35 |  |  |  |  | 115 | my @caller = caller; | 
| 73 | 35 | 100 |  |  |  | 111 | if (!defined $opts{name}) { | 
| 74 | 21 |  |  |  |  | 38 | state $c    = -1; $c++; | 
|  | 21 |  |  |  |  | 35 |  | 
| 75 | 21 |  |  |  |  | 85 | $opts{name} = "$event_name:$caller[0]($caller[2],$c)"; | 
| 76 |  |  |  |  |  |  | } | 
| 77 |  |  |  |  |  |  |  | 
| 78 |  |  |  |  |  |  | # determine the event store. | 
| 79 | 35 |  |  |  |  | 86 | my $event_store = _event_store($eo); | 
| 80 |  |  |  |  |  |  |  | 
| 81 |  |  |  |  |  |  | # before/after a callback. | 
| 82 | 35 |  | 100 |  |  | 134 | my $priority = delete $opts{priority} || 0; | 
| 83 | 35 | 100 | 100 |  |  | 158 | if (defined $opts{before} or defined $opts{after}) { | 
| 84 | 7 |  |  |  |  | 10 | $priority = 'nan'; | 
| 85 |  |  |  |  |  |  | # nan priority indicates it should be determined at a later time. | 
| 86 |  |  |  |  |  |  | } | 
| 87 |  |  |  |  |  |  |  | 
| 88 |  |  |  |  |  |  | # add the callback. | 
| 89 | 35 |  | 100 |  |  | 183 | my $callbacks = $event_store->{$event_name}{$priority} ||= []; | 
| 90 | 35 |  |  |  |  | 171 | push @$callbacks, my $cb = { | 
| 91 |  |  |  |  |  |  | %opts, | 
| 92 |  |  |  |  |  |  | code   => $code, | 
| 93 |  |  |  |  |  |  | caller => \@caller | 
| 94 |  |  |  |  |  |  | }; | 
| 95 |  |  |  |  |  |  |  | 
| 96 |  |  |  |  |  |  | # tell class monitor. | 
| 97 |  |  |  |  |  |  | _monitor_fire( | 
| 98 | 35 |  | 33 |  |  | 189 | $opts{_caller} // $caller[0], | 
| 99 |  |  |  |  |  |  | register_callback => $eo, $event_name, $cb | 
| 100 |  |  |  |  |  |  | ); | 
| 101 |  |  |  |  |  |  |  | 
| 102 | 35 |  |  |  |  | 110 | return $cb; | 
| 103 |  |  |  |  |  |  | } | 
| 104 |  |  |  |  |  |  |  | 
| 105 |  |  |  |  |  |  | # ->register_callbacks() | 
| 106 |  |  |  |  |  |  | # | 
| 107 |  |  |  |  |  |  | # attaches several event callbacks at once. | 
| 108 |  |  |  |  |  |  | # | 
| 109 |  |  |  |  |  |  | sub register_callbacks { | 
| 110 | 0 |  |  | 0 | 1 | 0 | my $eo = shift; | 
| 111 | 0 |  |  |  |  | 0 | return map { $eo->register_callback(%$_, _caller => caller) } @_; | 
|  | 0 |  |  |  |  | 0 |  | 
| 112 |  |  |  |  |  |  | } | 
| 113 |  |  |  |  |  |  |  | 
| 114 |  |  |  |  |  |  | ########################## | 
| 115 |  |  |  |  |  |  | ### DELETING CALLBACKS ### | 
| 116 |  |  |  |  |  |  | ########################## | 
| 117 |  |  |  |  |  |  |  | 
| 118 |  |  |  |  |  |  | # ->delete_callback(event_name => 'callback.name') | 
| 119 |  |  |  |  |  |  | # ->delete_event('event_name') | 
| 120 |  |  |  |  |  |  | # | 
| 121 |  |  |  |  |  |  | # deletes an event callback or all callbacks of an event. | 
| 122 |  |  |  |  |  |  | # returns a true value if any events were deleted, false otherwise. | 
| 123 |  |  |  |  |  |  | # more specifically, it returns the number of callbacks deleted. | 
| 124 |  |  |  |  |  |  | # | 
| 125 |  |  |  |  |  |  | sub delete_callback { | 
| 126 | 16 |  |  | 16 | 1 | 61 | my ($eo, $event_name, $name, $caller) = @_; | 
| 127 | 16 | 50 | 33 |  |  | 113 | my @caller      = $caller && ref $caller eq 'ARRAY' ? @$caller : caller; | 
| 128 | 16 |  |  |  |  | 37 | my $amount      = 0; | 
| 129 | 16 |  |  |  |  | 36 | my $event_store = _event_store($eo); | 
| 130 |  |  |  |  |  |  |  | 
| 131 |  |  |  |  |  |  | # event does not have any callbacks. | 
| 132 | 16 | 50 |  |  |  | 72 | return 0 unless $event_store->{$event_name}; | 
| 133 |  |  |  |  |  |  |  | 
| 134 |  |  |  |  |  |  | # if no callback is specified, delete all events of this type. | 
| 135 | 16 | 100 |  |  |  | 67 | if (!$name) { | 
| 136 | 15 |  |  |  |  | 35 | $amount = scalar keys %{ $event_store->{$event_name} }; | 
|  | 15 |  |  |  |  | 44 |  | 
| 137 | 15 |  |  |  |  | 126 | delete $event_store->{$event_name}; | 
| 138 | 15 |  |  |  |  | 57 | _monitor_fire($caller[0], delete_event => $eo, $event_name); | 
| 139 | 15 |  |  |  |  | 36 | return $amount; | 
| 140 |  |  |  |  |  |  | } | 
| 141 |  |  |  |  |  |  |  | 
| 142 |  |  |  |  |  |  | # iterate through callbacks and delete matches. | 
| 143 | 1 |  |  |  |  | 3 | PRIORITY: foreach my $priority (keys %{ $event_store->{$event_name} }) { | 
|  | 1 |  |  |  |  | 4 |  | 
| 144 | 2 |  |  |  |  | 5 | my $callbacks = $event_store->{$event_name}{$priority}; | 
| 145 | 2 |  |  |  |  | 3 | my @goodbacks; | 
| 146 |  |  |  |  |  |  |  | 
| 147 | 2 |  |  |  |  | 3 | CALLBACK: foreach my $cb (@$callbacks) { | 
| 148 |  |  |  |  |  |  |  | 
| 149 |  |  |  |  |  |  | # don't want this one. | 
| 150 | 2 | 100 | 66 |  |  | 26 | if (ref $cb ne 'HASH' || $cb->{name} eq $name) { | 
| 151 | 1 |  |  |  |  | 2 | $amount++; | 
| 152 | 1 |  |  |  |  | 4 | next CALLBACK; | 
| 153 |  |  |  |  |  |  | } | 
| 154 |  |  |  |  |  |  |  | 
| 155 | 1 |  |  |  |  | 3 | push @goodbacks, $cb; | 
| 156 |  |  |  |  |  |  | } | 
| 157 |  |  |  |  |  |  |  | 
| 158 |  |  |  |  |  |  | # no callbacks left in this priority. | 
| 159 | 2 | 100 |  |  |  | 4 | if (!scalar @goodbacks) { | 
| 160 | 1 |  |  |  |  | 3 | delete $event_store->{$event_name}{$priority}; | 
| 161 | 1 |  |  |  |  | 6 | next PRIORITY; | 
| 162 |  |  |  |  |  |  | } | 
| 163 |  |  |  |  |  |  |  | 
| 164 |  |  |  |  |  |  | # keep these callbacks. | 
| 165 | 1 |  |  |  |  | 4 | @$callbacks = @goodbacks; | 
| 166 |  |  |  |  |  |  |  | 
| 167 |  |  |  |  |  |  | } | 
| 168 |  |  |  |  |  |  |  | 
| 169 | 1 |  |  |  |  | 4 | return $amount; | 
| 170 |  |  |  |  |  |  | } | 
| 171 |  |  |  |  |  |  |  | 
| 172 |  |  |  |  |  |  | # ->delete_all_events() | 
| 173 |  |  |  |  |  |  | # | 
| 174 |  |  |  |  |  |  | # deletes all the callbacks of EVERY event. | 
| 175 |  |  |  |  |  |  | # useful when you're done with an object to ensure any possible self-referencing | 
| 176 |  |  |  |  |  |  | # callbacks are properly destroyed for garbage collection to work. | 
| 177 |  |  |  |  |  |  | # | 
| 178 |  |  |  |  |  |  | sub delete_all_events { | 
| 179 | 15 |  |  | 15 | 1 | 44 | my ($eo, $amount) = (shift, 0); | 
| 180 | 15 | 50 |  |  |  | 39 | my $event_store   = _event_store($eo) or return; | 
| 181 | 15 | 50 |  |  |  | 75 | ref $event_store eq 'HASH'            or return; | 
| 182 |  |  |  |  |  |  |  | 
| 183 |  |  |  |  |  |  | # delete one-by-one. | 
| 184 |  |  |  |  |  |  | # we can't simply set an empty list because monitor events must be fired. | 
| 185 | 15 |  |  |  |  | 65 | foreach my $event_name (keys %$event_store) { | 
| 186 | 14 |  |  |  |  | 64 | $eo->delete_event($event_name); | 
| 187 | 14 |  |  |  |  | 35 | $amount++; | 
| 188 |  |  |  |  |  |  | } | 
| 189 |  |  |  |  |  |  |  | 
| 190 |  |  |  |  |  |  | # just clear it to be safe. | 
| 191 | 15 |  |  |  |  | 82 | %$event_store = (); | 
| 192 | 15 |  |  |  |  | 44 | delete $eo->{$events}; | 
| 193 | 15 |  |  |  |  | 35 | delete $eo->{$props}; | 
| 194 |  |  |  |  |  |  |  | 
| 195 | 15 |  |  |  |  | 1625 | return $amount; | 
| 196 |  |  |  |  |  |  | } | 
| 197 |  |  |  |  |  |  |  | 
| 198 |  |  |  |  |  |  | ######################## | 
| 199 |  |  |  |  |  |  | ### PREPARING EVENTS ### | 
| 200 |  |  |  |  |  |  | ######################## | 
| 201 |  |  |  |  |  |  |  | 
| 202 |  |  |  |  |  |  | # ->prepare() | 
| 203 |  |  |  |  |  |  | # | 
| 204 |  |  |  |  |  |  | # automatically guesses whether to use | 
| 205 |  |  |  |  |  |  | # ->prepare_event() or ->prepare_together(). | 
| 206 |  |  |  |  |  |  | # | 
| 207 |  |  |  |  |  |  | sub prepare { | 
| 208 | 2 |  |  | 2 | 1 | 9 | my ($eo_maybe, $eo) = $_[0]; | 
| 209 | 2 | 50 | 33 |  |  | 17 | $eo = shift if blessed $eo_maybe && $eo_maybe->isa(__PACKAGE__); | 
| 210 | 2 | 50 | 33 |  |  | 8 | if (ref $_[0] && ref $_[0] eq 'ARRAY') { | 
| 211 | 0 |  |  |  |  | 0 | return $eo->prepare_together(@_); | 
| 212 |  |  |  |  |  |  | } | 
| 213 | 2 |  |  |  |  | 7 | return $eo->prepare_event(@_); | 
| 214 |  |  |  |  |  |  | } | 
| 215 |  |  |  |  |  |  |  | 
| 216 |  |  |  |  |  |  | # ->prepare_event() | 
| 217 |  |  |  |  |  |  | # | 
| 218 |  |  |  |  |  |  | # prepares a single event fire by creating a callback collection. | 
| 219 |  |  |  |  |  |  | # returns the collection. | 
| 220 |  |  |  |  |  |  | # | 
| 221 |  |  |  |  |  |  | sub prepare_event { | 
| 222 | 13 |  |  | 13 | 1 | 46 | my ($eo, $event_name, @args) = @_; | 
| 223 | 13 |  |  |  |  | 55 | return $eo->prepare_together([ $event_name, @args ]); | 
| 224 |  |  |  |  |  |  | } | 
| 225 |  |  |  |  |  |  |  | 
| 226 |  |  |  |  |  |  | # ->prepare_together() | 
| 227 |  |  |  |  |  |  | # | 
| 228 |  |  |  |  |  |  | # prepares several events fire by creating a callback collection. | 
| 229 |  |  |  |  |  |  | # returns the collection. | 
| 230 |  |  |  |  |  |  | # | 
| 231 |  |  |  |  |  |  | sub prepare_together { | 
| 232 | 13 |  |  | 13 | 1 | 23 | my $obj; | 
| 233 | 13 |  |  |  |  | 91 | my $collection = Evented::Object::Collection->new; | 
| 234 | 13 |  |  |  |  | 47 | foreach my $set (@_) { | 
| 235 | 26 |  |  |  |  | 46 | my $eo; | 
| 236 |  |  |  |  |  |  |  | 
| 237 |  |  |  |  |  |  | # called with evented object. | 
| 238 | 26 | 100 |  |  |  | 111 | if (blessed $set) { | 
| 239 | 13 | 50 |  |  |  | 133 | $set->isa(__PACKAGE__) or return; | 
| 240 | 13 |  |  |  |  | 50 | $obj = $set; | 
| 241 | 13 |  |  |  |  | 68 | next; | 
| 242 |  |  |  |  |  |  | } | 
| 243 |  |  |  |  |  |  |  | 
| 244 |  |  |  |  |  |  | # okay, it's an array ref of | 
| 245 |  |  |  |  |  |  | # [ $eo (optional), $event_name => @args ] | 
| 246 | 13 | 50 |  |  |  | 73 | ref $set eq 'ARRAY' or next; | 
| 247 | 13 |  |  |  |  | 38 | my ($eo_maybe, $event_name, @args); | 
| 248 |  |  |  |  |  |  |  | 
| 249 |  |  |  |  |  |  | # was an object specified? | 
| 250 | 13 |  |  |  |  | 102 | $eo_maybe = shift @$set; | 
| 251 | 13 | 50 | 33 |  |  | 98 | if (blessed $eo_maybe && $eo_maybe->isa(__PACKAGE__)) { | 
| 252 | 0 |  |  |  |  | 0 | $eo = $eo_maybe; | 
| 253 | 0 |  |  |  |  | 0 | ($event_name, @args) = @$set; | 
| 254 |  |  |  |  |  |  | } | 
| 255 |  |  |  |  |  |  |  | 
| 256 |  |  |  |  |  |  | # no object; fall back to $obj. | 
| 257 |  |  |  |  |  |  | else { | 
| 258 | 13 | 50 |  |  |  | 58 | $eo = $obj or return; | 
| 259 | 13 |  |  |  |  | 46 | ($event_name, @args) = ($eo_maybe, @$set); | 
| 260 |  |  |  |  |  |  | } | 
| 261 |  |  |  |  |  |  |  | 
| 262 |  |  |  |  |  |  | # add to the collection. | 
| 263 | 13 |  |  |  |  | 50 | my ($callbacks, $names) = | 
| 264 |  |  |  |  |  |  | _get_callbacks($eo, $event_name, @args); | 
| 265 | 13 |  |  |  |  | 75 | $collection->push_callbacks($callbacks, $names); | 
| 266 |  |  |  |  |  |  |  | 
| 267 |  |  |  |  |  |  | } | 
| 268 |  |  |  |  |  |  |  | 
| 269 | 13 |  |  |  |  | 108 | return $collection; | 
| 270 |  |  |  |  |  |  | } | 
| 271 |  |  |  |  |  |  |  | 
| 272 |  |  |  |  |  |  | ##################### | 
| 273 |  |  |  |  |  |  | ### FIRING EVENTS ### | 
| 274 |  |  |  |  |  |  | ##################### | 
| 275 |  |  |  |  |  |  |  | 
| 276 |  |  |  |  |  |  | # ->fire_event() | 
| 277 |  |  |  |  |  |  | # | 
| 278 |  |  |  |  |  |  | # prepares an event and then fires it. | 
| 279 |  |  |  |  |  |  | # | 
| 280 |  |  |  |  |  |  | sub fire_event { | 
| 281 | 11 |  |  | 11 | 1 | 94 | shift->prepare_event(shift, @_)->fire(caller => [caller 1]); | 
| 282 |  |  |  |  |  |  | } | 
| 283 |  |  |  |  |  |  |  | 
| 284 |  |  |  |  |  |  | # ->fire_events_together() | 
| 285 |  |  |  |  |  |  | # fire_events_together() | 
| 286 |  |  |  |  |  |  | # | 
| 287 |  |  |  |  |  |  | # prepares several events and then fires them together. | 
| 288 |  |  |  |  |  |  | # | 
| 289 |  |  |  |  |  |  | sub fire_events_together { | 
| 290 | 0 |  |  | 0 | 1 | 0 | prepare_together(@_)->fire(caller => [caller 1]); | 
| 291 |  |  |  |  |  |  | } | 
| 292 |  |  |  |  |  |  |  | 
| 293 |  |  |  |  |  |  | # ->fire_once() | 
| 294 |  |  |  |  |  |  | # | 
| 295 |  |  |  |  |  |  | # prepares an event, fires it, and deletes all callbacks afterward. | 
| 296 |  |  |  |  |  |  | # | 
| 297 |  |  |  |  |  |  | sub fire_once { | 
| 298 | 0 |  |  | 0 | 1 | 0 | my ($eo, $event_name, @args) = @_; | 
| 299 |  |  |  |  |  |  |  | 
| 300 |  |  |  |  |  |  | # fire with this caller. | 
| 301 | 0 |  |  |  |  | 0 | my $fire = $eo->prepare_event($event_name, @args)->fire( | 
| 302 |  |  |  |  |  |  | caller => [caller 1] | 
| 303 |  |  |  |  |  |  | ); | 
| 304 |  |  |  |  |  |  |  | 
| 305 |  |  |  |  |  |  | # delete the event. | 
| 306 | 0 |  |  |  |  | 0 | $eo->delete_event($event_name); | 
| 307 | 0 |  |  |  |  | 0 | return $fire; | 
| 308 |  |  |  |  |  |  |  | 
| 309 |  |  |  |  |  |  | } | 
| 310 |  |  |  |  |  |  |  | 
| 311 |  |  |  |  |  |  | ######################## | 
| 312 |  |  |  |  |  |  | ### LISTENER OBJECTS ### | 
| 313 |  |  |  |  |  |  | ######################## | 
| 314 |  |  |  |  |  |  |  | 
| 315 |  |  |  |  |  |  | # ->add_listener() | 
| 316 |  |  |  |  |  |  | # | 
| 317 |  |  |  |  |  |  | # adds an object as a listener of another object's events. | 
| 318 |  |  |  |  |  |  | # see "listeners" in the documentation. | 
| 319 |  |  |  |  |  |  | # | 
| 320 |  |  |  |  |  |  | sub add_listener { | 
| 321 | 3 |  |  | 3 | 1 | 25 | my ($eo, $obj, $prefix) = @_; | 
| 322 |  |  |  |  |  |  |  | 
| 323 |  |  |  |  |  |  | # find listeners list. | 
| 324 | 3 |  | 50 |  |  | 39 | my $listeners = $eo->{$props}{listeners} ||= []; | 
| 325 |  |  |  |  |  |  |  | 
| 326 |  |  |  |  |  |  | # store this listener. | 
| 327 | 3 |  |  |  |  | 12 | push @$listeners, [$prefix, $obj]; | 
| 328 |  |  |  |  |  |  |  | 
| 329 |  |  |  |  |  |  | # weaken the reference to the listener. | 
| 330 | 3 |  |  |  |  | 21 | weaken($listeners->[$#$listeners][1]); | 
| 331 |  |  |  |  |  |  |  | 
| 332 | 3 |  |  |  |  | 8 | return 1; | 
| 333 |  |  |  |  |  |  | } | 
| 334 |  |  |  |  |  |  |  | 
| 335 |  |  |  |  |  |  | # ->delete_listener() | 
| 336 |  |  |  |  |  |  | # | 
| 337 |  |  |  |  |  |  | # removes an object which was listening to another object's events. | 
| 338 |  |  |  |  |  |  | # see "listeners" in the documentation. | 
| 339 |  |  |  |  |  |  | # | 
| 340 |  |  |  |  |  |  | sub delete_listener { | 
| 341 | 0 |  |  | 0 | 1 | 0 | my ($eo, $obj) = @_; | 
| 342 | 0 | 0 |  |  |  | 0 | return 1 unless my $listeners = $eo->{$props}{listeners}; | 
| 343 |  |  |  |  |  |  | @$listeners = grep { | 
| 344 | 0 | 0 |  |  |  | 0 | ref $_->[1] eq 'ARRAY' and $_->[1] != $obj | 
|  | 0 |  |  |  |  | 0 |  | 
| 345 |  |  |  |  |  |  | } @$listeners; | 
| 346 | 0 |  |  |  |  | 0 | return 1; | 
| 347 |  |  |  |  |  |  | } | 
| 348 |  |  |  |  |  |  |  | 
| 349 |  |  |  |  |  |  | ###################### | 
| 350 |  |  |  |  |  |  | ### CLASS MONITORS ### | 
| 351 |  |  |  |  |  |  | ###################### | 
| 352 |  |  |  |  |  |  |  | 
| 353 |  |  |  |  |  |  | # for objective use $eo->monitor_events($pkg) | 
| 354 | 0 |  |  | 0 | 1 | 0 | sub monitor_events  {    add_class_monitor(reverse @_) } | 
| 355 | 0 |  |  | 0 | 1 | 0 | sub stop_monitoring { delete_class_monitor(reverse @_) } | 
| 356 |  |  |  |  |  |  |  | 
| 357 |  |  |  |  |  |  | # add_class_monitor() | 
| 358 |  |  |  |  |  |  | # | 
| 359 |  |  |  |  |  |  | # set the monitor object of a class. | 
| 360 |  |  |  |  |  |  | # | 
| 361 |  |  |  |  |  |  | # TODO: honestly class monitors need to track individual callbacks so that the | 
| 362 |  |  |  |  |  |  | # monitor is notified of all deletes of callbacks added by the class being | 
| 363 |  |  |  |  |  |  | # monitored even if the delete action was not committed by that package. | 
| 364 |  |  |  |  |  |  | # | 
| 365 |  |  |  |  |  |  | sub add_class_monitor { | 
| 366 | 0 |  |  | 0 | 0 | 0 | my ($pkg, $obj) = @_; | 
| 367 |  |  |  |  |  |  |  | 
| 368 |  |  |  |  |  |  | # ensure it's an evented object. | 
| 369 | 0 | 0 |  |  |  | 0 | return unless $obj->isa(__PACKAGE__); | 
| 370 |  |  |  |  |  |  |  | 
| 371 |  |  |  |  |  |  | # it's already in the list. | 
| 372 | 0 |  | 0 |  |  | 0 | my $m = $monitors{$pkg} ||= []; | 
| 373 | 0 | 0 |  |  |  | 0 | return if grep { $_ == $obj } @$m = grep { defined } @$m; | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 374 |  |  |  |  |  |  |  | 
| 375 |  |  |  |  |  |  | # hold a weak reference to the monitor. | 
| 376 | 0 |  |  |  |  | 0 | push @$m, $obj; | 
| 377 | 0 |  |  |  |  | 0 | weaken($monitors{$pkg}[$#$m]); | 
| 378 |  |  |  |  |  |  |  | 
| 379 | 0 |  |  |  |  | 0 | return 1; | 
| 380 |  |  |  |  |  |  | } | 
| 381 |  |  |  |  |  |  |  | 
| 382 |  |  |  |  |  |  | # delete_class_monitor() | 
| 383 |  |  |  |  |  |  | # | 
| 384 |  |  |  |  |  |  | # remove a class monitor object from a class. | 
| 385 |  |  |  |  |  |  | # | 
| 386 |  |  |  |  |  |  | sub delete_class_monitor { | 
| 387 | 0 |  |  | 0 | 0 | 0 | my ($pkg, $obj) = @_; | 
| 388 | 0 | 0 |  |  |  | 0 | my $m = $monitors{$pkg} or return; | 
| 389 | 0 | 0 |  |  |  | 0 | @$m   = grep { defined && $_ != $obj } @$m; | 
|  | 0 |  |  |  |  | 0 |  | 
| 390 |  |  |  |  |  |  | } | 
| 391 |  |  |  |  |  |  |  | 
| 392 |  |  |  |  |  |  | ####################### | 
| 393 |  |  |  |  |  |  | ### CLASS FUNCTIONS ### | 
| 394 |  |  |  |  |  |  | ####################### | 
| 395 |  |  |  |  |  |  |  | 
| 396 |  |  |  |  |  |  | # safe_fire($obj, event => ...) | 
| 397 |  |  |  |  |  |  | # | 
| 398 |  |  |  |  |  |  | # checks that an object is blessed and that it is an evented object. | 
| 399 |  |  |  |  |  |  | # if so, prepares and fires an event with optional arguments. | 
| 400 |  |  |  |  |  |  | # | 
| 401 |  |  |  |  |  |  | sub safe_fire { | 
| 402 | 0 |  |  | 0 | 1 | 0 | my $obj = shift; | 
| 403 | 0 | 0 | 0 |  |  | 0 | return if !blessed $obj || !$obj->isa(__PACKAGE__); | 
| 404 | 0 |  |  |  |  | 0 | return $obj->fire_event(@_); | 
| 405 |  |  |  |  |  |  | } | 
| 406 |  |  |  |  |  |  |  | 
| 407 |  |  |  |  |  |  | ######################### | 
| 408 |  |  |  |  |  |  | ### INTERNAL ROUTINES ### | 
| 409 |  |  |  |  |  |  | ######################### | 
| 410 |  |  |  |  |  |  |  | 
| 411 |  |  |  |  |  |  | # access package storage. | 
| 412 |  |  |  |  |  |  | sub _package_store { | 
| 413 | 13 |  |  | 13 |  | 40 | my $package = shift; | 
| 414 | 13 |  |  | 13 |  | 111 | no strict 'refs'; | 
|  | 13 |  |  |  |  | 39 |  | 
|  | 13 |  |  |  |  | 12081 |  | 
| 415 | 13 |  |  |  |  | 44 | my $ref = "${package}::__EO__"; | 
| 416 | 13 | 100 |  |  |  | 128 | if (!keys %$ref) { | 
| 417 | 12 |  |  |  |  | 44 | %$ref = (); | 
| 418 |  |  |  |  |  |  | } | 
| 419 | 13 |  |  |  |  | 66 | return *$ref{HASH}; | 
| 420 |  |  |  |  |  |  | } | 
| 421 |  |  |  |  |  |  |  | 
| 422 |  |  |  |  |  |  | # fetch the event store of object or package. | 
| 423 |  |  |  |  |  |  | sub _event_store { | 
| 424 | 79 |  |  | 79 |  | 229 | my $eo    = shift; | 
| 425 | 79 | 100 | 100 |  |  | 571 | return $eo->{$events}   ||= {} if blessed $eo; | 
| 426 | 13 |  |  |  |  | 52 | my $store = _package_store($eo); | 
| 427 | 13 | 50 | 100 |  |  | 163 | return $store->{events} ||= {} if not blessed $eo; | 
| 428 |  |  |  |  |  |  | } | 
| 429 |  |  |  |  |  |  |  | 
| 430 |  |  |  |  |  |  | # fetch the property store of object or package. | 
| 431 |  |  |  |  |  |  | sub _prop_store { | 
| 432 | 0 |  |  | 0 |  | 0 | my $eo    = shift; | 
| 433 | 0 | 0 | 0 |  |  | 0 | return $eo->{$props}   ||= {} if blessed $eo; | 
| 434 | 0 |  |  |  |  | 0 | my $store = _package_store($eo); | 
| 435 | 0 | 0 | 0 |  |  | 0 | return $store->{props} ||= {} if not blessed $eo; | 
| 436 |  |  |  |  |  |  | } | 
| 437 |  |  |  |  |  |  |  | 
| 438 |  |  |  |  |  |  | # fetch a callback from its name. | 
| 439 |  |  |  |  |  |  | sub _get_callback_named { | 
| 440 | 0 |  |  | 0 |  | 0 | my ($eo, $event_name, $callback_name) = @_; | 
| 441 | 0 |  |  |  |  | 0 | foreach my $callback (@{ _get_callbacks($eo, $event_name) }) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 442 | 0 | 0 |  |  |  | 0 | return $callback if $callback->[2]{name} eq $callback_name | 
| 443 |  |  |  |  |  |  | } | 
| 444 | 0 |  |  |  |  | 0 | return; | 
| 445 |  |  |  |  |  |  | } | 
| 446 |  |  |  |  |  |  |  | 
| 447 |  |  |  |  |  |  | # fetches callbacks of an event. | 
| 448 |  |  |  |  |  |  | # internal use only. | 
| 449 |  |  |  |  |  |  | sub _get_callbacks { | 
| 450 | 13 |  |  | 13 |  | 45 | my ($eo, $event_name, @args) = @_; | 
| 451 | 13 |  |  |  |  | 27 | my (%callbacks, %callback_names); | 
| 452 |  |  |  |  |  |  |  | 
| 453 |  |  |  |  |  |  | # start out with two stores: the object and the package. | 
| 454 |  |  |  |  |  |  | my @stores = ( | 
| 455 | 13 |  |  |  |  | 93 | [ $event_name => $eo->{$events}             ], | 
| 456 |  |  |  |  |  |  | [ $event_name => _event_store(blessed $eo)  ] | 
| 457 |  |  |  |  |  |  | ); | 
| 458 |  |  |  |  |  |  |  | 
| 459 |  |  |  |  |  |  |  | 
| 460 |  |  |  |  |  |  | # if there are any listening objects, add those stores. | 
| 461 | 13 | 100 |  |  |  | 81 | if (my $listeners = $eo->{$props}{listeners}) { | 
| 462 | 3 |  |  |  |  | 5 | my @delete; | 
| 463 |  |  |  |  |  |  |  | 
| 464 | 3 |  |  |  |  | 18 | LISTENER: foreach my $i (0 .. $#$listeners) { | 
| 465 | 3 | 50 |  |  |  | 21 | my $l = $listeners->[$i] or next; | 
| 466 | 3 |  |  |  |  | 10 | my ($prefix, $lis) = @$l; | 
| 467 | 3 |  |  |  |  | 9 | my $listener_event_name = $prefix.q(.).$event_name; | 
| 468 |  |  |  |  |  |  |  | 
| 469 |  |  |  |  |  |  | # object has been deallocated by garbage disposal, | 
| 470 |  |  |  |  |  |  | # so we can delete this listener. | 
| 471 | 3 | 50 |  |  |  | 20 | if (!$lis) { | 
| 472 | 0 |  |  |  |  | 0 | push @delete, $i; | 
| 473 | 0 |  |  |  |  | 0 | next LISTENER; | 
| 474 |  |  |  |  |  |  | } | 
| 475 |  |  |  |  |  |  |  | 
| 476 |  |  |  |  |  |  |  | 
| 477 | 3 |  |  |  |  | 16 | push @stores, [ $listener_event_name => $lis->{$events} ]; | 
| 478 |  |  |  |  |  |  |  | 
| 479 |  |  |  |  |  |  | } | 
| 480 |  |  |  |  |  |  |  | 
| 481 |  |  |  |  |  |  | # delete listeners if necessary. | 
| 482 | 3 |  |  |  |  | 11 | splice @$listeners, $_, 1 foreach @delete; | 
| 483 |  |  |  |  |  |  |  | 
| 484 |  |  |  |  |  |  | } | 
| 485 |  |  |  |  |  |  |  | 
| 486 |  |  |  |  |  |  | # add callbacks from each store. | 
| 487 | 13 |  |  |  |  | 39 | foreach my $st (@stores) { | 
| 488 | 29 |  |  |  |  | 78 | my ($event_name, $event_store) = @$st; | 
| 489 | 29 | 100 |  |  |  | 100 | my $store = $event_store->{$event_name} or next; | 
| 490 | 15 |  |  |  |  | 65 | foreach my $priority (keys %$store) { | 
| 491 |  |  |  |  |  |  |  | 
| 492 |  |  |  |  |  |  | # create a group reference. | 
| 493 | 24 |  |  |  |  | 81 | my $group_id = "$eo/$event_name"; | 
| 494 | 24 |  |  |  |  | 66 | my $group    = [ $eo, $event_name, \@args, $group_id ]; | 
| 495 | 24 |  |  |  |  | 94 | weaken($group->[0]); | 
| 496 |  |  |  |  |  |  |  | 
| 497 |  |  |  |  |  |  | # add each callback set. inject callback name. | 
| 498 | 24 |  |  |  |  | 36 | foreach my $cb_ref (@{ $store->{$priority} }) { | 
|  | 24 |  |  |  |  | 59 |  | 
| 499 | 29 |  |  |  |  | 165 | my %cb = %$cb_ref; # make a copy | 
| 500 | 29 |  |  |  |  | 119 | $cb{id} = "$group_id/$cb{name}"; | 
| 501 | 29 |  |  |  |  | 126 | $callbacks{ $cb{id} } = [ $priority, $group, \%cb ]; | 
| 502 | 29 |  |  |  |  | 147 | $callback_names{$group_id}{ $cb{name} } = $cb{id}; | 
| 503 |  |  |  |  |  |  | } | 
| 504 |  |  |  |  |  |  |  | 
| 505 |  |  |  |  |  |  | } | 
| 506 |  |  |  |  |  |  | } | 
| 507 |  |  |  |  |  |  |  | 
| 508 | 13 | 50 |  |  |  | 146 | return wantarray ? (\%callbacks, \%callback_names) : \%callbacks; | 
| 509 |  |  |  |  |  |  | } | 
| 510 |  |  |  |  |  |  |  | 
| 511 |  |  |  |  |  |  | # fire a class monitor event. | 
| 512 |  |  |  |  |  |  | sub _monitor_fire { | 
| 513 | 50 |  |  | 50 |  | 189 | my ($pkg, $event_name, @args) = @_; | 
| 514 | 50 | 50 |  |  |  | 158 | my $m = $monitors{$pkg} or return; | 
| 515 | 0 |  |  |  |  | 0 | safe_fire($_, "monitor:$event_name" => @args) foreach @$m; | 
| 516 |  |  |  |  |  |  | } | 
| 517 |  |  |  |  |  |  |  | 
| 518 | 14 |  |  | 14 |  | 22321 | sub DESTROY { shift->delete_all_events } | 
| 519 |  |  |  |  |  |  |  | 
| 520 |  |  |  |  |  |  | ############### | 
| 521 |  |  |  |  |  |  | ### ALIASES ### | 
| 522 |  |  |  |  |  |  | ############### | 
| 523 |  |  |  |  |  |  |  | 
| 524 |  |  |  |  |  |  | sub register_event; | 
| 525 |  |  |  |  |  |  | sub register_events; | 
| 526 |  |  |  |  |  |  | sub delete_event; | 
| 527 |  |  |  |  |  |  |  | 
| 528 |  |  |  |  |  |  | sub on; | 
| 529 |  |  |  |  |  |  | sub del; | 
| 530 |  |  |  |  |  |  | sub fire; | 
| 531 |  |  |  |  |  |  |  | 
| 532 |  |  |  |  |  |  | BEGIN { | 
| 533 | 13 |  |  | 13 |  | 85 | *register_event     = *register_callback; | 
| 534 | 13 |  |  |  |  | 36 | *register_events    = *register_callbacks; | 
| 535 | 13 |  |  |  |  | 35 | *delete_event       = *delete_callback; | 
| 536 | 13 |  |  |  |  | 49 | *on                 = *register_callback; | 
| 537 | 13 |  |  |  |  | 30 | *del                = *delete_callback; | 
| 538 | 13 |  |  |  |  | 1990 | *fire               = *fire_event; | 
| 539 |  |  |  |  |  |  | } | 
| 540 |  |  |  |  |  |  |  | 
| 541 |  |  |  |  |  |  | 1; | 
| 542 |  |  |  |  |  |  |  | 
| 543 |  |  |  |  |  |  | =head1 NAME | 
| 544 |  |  |  |  |  |  |  | 
| 545 |  |  |  |  |  |  | B - base class which allows you to attach callbacks to | 
| 546 |  |  |  |  |  |  | objects and then fire events on them. | 
| 547 |  |  |  |  |  |  |  | 
| 548 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 549 |  |  |  |  |  |  |  | 
| 550 |  |  |  |  |  |  | package Person; | 
| 551 |  |  |  |  |  |  |  | 
| 552 |  |  |  |  |  |  | use warnings; | 
| 553 |  |  |  |  |  |  | use strict; | 
| 554 |  |  |  |  |  |  | use 5.010; | 
| 555 |  |  |  |  |  |  | use parent 'Evented::Object'; | 
| 556 |  |  |  |  |  |  |  | 
| 557 |  |  |  |  |  |  | use Evented::Object; | 
| 558 |  |  |  |  |  |  |  | 
| 559 |  |  |  |  |  |  | # Creates a new person object. This is nothing special. | 
| 560 |  |  |  |  |  |  | # Evented::Object does not require any specific constructor to be called. | 
| 561 |  |  |  |  |  |  | sub new { | 
| 562 |  |  |  |  |  |  | my ($class, %opts) = @_; | 
| 563 |  |  |  |  |  |  | bless \%opts, $class; | 
| 564 |  |  |  |  |  |  | } | 
| 565 |  |  |  |  |  |  |  | 
| 566 |  |  |  |  |  |  | # Fires birthday event and increments age. | 
| 567 |  |  |  |  |  |  | sub have_birthday { | 
| 568 |  |  |  |  |  |  | my $person = shift; | 
| 569 |  |  |  |  |  |  | $person->fire(birthday => ++$person->{age}); | 
| 570 |  |  |  |  |  |  | } | 
| 571 |  |  |  |  |  |  |  | 
| 572 |  |  |  |  |  |  | In some other package... | 
| 573 |  |  |  |  |  |  |  | 
| 574 |  |  |  |  |  |  | package main; | 
| 575 |  |  |  |  |  |  |  | 
| 576 |  |  |  |  |  |  | # Create a person named Jake at age 19. | 
| 577 |  |  |  |  |  |  | my $jake = Person->new(name => 'Jake', age => 19); | 
| 578 |  |  |  |  |  |  |  | 
| 579 |  |  |  |  |  |  | # Add an event callback that assumes Jake is under 21. | 
| 580 |  |  |  |  |  |  | $jake->on(birthday => sub { | 
| 581 |  |  |  |  |  |  | my ($fire, $new_age) = @_; | 
| 582 |  |  |  |  |  |  | say 'not quite 21 yet...'; | 
| 583 |  |  |  |  |  |  | }, name => '21-soon'); | 
| 584 |  |  |  |  |  |  |  | 
| 585 |  |  |  |  |  |  | # Add an event callback that checks if Jake is 21 | 
| 586 |  |  |  |  |  |  | # and cancels the above callback if so. | 
| 587 |  |  |  |  |  |  | $jake->on(birthday => sub { | 
| 588 |  |  |  |  |  |  | my ($fire, $new_age) =  @_; | 
| 589 |  |  |  |  |  |  | if ($new_age == 21) { | 
| 590 |  |  |  |  |  |  | say 'time to get drunk!'; | 
| 591 |  |  |  |  |  |  | $fire->cancel('21-soon'); | 
| 592 |  |  |  |  |  |  | } | 
| 593 |  |  |  |  |  |  | }, name => 'finally-21', priority => 1); | 
| 594 |  |  |  |  |  |  |  | 
| 595 |  |  |  |  |  |  | # Jake has two birthdays. | 
| 596 |  |  |  |  |  |  |  | 
| 597 |  |  |  |  |  |  | # Jake's 20th birthday. | 
| 598 |  |  |  |  |  |  | $jake->have_birthday; | 
| 599 |  |  |  |  |  |  |  | 
| 600 |  |  |  |  |  |  | # Jake's 21st birthday. | 
| 601 |  |  |  |  |  |  | $jake->have_birthday; | 
| 602 |  |  |  |  |  |  |  | 
| 603 |  |  |  |  |  |  | # Because 21-soon has a lower priority than finally-21, | 
| 604 |  |  |  |  |  |  | # finally-21 will cancel 21-soon if Jake is 21. | 
| 605 |  |  |  |  |  |  |  | 
| 606 |  |  |  |  |  |  | # The result: | 
| 607 |  |  |  |  |  |  | # | 
| 608 |  |  |  |  |  |  | #   not quite 21 yet... | 
| 609 |  |  |  |  |  |  | #   time to get drunk! | 
| 610 |  |  |  |  |  |  |  | 
| 611 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 612 |  |  |  |  |  |  |  | 
| 613 |  |  |  |  |  |  | B | 
| 614 |  |  |  |  |  |  |  | 
| 615 |  |  |  |  |  |  | Evented::Object supplies an (obviously objective) interface to store and manage | 
| 616 |  |  |  |  |  |  | callbacks for events, fire events upon objects, and more. | 
| 617 |  |  |  |  |  |  |  | 
| 618 |  |  |  |  |  |  | Evented::Object allows you to attach event callbacks to an object | 
| 619 |  |  |  |  |  |  | (i.e., a blessed hash reference) and then fire events on that object. Event | 
| 620 |  |  |  |  |  |  | fires are much like method calls, except that there can be many responders. | 
| 621 |  |  |  |  |  |  |  | 
| 622 |  |  |  |  |  |  | Whereas many event systems involve globally unique event names, Evented::Object | 
| 623 |  |  |  |  |  |  | allows you to attach events on specific objects. The event callbacks, | 
| 624 |  |  |  |  |  |  | priority options, and other data are stored within the object itself. | 
| 625 |  |  |  |  |  |  |  | 
| 626 |  |  |  |  |  |  | =head1 MANAGING CALLBACKS | 
| 627 |  |  |  |  |  |  |  | 
| 628 |  |  |  |  |  |  | The Evented::Object package provides several convenient methods for managing an | 
| 629 |  |  |  |  |  |  | event-driven object. | 
| 630 |  |  |  |  |  |  |  | 
| 631 |  |  |  |  |  |  | =head2 Evented::Object->new() | 
| 632 |  |  |  |  |  |  |  | 
| 633 |  |  |  |  |  |  | Creates a new Evented::Object. | 
| 634 |  |  |  |  |  |  |  | 
| 635 |  |  |  |  |  |  | Typically, this method is overriden by a child class of Evented::Object. | 
| 636 |  |  |  |  |  |  |  | 
| 637 |  |  |  |  |  |  | my $eo = Evented::Object->new(); | 
| 638 |  |  |  |  |  |  |  | 
| 639 |  |  |  |  |  |  | =head2 $eo->register_callback($event_name => \&callback, %options) | 
| 640 |  |  |  |  |  |  |  | 
| 641 |  |  |  |  |  |  | Attaches an event callback the object. | 
| 642 |  |  |  |  |  |  |  | 
| 643 |  |  |  |  |  |  | When the specified event is fired, each | 
| 644 |  |  |  |  |  |  | of the callbacks registered using this method will be called by descending | 
| 645 |  |  |  |  |  |  | priority order (numerically higher priority numbers are called first.) | 
| 646 |  |  |  |  |  |  |  | 
| 647 |  |  |  |  |  |  | $eo->register_callback(myEvent => sub { | 
| 648 |  |  |  |  |  |  | ... | 
| 649 |  |  |  |  |  |  | }, name => 'some.callback', priority => 200); | 
| 650 |  |  |  |  |  |  |  | 
| 651 |  |  |  |  |  |  | B | 
| 652 |  |  |  |  |  |  |  | 
| 653 |  |  |  |  |  |  | =over | 
| 654 |  |  |  |  |  |  |  | 
| 655 |  |  |  |  |  |  | =item * | 
| 656 |  |  |  |  |  |  |  | 
| 657 |  |  |  |  |  |  | B<$event_name> - name of the event. | 
| 658 |  |  |  |  |  |  |  | 
| 659 |  |  |  |  |  |  | =item * | 
| 660 |  |  |  |  |  |  |  | 
| 661 |  |  |  |  |  |  | B<\&callback> - CODE reference to be called when the event is fired. | 
| 662 |  |  |  |  |  |  |  | 
| 663 |  |  |  |  |  |  | =item * | 
| 664 |  |  |  |  |  |  |  | 
| 665 |  |  |  |  |  |  | B<%options> - I, a hash (NOT a hash reference) of any of the below | 
| 666 |  |  |  |  |  |  | options. | 
| 667 |  |  |  |  |  |  |  | 
| 668 |  |  |  |  |  |  | =back | 
| 669 |  |  |  |  |  |  |  | 
| 670 |  |  |  |  |  |  | B<%options> - event handler options | 
| 671 |  |  |  |  |  |  |  | 
| 672 |  |  |  |  |  |  | All of these options are I, but the use of a callback name is | 
| 673 |  |  |  |  |  |  | B. | 
| 674 |  |  |  |  |  |  |  | 
| 675 |  |  |  |  |  |  | =over | 
| 676 |  |  |  |  |  |  |  | 
| 677 |  |  |  |  |  |  | =item * | 
| 678 |  |  |  |  |  |  |  | 
| 679 |  |  |  |  |  |  | B - name of the callback being registered. must be unique to this | 
| 680 |  |  |  |  |  |  | particular event. | 
| 681 |  |  |  |  |  |  |  | 
| 682 |  |  |  |  |  |  | =item * | 
| 683 |  |  |  |  |  |  |  | 
| 684 |  |  |  |  |  |  | B - numerical priority of the callback. | 
| 685 |  |  |  |  |  |  |  | 
| 686 |  |  |  |  |  |  | =item * | 
| 687 |  |  |  |  |  |  |  | 
| 688 |  |  |  |  |  |  | B - name of a callback or an array reference of callback names to | 
| 689 |  |  |  |  |  |  | precede. | 
| 690 |  |  |  |  |  |  |  | 
| 691 |  |  |  |  |  |  | =item * | 
| 692 |  |  |  |  |  |  |  | 
| 693 |  |  |  |  |  |  | B - name of a callback or an array reference of callback names to | 
| 694 |  |  |  |  |  |  | succeed. | 
| 695 |  |  |  |  |  |  |  | 
| 696 |  |  |  |  |  |  | =item * | 
| 697 |  |  |  |  |  |  |  | 
| 698 |  |  |  |  |  |  | B - data that will be stored as C<< $fire->callback_data >> as the | 
| 699 |  |  |  |  |  |  | callback is fired. If C is a hash reference, its values can be fetched | 
| 700 |  |  |  |  |  |  | conveniently with C<< $fire->callback_data('key') >>. | 
| 701 |  |  |  |  |  |  |  | 
| 702 |  |  |  |  |  |  | =item * | 
| 703 |  |  |  |  |  |  |  | 
| 704 |  |  |  |  |  |  | B - if true, the evented object will prepended to the argument list | 
| 705 |  |  |  |  |  |  | (which is not the default behavior). note that this is enabled automatically | 
| 706 |  |  |  |  |  |  | when using the odd-argument version. | 
| 707 |  |  |  |  |  |  |  | 
| 708 |  |  |  |  |  |  | =item * | 
| 709 |  |  |  |  |  |  |  | 
| 710 |  |  |  |  |  |  | B - if true, the L will not | 
| 711 |  |  |  |  |  |  | be prepended to the argument list (which is the default behavior). | 
| 712 |  |  |  |  |  |  |  | 
| 713 |  |  |  |  |  |  | =back | 
| 714 |  |  |  |  |  |  |  | 
| 715 |  |  |  |  |  |  | Note: the order of objects will always be C<$eo>, C<$fire>, C<@args>, regardless | 
| 716 |  |  |  |  |  |  | of omissions. By default, the argument list is C<$fire>, C<@args>. | 
| 717 |  |  |  |  |  |  |  | 
| 718 |  |  |  |  |  |  | You may have any number of C and any | 
| 719 |  |  |  |  |  |  | number of C options for any given callback. For instance, one callback | 
| 720 |  |  |  |  |  |  | may specify to be before 'b' and 'c' but after 'a'. Evented::Object will resolve | 
| 721 |  |  |  |  |  |  | these priorities to its best ability. | 
| 722 |  |  |  |  |  |  |  | 
| 723 |  |  |  |  |  |  | In the case that the priorities can not be resolved (for instance, if a callback | 
| 724 |  |  |  |  |  |  | asks to be before 'a' and after 'b' while 'b' has already asked to be before | 
| 725 |  |  |  |  |  |  | 'a'), the behavior of Evented::Object is not guaranteed to be consistent. In | 
| 726 |  |  |  |  |  |  | other words, please do your best to not request impossible priorities. | 
| 727 |  |  |  |  |  |  |  | 
| 728 |  |  |  |  |  |  | In any case, C and C options are completely ignored when a | 
| 729 |  |  |  |  |  |  | C is explicitly specified. | 
| 730 |  |  |  |  |  |  |  | 
| 731 |  |  |  |  |  |  | =head2 $eo->register_callback($event_name => \&callback, $cb_name, %options) | 
| 732 |  |  |  |  |  |  |  | 
| 733 |  |  |  |  |  |  | If the list of options is odd, it is assumed that the first element is the | 
| 734 |  |  |  |  |  |  | callback name. In this case, the C option is also automatically | 
| 735 |  |  |  |  |  |  | enabled. | 
| 736 |  |  |  |  |  |  |  | 
| 737 |  |  |  |  |  |  | $eo->register_callback(myEvent => sub { | 
| 738 |  |  |  |  |  |  | ... | 
| 739 |  |  |  |  |  |  | }, 'some.callback, priority => 200); | 
| 740 |  |  |  |  |  |  |  | 
| 741 |  |  |  |  |  |  | See the above method specification for parameters and supported options. | 
| 742 |  |  |  |  |  |  |  | 
| 743 |  |  |  |  |  |  | =head2 $eo->register_callbacks(@events) | 
| 744 |  |  |  |  |  |  |  | 
| 745 |  |  |  |  |  |  | Registers several event callbacks at once. | 
| 746 |  |  |  |  |  |  |  | 
| 747 |  |  |  |  |  |  | The arguments should be a list of hash | 
| 748 |  |  |  |  |  |  | references. These references take the same options as | 
| 749 |  |  |  |  |  |  | C<< ->register_callback() >>. Returns a list of return values in the order that | 
| 750 |  |  |  |  |  |  | the events were specified. | 
| 751 |  |  |  |  |  |  |  | 
| 752 |  |  |  |  |  |  | $eo->register_callbacks( | 
| 753 |  |  |  |  |  |  | { myEvent => \&my_event_1, name => 'cb.1', priority => 200 }, | 
| 754 |  |  |  |  |  |  | { myEvent => \&my_event_2, name => 'cb.2', priority => 100 } | 
| 755 |  |  |  |  |  |  | ); | 
| 756 |  |  |  |  |  |  |  | 
| 757 |  |  |  |  |  |  | B | 
| 758 |  |  |  |  |  |  |  | 
| 759 |  |  |  |  |  |  | =over | 
| 760 |  |  |  |  |  |  |  | 
| 761 |  |  |  |  |  |  | =item * | 
| 762 |  |  |  |  |  |  |  | 
| 763 |  |  |  |  |  |  | B<@events> - array of hash references to pass to C<< ->register_callback() >>. | 
| 764 |  |  |  |  |  |  |  | 
| 765 |  |  |  |  |  |  | =back | 
| 766 |  |  |  |  |  |  |  | 
| 767 |  |  |  |  |  |  | =head2 $eo->delete_event($event_name) | 
| 768 |  |  |  |  |  |  |  | 
| 769 |  |  |  |  |  |  | Deletes all callbacks registered for the supplied event. | 
| 770 |  |  |  |  |  |  |  | 
| 771 |  |  |  |  |  |  | Returns number of callbacks deleted, false if none. | 
| 772 |  |  |  |  |  |  |  | 
| 773 |  |  |  |  |  |  | $eo->delete_event('myEvent'); | 
| 774 |  |  |  |  |  |  |  | 
| 775 |  |  |  |  |  |  | B | 
| 776 |  |  |  |  |  |  |  | 
| 777 |  |  |  |  |  |  | =over | 
| 778 |  |  |  |  |  |  |  | 
| 779 |  |  |  |  |  |  | =item * | 
| 780 |  |  |  |  |  |  |  | 
| 781 |  |  |  |  |  |  | B<$event_name> - name of the event. | 
| 782 |  |  |  |  |  |  |  | 
| 783 |  |  |  |  |  |  | =back | 
| 784 |  |  |  |  |  |  |  | 
| 785 |  |  |  |  |  |  | =head2 $eo->delete_callback($event_name, $callback_name) | 
| 786 |  |  |  |  |  |  |  | 
| 787 |  |  |  |  |  |  | Deletes an event callback from the object with the given callback name. | 
| 788 |  |  |  |  |  |  |  | 
| 789 |  |  |  |  |  |  | Returns true if a callback was deleted. | 
| 790 |  |  |  |  |  |  |  | 
| 791 |  |  |  |  |  |  | $eo->delete_callback(myEvent => 'my.callback'); | 
| 792 |  |  |  |  |  |  |  | 
| 793 |  |  |  |  |  |  | B | 
| 794 |  |  |  |  |  |  |  | 
| 795 |  |  |  |  |  |  | =over | 
| 796 |  |  |  |  |  |  |  | 
| 797 |  |  |  |  |  |  | =item * | 
| 798 |  |  |  |  |  |  |  | 
| 799 |  |  |  |  |  |  | B<$event_name> - name of the event. | 
| 800 |  |  |  |  |  |  |  | 
| 801 |  |  |  |  |  |  | =item * | 
| 802 |  |  |  |  |  |  |  | 
| 803 |  |  |  |  |  |  | B<$callback_name> - name of the callback being removed. | 
| 804 |  |  |  |  |  |  |  | 
| 805 |  |  |  |  |  |  | =back | 
| 806 |  |  |  |  |  |  |  | 
| 807 |  |  |  |  |  |  | =head2 $eo->delete_all_events() | 
| 808 |  |  |  |  |  |  |  | 
| 809 |  |  |  |  |  |  | Deletes all events and all callbacks from the object. | 
| 810 |  |  |  |  |  |  |  | 
| 811 |  |  |  |  |  |  | If you know that an | 
| 812 |  |  |  |  |  |  | evented object will no longer be used in your program, by calling this method | 
| 813 |  |  |  |  |  |  | you can be sure that no cyclical references from within callbacks will cause the | 
| 814 |  |  |  |  |  |  | object to be leaked. | 
| 815 |  |  |  |  |  |  |  | 
| 816 |  |  |  |  |  |  | =head1 FIRING EVENTS | 
| 817 |  |  |  |  |  |  |  | 
| 818 |  |  |  |  |  |  | =head2 $eo->fire_event($event_name => @arguments) | 
| 819 |  |  |  |  |  |  |  | 
| 820 |  |  |  |  |  |  | Fires the specified event, calling each callback that was registered with | 
| 821 |  |  |  |  |  |  | C<< ->register_callback() >> in descending order of their priorities. | 
| 822 |  |  |  |  |  |  |  | 
| 823 |  |  |  |  |  |  | Returns the L. | 
| 824 |  |  |  |  |  |  |  | 
| 825 |  |  |  |  |  |  | $eo->fire_event('some_event'); | 
| 826 |  |  |  |  |  |  |  | 
| 827 |  |  |  |  |  |  | $eo->fire_event(some_event => $some_argument, $some_other_argument); | 
| 828 |  |  |  |  |  |  |  | 
| 829 |  |  |  |  |  |  | B | 
| 830 |  |  |  |  |  |  |  | 
| 831 |  |  |  |  |  |  | =over | 
| 832 |  |  |  |  |  |  |  | 
| 833 |  |  |  |  |  |  | =item * | 
| 834 |  |  |  |  |  |  |  | 
| 835 |  |  |  |  |  |  | B<$event_name> - name of the event being fired. | 
| 836 |  |  |  |  |  |  |  | 
| 837 |  |  |  |  |  |  | =item * | 
| 838 |  |  |  |  |  |  |  | 
| 839 |  |  |  |  |  |  | B<@arguments> - I, list of arguments to pass to event callbacks. | 
| 840 |  |  |  |  |  |  |  | 
| 841 |  |  |  |  |  |  | =back | 
| 842 |  |  |  |  |  |  |  | 
| 843 |  |  |  |  |  |  | =head2 $eo->fire_once($event_name => @arguments) | 
| 844 |  |  |  |  |  |  |  | 
| 845 |  |  |  |  |  |  | Fires the specified event, calling each callback that was registered with | 
| 846 |  |  |  |  |  |  | C<< ->register_callback() >> in descending order of their priorities. | 
| 847 |  |  |  |  |  |  |  | 
| 848 |  |  |  |  |  |  | Then, all callbacks for the event are deleted. This method is useful for | 
| 849 |  |  |  |  |  |  | situations where an event will never be fired more than once. | 
| 850 |  |  |  |  |  |  |  | 
| 851 |  |  |  |  |  |  | Returns the L. | 
| 852 |  |  |  |  |  |  |  | 
| 853 |  |  |  |  |  |  | $eo->fire_once('some_event'); | 
| 854 |  |  |  |  |  |  | $eo->fire_event(some_event => $some_argument, $some_other_argument); | 
| 855 |  |  |  |  |  |  | # the second does nothing because the first deleted the callbacks | 
| 856 |  |  |  |  |  |  |  | 
| 857 |  |  |  |  |  |  | B | 
| 858 |  |  |  |  |  |  |  | 
| 859 |  |  |  |  |  |  | =over | 
| 860 |  |  |  |  |  |  |  | 
| 861 |  |  |  |  |  |  | =item * | 
| 862 |  |  |  |  |  |  |  | 
| 863 |  |  |  |  |  |  | B<$event_name> - name of the event being fired. | 
| 864 |  |  |  |  |  |  |  | 
| 865 |  |  |  |  |  |  | =item * | 
| 866 |  |  |  |  |  |  |  | 
| 867 |  |  |  |  |  |  | B<@arguments> - I, list of arguments to pass to event callbacks. | 
| 868 |  |  |  |  |  |  |  | 
| 869 |  |  |  |  |  |  | =back | 
| 870 |  |  |  |  |  |  |  | 
| 871 |  |  |  |  |  |  | =head2 $eo->fire_events_together(@events) | 
| 872 |  |  |  |  |  |  |  | 
| 873 |  |  |  |  |  |  | The C function can be used as a method on evented | 
| 874 |  |  |  |  |  |  | objects. See the documentation for the function in L"PROCEDURAL FUNCTIONS">. | 
| 875 |  |  |  |  |  |  |  | 
| 876 |  |  |  |  |  |  | =head2 $eo->prepare_event(event_name => @arguments) | 
| 877 |  |  |  |  |  |  |  | 
| 878 |  |  |  |  |  |  | Prepares a single event for firing. | 
| 879 |  |  |  |  |  |  |  | 
| 880 |  |  |  |  |  |  | Returns an L representing the pending callbacks. | 
| 881 |  |  |  |  |  |  |  | 
| 882 |  |  |  |  |  |  | # an example using the fire option return_check. | 
| 883 |  |  |  |  |  |  | $eo->prepare_event(some_event => @arguments)->fire('return_check'); | 
| 884 |  |  |  |  |  |  |  | 
| 885 |  |  |  |  |  |  | =head2 $eo->prepare_together(@events) | 
| 886 |  |  |  |  |  |  |  | 
| 887 |  |  |  |  |  |  | The preparatory method equivalent to C<< ->fire_events_together >>. | 
| 888 |  |  |  |  |  |  |  | 
| 889 |  |  |  |  |  |  | Returns an L representing the pending callbacks. | 
| 890 |  |  |  |  |  |  |  | 
| 891 |  |  |  |  |  |  | =head2 $eo->prepare(...) | 
| 892 |  |  |  |  |  |  |  | 
| 893 |  |  |  |  |  |  | A smart method that uses the best guess between C<< ->prepare_event >> and | 
| 894 |  |  |  |  |  |  | C<< ->prepare_together >>. | 
| 895 |  |  |  |  |  |  |  | 
| 896 |  |  |  |  |  |  | # uses ->prepare_event() | 
| 897 |  |  |  |  |  |  | $eo->prepare(some_event => @arguments); | 
| 898 |  |  |  |  |  |  |  | 
| 899 |  |  |  |  |  |  | # uses ->prepare_together() | 
| 900 |  |  |  |  |  |  | $eo->prepare( | 
| 901 |  |  |  |  |  |  | [ some_event => @arguments ], | 
| 902 |  |  |  |  |  |  | [ some_other => @other_arg ] | 
| 903 |  |  |  |  |  |  | ); | 
| 904 |  |  |  |  |  |  |  | 
| 905 |  |  |  |  |  |  | =head1 LISTENERS | 
| 906 |  |  |  |  |  |  |  | 
| 907 |  |  |  |  |  |  | An evented object can I for event notifications from another evented | 
| 908 |  |  |  |  |  |  | object using the method L"$eo-Eadd_listener($other_eo, $prefix)">. | 
| 909 |  |  |  |  |  |  |  | 
| 910 |  |  |  |  |  |  | Consider a scenario where you have a class whose objects represent a farm. You | 
| 911 |  |  |  |  |  |  | have another class which represents a cow. You would like to use the same | 
| 912 |  |  |  |  |  |  | callback for all of the moos that occur on the farm, regardless of which cow | 
| 913 |  |  |  |  |  |  | initiated it. | 
| 914 |  |  |  |  |  |  |  | 
| 915 |  |  |  |  |  |  | Rather than attaching an event callback to every cow, you can instead make the | 
| 916 |  |  |  |  |  |  | farm a listener of the cow. Then, you can attach a single callback to your farm. | 
| 917 |  |  |  |  |  |  | If your cow's event for mooing is C, your farm's event for any mooing is | 
| 918 |  |  |  |  |  |  | C. | 
| 919 |  |  |  |  |  |  |  | 
| 920 |  |  |  |  |  |  | When an event is fired on an object, the same fire object is used for callbacks | 
| 921 |  |  |  |  |  |  | belonging to both the evented object and its listening objects. Therefore, | 
| 922 |  |  |  |  |  |  | callback names should be unique not only to the listener object but to the | 
| 923 |  |  |  |  |  |  | object being listened on as well. | 
| 924 |  |  |  |  |  |  |  | 
| 925 |  |  |  |  |  |  | You should also note the values of the | 
| 926 |  |  |  |  |  |  | L: | 
| 927 |  |  |  |  |  |  |  | 
| 928 |  |  |  |  |  |  | =over | 
| 929 |  |  |  |  |  |  |  | 
| 930 |  |  |  |  |  |  | =item * | 
| 931 |  |  |  |  |  |  |  | 
| 932 |  |  |  |  |  |  | B<< $fire->event_name >> - name of the event from the perspective of the | 
| 933 |  |  |  |  |  |  | listener; i.e. C (NOT C) | 
| 934 |  |  |  |  |  |  |  | 
| 935 |  |  |  |  |  |  | =item * | 
| 936 |  |  |  |  |  |  |  | 
| 937 |  |  |  |  |  |  | B<< $fire->object >> - object being listened to; i.e. C<$cow> (NOT C<$farm>) | 
| 938 |  |  |  |  |  |  |  | 
| 939 |  |  |  |  |  |  | =back | 
| 940 |  |  |  |  |  |  |  | 
| 941 |  |  |  |  |  |  | This also means that stopping the event from a listener object will cancel | 
| 942 |  |  |  |  |  |  | I remaining callbacks. | 
| 943 |  |  |  |  |  |  |  | 
| 944 |  |  |  |  |  |  | =head2 $eo->add_listener($other_eo, $prefix) | 
| 945 |  |  |  |  |  |  |  | 
| 946 |  |  |  |  |  |  | Makes the passed evented object a listener of this evented object. | 
| 947 |  |  |  |  |  |  |  | 
| 948 |  |  |  |  |  |  | See L"LISTENERS">. | 
| 949 |  |  |  |  |  |  |  | 
| 950 |  |  |  |  |  |  | $cow->add_listener($farm, 'cow'); | 
| 951 |  |  |  |  |  |  |  | 
| 952 |  |  |  |  |  |  | B | 
| 953 |  |  |  |  |  |  |  | 
| 954 |  |  |  |  |  |  | =over | 
| 955 |  |  |  |  |  |  |  | 
| 956 |  |  |  |  |  |  | =item * | 
| 957 |  |  |  |  |  |  |  | 
| 958 |  |  |  |  |  |  | B<$other_eo> - evented object that will listen. | 
| 959 |  |  |  |  |  |  |  | 
| 960 |  |  |  |  |  |  | =item * | 
| 961 |  |  |  |  |  |  |  | 
| 962 |  |  |  |  |  |  | B<$prefix> - string that event names will be prefixed with on the listener. | 
| 963 |  |  |  |  |  |  |  | 
| 964 |  |  |  |  |  |  | =back | 
| 965 |  |  |  |  |  |  |  | 
| 966 |  |  |  |  |  |  | =head2 $eo->delete_listener($other_eo) | 
| 967 |  |  |  |  |  |  |  | 
| 968 |  |  |  |  |  |  | Removes a listener of this evented object. | 
| 969 |  |  |  |  |  |  |  | 
| 970 |  |  |  |  |  |  | See L"LISTENERS">. | 
| 971 |  |  |  |  |  |  |  | 
| 972 |  |  |  |  |  |  | $cow->delete_listener($farm); | 
| 973 |  |  |  |  |  |  |  | 
| 974 |  |  |  |  |  |  | B | 
| 975 |  |  |  |  |  |  |  | 
| 976 |  |  |  |  |  |  | =over | 
| 977 |  |  |  |  |  |  |  | 
| 978 |  |  |  |  |  |  | =item * | 
| 979 |  |  |  |  |  |  |  | 
| 980 |  |  |  |  |  |  | B<$other_eo> - evented object that will listen. | 
| 981 |  |  |  |  |  |  |  | 
| 982 |  |  |  |  |  |  | =back | 
| 983 |  |  |  |  |  |  |  | 
| 984 |  |  |  |  |  |  | =head1 CLASS MONITORS | 
| 985 |  |  |  |  |  |  |  | 
| 986 |  |  |  |  |  |  | An evented object can be registered as a "monitor" of a specific class/package. | 
| 987 |  |  |  |  |  |  |  | 
| 988 |  |  |  |  |  |  | I event callbacks that are added from that class to I evented object | 
| 989 |  |  |  |  |  |  | of I type will trigger an event on the monitor object. | 
| 990 |  |  |  |  |  |  |  | 
| 991 |  |  |  |  |  |  | An example scenario of when this might be useful is an evented object for | 
| 992 |  |  |  |  |  |  | debugging all events being registered by a certain package. It would log all of | 
| 993 |  |  |  |  |  |  | them, making it easier to find a problem. | 
| 994 |  |  |  |  |  |  |  | 
| 995 |  |  |  |  |  |  | =head2 $eo->monitor_events($pkg) | 
| 996 |  |  |  |  |  |  |  | 
| 997 |  |  |  |  |  |  | Registers an evented object as the class monitor for a specific package. | 
| 998 |  |  |  |  |  |  |  | 
| 999 |  |  |  |  |  |  | See L"CLASS MONITORS">. | 
| 1000 |  |  |  |  |  |  |  | 
| 1001 |  |  |  |  |  |  | my $some_eo  = Evented::Object->new; | 
| 1002 |  |  |  |  |  |  | my $other_eo = Evented::Object->new; | 
| 1003 |  |  |  |  |  |  |  | 
| 1004 |  |  |  |  |  |  | $some_eo->on('monitor:register_callback', sub { | 
| 1005 |  |  |  |  |  |  | my ($event, $eo, $event_name, $cb) = @_; | 
| 1006 |  |  |  |  |  |  | # $eo         == $other_eo | 
| 1007 |  |  |  |  |  |  | # $event_name == "blah" | 
| 1008 |  |  |  |  |  |  | # $cb         == callback hash from ->register_callback() | 
| 1009 |  |  |  |  |  |  | say "Registered $$cb{name} to $eo for $event_name"; | 
| 1010 |  |  |  |  |  |  | }); | 
| 1011 |  |  |  |  |  |  |  | 
| 1012 |  |  |  |  |  |  | $some_eo->monitor_events('Some::Class'); | 
| 1013 |  |  |  |  |  |  |  | 
| 1014 |  |  |  |  |  |  | package Some::Class; | 
| 1015 |  |  |  |  |  |  | $other_eo->on(blah => sub{}); # will trigger the callback above | 
| 1016 |  |  |  |  |  |  |  | 
| 1017 |  |  |  |  |  |  | =over | 
| 1018 |  |  |  |  |  |  |  | 
| 1019 |  |  |  |  |  |  | =item * | 
| 1020 |  |  |  |  |  |  |  | 
| 1021 |  |  |  |  |  |  | B<$pkg> - package whose event activity you wish to monitor. | 
| 1022 |  |  |  |  |  |  |  | 
| 1023 |  |  |  |  |  |  | =back | 
| 1024 |  |  |  |  |  |  |  | 
| 1025 |  |  |  |  |  |  | =head2 $eo->stop_monitoring($pkg) | 
| 1026 |  |  |  |  |  |  |  | 
| 1027 |  |  |  |  |  |  | Removes an evented object from its current position as a monitor for a specific | 
| 1028 |  |  |  |  |  |  | package. | 
| 1029 |  |  |  |  |  |  |  | 
| 1030 |  |  |  |  |  |  | See L"CLASS MONITORS">. | 
| 1031 |  |  |  |  |  |  |  | 
| 1032 |  |  |  |  |  |  | $some_eo->stop_monitoring('Some::Class'); | 
| 1033 |  |  |  |  |  |  |  | 
| 1034 |  |  |  |  |  |  | =over | 
| 1035 |  |  |  |  |  |  |  | 
| 1036 |  |  |  |  |  |  | =item * | 
| 1037 |  |  |  |  |  |  |  | 
| 1038 |  |  |  |  |  |  | B<$pkg> - package whose event activity you're monitoring. | 
| 1039 |  |  |  |  |  |  |  | 
| 1040 |  |  |  |  |  |  | =back | 
| 1041 |  |  |  |  |  |  |  | 
| 1042 |  |  |  |  |  |  | =head1 PROCEDURAL FUNCTIONS | 
| 1043 |  |  |  |  |  |  |  | 
| 1044 |  |  |  |  |  |  | The Evented::Object package provides some functions for use. These functions | 
| 1045 |  |  |  |  |  |  | typically are associated with more than one evented object or none at all. | 
| 1046 |  |  |  |  |  |  |  | 
| 1047 |  |  |  |  |  |  | =head2 fire_events_together(@events) | 
| 1048 |  |  |  |  |  |  |  | 
| 1049 |  |  |  |  |  |  | Fires multiple events at the same time. | 
| 1050 |  |  |  |  |  |  |  | 
| 1051 |  |  |  |  |  |  | This allows you to fire multiple similar | 
| 1052 |  |  |  |  |  |  | events on several evented objects at the same time. It essentially pretends that | 
| 1053 |  |  |  |  |  |  | the callbacks are all for the same event and all on the same object. | 
| 1054 |  |  |  |  |  |  |  | 
| 1055 |  |  |  |  |  |  | It follows priorities throughout all of the events and all of the objects, so it | 
| 1056 |  |  |  |  |  |  | is ideal for firing similar or identical events on multiple objects. | 
| 1057 |  |  |  |  |  |  |  | 
| 1058 |  |  |  |  |  |  | The same L is used throughout. | 
| 1059 |  |  |  |  |  |  | This means that callback names must unique among all of these | 
| 1060 |  |  |  |  |  |  | objects and events. It also means that stopping an event from any callback will | 
| 1061 |  |  |  |  |  |  | cancel all remaining callbacks, regardless to which event or which object they | 
| 1062 |  |  |  |  |  |  | belong. | 
| 1063 |  |  |  |  |  |  |  | 
| 1064 |  |  |  |  |  |  | The function takes a list of array references in the form of: | 
| 1065 |  |  |  |  |  |  | C<< [ $evented_object, event_name => @arguments ] >> | 
| 1066 |  |  |  |  |  |  |  | 
| 1067 |  |  |  |  |  |  | Evented::Object::fire_events_together( | 
| 1068 |  |  |  |  |  |  | [ $server,  user_joined_channel => $user, $channel ], | 
| 1069 |  |  |  |  |  |  | [ $channel, user_joined         => $user           ], | 
| 1070 |  |  |  |  |  |  | [ $user,    joined_channel      => $channel        ] | 
| 1071 |  |  |  |  |  |  | ); | 
| 1072 |  |  |  |  |  |  |  | 
| 1073 |  |  |  |  |  |  | C<< ->fire_events_together >> can also be used as a method | 
| 1074 |  |  |  |  |  |  | on any evented object. | 
| 1075 |  |  |  |  |  |  |  | 
| 1076 |  |  |  |  |  |  | $eo->fire_events_together( | 
| 1077 |  |  |  |  |  |  | [ some_event => @arguments ], | 
| 1078 |  |  |  |  |  |  | [ some_other => @other_arg ] | 
| 1079 |  |  |  |  |  |  | ); | 
| 1080 |  |  |  |  |  |  |  | 
| 1081 |  |  |  |  |  |  | The above example would formerly be achieved as: | 
| 1082 |  |  |  |  |  |  |  | 
| 1083 |  |  |  |  |  |  | Evented::Object::fire_events_together( | 
| 1084 |  |  |  |  |  |  | [ $eo, some_event => @arguments ], | 
| 1085 |  |  |  |  |  |  | [ $eo, some_other => @other_arg ] | 
| 1086 |  |  |  |  |  |  | ); | 
| 1087 |  |  |  |  |  |  |  | 
| 1088 |  |  |  |  |  |  | However, other evented objects may be specified even when this is used as a | 
| 1089 |  |  |  |  |  |  | method. Basically, anywhere that an object is missing will fall back to the | 
| 1090 |  |  |  |  |  |  | object on which the method was called. | 
| 1091 |  |  |  |  |  |  |  | 
| 1092 |  |  |  |  |  |  | $eo->fire_events_together( | 
| 1093 |  |  |  |  |  |  | [ $other_eo, some_event => @arguments ], | 
| 1094 |  |  |  |  |  |  | [            some_other => @other_arg ] # no object, falls back to $eo | 
| 1095 |  |  |  |  |  |  | ); | 
| 1096 |  |  |  |  |  |  |  | 
| 1097 |  |  |  |  |  |  | Returns the L. | 
| 1098 |  |  |  |  |  |  |  | 
| 1099 |  |  |  |  |  |  | B | 
| 1100 |  |  |  |  |  |  |  | 
| 1101 |  |  |  |  |  |  | =over | 
| 1102 |  |  |  |  |  |  |  | 
| 1103 |  |  |  |  |  |  | =item * | 
| 1104 |  |  |  |  |  |  |  | 
| 1105 |  |  |  |  |  |  | B<@events> - array of events in the form of | 
| 1106 |  |  |  |  |  |  | C<< [$eo, event_name => @arguments] >>. | 
| 1107 |  |  |  |  |  |  |  | 
| 1108 |  |  |  |  |  |  | =back | 
| 1109 |  |  |  |  |  |  |  | 
| 1110 |  |  |  |  |  |  | =head2 safe_fire($eo, $event_name, @args) | 
| 1111 |  |  |  |  |  |  |  | 
| 1112 |  |  |  |  |  |  | Safely fires an event. In other words, if the C<$eo> is not an evented | 
| 1113 |  |  |  |  |  |  | object or is not blessed at all, the call will be ignored. This eliminates the | 
| 1114 |  |  |  |  |  |  | need to use C and C<< ->isa() >> on a value for testing whether it is | 
| 1115 |  |  |  |  |  |  | an evented object. | 
| 1116 |  |  |  |  |  |  |  | 
| 1117 |  |  |  |  |  |  | Evented::Object::safe_fire($eo, myEvent => 'my argument'); | 
| 1118 |  |  |  |  |  |  |  | 
| 1119 |  |  |  |  |  |  | B | 
| 1120 |  |  |  |  |  |  |  | 
| 1121 |  |  |  |  |  |  | =over | 
| 1122 |  |  |  |  |  |  |  | 
| 1123 |  |  |  |  |  |  | =item * | 
| 1124 |  |  |  |  |  |  |  | 
| 1125 |  |  |  |  |  |  | B<$eo> - evented object. | 
| 1126 |  |  |  |  |  |  |  | 
| 1127 |  |  |  |  |  |  | =item * | 
| 1128 |  |  |  |  |  |  |  | 
| 1129 |  |  |  |  |  |  | B<$event_name> - name of the event. | 
| 1130 |  |  |  |  |  |  |  | 
| 1131 |  |  |  |  |  |  | =item * | 
| 1132 |  |  |  |  |  |  |  | 
| 1133 |  |  |  |  |  |  | B<@args> - arguments for the event fire. | 
| 1134 |  |  |  |  |  |  |  | 
| 1135 |  |  |  |  |  |  | =back | 
| 1136 |  |  |  |  |  |  |  | 
| 1137 |  |  |  |  |  |  | =head1 ALIASES | 
| 1138 |  |  |  |  |  |  |  | 
| 1139 |  |  |  |  |  |  | A number of aliases exist for convenience, but please only use them if you're | 
| 1140 |  |  |  |  |  |  | certain that other subclassing will not interfere. | 
| 1141 |  |  |  |  |  |  |  | 
| 1142 |  |  |  |  |  |  | =head2 $eo->on(...) | 
| 1143 |  |  |  |  |  |  |  | 
| 1144 |  |  |  |  |  |  | Alias for C<< $eo->register_callback() >>. | 
| 1145 |  |  |  |  |  |  |  | 
| 1146 |  |  |  |  |  |  | =head2 $eo->del(...) | 
| 1147 |  |  |  |  |  |  |  | 
| 1148 |  |  |  |  |  |  | If one argument provided, alias for C<< $eo->delete_event >>. | 
| 1149 |  |  |  |  |  |  |  | 
| 1150 |  |  |  |  |  |  | If two arguments provided, alias for C<< $eo->delete_callback >>. | 
| 1151 |  |  |  |  |  |  |  | 
| 1152 |  |  |  |  |  |  | =head2 $eo->fire(...) | 
| 1153 |  |  |  |  |  |  |  | 
| 1154 |  |  |  |  |  |  | Alias for C<< $eo->fire_event() >>. | 
| 1155 |  |  |  |  |  |  |  | 
| 1156 |  |  |  |  |  |  | =head2 $eo->register_event(...) | 
| 1157 |  |  |  |  |  |  |  | 
| 1158 |  |  |  |  |  |  | Alias for C<< $eo->register_callback() >>. | 
| 1159 |  |  |  |  |  |  |  | 
| 1160 |  |  |  |  |  |  | =head2 $eo->register_events(...) | 
| 1161 |  |  |  |  |  |  |  | 
| 1162 |  |  |  |  |  |  | Alias for C<< $eo->register_callbacks() >>. | 
| 1163 |  |  |  |  |  |  |  | 
| 1164 |  |  |  |  |  |  | =head2 $fire->eo | 
| 1165 |  |  |  |  |  |  |  | 
| 1166 |  |  |  |  |  |  | Alias for C<< $fire->object >>. | 
| 1167 |  |  |  |  |  |  |  | 
| 1168 |  |  |  |  |  |  | =head1 AUTHOR | 
| 1169 |  |  |  |  |  |  |  | 
| 1170 |  |  |  |  |  |  | L | 
| 1171 |  |  |  |  |  |  |  | 
| 1172 |  |  |  |  |  |  | Copyright E 2011-2020. Released under New BSD license. | 
| 1173 |  |  |  |  |  |  |  | 
| 1174 |  |  |  |  |  |  | Comments, complaints, and recommendations are accepted. Bugs may be reported on | 
| 1175 |  |  |  |  |  |  | L. |