File Coverage

lib/Haineko/E.pm

Criterion	Covered	Total	%
statement	47	47	100.0
branch	6	8	75.0
condition	4	4	100.0
subroutine	7	7	100.0
pod	3	4	75.0
total	67	70	95.7

package Haineko::E;
use strict;
use warnings;
use Class::Accessor::Lite;

my $rwaccessors = [
    'file',     # (String) Path to the module file which an error occurred.
    'line',     # (Integer) line number
    'mesg',     # (ArrayRef) Reply messages
];
my $roaccessors = [];
my $woaccessors = [];
Class::Accessor::Lite->mk_accessors( @$rwaccessors );

sub new {
    my $class = shift;
    my $argvs = shift || return undef;
    my $param = {
        'file' => undef,
        'line' => undef,
        'mesg' => [],
    };
    chomp $argvs;

    if( $argvs =~ m|\A(.+)\s+at\s+(.+)\s+line\s+(\d+)[.]\z| ) {
        # Error message at /path/to/file line 22.
        $param->{'file'} = $2;
        $param->{'line'} = $3;
        $param->{'mesg'} = __PACKAGE__->p( $1 );

    } else {
        my $c = [ caller ];
        $param->{'file'} = $c->[1];
        $param->{'line'} = $c->[2];
        $param->{'mesg'} = __PACKAGE__->p( $1 );
    }
    return bless $param, __PACKAGE__;
}

sub p {
    my $class = shift;
    my $argvs = shift || return [];
    my $error = [];

    chomp $argvs;
    if( $argvs =~ m|\A(Can't locate .+\s)(in\s[@]INC\s.+)\z| ) {
        # Can\'t locate Haineko/SMTPD/Relay/Neko.pm in @INC (@INC contains: /tmp...)
        $error = [ $1, $2 ];

    } else {
        $error = [ split( "\n", $argvs ) ];
    }

    for my $e ( @$error ) {
        $e =~ s|\A\s*||;
        $e =~ s|\s*\z||;
    }

    return $error;
}

sub message {
    my $self = shift;
    my $mesg = q();

    return q() unless scalar @{ $self->{'mesg'} };
    $mesg .= join( "\n", @{ $self->{'mesg'} } );
    $mesg .= sprintf( " at %s", $self->{'file'} );
    $mesg .= sprintf( " line %d.", $self->{'line'} );

    return $mesg;
}

sub text {
    my $self = shift;
    return q() unless scalar @{ $self->{'mesg'} };
    return join( ' ', @{ $self->{'mesg'} } );
}

1;
__END__