Error-Base
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
lib/Error/Base.pm view on Meta::CPAN
#=========# INTERNAL FUNCTION
#
# $string = _join_local(@_); # short
#
# Purpose : Like builtin join() but with local list separator.
# Parms : @_ : strings to join
# Returns : $string : joined strings
# Throws : ____
# See also : init()
#
# Buitin join() does not take $" (or anything else) by default.
# We splice out empty strings to avoid useless runs of spaces.
#
sub _join_local {
my @parts = @_;
# Splice out empty strings.
@parts = grep { $_ ne q** } @parts;
return join $", @parts;
}; ## _join_local
#=========# INTERNAL FUNCTION
#
# my %args = _paired(@_); # check for unpaired arguments
#
# Purpose : ____
# Parms : ____
# Reads : ____
# Returns : ____
# Writes : ____
# Throws : ____
# See also : ____
#
# ____
#
sub _paired {
if ( scalar @_ % 2 ) { # an odd number modulo 2 is one: true
die 'Error::Base internal error: unpaired args';
};
return @_;
}; ## _paired
#=========# CLASS METHOD
#
# my $obj = $class->new();
# my $obj = $class->new({ -a => 'x' });
#
# Purpose : Object constructor
# Parms : $class : Any subclass of this class
# anything else will be passed to init()
# Returns : $self
# Invokes : init()
#
# Good old-fashioned hashref-based object constructor.
#
sub new {
my $class = shift;
my $self = {}; # always hashref
bless ($self => $class);
$self->init(@_); # init remaining args
return $self;
}; ## new
#=========# OBJECT METHOD
#
# $err->init( k => 'v', f => $b );
# $err->init( $text, k => 'v', f => $b );
#
# An object can be init()-ed more than once; all new values overwrite the old.
# This non-standard init() allows an unnamed initial arg.
#
# See: crash()
#
sub init {
my $self = shift;
if ( scalar @_ % 2 ) { # an odd number modulo 2 is one: true
$self->{-mesg} = shift; # and now it's even
};
# Merge all values. Newer values always overwrite.
%{$self} = ( %{$self}, @_ );
# Set some default values, mostly to avoid 'uninitialized' warnings.
$self->put_base( $self->{-base} );
$self->put_type( $self->{-type} );
$self->put_mesg( $self->{-mesg} );
$self->put_quiet( $self->{-quiet} );
$self->put_nest( $self->{-nest} );
$self->_fix_pre_ind();
return $self;
}; ## init
#----------------------------------------------------------------------------#
# ACCSESSORS
my $Default = {
-base => q{},
-type => q{},
-mesg => q{},
-quiet => 0,
-nest => 0,
-prepend => undef,
-indent => undef,
};
# put
sub put_base {
my $self = shift;
$self->{-base} = shift;
if ( not defined $self->{-base} ) {
$self->{-base} = $Default->{-base};
};
return $self;
};
sub put_type {
view all matches for this distributionview release on metacpan - search on metacpan
( run in 0.832 second using v1.00-cache-2.02-grep-82fe00e-cpan-503542c4f10 )