view release on metacpan or  search on metacpan

lib/Badger/Exception.pm  view on Meta::CPAN

    $text  =~ s/<(\w+)>/defined $self->{ $1 } ? $self->{ $1 } : "(no $1)"/eg;

    # TODO: not sure we should add file and line automatically - better to
    # leave it up to the $FORMAT
    $text .= " in $self->{ file }"      if $self->{ file };
    $text .= " at line $self->{ line }" if $self->{ line };

    if ($self->{ trace } && (my $trace = $self->stack_trace)) {
        $text .= "\n" . $trace;
    }

    return $text;
}


sub stack_trace {
    my $self = shift;
    my @lines;

    if (my $stack = $self->{ stack }) {
        foreach my $caller (@$stack) {
            my @args = $COLOUR
                ? (
                    cyan($caller->[0]),
                    cyan($caller->[1]),
                    yellow($caller->[2]),
                    yellow($caller->[3]),
                  )
                : @$caller;
            push(@lines, $self->message( caller => @args ));
        }
    }

    return join("\n", @lines);
}


sub trace {
    my $self = shift;
    if (ref $self) {
        return @_
            ? ($self->{ trace } = shift )
            :  $self->{ trace };
    }
    else {
        return @_
            ? $self->class->var( TRACE => shift )
            : $self->class->var('TRACE');
    }
}

sub throw {
    my $self = shift;

    # save relevant information from caller stack for enhanced debugging,
    # but only the first time the exception is thrown
    if ($self->{ trace } && ! $self->{ stack }) {
        my @stack;
        my $i = 1;
        while (1) {
            my @info = caller($i++);
            last unless @info;
            push(@stack, \@info);
        }
        $self->{ stack } = \@stack;
    }

    die $self;
}




#------------------------------------------------------------------------
# match_type(@types)
#
# Selects the most appropriate handler for the current exception type,
# from the list of types passed in as arguments.  The method returns the
# item which is an exact match for type or the closest, more
# generic handler (e.g. foo being more generic than foo.bar, etc.)
#------------------------------------------------------------------------

sub match_type {
    my $self  = shift;
    my $types = @_ == 1 ? shift :  [@_];
    my $type  = $self->{ type };

    $types = [ split(DELIMITER, $types) ]
        unless ref $types;

    $types = { map { $_ => $_ } @$types }
        if ref $types eq ARRAY;

    return $self->error( invalid => 'type match' => $types )
        unless ref $types eq HASH;

    while ($type) {
        return $types->{ $type }
            if $types->{ $type };

        # strip .element from the end of the exception type to find a
        # more generic handler
        $type =~ s/\.?[^\.]*$//;
    }

    return undef;
}



1;
__END__

=head1 NAME

Badger::Exception - structured exception for error handling

=head1 SYNOPSIS

    use Badger::Exception;

lib/Badger/Exception.pm  view on Meta::CPAN

(more specific) handler name will always match in preference to a shorter
(more general) handler as shown in the next example:

    $exception->type('database.connection');

    my $match = $exception->match_type('database', 'database.connection')
        || die "no match for exception\n";

    print $match;    # database.connection

When there is no exact match, the C<match_type()> method will return
something more general that matches.  In the following example, there
is no specific handler type for C<database.exploded>, but the more
general C<database> type still matches.

    $exception->type('database.exploded');

    my $match = $exception->match_type('database', 'database.connection')
        || die "no match for exception\n";

    print $match;    # database

You can also specify multiple exception types using a reference to a list.

    if ($exception->match_type(['warp.drive', 'shields'])) {
        ...
    }

Or using a single string of whitespace delimited exception types.

    if ($exception->match_type('warp.drive shields')) {
        ...
    }

You can also pass a reference to a hash array in which the keys are exception
types.  The corresponding value for a matching type will be returned.

    my $type_map = {
        'warp.drive'    => 'propulsion',
        'impulse.drive' => 'propulsion',
        'shields'       => 'defence',
        'phasers'       => 'defence'
    };

    if ($exception->match_type($type_map)) {
        ...
    }

=head2 throw()

This method throws the exception by calling C<die()> with the exception object
as an argument. If the C<$TRACE> flag is set to a true value then the method
will first save the pertinent details from a stack backtrace into the
exception object before throwing it.

=head2 stack()

If stack tracing is enabled then this method will return a reference to a list
of information from the caller stack at the point at which the exception was
thrown. Each item in the list is a reference to a list containing the
information returned by the inbuilt C<caller()> method. See
C<perldoc -f caller> for further information.

    use Badger::Exception trace => 1;

    eval {
        # some code that throws an exception object
        $exception->throw();
    };

    my $catch = $@;                 # exception object
    my $stack = $catch->stack;

    foreach my $caller (@$stack) {
        my ($pkg, $file, $line, @other_stuff) = @$caller;
        # do something
    }

The first set of information relates to the immediate caller of the
L<throw()> method.  The next item is the caller of that method, and so
on.

=head2 stack_trace()

If stack tracing is enabled then this method returns a text string summarising
the caller stack at the point at which the exception was thrown.

    use Badger::Exception trace => 1;

    eval {
        # some code that throws an exception object
        $exception->throw();
    };
    if ($@) {
        print $@->stack_trace;
    }

=head1 AUTHOR

Andy Wardley L<http://wardley.org/>

=head1 COPYRIGHT

Copyright (C) 1996-2009 Andy Wardley.  All Rights Reserved.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 SEE ALSO

L<Badger::Base>

=cut

# Local Variables:
# mode: perl
# perl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# vim: expandtab shiftwidth=4: