examples/root/exceptions1.pl

   1 #!/usr/bin/perl
   2
   3 # A simple tester script for demonstrating how to throw and catch
   4 # Error.pm objects. It also shows how to define new types of
   5 # Error.pm-based objects.
   6 #
   7 # It relies on the tester modules TestObject.pm and TestInterface.pm
   8 # which you should also look at.
   9 #
  10 # Note that Bio::Root::NotImplemented is a subclass of Error.pm
  11 # and is defined in Bio::Root::Exception.pm
  12 #
  13 # This code requires Graham Barr's Error.pm module available from CPAN.
  14 #
  15 # Author: Steve Chervitz <sac@bioperl.org>
  16 #
  17
  18 use strict;
  19 use Error qw(:try);
  20 use TestObject;
  21 use Getopt::Long;
  22
  23 # Command-line options:
  24 my $eg = 0;        # which example to run (a number 1-4)
  25 my $help = 0;      # print usage info
  26
  27 # $Error::Debug is set to true by default in Bio::Root::Interface.
  28 $Error::Debug = 1; # enables verbose stack trace
  29
  30 GetOptions( "debug!" => \$Error::Debug,
  31             "eg=s"   => \$eg,
  32             "h"      => \$help
  33           );
  34
  35 my $options = << "OPTS";
  36       -eg  1|2|3|4   Run a particular example
  37       -nodebug       Deactivate verbose stacktrace
  38       -h             Print this usage
  39 OPTS
  40
  41 (!$eg || $help) and die "Usage: $0 -eg 1|2|3|4 [-nodebug] [-h]\nOptions:\n$options";
  42
  43 print $Error::Debug ? "Try a -nodebug option to supress stack trace." : "Verbose stacktrace off.";
  44 print "\n\n";
  45
  46 # Set up a tester object.
  47 my $test = TestObject->new();
  48 $test->data('Eeny meeny miney moe.');
  49
  50 try {
  51
  52     test_notimplemented( $test ) if $eg == 1;
  53
  54     test_custom_error( $test ) if $eg == 2;
  55
  56     test_simple_error() if $eg == 3;
  57
  58     # This subroutine doesn't even exist. But because it occurs within a try block,
  59     # the Error module will create a Error::Simple to capture it. Handy eh?
  60     if(  $eg == 4 ) {
  61         print "Test #4: Calling an undefined subroutine.\n";
  62         test_foobar();
  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 # Multiple catch blocks to handle different types of errors:
  74
  75 catch Bio::Root::NotImplemented with {
  76     my $error = shift;
  77     print "\nCaught a Bio::Root::NotImplemented.\n",
  78       "  file  : ", $error->file, "\n",
  79       "  line  : ", $error->line, "\n",
  80       "  text  : ", $error->text, "\n",
  81       "  value : ", $error->value, "\n",
  82       "  object: ", ref($error->object), "\n";
  83
  84     print "\nstacktrace:\n", $error->stacktrace, "\n";
  85
  86     print "\nstringify:\n$error\n";
  87     # The above line is equivalent to this:
  88     #print "\nstringify:\n", $error->stringify, "\n";
  89 }
  90
  91 catch Bio::TestException with {
  92     # Since we know what type of error we're getting,
  93     # we can extract more information about the offending object
  94     # which is retrievable from the error object.
  95     my $error = shift;
  96     print "\nCaught a Bio::TestException.\n",
  97       "  file  : ", $error->file, "\n",
  98       "  line  : ", $error->line, "\n",
  99       "  text  : ", $error->text, "\n",
 100       "  value : ", $error->value, "\n",
 101       "  object: ", ref($error->object), "\n",
 102       "  data  : ", $error->object->data, "\n";
 103
 104     print "\nstacktrace:\n", $error->stacktrace, "\n";
 105     print "\nstringify:\n", $error->stringify, "\n";
 106
 107 }
 108
 109 otherwise {
 110     # This is a catch-all handler for any type of error not handled above.
 111     my $error = shift;
 112     print "\nCaught an other type of error: ", ref($error), "\n",
 113       "  file  : ", $error->file, "\n",
 114       "  line  : ", $error->line, "\n",
 115       "  text  : ", $error->text, "\n",
 116       "  value : ", $error->value, "\n",
 117       "  object: ", ref($error->object), "\n";
 118
 119 #    print "\nstack_trace_dump:\n", $error->stack_trace_dump(), "\n";
 120
 121     print "\nstacktrace:\n", $error->stacktrace, "\n";
 122
 123     print "\nstringify:\n$error\n";
 124
 125 };  # This semicolon is essential.
 126
 127 print "\nDone $0\n";
 128
 129 sub test_notimplemented {
 130
 131     my $test = shift;
 132     # This demonstrates what will happen if a method defined in an interface
 133     # that is not implemented in the implementating object.
 134
 135     print "Test #1: Inducing a Bio::Root::NotImplemented exception from TestObject\n";
 136
 137     $test->foo();
 138 }
 139
 140
 141 sub test_custom_error {
 142
 143     my $test = shift;
 144
 145     # TestObject::bar() deliberately throws a Bio::TestException,
 146     # which is defined in TestObject.pm
 147
 148     print "Test #2: Throwing a Bio::TestException exception from TestObject\n";
 149
 150     $test->bar;
 151
 152 }
 153
 154
 155 sub test_simple_error {
 156
 157     # Error::Simple comes with Error.pm and can have only a string and a value.
 158
 159     print "Test #3: Throwing a Error::Simple object\n";
 160
 161     throw Error::Simple( "A simple error", 42 );
 162 }
 163
 164