File Coverage

blib/lib/OpenPlugin/Exception.pm

Criterion	Covered	Total	%
statement	57	71	80.2
branch	7	16	43.7
condition	5	11	45.4
subroutine	15	19	78.9
pod	2	12	16.6
total	86	129	66.6

package OpenPlugin::Exception;

# $Id: Exception.pm,v 1.33 2003/05/13 14:59:22 andreychek Exp $

use strict;
use base                  qw( OpenPlugin::Plugin );
#use overload              q("") => \&stringify;
use overload '""' => sub { $_[0]->to_string };
use Devel::StackTrace();

$OpenPlugin::Exception::VERSION = sprintf("%d.%02d", q$Revision: 1.33 $ =~ /(\d+)\.(\d+)/);

my @STACK  = ();
my @FIELDS = qw( message package filename line method trace );

sub type { return 'exception' }
sub OP   { return $_[0]->{_m}{OP} }


########################################
# CLASS METHODS

sub log_throw {
    my ( $self, @message ) = @_;

    my $params  = ( ref $message[-1] eq 'HASH' )
                    ? pop( @message ) : {};

    my $message = join( '', @message );

    # We don't want the message to look like it's coming from this method, we
    # want it to appear as if it was generated by the method which called us
    $Log::Log4perl::caller_depth++;
    $self->OP->log->fatal( @message );
    $Log::Log4perl::caller_depth--;

    $self->throw( $message );

}

sub throw {
    my ( $self, @message ) = @_;

    my $class = ref( $self ) || $self;

    # Allow exception's to be rethrown, without further processing
    if ( ref $message[0] ) {
        my $rethrown = $message[0];
        if ( UNIVERSAL::isa( $rethrown, __PACKAGE__ ) ) {
            die $rethrown;
        }
    }

    my $params = ( ref $message[-1] eq 'HASH' )
                   ? pop( @message ) : {};

    my $msg    = join( '', @message );

    # Set a default in case throw is called without a value
    $msg ||= "Nuts, an error has occurred.";

    foreach my $field ( $self->get_fields() ) {
        $self->state( $field, $params->{ $field } ) if ( $params->{ $field } );

        # Build the accessor methods to our exception properties
        no strict 'refs';
        unless ( defined &{ $field } ) {
            *{ $field } = sub { return $_[0]->state( $field ); };
        }
    }

    # Now do the message and the initial trace stuff

    $self->state( 'message', $msg );

    my @initial_call = $self->custom_caller;
    $self->state( 'package',  $initial_call[0] );
    $self->state( 'filename', $initial_call[1] );
    $self->state( 'line',     $initial_call[2] );
    $self->state( 'method',   $initial_call[3] );

    $self->state( 'trace', Devel::StackTrace->new());

    $self->initialize( $params );

    push @STACK, $self;

    die $self;

}

sub custom_caller {
    # the below could all be just:
    # my ($pack, $file, $line) = caller(2);
    # but if we ever bury this further, it'll break. So we do this
    # little trick stolen and paraphrased first from Carp/Heavy.pm, then
    # from Log4perl/Logger.pm

    my $i = 0;
    my (undef, $localfile, undef) = caller($i++);
    my ($pack, $file, $line, $method);
    do {
        ($pack, $file, $line) = caller($i++);
    } while ($file && $file eq $localfile);

    # Grab the method name separately, since the subroutine call
    # doesn't seem to be matched up properly with the other caller()
    # stuff when we do caller(0). Weird.
    $method = (caller($i))[3];

    return ( $pack, $file, $line, $method );
}

sub initialize {}

sub get_fields  { return @FIELDS }

sub get_stack   { return @STACK }
sub clear_stack { @STACK = ()   }

#sub trace       { return $_[0]->state->{ trace } };

########################################
# OBJECT METHODS

sub creation_location {
    my ( $self ) = @_;
    return 'Created in package [' . $self->state->{ package }  . '] ' .
                    'in method [' . $self->state->{ method }   . '] ' .
                      'at file [' . $self->state->{ filename } . '] ' .
                      'at line [' . $self->state->{ line }     . ']';
}

sub stringify   { return $_[0]->to_string() }
sub to_string   {
    my ( $self ) = @_;
    my $class = ref $self;

    return "Invalid -- not called from object." unless ( $class );

    # Give everything back if it doesn't look like we were meant to be called
    unless (( $self->state ) && ( $self->state->{ message } )) {
        return @_;
    }

    #no strict 'refs';
    return $self->state->{ message }; #unless ( ${ $class . '::ShowTrace' } );

    #return join( "\n", $_[0]->state->{message}, $_[0]->trace );
}


1;

__END__