File Coverage

blib/lib/Exception/ThrowUnless.pm

Criterion	Covered	Total	%
statement	48	73	65.7
branch	14	28	50.0
condition	1	9	11.1
subroutine	21	28	75.0
pod	0	18	0.0
total	84	156	53.8

#!/usr/bin/perl -w

package Exception::ThrowUnless;

require Exporter;
use strict;
use File::Spec::Functions;

our(@ISA)=qw(Exporter);
our $VERSION = "1.11";
our @EXPORT_OK = qw(
	schdir      schmod  sclose       sexec  sfork      slink
	smkdir      sopen   sopendir     spipe  sreadlink  srename
	srename_nc  srmdir  ssocketpair  sspit  ssuck      ssymlink
	sunlink
);
our %EXPORT_TAGS = ( 'all' => \@EXPORT_OK );

sub _throw(@) {
	eval q[
		use Carp;
		*Exception::_throw = \&Carp::confess;
	];
	goto &Carp::confess;
	die "$@";
};
sub _checktrue($@) {
	_throw splice(@_,1) unless $_[0];
	$_[0];
};
sub _checkdef($@) {
	_throw splice(@_,1) unless defined $_[0];
	$_[0];
};
sub schdir($){
	_checktrue(chdir($_[0]),"chdir:$_[0]:$!");
};
sub srmdir(;$) {
	local $_ = shift if @_;
	_checktrue(rmdir($_),"rmdir:$_:$!\n");
};
sub schmod(@) {
	local $"=',';
	return @_-1 if ( chmod(@_) == @_-1 );
	_throw("chmod:@_:$!");
};
sub sclose(*){
	local $_ = shift;
	return 1 if close($_);
	die "close:$_:$!";
};
sub sexec(@){
	exec @_;
	die _throw "exec (@_):$!";
};
sub sfork() {
	_checkdef(fork,"fork:$!");
};
sub slink($$) {
	my ($f,$t) = @_;
	_checkdef(link($f, $t),"link:$f,$t:$!");
};
sub smkdir($$) {
	my ( $dir, $mode ) = @_;
	my $res = mkdir $dir, $mode;
	return $res if $res;
	return $res if -d $dir && $! == 17;
	_throw "smkdir:$dir:$! and is not a directory" if $! == 17;
	_throw "smkdir:$dir:$!";
};
sub sopen(\*$) {
	_checkdef(open($_[0],$_[1]),"open:$_[0],$_[1]:$!");
};
sub sopendir(\*$){
	_checkdef(opendir($_[0],$_[1]),"opendir:$_[0],$_[1]:$!\n");
};
sub spipe(\*\*){
	_checkdef(pipe($_[0],$_[1]),"pipe:@_:$!");
};
sub sreadlink($) {
	_checkdef(readlink($_[0]),"readlink:$_[0]:$!");
};
sub srename($$) {
	my ($f,$t) = @_;
	_checkdef(rename($f,$t),"rename:$f,$t:$!");
};
sub srename_nc($$) {
	my ($f,$t) = @_;
	-e $t || -l $t && _throw "won't clobber '$t'";
	srename($f,$t);
};
sub ssocketpair(\*\*$$$) {
	_checkdef(socketpair($_[0],$_[1],$_[2],$_[3],$_[4]),"socketpair:@_:$!");
};
sub ssuck(@);
sub ssuck(@){
	warn "useless ssuck in void context" unless defined wantarray;
	return join("",ssuck(@_)) unless wantarray;
	map { local $_="<$_"; sopen(local *F,$_); $_=[]; sclose(*F);@$_; } @_;
};
sub ssymlink($$) {
	_checktrue(symlink($_[0],$_[1]),"symlink:$_[0],$_[1]:$!");
};
sub sunlink(@) {
	unlink(@_) == @_ && return scalar(@_);
	for ( @_ ) {
		-l $_ || -e $_ || next;
		unlink($_) && next;
		_throw "unlink:$_:$!";
	}
	return scalar(@_);
};
{
	no warnings 'once';
	eval join("",) unless caller;
}
1;
__DATA__