File Coverage

blib/lib/OpenInteract/Error.pm

Criterion	Covered	Total	%
statement	9	39	23.0
branch	0	4	0.0
condition	0	15	0.0
subroutine	3	7	42.8
pod	0	4	0.0
total	12	69	17.3

package OpenInteract::Error;

# $Id: Error.pm,v 1.6 2002/01/02 02:43:53 lachoy Exp $

use strict;

$OpenInteract::Error::VERSION = sprintf("%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/);

use constant DEBUG => 0;

# Collection of error tracking variables -- look ma, no 'use vars'!

$OpenInteract::Error::user_msg   = undef;
$OpenInteract::Error::system_msg = undef;
$OpenInteract::Error::type       = undef;
$OpenInteract::Error::package    = undef;
$OpenInteract::Error::filename   = undef;
$OpenInteract::Error::line       = undef;
$OpenInteract::Error::method     = undef;
$OpenInteract::Error::extra      = ();
$OpenInteract::Error::notes      = undef;

sub clear {
    $OpenInteract::Error::user_msg   = undef;
    $OpenInteract::Error::system_msg = undef;
    $OpenInteract::Error::type       = undef;
    $OpenInteract::Error::package    = undef;
    $OpenInteract::Error::filename   = undef;
    $OpenInteract::Error::line       = undef;
    $OpenInteract::Error::method     = undef;
    $OpenInteract::Error::extra      = {};
    $OpenInteract::Error::notes      = undef;
}

# Retrieve all the package variables in a hashref
sub get {
    my ( $class ) = @_;
    return { user_msg   => $OpenInteract::Error::user_msg,
             system_msg => $OpenInteract::Error::system_msg,
             type       => $OpenInteract::Error::type,
             package    => $OpenInteract::Error::package,
             filename   => $OpenInteract::Error::filename,
             line       => $OpenInteract::Error::line,
             method     => $OpenInteract::Error::method,
             extra      => $OpenInteract::Error::extra,
             notes      => $OpenInteract::Error::notes };
}


# Set all package variables

sub set {
    my ( $class, $p ) = @_;
    no strict 'refs';

    # First clean everything up so there's nothing
    # hanging around from a previous error

    OpenInteract::Error->clear;

    # Then set everything passed in

    foreach my $key ( keys %{ $p } ) {
        warn "OpenInteractI::Error::set >> Setting error $key to $p->{ $key }\n" if ( DEBUG );
        ${ 'OpenInteract::Error::' . $key } = $p->{ $key };
    }

    # Set the caller information if the user didn't pass
    # anything in

    unless ( $p->{package} and $p->{filename} and $p->{line} ) {
        ( $OpenInteract::Error::package,
          $OpenInteract::Error::filename,
          $OpenInteract::Error::line ) = caller;
    }
    return OpenInteract::Error->get;
}


# Class method -- really we just collect the caller info and
# send it over to the error object...

sub throw {
    my ( $class, $p ) = @_;
    my $R = OpenInteract::Request->instance;
    unless ( $p->{package} and $p->{filename} and $p->{line} ) {
        my ( $cpkg, $cfile, $cline ) = caller;
        $p->{package}  = $cpkg;
        $p->{filename} = $cfile;
        $p->{line}     = $cline;
    }
    my $error_obj_class = $R->CONFIG->{error}{error_object_class} ||
                          $R->CONFIG->{error_object_class};
    return $error_obj_class->throw( $p );
}

1;

__END__