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