view release on metacpan or  search on metacpan

lib/Module/Generic.pm  view on Meta::CPAN

    }
    elsif( $type eq 'CODE' )
    {
        if( $] < 5.013004 )
        {
            return( \&{ $class . '::' . $var } );
        }
        else
        {
            return( *{ $ns->{ $var } }{CODE} );
        }
    }
    else
    {
        return( wantarray ? () : undef );
    }
}
PERL
        # NOTE: _has_base64()
        _has_base64 => <<'PERL',
sub _has_base64
{
    my $self = shift( @_ );
    my $val  = shift( @_ );
    return( '' ) if( !defined( $val ) || !length( $val ) );
    if( ref( $val ) eq 'ARRAY' && 
        scalar( @$val ) >= 2 && 
        defined( $val->[0] ) && 
        defined( $val->[1] ) &&
        ref( $val->[0] ) eq 'CODE' && 
        ref( $val->[1] ) eq 'CODE' )
    {
        return( $val );
    }
    
    my $class = ref( $self ) || $self;
    
    unless( defined( ${"${class}\::HAS_B64"} ) && ref( ${"${class}\::HAS_B64"} ) eq 'HASH' )
    {
        my $ref = ${"${class}\::HAS_B64"} = {};
        if( $self->_is_class_loadable( 'MIME::Base64' ) )
        {
            $ref->{ 'MIME::Base64' } =
            [
                sub{ return( &{"MIME::Base64\::encode_base64"}( shift( @_ ), '' ) ); },
                \&{"MIME::Base64\::decode_base64"},
            ];
        }
        if( $self->_is_class_loadable( 'Crypt::Misc' ) )
        {
            $ref->{ 'Crypt::Misc' } =
            [
                \&{"Crypt::Misc\::encode_b64"},
                \&{"Crypt::Misc\::decode_b64"},
            ];
        }
    }
    my $ref = ${"${class}\::HAS_B64"};
    return( '' ) if( !scalar( keys( %$ref ) ) );
    
    my $prefs = [];
    if( $val eq 'Crypt::Misc' || $val eq 'CryptX' )
    {
        push( @$prefs, qw( Crypt::Misc MIME::Base64 ) );
    }
    # for any other value, including 'MIME::Base64'
    else
    {
        push( @$prefs, qw( MIME::Base64 Crypt::Misc ) );
    }
    
    foreach my $mod ( @$prefs )
    {
        if( exists( $ref->{ $mod } ) && $self->_load_class( $mod ) )
        {
            return( $ref->{ $mod } );
        }
    }
    return( '' );
}
PERL
        # NOTE: _has_symbol()
        _has_symbol => <<'PERL',
sub _has_symbol
{
    my $self = shift( @_ );
    my( $class, $var ) = ( @_ >= 2 ) ? splice( @_, 0, 2 ) : ( ( ref( $self ) || $self ), shift( @_ ) );
    if( $class !~ /^[a-zA-Z_][a-zA-Z0-9_]+(?:\:{2}[a-zA-Z0-9_]+)*$/ )
    {
        return( $self->error( "Invalid class name '$class'" ) );
    }
    elsif( !defined( $var ) || !length( $var ) )
    {
        return( $self->error( "No variable was aprovided." ) );
    }

    no strict 'refs';
    my $ns = \%{$class . '::'};
    my $map = 
    {
    '$' => 'SCALAR',
    '@' => 'ARRAY',
    '%' => 'HASH',
    '&' => 'CODE',
    ''  => 'IO',
    };
    my( $sigil, $type );
    if( exists( $map->{ substr( $var, 0, 1 ) } ) )
    {
        $sigil = substr( $var, 0, 1, '' );
        $type = $map->{ $sigil };
    }
    else
    {
        $type = $map->{ '' };
    }
    return(0) if( !exists( $ns->{ $var } ) );
    my $glob = \$ns->{ $var };
    if( ( Scalar::Util::reftype( $glob ) // '' ) eq 'GLOB' )
    {
        if( $type eq 'SCALAR' )
        {
            return( defined( ${ *{$glob}{$type} } ) ? 1 : 0 );
        }
        else
        {
            return( defined( *{$glob}{$type} ) ? 1 : 0 );
        }
    }
    else
    {
        return( $type eq 'CODE' ? 1 : 0 );