File Coverage

blib/lib/Error/Hierarchy/Container.pm

Criterion	Covered	Total	%
statement	22	45	48.8
branch	0	2	0.0
condition			n/a
subroutine	8	12	66.6
pod	5	5	100.0
total	35	64	54.6

use 5.008;
use strict;
use warnings;

package Error::Hierarchy::Container;
BEGIN {
  $Error::Hierarchy::Container::VERSION = '1.103530';
}

use Class::Trigger;
use Error::Hierarchy::Util 'load_class';

# ABSTRACT: Container for hierarchical exceptions
use parent qw(
  Data::Container
  Error::Hierarchy::Base
);

sub items_push {
    my ($self, @values) = @_;
    $self->call_trigger('before_push', @values);
    $self->SUPER::items_push(@values);

}

sub items_set_push {
    my ($self, @values) = @_;

    # Some methods won't work on non-E-H objects; report them so they appear
    # directly - e.g., in the error.log if running under mod_perl
    $self->call_trigger('before_push', @values);
    $self->SUPER::items_set_push(@values);
}

sub record {
    my ($self, $exception_class, %args) = @_;

    load_class $exception_class, 1;
    # make record() invisible to caller when reporting exception location
    local $Error::Depth = $Error::Depth + 1;
    $self->items_set_push($exception_class->record(%args));
}

# Given a list of uuid's, deletes all exceptions from the container whose uuid
# is one of those given.
sub delete_by_uuid {
    my ($self, @uuid) = @_;
    my %uuid;
    @uuid{@uuid} = ();
    $self->items(grep { !exists $uuid{$_} } $self->items);
}

sub delete_duplicate_exceptions {
    my $self = shift;
    my @items;
    my %seen;
    for my $exception ($self->items) {
        my %properties = $exception->properties_as_hash;
        $properties{__package} = ref $exception;
        my $signature =
          join ';' => map { $_ => $properties{$_} } sort keys %properties;
        next if $seen{$signature}++;
        push @items => $exception;
    }
    $self->items(@items);
    $self;
}
1;


__END__