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