view release on metacpan or  search on metacpan

lib/Error/Base.pm  view on Meta::CPAN

    return $self->{-quiet};
};
sub get_nest {
    my $self    = shift;
    return $self->{-nest};
};
sub get_prepend {
    my $self    = shift;
    return $self->{-prepend};
};
sub get_indent {
    my $self    = shift;
    return $self->{-indent};
};
sub get_all {
    my $self    = shift;
    return $self->{-all};
};
sub get_lines {
    my $self    = shift;
    return $self->{-lines};
};
sub get_frames {
    my $self    = shift;
    return $self->{-frames};
};

## accessors
#----------------------------------------------------------------------------#

#=========# INTERNAL OBJECT METHOD
#
#   $out    = $self->_late( $in );     # late interpolate
#
# Wrapper method; see Error::Base::Late::_late().
sub _late { return Error::Base::Late::_late(@_) };
##

}   #=====# ... Entire package inside bare block, not indented.
#=========# END PACKAGE BLOCK

package Error::Base::Late;   # switch package to avoid pseudo-global lexicals
{

#=========# INTERNAL FUNCTION IN FOREIGN PACKAGE
#
#   $out    = _late( $self, $in );     # late interpolate
#       
# Purpose   : ____
# Parms     : $in       : scalar string
# Reads     : every key in $self starting with a $, @, or % sigil
#           : $self     : available as '$self'
# Returns   : $out      : scalar string
# Writes    : ____
# Throws    : ____
# See also  : ____
# 
# I hope this is the worst possible implementation of late(). 
# Late interpolation is accomplished by multiple immediate interpolations, 
#   inside and outside of a string eval. 
# Non-core PadWalker is not used to derive interpolation context; 
#   caller is required to pass context inside the $self object. 
# To avoid collision and unintended interpolation, I make housekeeping 
#   variables internal to this routine, package variables. 
#   These are fully qualified to a "foreign" package; caller cannot 
#   accidentally access them (although I cannot stop you from doing stupid).
# Some work is done in a bare "setup" block with lexical variables. 
#   But package variables are used to pass values within the routine, 
#   from block to block, inside to outside, within and without the eval. 
# Quoting is a major concern. Heredocs are used in three places for 
#   double-quoted interpolation; they may not conflict with each other 
#   or with any string that may exist within any of: 
#       - the string to be interpolated, $in
#       - values passed in $self against @keys (keys with leading sigils)
#   Rather than attempt to exclude all of these from a generic q//, 
#       I chose heredocs and three long, arbitrary strings. 
# 
sub _late {
    use strict;
    use warnings;
    no warnings 'uninitialized';          # too many to count
#~ ##### CASE:
#~ ##### @_    
    # No lexical variables loose in the outer block of the subroutine.
    $Error::Base::Late::self    = shift;
    if ( not ref $Error::Base::Late::self ) {
        die 'Error::Base internal error: no $self';
    };
    $Error::Base::Late::in      = shift || undef;
    return $Error::Base::Late::in 
        unless $Error::Base::Late::in =~ /[\$\@%]/; # no sigil, don't bother
    
    # Y0uMaYFiReWHeNReaDYGRiDLeY          # quite unlikely to collide
    
    @Error::Base::Late::code    = undef;  # to be eval-ed
    $Error::Base::Late::out     = undef;  # interpolated
    
    #--------------------------------------------------------------------#
    { # setup block
        
        # Some preamble.
        push @Error::Base::Late::code, 
            q**,
            q*#--------------------------------------------------------#*,
            q*# START EVAL                                              *,
            q**,
            q*my $self  = $Error::Base::Late::self;*,
            q**,
        ;
        
        # Unpack all appropriate k/v pairs into their own lexical variables... 
        
        # Each key includes leading sigil.
        my @keys    = grep { /^[\$\@%]/ } keys %$Error::Base::Late::self;
        return $Error::Base::Late::in   # abort if not interpolating today
#~             unless ( @keys or $Error::Base::Late::in =~ /\$self/ );
            unless ( @keys );
        my $key     ;  # placeholder includes sigil!
        my $val     ;  # value to be interpolated
        my $rt      ;  # builtin 'ref' returns (unwanted) class of blessed ref