view release on metacpan or  search on metacpan

lib/PLS/Parser/PackageSymbols.pm  view on Meta::CPAN

{
    my $packages_to_find = $json->decode($line);
    my %functions;

    foreach my $find_package (@{$packages_to_find})
    {
        my @module_parts        = split /::/, $find_package;
        my @parent_module_parts = @module_parts;
        pop @parent_module_parts;

        my @packages;

        foreach my $parts (\@parent_module_parts, \@module_parts)
        {
            my $package = join '::', @{$parts};
            next unless (length $package);

            my $package_path = $package =~ s/::/\//gr;
            $package_path .= '.pm';

            if (exists $mtimes{$package_path} and $mtimes{$package_path} != (stat $INC{$package_path})[9])
            {
                delete $INC{$package_path};
            }

            eval "require $package";
            next unless (length $INC{$package_path});

            $mtimes{$package_path} = (stat $INC{$package_path})[9];

            push @packages, $package;

            my @isa = add_parent_classes($package);

            foreach my $isa (@isa)
            {
                my $isa_path = $isa =~ s/::/\//gr;
                $isa_path .= '.pm';

                if (exists $mtimes{$isa_path} and $mtimes{$isa_path} != (stat $INC{$isa_path})[9])
                {
                    delete $INC{$isa_path};
                }

                eval "require $isa";
                next if (length $@);

                $mtimes{$isa_path} = (stat $INC{$isa_path})[9];

                push @packages, $isa;
            } ## end foreach my $isa (@isa)
        } ## end foreach my $parts (\@parent_module_parts...)

        foreach my $package (@packages)
        {
            my @parts = split /::/, $package;
            my $ref   = \%{"${package}::"};

            foreach my $name (keys %{$ref})
            {
                next if $name =~ /^BEGIN|UNITCHECK|INIT|CHECK|END|VERSION|DESTROY|import|unimport|can|isa$/;
                next if $name =~ /^_/;                                                                         # hide private subroutines
                next if $name =~ /^\(/; # overloaded operators start with a parenthesis

                my $code_ref = $package->can($name);
                next if (ref $code_ref ne 'CODE');
                my $defined_in = eval { B::svref_2object($code_ref)->GV->STASH->NAME };
                next if ($defined_in ne $package and not $package->isa($defined_in));

                if ($find_package->isa($package))
                {
                    push @{$functions{$find_package}}, $name;
                }
                else
                {
                    push @{$functions{$package}}, $name;
                }
            } ## end foreach my $name (keys %{$ref...})
        } ## end foreach my $package (@packages...)
    } ## end foreach my $find_package (@...)

    print $json->encode(\%functions);
    print "\n";
} ## end while (my $line = <STDIN>...)

sub add_parent_classes
{
    my ($package) = @_;

    my @isa = eval "\@${package}::ISA";
    return unless (scalar @isa);

    foreach my $isa (@isa)
    {
        push @isa, add_parent_classes($isa);
    }

    return @isa;
} ## end sub add_parent_classes
EOF

    return $code;
} ## end sub get_package_symbols_code

sub get_imported_package_symbols_code
{
    my $code = <<'EOF';
#close STDERR;

my $json_package = 'JSON::PP';

if (eval { require Cpanel::JSON::XS; 1 })
{
    $json_package = 'Cpanel::JSON::XS';
}
elsif (eval { require JSON::XS; 1 })
{
    $json_package = 'JSON::XS';
}
else
{