MOON
Server: Apache
System: Linux server1.studioinfinity.com.br 2.6.32-954.3.5.lve1.4.90.el6.x86_64 #1 SMP Tue Feb 21 12:26:30 UTC 2023 x86_64
User: artinside (517)
PHP: 7.4.33
Disabled: exec,passthru,shell_exec,system
Upload Files
File: //usr/local/lib64/perl5/Cpanel/Class/Meta/Package.pm
package Cpanel::Class::Meta::Package;

use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed', 'reftype';

use base 'Cpanel::Class::Meta::Object';

our $VERSION = '1.0.5';

sub name { $_[0]->{'$!package'} }

sub namespace {
    no strict 'refs';
    \%{ $_[0]->name . '::' };
}

{
    my %SIGIL_MAP = (
        '$' => 'SCALAR',
        '@' => 'ARRAY',
        '%' => 'HASH',
        '&' => 'CODE',
    );

    sub _deconstruct_variable_name {
        my ( $self, $variable ) = @_;

        ( defined $variable )
          || confess "You must pass a variable name";

        my ( $sigil, $name ) = ( $variable =~ /^(.)(.*)$/ );

        ( defined $sigil )
          || confess "The variable name must include a sigil";

        ( exists $SIGIL_MAP{$sigil} )
          || confess "I do not recognize that sigil '$sigil'";

        return ( $name, $sigil, $SIGIL_MAP{$sigil} );
    }
}

sub list_all_package_symbols {
    my ( $self, $type_filter ) = @_;
    return keys %{ $self->namespace } unless defined $type_filter;

    # NOTE:
    # or we can filter based on
    # type (SCALAR|ARRAY|HASH|CODE)
    my $namespace = $self->namespace;
    return grep { ( ref( $namespace->{$_} ) ? ( ref( $namespace->{$_} ) eq 'SCALAR' && $type_filter eq 'CODE' ) : ( ref( \$namespace->{$_} ) eq 'GLOB' && defined( *{ $namespace->{$_} }{$type_filter} ) ) ); } keys %{$namespace};
}

sub get_package_symbol {
    my ( $self, $variable ) = @_;

    my ( $name, $sigil, $type ) = $self->_deconstruct_variable_name($variable);

    $self->add_package_symbol($variable)
      unless exists $self->namespace->{$name};

    if ( ref( $self->namespace->{$name} ) eq 'SCALAR' ) {
        if ( $type eq 'CODE' ) {
            no strict 'refs';
            return \&{ $self->name . '::' . $name };
        }
        else {
            return undef;
        }
    }
    else {
        return *{ $self->namespace->{$name} }{$type};
    }
}

sub add_package_symbol {
    my ( $self, $variable, $initial_value ) = @_;

    my ( $name, $sigil, $type ) = $self->_deconstruct_variable_name($variable);

    no strict 'refs';
    no warnings 'redefine', 'misc';
    *{ $self->name . '::' . $name } = ref $initial_value ? $initial_value : \$initial_value;
}

sub has_package_symbol {
    my ( $self, $variable ) = @_;

    my ( $name, $sigil, $type ) = $self->_deconstruct_variable_name($variable);

    return 0 unless exists $self->namespace->{$name};

    if ( ref( $self->namespace->{$name} ) eq 'SCALAR' ) {
        return ( $type eq 'CODE' ? 1 : 0 );
    }
    elsif ( $type eq 'SCALAR' ) {
        my $val = *{ $self->namespace->{$name} }{$type};
        return defined( ${$val} ) ? 1 : 0;
    }
    else {
        defined( *{ $self->namespace->{$name} }{$type} ) ? 1 : 0;
    }
}

sub remove_package_glob {
    my ( $self, $name ) = @_;
    no strict 'refs';
    delete ${ $self->name . '::' }{$name};
}

sub remove_package_symbol {
    my ( $self, $variable ) = @_;

    my ( $name, $sigil, $type ) = $self->_deconstruct_variable_name($variable);

    my ( $scalar, $array, $hash, $code );
    if ( $type eq 'SCALAR' ) {
        $array = $self->get_package_symbol( '@' . $name ) if $self->has_package_symbol( '@' . $name );
        $hash  = $self->get_package_symbol( '%' . $name ) if $self->has_package_symbol( '%' . $name );
        $code  = $self->get_package_symbol( '&' . $name ) if $self->has_package_symbol( '&' . $name );
    }
    elsif ( $type eq 'ARRAY' ) {
        $scalar = $self->get_package_symbol( '$' . $name ) if $self->has_package_symbol( '$' . $name );
        $hash   = $self->get_package_symbol( '%' . $name ) if $self->has_package_symbol( '%' . $name );
        $code   = $self->get_package_symbol( '&' . $name ) if $self->has_package_symbol( '&' . $name );
    }
    elsif ( $type eq 'HASH' ) {
        $scalar = $self->get_package_symbol( '$' . $name ) if $self->has_package_symbol( '$' . $name );
        $array  = $self->get_package_symbol( '@' . $name ) if $self->has_package_symbol( '@' . $name );
        $code   = $self->get_package_symbol( '&' . $name ) if $self->has_package_symbol( '&' . $name );
    }
    elsif ( $type eq 'CODE' ) {
        $scalar = $self->get_package_symbol( '$' . $name ) if $self->has_package_symbol( '$' . $name );
        $array  = $self->get_package_symbol( '@' . $name ) if $self->has_package_symbol( '@' . $name );
        $hash   = $self->get_package_symbol( '%' . $name ) if $self->has_package_symbol( '%' . $name );
    }
    else {
        confess "This should never ever ever happen";
    }

    $self->remove_package_glob($name);

    $self->add_package_symbol( ( '$' . $name ) => $scalar ) if defined $scalar;
    $self->add_package_symbol( ( '@' . $name ) => $array )  if defined $array;
    $self->add_package_symbol( ( '%' . $name ) => $hash )   if defined $hash;
    $self->add_package_symbol( ( '&' . $name ) => $code )   if defined $code;
}

sub find_all_methods_by_name {
    my ( $self, $method_name ) = @_;
    ( defined $method_name && $method_name )
      || confess "You must define a method name to find";
    my @methods;
    foreach my $class ( $self->linearized_isa ) {

        # fetch the meta-class ...
        my $meta = $self->initialize($class);
        push @methods => {
            name  => $method_name,
            class => $class,
            code  => $meta->get_method($method_name)
        } if $meta->has_method($method_name);
    }
    return @methods;
}

1;