view release on metacpan or  search on metacpan

lib/App/MtAws/Exceptions.pm  view on Meta::CPAN

	} else {
		@data{qw/code message/} = (shift, shift);
		while (@_) {
			my $key = shift;
			if ($key eq 'ERRNO') {
				confess "ERRNO already used" if exists $data{'errno'};
				$data{'errno'} = get_errno($!);
				$data{'errno_code'} = $!+0; # numify
			} else {
				$data{$key} = shift or confess "Malformed exception"
			}
		}
	}
	return { 'MTEXCEPTION' => 1, %data };
}

# get_exception -> TRUE|FALSE
# get_exception($@)
# get_exception->{code}
sub get_exception
{
	my $e = @_ ? $_[0] : $@;
	ref $e eq ref {} && $e->{MTEXCEPTION} && $e;
}

# is_exception()
# is_exception($code)
# is_exception($code, $@)
sub is_exception
{
	my ($code, $e) = @_;
	$e = $@ unless defined $e;
	get_exception($e) &&
		(!defined($code) || ( defined(get_exception($e)->{code}) && get_exception($e)->{code} eq $code ));
}


sub exception_message
{
	my ($e) = @_;
	my %data = %$e;
	my $spec = delete $data{message};
	my $rep = sub {
		my ($match) = @_;
		if (my ($format, $name) = $match =~ /^([\w]+)\s+([\w]+)$/) {
			my $value = $data{$name};
			if (defined($value)) {
				if (lc $format eq lc 'string') {
					qq{"$value"};
				} else {
					sprintf("%$format", $value);
				}
			} else {
				':NULL:'
			}
		} else {
			defined($data{$match}) ? $data{$match} : ':NULL:';
		}
	};

	$spec =~ s{%([\w\s]+)%} {$rep->($1)}ge if %data; # in new perl versions \w also means unicode chars..
	$spec;
}



sub dump_error
{
	my ($where) = (@_, '');
	$where = defined($where) && length($where) ? " ($where)" : '';
	if (is_exception('cmd_error')) {
		# no additional output
	} elsif (is_exception) {
		print STDERR "ERROR$where: ".exception_message($@)."\n";
	} else {
		print STDERR "UNEXPECTED ERROR$where: $@\n";
	}
}
1;

__END__