{
use strict;

package Banana1;
use Time::Local;
use Carp;

sub new {
        my ($class,$d,$m,$y,$paid,$q) = @_;
        my %info;
        $info{"date"} = timegm(0,0,12,$d,$m,$y);
        $info{"paid"} = $paid;
        $info{"quantity"} = $q;
        bless \%info,$class;
        }

sub getpriceeach {
        my ($which) = @_;

        # Validate the call!

        # Report where it is CALLED from!

        # Is it called on the right type of object?
        # If not, abort program with full stack trace
        if (ref($which) ne "Banana1") {
                my @about = caller;
                print "Wrong - @about\n";
                my $i = 0;
                while (my @rslt = caller($i)) {
                        print "Frame $i: @rslt\n";
                        $i++;
                        }
                # Will fail (undef fn.) but we are
                # in an eval so it's trapped
                camel();
                }

        # Is it called without params?
        # If extra params given, warn but carry on
        # (use 'croak' if you want to die)
        if ($#_ != 0) {
                carp "Parameter(s) ignored";
                }

        $which->{"paid"} / $which->{"quantity"};
        }
}

# Test program - lots of levels to ensure we have plenty of frames
# on the stack for error reporting tests!

sub action {
$sept = new Banana1 (7,9,2010,1.60,8);
$oct = Banana1::new("Banana1",14,10,2010,1.75,9);
$nov = Banana1::new("Banana1",5,11,2010,1.80,8);

print ("$sept ... $oct ... $nov \n");

$p1 = $sept -> getpriceeach();
$p2 = $oct -> getpriceeach("yellow"); # will generate a warning
$p3 = Banana1::getpriceeach($nov);

print "Prices are $p1 $p2 and $p3\n";

# Test the error handler - should crash

$p2 = Banana1::getpriceeach("hhh"); # will generate an error
print "Prices are $p1 $p2 and $p3\n";

}

sub runme{ # Just to build another frame to make caller
        action; # demo more interesting!
        }

$dobbin = eval ('runme'); # Don't abort on failure - return error

if ($@) {
        print ("We know what the issue was ...\n");
        print "Failure: $@\n";
} else {
        print "AOK\n";
}

print ("We are still alive because eval trapped it\n");

__END__

Here's how that runs:

munchkin:pl grahamellis$ perl Banana1.pl
Banana1=HASH(0x100853c20) ... Banana1=HASH(0x100858798) ... Banana1=HASH(0x100858810)
Parameter(s) ignored at Banana1.pl line 62
Prices are 0.2 0.194444444444444 and 0.225
Wrong - main Banana1.pl 69
Frame 0: main Banana1.pl 69 Banana1::getpriceeach 1 0 256
Frame 1: main Banana1.pl 75 main::action 1 0 0
Frame 2: main (eval 1) 1 main::runme 1 0 0
Frame 3: main Banana1.pl 78 (eval) 0 0 runme
; 256
We know what the issue was ...
Failure: Undefined subroutine &Banana1::camel called at Banana1.pl line 36.

We are still alive because eval trapped it
munchkin:pl grahamellis$