Fry::Error - Redefines warn and die to trigger actions by error levels and tags.

	- Redefining die or warn to call die-like or warn-like subs ie Carp::croak and Carp::carp.
	- Errors are assigned levels, generally indicating severity of error.
	- Errors can have actions, the most obvious being logging an error, throwing a warning or
		dying. This means that logging can be done simply with &warn.
	- Errors can have tags associated with them which can affect actions or level settings.

	Attributes with a '*' next to them are always defined.
	*id($): Unique id indicating order among other errors
	*caller(\@): Contains all of caller()'s data for the error's origin.
	*from($): Has value of either 'die' or 'warn' indicating from what error subroutine it was called.
	*level($): Number indicating error level. By default the values should go from 0-7 similar
		to the syslog command.
	*arg($): Contains arguments to be passed to a warn or die subroutine.
	tags(\@): Keywords or tags associated with error.

	Class methods
		sigHandler(%attr): Passes its arguments directly to &new. This subroutine first defines an
			error object, provides an early exit via global variables and then performs
			actions for the error.
		new(%attributes): Creates an error object.
		parseDieArgs(@args): Parses arguments given to die() and returns attributes to construct an
			error object via &new. By default, if the last argument is a hashref, it is
			interpreted as parameters for the object

			ie: die('really strange',{tags=>[qw/bizarre/]})

		parseWarnArgs(@args): Parses arguments given to warn() and returns attributes to construct an
			error object via &new. Same default as parseDieArgs. In addition, multiple
			arguments (up to three) are implicitly matched with the attributes: arg, level,tags.

			ie: warn('yo',4,'interjection'); would create the following attribute hash
			{qw/arg yo level 4 tags interjection/}

		setDefaultDie(@args): Set $DefaultDie for desired cases ie only certain modules.
		setDefaultWarn(@args): Set $DefaultWarn for desired cases.
		diesub(@arg): Calls a die-like sub with given arguments ie Carp::croak
		warnsub(@arg): Calls a warn-like sub with given arguments ie Carp::carp.

	Object methods
		setLevel(): Sets an object's level via more complex requirements ie other object
			attributes such as tags or caller.
		takeAction(): Can take action on an error based on any attribute, the most likely
			being 'level'. Aside from the obvious actions of calling a diesub or warnsub,
			another action could be logging via logging modules such as Log::Dispatch or
			Log::Log4perl or simplyt to a file. When subclassing this method, don't
			forget calls to &warnsub and &diesub.

package Fry::Error;
use strict;
#use Data::Dumper;

my $error_class = __PACKAGE__;
my @stack = ();
my $id = 0;

our $Called = 0;
#indicates if a diesub or warnsub was called
our $MinDieLevel = 7; 
#minium level for a diesub to be called
#our $defaultWarnLevel = 3; 
our $CallError = 1;
#a nonzero value doesn't call any error subroutine
our $MinLevel = 3;
#Minimum Level for a warning or die to be thrown
our $DefaultDie = 0;
#A nonzero value calls &CORE::die
our $DefaultWarn = 0;
#A nonzero value calls &CORE::warn

	#class methods
	sub setup {
		#w: has to be able to handle anything after &initCoreClass
		my $cls = shift;
		#no strict 'refs';
		#die ("&setup should be called by Fry::Error or a subclass of it: $@")
		#if  (grep(/Fry::Error/,@{"$cls\::ISA"}) == 0 && $cls ne "Fry::Error");

		$error_class = $cls;
	}
	#die/warn subs
	*CORE::GLOBAL::die = sub {
		$Called = 0;
		$error_class->setDefaultDie;

		if ($DefaultDie) { CORE::die(@_) }
		else {
			my %attr = $error_class->parseDieArgs(@_);
			$error_class->sigHandler(from=>'die',%attr);
		}
	};
	*CORE::GLOBAL::warn = sub {
		$Called = 0;
		$error_class->setDefaultWarn;
		if ($DefaultWarn) { CORE::warn(@_) }
		else {
			my %attr = $error_class->parseWarnArgs(@_);
			$error_class->sigHandler(from=>'warn',%attr);
		}
	};
	sub _newwarn($@) {
		my ($cls,@arg) = @_;
		$Called =1; 
		$cls->warnsub(@arg);
	}
	sub _newdie ($@) {
		my ($cls,@arg) = @_;
		$Called =1; 
		$cls->diesub(@arg);
	}

	#main class methods
	sub sigHandler($%) {
		my ($cls,%attr) = @_;

		my $err = $cls->new(%attr);

		#push(@stack,$err) unless ($$err{stack} == 0);

		#early exit for 2 cases
		return 0 if ($CallError != 1 or $MinLevel > $$err{level});

		$err->takeAction;
	}
	sub new {
		my ($cls,%attr) = @_;
		my %fromlevels = qw/die 7 warn 3/;
		my $err = {%attr};
		$id++;
		$err->{id} = $id;
		#$err->{stack} = 1;

		#set caller,time
		$err->{caller} = [caller(2)] ;

		#print Dumper $err;
		bless $err, $cls;

		#set levels
		$err->{level} = $fromlevels{$attr{from}} if (! exists $err->{level});
		$err->setLevel;

		return $err;
	}

	#subclassable $err methods
	sub takeAction {
		my $err = shift;
		my $cls = ref $err;

		my @arg = (ref ($$err{arg}) eq "ARRAY") ? @{$$err{arg}} : $$err{arg};
		#die in eval takes priority over levels
		$cls->_newdie(@arg) if ($$err{from} eq "die" && $^S == 1);


		if ($$err{level} >= $MinDieLevel) {
			$cls->_newdie(@arg)
		}
		#elsif ($$err{level} >= $defaultWarnLevel) 
		else { $cls->_newwarn(@arg) }
	}

	sub setLevel {}

	##subclassable class methods
	sub setDefaultDie {}
	sub setDefaultWarn {}
	sub parseDieArgs {
		shift; 
		my %attr;
		if (ref $_[-1] eq "HASH") {
			%attr = %{pop()}
		}
		$attr{arg} = [@_];

		return %attr
	}
	sub parseWarnArgs {
		my $cls = shift;
		my %attr;
		#my @arg = (@_ > 1) ? {map { (shift(@attr),$_) } @_ } : @_;

		if (ref $_[-1] eq "HASH") {
			%attr = %{pop()}
		}

		if (@_ > 1) {
			my @attr = qw/arg level tags/;
			my %quick = map { (shift(@attr),$_) } splice(@_,0,3) ;
			%attr = (%attr,%quick);
		}
		else { $attr{arg} = [@_] }
		return %attr;
	}
	sub diesub { shift; CORE::die(@_) }
	sub warnsub { shift; CORE::warn(@_) }
1;
__END__	

#OLD CODE
	sub stack {@stack }
	sub flush { 
		my $cls = shift;
		if (my $number = shift) {
			return splice(@stack,0,$number)
		}
		else { my @deleted = @stack ; @stack = () ; return @deleted }
	}
	sub stringify_stack {
		my ($cls,%arg) = @_;
		my @keys = (exists $arg{keys}) ? @{$arg{keys}} : (qw/arg level/);
		my $num = $arg{stack} || scalar(@stack);
		my $body;

		for (0 .. $num -1) {
			$body .= ($_+1) . ".\n";
			for my $k (@keys) {
				my $item = $stack[$_]->{$k};
				$item = "@$item" if (ref $item eq "ARRAY");
				$body .= "\t$k\: ". $item ."\n";
			}
		}
		return $body;
	}
	sub cleanArgs {
		no strict 'refs';
		my ($cls,$err) = @_;
		my $caller = caller;
		my %valid = map { ($_=>1) }  @{"$caller\::param"};

		for (keys %$err) {
			if (! exists $valid{$_}) {
				delete $err->{$_};
				#warn
			}
		}	
	}