exceptions2.pl

#!/usr/bin/env perl

# This shows how Error.pm-based objects can be thrown 
# by Bio::Root::Root::throw() when Error.pm is available.
# When Error.pm isn't available, Bio::Root::Root::throw() 
# works as usual.
#
# It also demonstrates what happens when you use an outer eval{}
# instead of a try{} to trap thrown Error.pm-based exceptions. 
# The behavior is the same as when Error.pm is not used.
# This is important for backward compatibility.
#
# Author: Steve Chervitz <sac@bioperl.org>
#
# $Id$

use strict;

use lib qw(lib/ ../../);

# Uncomment this line to force Bio::Root::Root::throw() to 
# not use Error.pm even if it's available.
# Some of the tests in this script will be skipped .
#BEGIN { $main::DONT_USE_ERROR = 1; }

use Bio::Root::Root;
#use Bio::Root::Exception;  # Not necessary since Bio::Root::Root uses it.
use Error qw(:try);

my $foo = Bio::Root::Root->new();

if (!$main::DONT_USE_ERROR) {
    try {
        # This is the new, fancier way to handle exceptions. 
        # You must have Error.pm to do this (tarball included in this dir).
        
        print "[1] Throwing Error within try block via call to Bio::Root::Root::throw()\n";
        $foo->throw( -class => 'Bio::Root::Exception',
                     -text  => "Oopsie!",
                     -value => "123" 
                   );
    }
    
    catch Bio::Root::Exception with {
        my $err = shift;
        print "[1] Caught Bio::Root::Exception:\n$err";

    }

    otherwise {
        my $err = shift;
        print "[1] Caught other Error: ", ref($err), "\n$err";
    };

    
    print "\n\n";
}

eval {

    # This example demonstrates the traditional method for throwing
    # an exception using Bio::Root::Root->throw('string').
    # Notice how an exception of type Bio::Root::Exception is created.

    print "[2] Calling Bio::Root::Root->throw('string') within an eval{}\n";
    $foo->throw("Error message string.");

};

if($@) {
    print "[2] Caught eval{}-based exception: ", ref($@), "\n$@";
}
else {
    print "[2] Nothing to catch.\n";
}



print "\n\n";

eval {

    # This example shows that calling Error::throw directly within
    # an eval{} doesn't lead to a true value in $@ if
    # the error lacks a value. 

    print "[3] Attempting to throw a valueless Error within an eval{} block\n    (this should fail to be caught by Error.pm v0.13 but is caught by v0.14 and greater).\n";

    if( $ENV{OSTYPE} =~ /cygwin/ ) {
        die "[3] This causes a segmentation fault with cygwin perl! Skipping.\n";
    }

    throw Error::Simple ("A simple error.");

};

if($@) {
    print "[3] Caught eval{}-based exception: ", ref($@), "\n$@\n";
}
else {
    print "[3] Nothing to catch.\n";
}


print "\n\n";

eval {

    # This example shows that calling Error::throw directly within
    # an eval{} *does* lead to a true value in $@ if the error 
    # contains a non-zero value. 

    print "[4] Attempting to throw a valued Error within an eval{} block.\n";

    throw Error::Simple ("A simple error.", 42);

};

if($@) {
    print "[4] Caught eval{}-based exception: ", ref($@), "\n$@\n";
}
else {
    print "[4] Nothing to catch.\n";
}

print "\n\n";

if (!$main::DONT_USE_ERROR) {
    eval {

        # This example shows what happens if we try to create a
        # Bio::Root::IOException (a subclass of Bio::Root::Exception)
        # with a zero value. Bio::Root::Exception::new() catches this
        # faux pas and substitutes a value that will register as true in if($@).

        print "[5] Attempting to throw a zero-valued Bio::Root::IOException\n    within an eval{} block.\n";

        throw Bio::Root::IOException ( -text =>"An error with zero value.",
                                   -value => 0);

    };

    if($@) {
        print "[5] Caught eval{}-based zero-valued exception: ", ref($@), "\n$@\n";
    }
    else {
        print "[5] Nothing to catch.\n";
    }
    print "\n\n";
}


eval {

    # If Error::throw is called *indirectly* within an eval{}
    # (i.e., by calling a method which then calls Error::throw),
    # $@ is defined and it consists of a reference to the Error.pm object.

    print "[6] Attempting to throw Error indirectly within an eval{} block \n    via Bio::Root::Root::throw()\n";

    $foo->throw( -class => 'Bio::Root::Exception',
                 -text  => "Oopsie!",
                 -value => "456"
                );

};

if($@) {
    print "[6] Caught eval{}-based exception: ", ref($@), "\n$@";
}
else {
    print "[6] Nothing to catch.\n";
}

print "Done.\n";