#!/afs/athena/contrib/perl5/p -w

use strict;

sub try (&@) {
  my ($try, $catch) = @_;

  # $try::state needs to be in scope in try block, but *not* in catch
  # block, because we want to be able to fail out of the catch block.
  my ($error, $errstate);
  {
    no strict 'vars';
    local ($try::state) = '';  # defined but false
    eval { &$try };
    ($error, $errstate) = ($@, $try::state);
  }

  if ($error) {
    local $_ = $error;
    &$catch($errstate);
  }
}
sub catch (&) { @_; }
sub fail ($@) {
  no strict 'vars';
  my($pkg, $file, $line) = caller;
  die "fail() called outside a 'try {...}' block at $file line $line\n"
    unless defined($try::state);
  $try::state = shift;
  die "@_ at $file line $line\n";
}

package Object;

sub new {
  my $class = shift;
  bless [ @_ ], $class;
}
sub print {
  my $self = shift;
  print ">> @$self, @_";
}

package main;

try {
  try {
    fail ((new Object 'hello'), "world!");
  } catch {
    my($obj)= @_;
    print "CAUGHT:\n";
    $obj->print($_);
    fail ((new Object 'so', 'long'), 'Butler', 'Yeats');
  };
} catch {
  my($obj)= @_;
  print "CAUGHT:\n";
  $obj->print('John', $_);
};

fail ((new Object 'dead'), 'beef');    # this will break!
