File Coverage

blib/lib/rperlnames.pm

Criterion	Covered	Total	%
statement	24	88	27.2
branch	0	16	0.0
condition	0	6	0.0
subroutine	8	10	80.0
pod			n/a
total	32	120	26.6

## no critic qw(Capitalization ProhibitMultiplePackages ProhibitReusedNames)  # SYSTEM DEFAULT 3: allow multiple & lower case package names
package  # hide from PAUSE indexing
    rperlnames;
use strict;
use warnings;
use RPerl::Config;
our $VERSION = 0.001_010;

1;

# DEV NOTE, CORRELATION #rp008: export name() and scope_type_name_value() to main:: namespace;
# can't achieve via Exporter due to circular dependency issue caused by Exporter in Config.pm and solved by 'require rperltypes;' in RPerl.pm
package main;
use rperltypes;
use rperlnamespaces;

#BEGIN { print 'in rperlnames.pm, have @INC = ' . "\n" . Dumper(\@INC) . "\n"; }

use PadWalker qw(peek_my peek_our);

# NEED UPGRADE: somehow reduce duplicate code of name() and scope_type_name_value(), not easy due to PadWalker magic!
sub name {
    { my string $RETURN_TYPE };
    my unknown $input_variable_ref = \$_[0];
    my hashref $pad                = peek_my 1;    # pad my
    for my string $name ( keys %{$pad} ) {
        if ( $pad->{$name} == $input_variable_ref ) { return $name; }
    }

    $pad = peek_our 1;                             # pad our
    for my string $name ( keys %{$pad} ) {
        if ( $pad->{$name} == $input_variable_ref ) { return $name; }
    }

    my string_arrayref_arrayref $sigil_reftypes = [
        [ '$', 'SCALAR' ],
        [ '@', 'ARRAY' ],
        [ '%', 'HASH' ],
        [ '&', 'CODE' ]
    ];
    foreach my string $namespace (
        ( caller() . '::' ),
        sort keys %{ rperlnamespaces::hash_noncore_nonrperl() }
        )
    {
        $pad = do { no strict 'refs'; \%{$namespace} };    # pad stash
        for my string $name ( keys %{$pad} ) {
            if ( ( ref \$pad->{$name} ) ne 'GLOB' ) { next; }
            for my string_arrayref $sigil_reftype ( @{$sigil_reftypes} ) {
                my string $variable_ref
                    = *{ $pad->{$name} }{ $sigil_reftype->[1] };
                if (    ( defined $variable_ref )
                    and ( $variable_ref == $input_variable_ref ) )
                {
                    return ( $sigil_reftype->[0] . $namespace . $name );
                }
            }
        }
    }
    return '$__NO_VARIABLE_NAME_FOUND';
}

sub scope_type_name_value {
    { my string $RETURN_TYPE };
    my unknown $input_variable_ref = \$_[0];

    my string $type  = type( ${$input_variable_ref} );
    my string $value = to_string( ${$input_variable_ref} );

    my hashref $pad = peek_my 1;                        # pad my
    for my string $name ( keys %{$pad} ) {
        if ( $pad->{$name} == $input_variable_ref ) {
            return (
                'my' . q{ } . $type . q{ } . $name . q{ = } . $value . q{;} );
        }
    }

    $pad = peek_our 1;                                  # pad our
    for my string $name ( keys %{$pad} ) {
        if ( $pad->{$name} == $input_variable_ref ) {
            return (  'our' . q{ }
                    . $type . q{ }
                    . $name . q{ = }
                    . $value
                    . q{;} );
        }
    }

    my string_arrayref_arrayref $sigil_reftypes = [
        [ '$', 'SCALAR' ],
        [ '@', 'ARRAY' ],
        [ '%', 'HASH' ],
        [ '&', 'CODE' ]
    ];

    foreach my string $namespace (
        ( caller() . '::' ),
        sort keys %{ rperlnamespaces::hash_noncore_nonrperl() }
        )
    {
#        RPerl::diag( 'in scope_type_name_value(), have $namespace = ' . $namespace . "\n" );
        $pad = do { no strict 'refs'; \%{$namespace} };    # pad stash
        for my string $name ( keys %{$pad} ) {
            if ( ( ref \$pad->{$name} ) ne 'GLOB' ) { next; }
            for my string_arrayref $sigil_reftype ( @{$sigil_reftypes} ) {
                my string $variable_ref
                    = *{ $pad->{$name} }{ $sigil_reftype->[1] };
                if (    ( defined $variable_ref )
                    and ( $variable_ref == $input_variable_ref ) )
                {
                    return (  $sigil_reftype->[0]
                            . $namespace
                            . $name . q{ = }
                            . $value
                            . q{;  # }
                            . $type );
                }
            }
        }
    }
    return $type . ' $__NO_VARIABLE_NAME_FOUND = ' . $value;
}

1;