CatalystX::Usul::Exception - Exception base class


CatalystX-Usul documentation Contained in the CatalystX-Usul distribution.

Index


Code Index:

Name

Top

CatalystX::Usul::Exception - Exception base class

Version

Top

0.3.$Revision: 596 $

Synopsis

Top

   use base qw(CatalystX::Usul);

   sub some_method {
      my $self = shift; my $e;

      eval { this_will_fail }

      $self->throw( $e ) if ($e = $self->catch);
   }

Description

Top

Implements try (by way of an eval), throw, and catch error semantics. Inherits from Exception::Class

Subroutines/Methods

Top

catch

Catches and returns a thrown exception or generates a new exception if EVAL_ERROR has been set

as_string

   warn $e->as_string( $verbosity, $offset );

Serialise the exception to a string. The passed parameters; verbosity and offset determine how much output is returned.

The verbosity parameter can be:

1

The default value. Only show a stack trace if $self->show_trace is true

2

Always show the stack trace and start at frame offset which defaults to 1. The stack trace stops when the first duplicate output line is detected

3

Always shows the complete stack trace starting at frame 0

throw

Create (or re-throw) an exception to be caught by the catch above. If the passed parameter is a reference it is re-thrown. If a single scalar is passed it is taken to be an error message code, a new exception is created with all other parameters taking their default values. If more than one parameter is passed the it is treated as a list and used to instantiate the new exception. The 'error' parameter must be provided in this case

Diagnostics

Top

None

Configuration and Environment

Top

The $IGNORE package variable is list of methods whose presence should be suppressed in the stack trace output

Dependencies

Top

Exception::Class
List::Util

Incompatibilities

Top

There are no known incompatibilities in this module

Bugs and Limitations

Top

The default ignore package list should be configurable

There are no known bugs in this module. Please report problems to the address below. Patches are welcome

Author

Top

Peter Flanigan <Support at RoxSoft.co.uk>

License and Copyright

Top


CatalystX-Usul documentation Contained in the CatalystX-Usul distribution.

# @(#)$Id: Exception.pm 596 2009-06-16 18:49:50Z pjf $

package CatalystX::Usul::Exception;

use strict;
use warnings;
use version; our $VERSION = qv( sprintf '0.3.%d', q$Rev: 596 $ =~ /\d+/gmx );
use Exception::Class
   ( 'CatalystX::Usul::Exception::Class' => { fields => [qw(args out rv)] } );
use base qw(CatalystX::Usul::Exception::Class);

use Carp;
use English qw(-no_match_vars);

my $NUL = q();

our $IGNORE = [ __PACKAGE__ ];

sub catch {
   my ($self, @rest) = @_; my $e;

   return $e if ($e = $self->caught( @rest ));

   return $self->new( args           => [],
                      ignore_package => $IGNORE,
                      out            => $NUL,
                      rv             => 1,
                      show_trace     => 0,
                      error          => $EVAL_ERROR ) if ($EVAL_ERROR);

   return;
}

sub as_string {
   my ($self, $verbosity, $offset) = @_; $verbosity ||= 1; $offset ||= 1;

   my ($l_no, %seen); my $text = $NUL.$self->message; # I hate Return::Value

   return $text if ($verbosity < 2 and not $self->show_trace);

   my $i = $verbosity > 2 ? 0 : $offset; my $frame = undef;

   while (defined ($frame = $self->trace->frame( $i++ ))) {
      my $line = "\n".$frame->package.' line '.$frame->line;

      if ($verbosity > 2) { $text .= $line; next }

      last if (($l_no = $seen{ $frame->package }) && $l_no == $frame->line);

      $seen{ $frame->package } = $frame->line;
   }

   return $text;
}

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

   croak $rest[0] if ($rest[0] and ref $rest[0]);

   my @args = @rest == 1 ? ( error => $rest[0] ) : @rest;

   croak $self->new( args           => [],
                     ignore_package => $IGNORE,
                     out            => $NUL,
                     rv             => 1,
                     show_trace     => 0,
                     @args );
}

1;

__END__

# Local Variables:
# mode: perl
# tab-width: 3
# End: