File Coverage

blib/lib/Math/ModInt/Event/Trap.pm

Criterion	Covered	Total	%
statement	57	57	100.0
branch	16	16	100.0
condition	2	3	66.6
subroutine	16	16	100.0
pod	2	2	100.0
total	93	94	98.9

# Copyright (c) 2010-2015 Martin Becker.  All rights reserved.
# This package is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# $Id: Trap.pm 60 2015-05-18 08:47:12Z demetri $

package Math::ModInt::Event::Trap;

use 5.006;
use strict;
use warnings;
use Carp qw(carp croak);

# ----- class data -----

BEGIN {
    our @CARP_NOT = qw(Math::ModInt::Event);
    our $VERSION  = '0.011';
}

# Math::ModInt::Event::Trap=ARRAY(...)

# ........... index ...........   # ............ value ............
use constant F_TRAP_ID    => 0;   # instance ID, used as a weak ref
use constant NFIELDS      => 1;

# ARRAY, element of @handlers:

# ........... index ...........   # ............ value ............
use constant H_TRAP_ID    => 0;   # instance ID of trap (0 if static)
use constant H_EVENT      => 1;   # event to trap
use constant H_HANDLER    => 2;   # the handler coderef

my $unique   = 0;
my @handlers = ();

my %generic_handlers = (
    'ignore' => sub { 0 },
    'warn' =>
        sub {
            my ($event, @details) = @_;
            carp join q[: ], 'warning', $event->description, @details;
            return 0;
        },
    'die' =>
        sub {
            my ($event, @details) = @_;
            croak join q[: ], 'error', $event->description, @details;
        },
);

# ----- private subroutines -----

sub _discard_handler {
    my ($trap_id) = @_;
    @handlers = grep { $trap_id != $_->[H_TRAP_ID] } @handlers;
}

sub _add_handler {
    my ($trap_id, $event, $handler) = @_;
    push @handlers, [$trap_id, $event, $handler];
}

sub _final_trap {
    my ($event, @details) = @_;
    croak join q[: ], $event->description, @details;
}

# ----- public methods -----

sub new {
    my ($class, $event, $handler) = @_;
    my $is_static = defined wantarray? 0: 1;
    my $trap_id   = $is_static? 0: ++$unique;
    if (!ref $handler) {
        if (!$handler || !exists $generic_handlers{$handler}) {
            $event->UsageError->raise(
                'bad argument: generic trap type or coderef expected'
            );
        }
        $handler = $generic_handlers{$handler};
    }
    _add_handler($trap_id, $event, $handler);
    return if $is_static;
    return bless [$trap_id], $class;
}

sub DESTROY {
    my ($this) = @_;
    _discard_handler($this->[F_TRAP_ID]);
}

sub broadcast {
    my ($class, $event, @details) = @_;
    my $called = 0;
    foreach my $handler (reverse @handlers) {
        if ($event->isa(ref $handler->[H_EVENT])) {
            ++$called;
            last if !$handler->[H_HANDLER]->($event, @details);
        }
    }
    if (!$event->is_recoverable) {
        _final_trap($event, @details);
    }
    return $called;
}

1;

__END__