获取给定Perl类或模块中的所有方法和/或属性 [英] Get all methods and/or properties in a given Perl class or module

问题描述

我正在处理一个明显的简单问题.

I'm dealing with an apparent simple issue.

我正在编写类似于

I'm writing a module similar to UML::Class::Simple but with some improvements. Summarizing, the idea is to retrieve a record card for each module in a given source, containing information about the Methods, Properties, Dependencies and Children. My current problem is getting Methods and Properties for each module. Let's see the code I've already written:

use Class::Inspector;
use Data::Dumper;
sub _load_methods{
  my $pkg = shift;
  my $methods = Class::Inspector->methods( $pkg, 'expanded' );
  print Dumper $methods;
  return 1;
}

为给定的程序包调用此函数，得到的方法比我预期的要多.原因是 Class :: Inspector 如果模块是Moose :: Object，则返回所有继承的方法以及访问器.我想过滤所有这些方法，以获取仅在给定程序包中定义的方法，而不是在其父程序中定义的方法.

Calling this function for a given package, I get more methods than I expect. The reason is Class::Inspector returns all inherited methods and also the accessors if the module is a Moose::Object. I would like to filter all of this methods to get just those defined in the given package, not in its parents.

任何人都可以按照我建议的方式提供一种优雅的方法来过滤方法列表吗?

Can anyone provide an elegant way to filter the list of methods in the way I suggest?

谢谢.

推荐答案

向我介绍了 @Oesor 模块Data :: Printer，其源代码中包含针对我的问题的解决方案，并提供给 @tobyink ，我是解析Moose类的关键，我想出了以下解决方案:

Thanks to @Oesor, who introduced to me the module Data::Printer, which contains a solution for my problem in its source code, and to @tobyink, who give me the key to parse Moose classes, I came up with the following solution:

sub _load_methods_for_one_pkg {
  # Inspired in Data::Printer::_show_methods
  # Thanks to Oesor
  my $pkg     = shift;
  my $string  = '';
  my $methods = {
    public  => [],
    private => [],
  };
  my $inherited = 'none';
  require B;
  my $methods_of = sub {
    my ($name) = @_;
    map {
      my $m;
      if (  $_
        and $m = B::svref_2object($_)
        and $m->isa('B::CV')
        and not $m->GV->isa('B::Special') )
      {
        [ $m->GV->STASH->NAME, $m->GV->NAME ];
      }
      else {
        ();
      }
    } values %{ Package::Stash->new($name)->get_all_symbols('CODE') };
  };
  my %seen_method_name;
METHOD:
  foreach my $method ( map $methods_of->($_), @{ mro::get_linear_isa($pkg) } ) {
    my ( $package_string, $method_string ) = @$method;
    next METHOD if $seen_method_name{$method_string}++;
    my $type = substr( $method_string, 0, 1 ) eq '_' ? 'private' : 'public';
    if ( $package_string ne $pkg ) {
      next METHOD
        unless $inherited ne 'none'
        and ( $inherited eq 'all' or $type eq $inherited );
      $method_string .= ' (' . $package_string . ')';
    }
    push @{ $methods->{$type} }, $method_string;
  }

# If is a Moose object, we have more things to do!
  if( grep 'Moose', @{ $self->dependencies->{ $pkg } }){
    my ($roles, $this_methods, $properties) = _parse_moose_class($pkg);
    push @{ $methods->{properties} }, @$properties;
    push @{ $methods->{roles} }, @$roles;
  }
  return $methods;
}

=head2 _parse_moose_class

=cut

sub _parse_moose_class{
  my $pkg = shift;
  my $meta = Moose::Util::find_meta($pkg);
  my @does = $meta->calculate_all_roles;
  my @can = $meta->get_method_list;
  my @has = $meta->get_attribute_list;
  return ( \@does, \@can, \@has );
}

这篇关于获取给定Perl类或模块中的所有方法和/或属性的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！