File Coverage

blib/lib/Eidolon/Core/Exception.pm

Criterion	Covered	Total	%
statement	36	37	97.3
branch	2	6	33.3
condition			n/a
subroutine	11	12	91.6
pod	5	5	100.0
total	54	60	90.0

package Eidolon::Core::Exception;
# ==============================================================================
#
#   Eidolon
#   Copyright (c) 2009, Atma 7
#   ---
#   Eidolon/Core/Exception.pm - base exception class
#
# ==============================================================================

use base qw/Class::Accessor::Fast/;
use warnings;
use strict;

__PACKAGE__->mk_accessors(qw/message line file/);

our $VERSION = "0.02"; # 2009-05-14 04:42:38

use constant TITLE => "Base exception";

# overload some operations
use overload
    "bool" => sub { 1 },
    "eq"   => "overloaded_equ",
    '""'   => "overloaded_str";

# ------------------------------------------------------------------------------
# \% new($message)
# constructor
# ------------------------------------------------------------------------------
sub new
{
    my ($class, $message, $self);

    ($class, $message) = @_;

    # class attributes
    $self =
    {
        "message" => $message,
        "line"    => undef,
        "file"    => undef
    };

    bless $self, $class;
    $self->_init;

    return $self;
}

# ------------------------------------------------------------------------------
# _init()
# class initialization
# ------------------------------------------------------------------------------
sub _init
{
    my ($self, $file, $line);

    $self = shift;

    # get caller info
    (undef, $file, $line) = caller(2);

    $self->file( $file );
    $self->line( $line );
}

# ------------------------------------------------------------------------------
# throw()
# throw exception
# ------------------------------------------------------------------------------
sub throw
{
    my $class = shift;

    $class->rethrow(@_) if (ref $class);
    die $class->new(@_);
}

# ------------------------------------------------------------------------------
# rethrow()
# rethrow exception
# ------------------------------------------------------------------------------
sub rethrow
{
    die $_[0] if (ref $_[0]);
}

# ------------------------------------------------------------------------------
# $ overloaded_equ($class)
# check the type of exception
# ------------------------------------------------------------------------------
sub overloaded_equ
{
    return $_[0]->isa($_[1]);
}

# ------------------------------------------------------------------------------
# $ overloaded_str()
# stringify exception
# ------------------------------------------------------------------------------
sub overloaded_str
{
    my ($self, $str);

    $self = shift;
    $str  = $self->TITLE;
    $str .= $self->message ? ": ".$self->message : "";

    return $str;
}

1;

__END__