exception.pm

platform file from motorola kernel code

package Exception;

# 
# Copyright 1999 by Daryn M. Sharp, All rights reserved.
# 
# This program is free software, you can redistribute it and/or
# modify it under the same terms as Perl itself.
#

use strict;
require Exporter;

our @ISA = qw(Exporter);
our @EXPORT = qw(
	try
	catch with onError noError finally
	retry recatch nextcatch
);

use Error;
use Carp ();

our $Verbose = 0;

use constant SYNTAX =>
	qq(Syntax error\n(did you forget to close the last try block with a ";" ?));

# class functions

sub try(&;$) {
	my $code = shift;
	my $ref = &_mkhash;

	my $wantarray = wantarray;
	my (%ct,@ans,$e);

	local $SIG{__DIE__};
	local $Carp::CarpLevel += 3;

	TRY: $ct{TRY}++;

	if ($wantarray) {
		@ans = eval { &$code };
	} elsif (defined($wantarray)) {
		$ans[0] = eval { &$code };
	} else {
		eval { &$code };
	}
	$e = Error->create;

	if (defined($e)) {
		RECATCH: $ct{RECATCH}++;

		if (exists($ref->{catch})) {
			my $catch = $ref->{catch};
			my $code;

			for (my $i = 0; $i < @$catch; $i += 2) {
				next unless $e->isa($catch->[$i]);
				$code = $catch->[$i+1];

				if ($wantarray) {
					@ans = eval { $@ = $e; $code->($e) };
				} elsif (defined($wantarray)) {
					$ans[0] = eval { $@ = $e; $code->($e) };
				} else {
					eval { $@ = $e; $code->($e) };
				}
				my $ee = Error->create;

				if (defined($ee) && !defined($e->{fatal})) {
					if (my $lbl = $ee->{_goto_}) {
						($ee->{_max_} and $ct{$lbl} > $ee->{_max_})
							? next
							: goto($lbl);
					} 
					#if ($e->{id} ne $ee->{id}) {
					#	$ee->_annotate("while handling:\n",$e);
					#}
				}
				$e = $ee unless defined($e->{fatal});
				last;

				NEXTCATCH:
				next;
			}
		}
	} elsif (my $code = $ref->{noError}) {
		if ($wantarray) {
			@ans = eval { $code->(@ans) };
		} elsif (defined($wantarray)) {
			$ans[0] = eval { $code->($ans[0]) };
		} else {
			eval { $code->() };
		}
		$e = Error->create;
	}

	if (my $code = $ref->{finally}) {
		eval { $@ = $e; $code->($e,@ans) };
		if (defined(my $ee = Error->create)) {
			#if (defined($e) && ($e->{id} ne $ee->{id})) {
			#	$ee->_annotate("while handling:\n",$e);
			#}
			$e = $ee unless (defined($e) && $e->{fatal});
		}
	}

	if (defined($e)) {
		$^S ? $e->_die : $e->throw('uncaught exception');
	}

	if ($wantarray) {
		return(@ans);
	} elsif (defined($wantarray)) {
		return($ans[0]);
	} else {
		return();
	}
}

sub catch(&;$)   { _add_catch(@_) }

sub with(&;$)    { @_ }

sub onError(&;$) { _add_catch(Error => @_) }

sub noError(&;$) { _add_handler(noError => @_) }

sub finally(&;$) { _add_handler(finally => @_) }

sub _add_catch {
	my @list = (ref($_[0]) eq 'CODE') 
		? shift->()
		: (shift,shift);
	my $ref = &_mkhash;

	while (@list) {
		push(@{$ref->{catch}},shift(@list),shift(@list));
	}
	
	$ref;
}

sub _add_handler {
	my $key = shift;
	my $code = shift;
	my $ref = &_mkhash;

	$ref->{$key} = $code;

	$ref;
}

sub _mkhash {
	my $ref;

	if (@_) {
		$ref = shift;
		Carp::croak(SYNTAX) unless UNIVERSAL::isa($ref,__PACKAGE__);
	} else {
		$ref = bless({},__PACKAGE__);
	}

	$ref;
}

sub retry(;$) {
	my $e = new Error;
	$e->{_goto_} = 'TRY';
	$e->{_max_} = shift;
	$e->_die;
}

sub recatch(;$) {
	my $e = new Error;
	$e->{_goto_} = 'RECATCH';
	$e->{_max_} = shift;
	$e->_die;
}

sub nextcatch() {
	my $e = new Error;
	$e->{_goto_} = 'NEXTCATCH';
	$e->_die;
}

1;