view release on metacpan or  search on metacpan

lib/Evented/Object/Collection.pm  view on Meta::CPAN

# Copyright (c) 2011-17, Mitchell Cooper
#
# Evented::Object: a simple yet featureful base class event framework.
# https://github.com/cooper/evented-object
#
package Evented::Object::Collection; # leave this package name the same FOREVER.

use warnings;
use strict;
use utf8;
use 5.010;

use Scalar::Util qw(weaken blessed);
use List::Util qw(min max);
use Carp qw(carp);

our $VERSION = '5.68';
our $events  = $Evented::Object::events;
our $props   = $Evented::Object::props;

my $dummy;
my %boolopts = map { $_ => 1 } qw(safe return_check fail_continue);

sub new {
    return bless {
        pending         => {},
        default_names   => {},
        names           => {}
    }, shift;
}

sub push_callbacks {
    my ($collection, $callbacks, $names) = @_;
    my $pending  = $collection->{pending};
    my $my_names = $collection->{names};

    # add to pending callbacks and callback name-to-ID mapping.
    @$pending { keys %$callbacks } = values %$callbacks;
    @$my_names{ keys %$names     } = values %$names;

    # set default names for any callback names which were not found
    $collection->{default_names}{ $_->[2]{name} } ||= $_->[2]{id}
        for values %$callbacks;
}

#
#   Available fire options
#   ----------------------
#
#   safe            calls all callbacks within eval blocks.
#                   consumes no parameter.
#
#   return_check    causes the event to ->stop if any callback returns false
#                   BUT IT WAITS until all have been fired. so if one returns false,
#                   the rest will be called, but $fire->stopper will be true afterward.
#                   consumes no parameter.
#
#   caller          specify an alternate [caller 1] value, mostly for internal use.
#                   parameter = caller(1) info wrapped in an array reference.
#
#   fail_continue   if 'safe' is enabled and a callback raises an exception, it will
#                   by default ->stop the fire. this option tells it to continue instead.
#                   consumes no parameter.
#
#   data            some data to fire with the event. esp. good for things that might be
#                   useful at times but not accessed frequently enough to be an argument.
#                   parameter = the data.
#
sub fire {
    my ($collection, @options) = @_;

    # handle options.
    my ($caller, $data) = $collection->{caller};

lib/Evented/Object/Collection.pm  view on Meta::CPAN

    # the final sort by numerical priority.
    $collection->{sorted} = [ sort { $b->[0] <=> $a->[0] } @sorted ];

}

# Nov. 22, 2013 revision
# ----------------------
#
#   collection      a set of callbacks about to be fired. they might belong to multiple
#                   objects or maybe even multiple events. they can each have their own
#                   arguments, and they all have their own options, code references, etc.
#
#        group      represents the group to which a callback belongs. a group consists of
#                   the associated evented object, event name, and arguments.
#
# This revision eliminates all of these nested structures by reworking the way
# a callback collection works. A collection should be an array of callbacks.
# This array, unlike before, will contain an additional element: an array
# reference representing the "group."
#
#   @collection = (
#       [ $priority, $group, $cb ],
#       [ $priority, $group, $cb ],
#       ...
#   )
#
#   $group =                                $cb =
#   [ $eo, $event_name, $args, $id ]        { code, caller, %opts }
#
# This format has several major advantages over the former one. Specifically,
# it makes it very simple to determine which callbacks will be called in the
# future, which ones have been called already, how many are left, etc.
#

# call the passed callback priority sets.
sub _call_callbacks {
    my ($collection, $fire) = @_;
    my $ef_props = $fire->{$props};

    # store the collection.
    my $remaining = $collection->{sorted} or return;
    $ef_props->{collection} = $collection;

    # call each callback.
    while (my $entry = shift @$remaining) {
        my ($priority, $group, $cb) = @$entry;
        my ($eo, $event_name, $args, $group_id) = @$group;

        # sanity check!
        blessed $eo && $eo->isa('Evented::Object') or return;

        # callback name-to-ID mapping is specific to each group.
        $ef_props->{callback_ids} = $collection->_group_names($group_id);

        # increment the callback counter.
        $ef_props->{callback_i}++;

        # set the evented object of this callback.
        # set the event name of this callback.
        $ef_props->{object}             = $eo; weaken($ef_props->{object});     # $fire->object
        $ef_props->{name}               = $event_name;                          # $fire->event_name

        # store identifiers.
        $ef_props->{callback_id}        = my $cb_id = $cb->{id};
        $ef_props->{group_id}           = $group_id;

        # create info about the call.
        $ef_props->{callback_name}      = $cb->{name};                          # $fire->callback_name
        $ef_props->{callback_priority}  = $priority;                            # $fire->callback_priority
        $ef_props->{callback_data}      = $cb->{data} if defined $cb->{data};   # $fire->callback_data

        # this callback has been called already.
        next if $ef_props->{called}{$cb_id};

        # this callback has probably been cancelled.
        next unless $collection->{pending}{$cb_id};


        # determine arguments.
        #
        # no compat <3.0: used to always have obj unless specified with no_obj or later no_fire_obj.
        # no compat <2.9: with_obj -> eo_obj
        # compat: all later version had a variety of with_obj-like-options below.
        #
        my @cb_args = @$args;
        my $include_obj = grep $cb->{$_}, qw(with_eo with_obj with_evented_obj eo_obj);
        unshift @cb_args, $fire unless $cb->{no_fire_obj};
        unshift @cb_args, $eo   if $include_obj;

        # set return values.
        $ef_props->{last_return}            =   # set last return value.
        $ef_props->{return}{$cb_id}         =   # set this callback's return value.

            # call the callback with proper arguments.
            $collection->{safe} ? eval { $cb->{code}(@cb_args) }
                                :        $cb->{code}(@cb_args);

        # set $fire->called($cb) true, and set $fire->last to the callback's name.
        $ef_props->{called}{$cb_id} = 1;
        $ef_props->{last_callback}  = $cb->{name};

        # no longer pending.
        delete $collection->{pending}{$cb_id};

        # stop if eval failed.
        if ($collection->{safe} and my $err = $@) {
            chomp $err;
            $ef_props->{error}{$cb_id} = # not used for anything
            $ef_props->{exception}     = $err;
            $fire->stop($err) unless $collection->{fail_continue};
        }

        # if stop is true, $fire->stop was called. stop the iteration.
        if ($ef_props->{stop}) {
            $ef_props->{stopper} = $cb->{name}; # set $fire->stopper.
            last;
        }

    }