File Coverage

blib/lib/results/exceptions.pm

Criterion	Covered	Total	%
statement	73	79	92.4
branch	9	12	75.0
condition	4	4	100.0
subroutine	20	21	95.2
pod	0	1	0.0
total	106	117	90.6

use 5.014;
use strict;
use warnings;

package results::exceptions;

our $AUTHORITY = 'cpan:TOBYINK';
our $VERSION   = '0.004';

use results ();
use B ();
use Exporter::Shiny;

sub _exporter_fail {
	my ( $class, $err_kind, $opts, $globals ) = @_;
	my $caller = $globals->{into};

	$err_kind =~ /
		\A
		(?:[[:upper:]][[:lower:]]*)
		(?:
			(?:[[:upper:]][[:lower:]]*)
			| [0-9]+
		)*
		\z
	/x or Carp::croak( "Bad err_kind name: $err_kind" );

	my $exception_class = "$caller\::Exception::$err_kind";
	$class->create_exception_class( $exception_class, $err_kind, $opts );

	$err_kind => eval sprintf( 'sub () { %s }', B::perlstring($exception_class) );
}

sub create_exception_class {
	my ( $class, $exception_class, $err_kind, $opts ) = @_;
	$opts //= {};

	no strict 'refs';
	*{"$exception_class\::new"} = sub {
		my $class = shift;
		bless { @_==1 ? %{$_[0]} : @_ }, $class;
	};
	*{"$exception_class\::err"} = sub {
		my $class = shift;
		results::err( $class->new( @_ ) );
	};
	*{"$exception_class\::throw"} = sub {
		my $class = shift;
		die( $class->new( @_ ) );
	};
	*{"$exception_class\::err_kind"} = sub {
		$err_kind
	};
	*{"$exception_class\::DOES"} = sub {
		my ( $class, $role ) = @_;
		return 1 if $role eq __PACKAGE__;
		$class->SUPER::DOES( $role );
	};
	*{"$exception_class\::to_string"} = sub {
		my $self = shift;
		if ( 'CODE' eq ref $opts->{to_string} ) {
			return $opts->{to_string}->( $self );
		}
		elsif ( defined $opts->{to_string} ) {
			return $opts->{to_string};
		}
		else {
			return $err_kind;
		}
	};
	for my $attr ( @{ $opts->{has} // [] } ) {
		*{"$exception_class\::$attr"} = sub { $_[0]{$attr} };
	}

	local $@;
	eval qq/
		package $exception_class;
		use overload (
			fallback => !!1,
			q[""]    => q[to_string],
			bool     => sub { !!1 },
		);
		1;
	/ or die( $@ );
}

1;

__END__