File Coverage

blib/lib/Error/Unhandled.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

##########################################################################
#
# Error::Unhandled - a Module for letting Errors do their own handling
#
# Author: Toby Everett
# Revision: 1.02
# Last Change: Fixed Makefile.pl bug
##########################################################################
# Copyright 1995 Graham Barr, 1999 Toby Everett.  All rights reserved.
#
# This file is distributed under the Artistic License. See
# http://www.ActiveState.com/corporate/artistic_license.htm or
# the license that comes with your perl distribution.
#
# For comments, questions, bugs or general interest, feel free to
# contact Toby Everett at [e-mail]
#
# Graham Barr was responsible for the prototype throw method which I copied
# and extended to implement this throw method.
##########################################################################

use Error 0.12;

package Error::Unhandled;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

@ISA = qw(Error);

$VERSION = '1.02';

sub throw {
  my $self = shift;
  local $Error::Depth = $Error::Depth + 1;

  # if we are not rethrow-ing then create the object to throw
  $self = $self->new(@_) unless ref($self);

  my $i = 0;
  my $handled = 0;
  while(my $subname = (caller($i++))[3]) {
    if ($subname eq '(eval)' && (caller($i))[3] eq 'Error::subs::try') {
      $handled = 1;
      last;
    }
  }
  unless ($handled) {
    if (exists $self->{unhandled}) {
      ref($self->{unhandled}) eq 'CODE' and $self->{unhandled}->($self);
    } else {
      $self->unhandled;
    }
  }
  die $Error::THROWN = $self;
}

sub unhandled {
}

1;

__END__