Sponsoring The Perl Toolchain Summit 2025: Help make this important event another success Learn more

WBRASWELL / RPerl-7.000000 / lib / rperlnames.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124

              
## 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;