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
|
#!/usr/bin/perl
# This shows how the examples work when Error.pm isn't installed.
# It also shows how to supress using Error.pm if it is installed
# and you don't want to use it for some reason.
#
# Here we use the eval{} style exception handling that's currently
# in vogue trapping Bioperl exceptions.
#
# Author: Steve Chervitz <sac@bioperl.org>
#
# Setting this variable simulates not having Error.pm installed.
BEGIN { $DONT_USE_ERROR = 1; }
use strict;
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 = 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|5 [-nodebug] [-h]\nOptions:\n$options";
# Set up a tester object.
my $test = TestObject->new();
$test->data('Eeny meeny miney moe.');
eval {
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();
}
# Throwing an exception the traditional bioperl way.
if( $eg == 5 ) {
print "Test #5: Creating a Bio::Root::Root object and calling throw('string').\n";
my $obj = Bio::Root::Root->new();
$obj->throw("Throwing string from Bio::Root::Root object.");
}
# 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";
};
if($@) {
my $error = shift;
print "\nAn exception occurred:\n$@\n";
}
else {
print "\nNo exception occurred\n";
}
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 implementation.
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::Root::TestError,
# which is defined in TestObject.pm
print "Test #2: Throwing a Bio::TestException exception from TestObject\n";
$test->bar;
}
sub test_simple_error {
# This example won't work without Error.pm installed.
# It shows how setting $DONT_USE_ERROR = 1
# really does simulate the absence of Error.pm.
# The exception should report something like:
# "Can't locate object method "throw" via package "Error::Simple"
# Error::Simple comes with Error.pm and can have only a string and a value.
print "Test #3: Throwing a Error::Simple object\n\n";
print "This should fail to find object method 'throw' via package 'Error::Simple'\n";
print "because Error.pm is not available.\n\n";
throw Error::Simple( "A simple error", 42 );
}
|
