【问题标题】:Get all methods and/or properties in a given Perl class or module获取给定 Perl 类或模块中的所有方法和/或属性
【发布时间】:2014-05-13 15:09:25
【问题描述】:

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

我正在编写一个类似于UML::Class::Simple 的模块,但有一些改进。总而言之,这个想法是为给定源中的每个模块检索一张记录卡,其中包含有关方法、属性、依赖项和子项的信息。我当前的问题是获取每个模块的方法和属性。让我们看看我已经写的代码:

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 的访问器。我想过滤所有这些方法以仅获取给定包中定义的方法,而不是其父包中定义的方法。

谁能提供一种优雅的方式来按照我建议的方式过滤方法列表?

提前致谢。

【问题讨论】:

  • 虽然这不是一个完整的答案,但看看 Data::Printer 是如何处理它的。
  • 我刚刚试了一下,它看起来非常漂亮和实用。感谢 Oesor,我的资源中添加了一个新的 perl 模块。

标签: perl methods uml


【解决方案1】:

如果一个类是 Moose 类,不要使用 Class::Inspector 来检查它。 Moose 提供了自己的非常广泛的自省 API。它可以为您提供方法、属性等列表。

my $meta = Moose::Util::find_meta($class_name);

my @isa    = $meta->superclasses;
my @does   = $meta->calculate_all_roles;
my @can    = $meta->get_method_list;
my @has    = $meta->get_attribute_list;

遗憾的是,所有这些的文档都分散在许多不同的页面上。 Moose::Meta::Class 是个不错的起点。

Mouse 提供了一个几乎但不完全相同的自省 API。

Moo 不提供自己的自省 API,但如果加载了 Moose,则会挂钩到 Moose 的 API,以便您可以使用 Moose::Util::find_meta 检索有关 Moo 类的信息。

【讨论】:

  • 好答案!我会执行你的建议。谢谢!
【解决方案2】:

感谢@Oesor,他向我介绍了模块Data::Printer,它的源代码中包含了我的问题的解决方案,感谢@tobyink,他给了我解析Moose类的关键,我来了提出以下解决方案:

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 );
}

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 2012-06-10
    • 2013-11-23
    • 1970-01-01
    • 1970-01-01
    • 2011-01-06
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多