Switch branches/tags
tag-ensembl-stable-061 start snapshot-at-head-of-07-branch release-ensembl-06 release-06 release-06-2 release-1_01 release-1-7-1 release-1-7-0 release-1-7-0-RC6 release-1-7-0-RC5 release-1-7-0-RC4 release-1-6-zenodo release-1-6-924 release-1-6-923 release-1-6-922 release-1-6-921 release-1-6-920 release-1-6-910 release-0-9-3 release-0-9-2 release-0-9-0 release-0-7-2 release-0-7-1 release-0-7-0 release-0-05 release-0-05-1 release-0-04-4 release-0-04-3 release-0-04-2 release-0-04-1 prerelease-06 ontology-overhaul-start ontology-overhaul-end ontology-fix1 lightweight_feature join-0-04-to-0-05 gbrowse_1_65 for_gmod_0_003 bioperl-run-release-1-2-0 bioperl-release-1-6 bioperl-release-1-6-901 bioperl-release-1-6-9 bioperl-release-1-6-1 bioperl-release-1-5-2 bioperl-release-1-5-2-patch2 bioperl-release-1-5-2-patch1 bioperl-release-1-5-1 bioperl-release-1-5-1-rc4 bioperl-release-1-5-0 bioperl-release-1-5-0-rc2 bioperl-release-1-5-0-rc1 bioperl-release-1-4-0 bioperl-release-1-2-3 bioperl-release-1-2-2 bioperl-release-1-2-1 bioperl-release-1-2-0 bioperl-release-1-1-0 bioperl-release-1-0-2 bioperl-release-1-0-1 bioperl-release-1-0-0 bioperl-devel-1-3-04 bioperl-devel-1-3-03 bioperl-devel-1-3-02 bioperl-devel-1-3-01 bioperl-devel-1-1-1 bioperl-061-pre1 bioperl-06-1 bioperl-1-6-RC4 bioperl-1-6-RC3_15392 bioperl-1-6-RC3 bioperl-1-6-RC2_15306 bioperl-1-6-RC2 bioperl-1-6-RC1 bioperl-1-6-0_006 bioperl-1-6-0_005 bioperl-1-6-0_004 bioperl-1-6-0_003 bioperl-1-6-0_002 bioperl-1-6-0_001 bioperl-1-2-1-rc1 bioperl-1-0-alpha2-rc bioperl-1-0-alpha bioperl-1-0-0 before-05-to-06-trunk before-05-to-06-merge after004 after-05-06-merge after-05-06-merge-2
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
executable file 129 lines (90 sloc) 3.29 KB
#!/usr/bin/env perl
# This shows how the examples work when isn't installed.
# It also shows how to supress using 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 <>
# Setting this variable simulates not having installed.
use strict;
use lib qw(lib/ ../../);
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
(!$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";
# 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";
sub test_custom_error {
my $test = shift;
# TestObject::bar() deliberately throws a Bio::Root::TestError,
# which is defined in
print "Test #2: Throwing a Bio::TestException exception from TestObject\n";
sub test_simple_error {
# This example won't work without installed.
# It shows how setting $DONT_USE_ERROR = 1
# really does simulate the absence of
# The exception should report something like:
# "Can't locate object method "throw" via package "Error::Simple"
# Error::Simple comes with 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 is not available.\n\n";
throw Error::Simple( "A simple error", 42 );