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