#!/usr/bin/env 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 lib qw(lib/ ../../);
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 );
}