examples/root/exceptions4.pl

   1 #!/usr/bin/env perl
   2
   3 # This shows how the examples work when Error.pm isn't installed.
   4 # It also shows how to supress using Error.pm if it is installed
   5 # and you don't want to use it for some reason.
   6 #
   7 # Here we use the eval{} style exception handling that's currently
   8 # in vogue trapping Bioperl exceptions.
   9 #
  10 # Author: Steve Chervitz <sac@bioperl.org>
  11 #
  12
  13
  14 # Setting this variable simulates not having Error.pm installed.
  15 BEGIN { $DONT_USE_ERROR = 1; }
  16
  17 use strict;
  18 use lib qw(lib/ ../../);
  19 use TestObject;
  20 use Getopt::Long;
  21
  22 # Command-line options:
  23 my $eg = 0;        # which example to run (a number 1-4)
  24 my $help = 0;      # print usage info
  25 $Error::Debug = 1; # enables verbose stack trace
  26
  27 GetOptions( "debug!" => \$Error::Debug,
  28             "eg=s"   => \$eg,
  29             "h"      => \$help
  30           );
  31
  32 my $options = << "OPTS";
  33       -eg  1|2|3|4   Run a particular example
  34       -nodebug       Deactivate verbose stacktrace
  35       -h             Print this usage
  36 OPTS
  37
  38 (!$eg || $help) and die "Usage: $0 -eg 1|2|3|4|5 [-nodebug] [-h]\nOptions:\n$options";
  39
  40 # Set up a tester object.
  41 my $test = TestObject->new();
  42 $test->data('Eeny meeny miney moe.');
  43
  44 eval {
  45
  46     test_notimplemented( $test ) if $eg == 1;
  47
  48     test_custom_error( $test ) if $eg == 2;
  49
  50     test_simple_error() if $eg == 3;
  51
  52     # This subroutine doesn't even exist. But because it occurs within a try block,
  53     # the Error module will create a Error::Simple to capture it. Handy eh?
  54     if(  $eg == 4 ) {
  55         print "Test #4: Calling an undefined subroutine.\n";
  56         test_foobar();
  57     }
  58
  59     # Throwing an exception the traditional bioperl way.
  60     if(  $eg == 5 ) {
  61         print "Test #5: Creating a Bio::Root::Root object and calling throw('string').\n";
  62         my $obj = Bio::Root::Root->new();
  63         $obj->throw("Throwing string from Bio::Root::Root object.");
  64     }
  65
  66     # We shouldn't see this stuff.
  67     print "----\n";
  68     print "----\n";
  69     print "Some other code within the try block after the last throw...\n";
  70     print "----\n";
  71     print "----\n";
  72 };
  73
  74 if($@) {
  75     my $error = shift;
  76     print "\nAn exception occurred:\n$@\n";
  77 }
  78 else {
  79     print "\nNo exception occurred\n";
  80 }
  81
  82 print "\nDone $0\n";
  83
  84 sub test_notimplemented {
  85
  86     my $test = shift;
  87     # This demonstrates what will happen if a method defined in an interface
  88     # that is not implemented in the implementation.
  89
  90     print "Test #1: Inducing a Bio::Root::NotImplemented exception from TestObject\n";
  91
  92     $test->foo();
  93 }
  94
  95
  96 sub test_custom_error {
  97
  98     my $test = shift;
  99
 100     # TestObject::bar() deliberately throws a Bio::Root::TestError,
 101     # which is defined in TestObject.pm
 102
 103     print "Test #2: Throwing a Bio::TestException exception from TestObject\n";
 104
 105     $test->bar;
 106
 107 }
 108
 109
 110 sub test_simple_error {
 111
 112     # This example won't work without Error.pm installed.
 113     # It shows how setting $DONT_USE_ERROR = 1
 114     # really does simulate the absence of Error.pm.
 115     # The exception should report something like:
 116     # "Can't locate object method "throw" via package "Error::Simple"
 117
 118     # Error::Simple comes with Error.pm and can have only a string and a value.
 119
 120     print "Test #3: Throwing a Error::Simple object\n\n";
 121
 122     print "This should fail to find object method 'throw' via package 'Error::Simple'\n";
 123     print "because Error.pm is not available.\n\n";
 124
 125     throw Error::Simple( "A simple error", 42 );
 126 }
 127
 128