File Coverage

blib/lib/failures.pm

Criterion	Covered	Total	%
statement	61	61	100.0
branch	16	16	100.0
condition	6	6	100.0
subroutine	14	14	100.0
pod			n/a
total	97	97	100.0

use 5.008001;
use strict;
use warnings;

package failures;
# ABSTRACT: Minimalist exception hierarchy generator
our $VERSION = '0.004'; # VERSION

sub import {
    no strict 'refs';
    my ( $class, @failures ) = @_;
    my $caller    = caller;
    my $is_custom = $class eq 'custom::failures';
    if ( $is_custom && ref $failures[1] eq 'ARRAY' ) {
        $caller   = shift @failures;
        @failures = @{ $failures[0] };
    }
    for my $f (@failures) {
        # XXX should check $f for valid package name
        my $custom  = $caller;
        my $default = 'failure';
        push @{"$custom\::ISA"}, $default if $is_custom;
        for my $p ( split /::/, $f ) {
            push @{"$default\::$p\::ISA"}, $default;
            $default .= "::$p";
            if ($is_custom) {
                push @{"$custom\::$p\::ISA"}, $custom, $default;
                $custom .= "::$p";
            }
        }
    }
}

package failure;

use Class::Tiny { msg => '', trace => '', payload => undef };

use overload ( q{""} => \&as_string, fallback => 1 );

sub throw {
    my ( $class, $msg ) = @_;
    my $m = ref $msg eq 'HASH' ? $msg : { msg => $msg };
    die $class->new( map { defined $m->{$_} ? ( $_ => $m->{$_} ) : () } keys %$m );
}

sub message {
    my ( $self, $msg ) = @_;
    my $intro = "Caught @{[ref $self]}";
    return defined($msg) && length($msg) ? "$intro: $msg" : $intro;
}

sub as_string {
    my ($self) = @_;
    my ( $message, $trace ) = ( $self->message( $self->msg ), $self->trace );
    return length($trace) ? "$message\n\n$trace\n" : "$message\n";
}

sub line_trace {
    my ( undef, $filename, $line ) = caller(0);
    return "Failure caught at $filename line $line.";
}

for my $fn (qw/croak_trace confess_trace/) {
    no strict 'refs';
    no warnings 'once';
    *{$fn} = sub {
        require Carp;
        local @failure::CARP_NOT = ( scalar caller );
        chomp( my $trace = $fn eq 'croak_trace' ? Carp::shortmess('') : Carp::longmess('') );
        return "Failure caught$trace";
    };
}

1;


# vim: ts=4 sts=4 sw=4 et:

__END__