Exception::Class::TryCatch

# Copyright (c) 2008 by David Golden. All rights reserved.
# Licensed under Apache License, Version 2.0 (the "License").
# You may not use this file except in compliance with the License.
# A copy of the License was distributed with this file or you may obtain a 
# copy of the License from http://www.apache.org/licenses/LICENSE-2.0

package Exception::Class::TryCatch;

$VERSION     = '1.12';
@ISA         = qw (Exporter);
@EXPORT      = qw ( catch try );
@EXPORT_OK   = qw ( caught );

use 5.005; # Aiming for same as Exception::Class
#use warnings -- not supported in Perl 5.5, darn
use strict;
use Exception::Class;
use Exporter ();

my @error_stack;

#--------------------------------------------------------------------------#
# catch()
#--------------------------------------------------------------------------#

sub catch(;$$) {
    my $e;
    my $err = @error_stack ? pop @error_stack : $@;
    if ( UNIVERSAL::isa($err, 'Exception::Class::Base' ) ) {
        $e = $err;
    } 
    elsif ($err eq '') {
        $e = undef;
    }
    else {
        # use error message or hope something stringifies
        $e = Exception::Class::Base->new( "$err" );
    }
    unless ( ref($_[0]) eq 'ARRAY' ) { 
        $_[0] = $e;
        shift;
    }
    if ($e) {
        if ( defined($_[0]) and ref($_[0]) eq 'ARRAY' ) {
            $e->rethrow() unless grep { $e->isa($_) } @{$_[0]};
        }
    }
    return wantarray ? ( $e ? ($e) : () ) : $e;
}

*caught = \&catch;

#--------------------------------------------------------------------------#
# try()
#--------------------------------------------------------------------------#

sub try($) {
    my $v = shift;
    push @error_stack, $@;
    return ref($v) eq 'ARRAY' ? @$v : $v if wantarray;
    return $v;
}

1;

__END__