view release on metacpan or  search on metacpan

lib/Log/Report/Minimal.pm  view on Meta::CPAN

	$opts->{errno} ||= $!+0 || $? || 1
		if use_errno($reason) && !defined $opts->{errno};

	my $message = shift;
	@_%2 and error __x"odd length parameter list with '{msg}'", msg => $message;

	my $show    = lc($reason).': '.$message;

	if($stop)
	{	# ^S = EXCEPTIONS_BEING_CAUGHT, within eval or try
		$! = $opts->{errno} || 0;
		die "$show\n";    # call the die handler
	}
	else
	{	warn "$show\n";   # call the warn handler
	}

	1;
}


sub dispatcher($@) { panic "no dispatchers available in ".__PACKAGE__ }


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

	@_ % 2 and report {}, PANIC => __x"odd length parameter list for try(): forgot the terminating ';'?";

	#XXX MO: only needs the fatal subset, exclude the warns/prints
	eval { $code->() };
}

#--------------------

sub report(@)
{	my %opt = @_ && ref $_[0] eq 'HASH' ? %{ (shift) } : ();
	_report \%opt, @_;
}

sub trace(@)   {_report {}, TRACE   => @_}
sub assert(@)  {_report {}, ASSERT  => @_}
sub info(@)    {_report {}, INFO    => @_}
sub notice(@)  {_report {}, NOTICE  => @_}
sub warning(@) {_report {}, WARNING => @_}
sub mistake(@) {_report {}, MISTAKE => @_}
sub error(@)   {_report {}, ERROR   => @_}
sub fault(@)   {_report {}, FAULT   => @_}
sub alert(@)   {_report {}, ALERT   => @_}
sub failure(@) {_report {}, FAILURE => @_}
sub panic(@)   {_report {}, PANIC   => @_}

#--------------------

sub __($) { $_[0] }



sub __x($@)
{	@_%2 or error __x"even length parameter list for __x at {where}", where => join(' line ', (caller)[1,2]);
	_interpolate @_, _expand => 1;
}


sub __n($$$@)
{	my ($single, $plural, $count) = (shift, shift, shift);
	_interpolate +($count==1 ? $single : $plural), _count => $count, @_;
}


sub __nx($$$@)
{	my ($single, $plural, $count) = (shift, shift, shift);
	_interpolate +($count==1 ? $single : $plural), _count => $count, _expand => 1, @_;
}


sub __xn($$$@)   # repeated for prototype
{	my ($single, $plural, $count) = (shift, shift, shift);
	_interpolate +($count==1 ? $single : $plural), _count => $count , _expand => 1, @_;
}


sub N__($)   { $_[0] }
sub N__n($$) {@_}
sub N__w(@)  {split " ", $_[0]}

#--------------------

sub import(@)
{	my $class = shift;

	my $to_level   = @_ && $_[0] =~ m/^\+\d+$/ ? shift : 0;
	my $textdomain = @_%2 ? shift : 'default';
	my %opts       = @_;
	my $syntax     = delete $opts{syntax} || 'SHORT';

	my ($pkg, $fn, $linenr) = caller $to_level;
	pkg2domain $pkg, $textdomain, $fn, $linenr;
	my $domain     = textdomain $textdomain;

	need delete $opts{mode}
		if defined $opts{mode};

	my @export;
	if(my $in = $opts{import})
	{	push @export, ref $in eq 'ARRAY' ? @$in : $in;
	}
	else
	{	push @export, @functions, @make_msg;

		my $syntax = delete $opts{syntax} || 'SHORT';
		if($syntax eq 'SHORT')
		{	push @export, @reason_functions
		}
		elsif($syntax ne 'REPORT' && $syntax ne 'LONG')
		{	error __x"syntax flag must be either SHORT or REPORT, not `{flag}'", flag => $syntax;
		}
	}

	$class->export_to_level(1+$to_level, undef, @export);