branch-1-6/examples/root/lib/TestObject.pm

   1 =head1 NAME
   2
   3 TestObject - An implementation of TestInterface
   4
   5 =head1 DESCRIPTION
   6
   7 This module attempts to provide an implementation of TestInterface and
   8 is used for illustrating exception throwing using Graham Barr's
   9 Error.pm object.
  10
  11 =head1 AUTHOR
  12
  13 Steve Chervitz E<lt>sac@bioperl.orgE<gt>
  14
  15 =cut
  16
  17 #'
  18
  19 package TestObject;
  20
  21 use strict;
  22
  23
  24 # Define a special type of error "Bio::TestException" as a subclass of Error.
  25 # Note two things:
  26 #   1. The ISA declaration effectively defines our new Exception object.
  27 #   2. This declaration doesn't have to be located in the Bio directory.
  28 #   3. We don't have to use Bio::Root::Exception in this module.
  29 #   4. If Error.pm isn't available this statement doesn't matter.
  30 @Bio::TestException::ISA = qw( Bio::Root::Exception );
  31
  32 use base qw(Bio::Root::Root TestInterface);
  33
  34
  35 # Note that we're not implementing foo(), so calling it
  36 # will result in a Bio::Root::NotImplemented exception.
  37
  38 sub data {
  39     my ($self, $data) = @_;
  40     print "Setting test data ($data)\n" if $data && $self->verbose;
  41     $self->{'data'} = $data if $data;
  42
  43    return $self->{'data'}
  44 }
  45
  46 sub bar {
  47
  48     my $self = shift;
  49
  50     print "\nExecuting method bar() in TestObject\n" if $self->verbose;
  51     print "Throwing a Bio::TestException\n" if $self->verbose;
  52
  53     my $message = "A Test error";
  54
  55     # Bio::Root::Root::throw() will make use of Error.pm if present.
  56     # The type of Error is specified with a -class parameter.
  57     # If -class is not supplied, a Bio::Root::Exception is throw.
  58     # In this case, the argument can consist of a simple string.
  59
  60     $self->throw( -class => 'Bio::TestException',
  61                   -text  => $message );
  62
  63     print "Code within bar() below the throw that shouldn't be executed.\n" if $self->verbose;
  64
  65 }
  66
  67 1;