<commit_before>package SNMP::Info::MRO;

use warnings;
use strict;

use PPI;
use Class::ISA;
use Module::Info;
use Module::Load ();
# use Data::Printer;

sub _walk_global_data {
    my $self = shift;
    my $class = (ref $self ? ref $self : $self);

    my $ppi = PPI::Document->new( file($class) );
    my $name    = shift or die "name (e.g. GLOBALS) required";
    my $results = shift || {};
    my $subref  = \&_walk_global_data;

    # get the hash declaration
    my $declaration = $ppi->find_first(sub {
      my ($doc, $tok) = @_;
      return ($tok->isa('PPI::Token::Symbol')
              and $tok->symbol eq "\%$name");
    });

    # get the hash content
    my $content = $declaration->snext_sibling->snext_sibling;

    # get relevant tokens in the hash content
    my @tokens = $content->find(sub {
      my ($doc, $tok) = @_;
      return ($tok->isa('PPI::Token::Symbol')
              or $tok->isa('PPI::Token::Quote'));
    });

    return $results unless scalar @tokens and ref $tokens[0] eq ref [];
    @tokens = @{ $tokens[0] };

    # walk tokens and build final result
    while (my $tok = splice(@tokens, 0, 1)) {
        if ($tok->isa('PPI::Token::Quote')) {
            my $token = $tok->string;
            my $leaf = splice(@tokens, 0, 1);
            my $extract = (($leaf =~ m/^&/) ? 'symbol' : 'string');

            unshift @{ $results->{$token} },
                     [ $class => $leaf->$extract ]
              # we can sometimes see the same package twice
              unless scalar grep { $_ eq $class }
                            map  { $_->[0] }
                                 @{ $results->{$token} };
        }
        elsif ($tok->isa('PPI::Token::Symbol')) {
            # recurse to get the results of the mentioned package
            (my $otherpkg = $tok->symbol) =~ s/^\%(.+)::$name$/$1/;
            $results = $subref->($otherpkg, $name, $results);
        }
    }

    return $results;
}

sub _print_global_data {
    my $results = _walk_global_data(@_);
    
    foreach my $key (sort keys %$results) {
        print $key, "\n";
        my @defs = @{ $results->{$key} };

        my $first = 0;
        while (my $classdef = splice(@defs, 0, 1)) {
            my $class = $classdef->[0];
            my $meth  = $classdef->[1];

            if ($first) {
                printf "     %s ( %s )\n", $meth, $class;
            }
            else {
                printf " `-- %s ( %s )\n", $meth, $class;
                $first = 1;
            }
        }
    }
}

=head1 NAME

SNMP::Info::MRO - Method resolution introspection for SNMP::Info

=head1 DESCRIPTION

This is a set of helpers to show where a given method in SNMP::Info has been
implemented, and which implementation is being used at runtime.

The following distributions are I<required> to run this code:

=over 4

=item *

PPI

=item *

Class::ISA

=item *

Module::Info

=item *

Module::Load

=back

=head1 FUNCTIONS

None of the functions are exported. For all helper functions, you can pass
either the name of a Perl module, or an object instance of SNMP::Info.

=over 4

=item all_methods( $module )

Returns the location of methods defined in C<$module> and all its ancestor
classes (superclasses), either as Perl subroutines or via C<%GLOBALS>
or C<%FUNCS> configuration. The data structure looks like:

 {
   method_name => {
     subs => [],
     globals => [
       [ Package::Name        => 'mib_leaf.0' ],
       [ Other::Package::Name => '1.3.6.1.4.1.9.2.1.58.0' ],
     ],
     funcs => [],
   },
   other_method_name => [
     subs => [
       'Package::Name',
     ],
     globals => [],
     funcs => [
       [ Package::Name => 'mib_leaf_name' ],
     ],
   ],
 }

It should be noted that the order of method resolution in SNMP::Info is to
first look for a defined subroutine (this is done by Perl), then the 
AUTOLOAD sequence will search for a definition in C<%GLOBALS> followed by
C<%FUNCS>.

The defining class or module at runtime is always the first entry in the
list, if it exists:

 $data->{method_name}->{subs}->[0]
   if scalar @{ $data->{method_name}->{subs} };

=cut

sub all_methods {
    my $self = shift;
    my $class = (ref $self ? ref $self : $self);

    my $results = subroutines( $class );
    $results = { map { $_ => { subs => $results->{$_} } }
                     keys %$results };

    my $globals = globals( $class );
    foreach my $key (keys %$globals) {
        $results->{$key}->{globals} = $globals->{$key};
    }

    my $funcs = funcs( $class );
    foreach my $key (keys %$funcs) {
        $results->{$key}->{funcs} = $funcs->{$key};
    }

    foreach my $key (keys %$results) {
        $results->{$key}->{subs}    ||= [];
        $results->{$key}->{globals} ||= [];
        $results->{$key}->{funcs}   ||= [];
    }

    return $results;
}

=item subroutines( $module )

Returns the set of subroutines defined in C<$module> and all its ancestor
classes (superclasses). The data structure looks like:

 {
   method_name => [
     'Package::Name',
     'Other::Package::Name',
   ],
   other_method_name => [
     'Package::Name',
   ],
 }

Should a subroutine have been defined more than once,
the defining classes are listed in reverse order, such that the definition
used at runtime is always:

 $data->{method_name}->[0];

=cut

sub subroutines {
    my $self = shift;
    my $class = (ref $self ? ref $self : $self);<commit_msg>add MRO synopsis and remove empty all_methods keys<commit_after>package SNMP::Info::MRO;

use warnings;
use strict;

use PPI;
use Class::ISA;
use Module::Info;
use Module::Load ();
# use Data::Printer;

sub _walk_global_data {
    my $self = shift;
    my $class = (ref $self ? ref $self : $self);

    my $ppi = PPI::Document->new( file($class) );
    my $name    = shift or die "name (e.g. GLOBALS) required";
    my $results = shift || {};
    my $subref  = \&_walk_global_data;

    # get the hash declaration
    my $declaration = $ppi->find_first(sub {
      my ($doc, $tok) = @_;
      return ($tok->isa('PPI::Token::Symbol')
              and $tok->symbol eq "\%$name");
    });

    # get the hash content
    my $content = $declaration->snext_sibling->snext_sibling;

    # get relevant tokens in the hash content
    my @tokens = $content->find(sub {
      my ($doc, $tok) = @_;
      return ($tok->isa('PPI::Token::Symbol')
              or $tok->isa('PPI::Token::Quote'));
    });

    return $results unless scalar @tokens and ref $tokens[0] eq ref [];
    @tokens = @{ $tokens[0] };

    # walk tokens and build final result
    while (my $tok = splice(@tokens, 0, 1)) {
        if ($tok->isa('PPI::Token::Quote')) {
            my $token = $tok->string;
            my $leaf = splice(@tokens, 0, 1);
            my $extract = (($leaf =~ m/^&/) ? 'symbol' : 'string');

            unshift @{ $results->{$token} },
                     [ $class => $leaf->$extract ]
              # we can sometimes see the same package twice
              unless scalar grep { $_ eq $class }
                            map  { $_->[0] }
                                 @{ $results->{$token} };
        }
        elsif ($tok->isa('PPI::Token::Symbol')) {
            # recurse to get the results of the mentioned package
            (my $otherpkg = $tok->symbol) =~ s/^\%(.+)::$name$/$1/;
            $results = $subref->($otherpkg, $name, $results);
        }
    }

    return $results;
}

sub _print_global_data {
    my $results = _walk_global_data(@_);
    
    foreach my $key (sort keys %$results) {
        print $key, "\n";
        my @defs = @{ $results->{$key} };

        my $first = 0;
        while (my $classdef = splice(@defs, 0, 1)) {
            my $class = $classdef->[0];
            my $meth  = $classdef->[1];

            if ($first) {
                printf "     %s ( %s )\n", $meth, $class;
            }
            else {
                printf " `-- %s ( %s )\n", $meth, $class;
                $first = 1;
            }
        }
    }
}

=head1 NAME

SNMP::Info::MRO - Method resolution introspection for SNMP::Info

=head1 SYNOPSIS

 use SNMP::Info::MRO;
 use Data::Printer;
 
 p SNMP::Info::MRO::all_methods('SNMP::Info::Layer3::Juniper');

=head1 DESCRIPTION

This is a set of helpers to show where a given method in SNMP::Info has been
implemented, and which implementation is being used at runtime.

The following distributions are I<required> to run this code:

=over 4

=item *

PPI

=item *

Class::ISA

=item *

Module::Info

=item *

Module::Load

=back

=head1 FUNCTIONS

None of the functions are exported. For all helper functions, you can pass
either the name of a Perl module, or an object instance of SNMP::Info.

=over 4

=item all_methods( $module )

Returns the location of methods defined in C<$module> and all its ancestor
classes (superclasses), either as Perl subroutines or via C<%GLOBALS>
or C<%FUNCS> configuration. The data structure looks like:

 {
   method_name => {
     globals => [
       [ Package::Name        => 'mib_leaf.0' ],
       [ Other::Package::Name => '1.3.6.1.4.1.9.2.1.58.0' ],
     ],
   },
   other_method_name => [
     subs => [
       'Package::Name',
     ],
     funcs => [
       [ Package::Name => 'mib_leaf_name' ],
     ],
   ],
 }

It should be noted that the order of method resolution in SNMP::Info is to
first look for a defined subroutine (this is done by Perl), then the 
AUTOLOAD sequence will search for a definition in C<%GLOBALS> followed by
C<%FUNCS>.

The defining class or module at runtime is always the first entry in the
list, if it exists:

 $data->{method_name}->{subs}->[0]
   if exists $data->{method_name}->{subs};

=cut

sub all_methods {
    my $self = shift;
    my $class = (ref $self ? ref $self : $self);

    my $results = subroutines( $class );
    $results = { map { $_ => { subs => $results->{$_} } }
                     keys %$results };

    my $globals = globals( $class );
    foreach my $key (keys %$globals) {
        $results->{$key}->{globals} = $globals->{$key};
    }

    my $funcs = funcs( $class );
    foreach my $key (keys %$funcs) {
        $results->{$key}->{funcs} = $funcs->{$key};
    }

    #foreach my $key (keys %$results) {
    #    $results->{$key}->{subs}    ||= [];
    #    $results->{$key}->{globals} ||= [];
    #    $results->{$key}->{funcs}   ||= [];
    #}

    return $results;
}

=item subroutines( $module )

Returns the set of subroutines defined in C<$module> and all its ancestor
classes (superclasses). The data structure looks like:

 {
   method_name => [
     'Package::Name',
     'Other::Package::Name',
   ],
   other_method_name => [
     'Package::Name',
   ],
 }

Should a subroutine have been defined more than once,
the defining classes are listed in reverse order, such that the definition
used at runtime is always:

 $data->{method_name}->[0];

=cut

sub subroutines {
    my $self = shift;
    my $class = (ref $self ? ref $self : $self);
{'fraction_non_alphanumeric': 0.1585455211577212, 'fraction_numerical': 0.0064114306649569516, 'mean_word_length': 2.340165188130927, 'pattern_counts': {'":': 0, '<': 17, '<?xml version=': 0, '>': 128, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 4, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7002078', 'n_tokens_mistral': 3677, 'n_tokens_neox': 3542, 'n_words': 1075}