perl – 使用单个模块并获取Moose和几个MooseX扩展

分类：Perl作者：编程之家用户
假设我有一堆基于 Moose的类的代码库,我希望它们都使用一组通用的 MooseX::*扩展模块.但我不希望每个基于Moose的课程都必须像这样开始： 
package My::Class;

use Moose;
use MooseX::Aliases;
use MooseX::HasDefaults::RO;
use MooseX::StrictConstructor;
...

相反,我希望每个类都像这样开始：

package MyClass;

use My::Moose;

并使它完全等同于上述.

我实现这一目标的第一次尝试是基于Mason::Moose(source)使用的方法：

package My::Moose;

use Moose;
use Moose::Exporter;
use MooseX::Aliases();
use MooseX::StrictConstructor();
use MooseX::HasDefaults::RO();
use Moose::Util::MetaRole;

Moose::Exporter->setup_import_methods(also => [ 'Moose' ]);

sub init_meta {
    my $class = shift;
    my %params = @_;

    my $for_class = $params{for_class};

    Moose->init_meta(@_);
    MooseX::Aliases->init_meta(@_);
    MooseX::StrictConstructor->init_meta(@_);
    MooseX::HasDefaults::RO->init_meta(@_);

    return $for_class->meta();
}

但irc.perl.org上的#moose IRC频道的人们并不推荐这种方法,并且它并不总是有效,具体取决于MooseX :: *模块的组合.例如,尝试使用上面的My :: Moose类来制作My :: Class,如下所示：

package My::Class;

use My::Moose;

has foo => (isa => 'Str');

加载类时导致以下错误：

Attribute (foo) of class My::Class has no associated methods (did you mean to provide an "is" argument?)
 at /usr/local/lib/perl5/site_perl/5.12.1/darwin-2level/Moose/Meta/Attribute.pm line 1020.
    Moose::Meta::Attribute::_check_associated_methods('Moose::Meta::Class::__ANON__::SERIAL::2=HASH(0x100bd6f00)') called at /usr/local/lib/perl5/site_perl/5.12.1/darwin-2level/Moose/Meta/Class.pm line 573
    Moose::Meta::Class::add_attribute('Moose::Meta::Class::__ANON__::SERIAL::1=HASH(0x100be2f10)','foo','isa','Str','definition_context','HASH(0x100bd2eb8)') called at /usr/local/lib/perl5/site_perl/5.12.1/darwin-2level/Moose.pm line 79
    Moose::has('Moose::Meta::Class::__ANON__::SERIAL::1=HASH(0x100be2f10)','Str') called at /usr/local/lib/perl5/site_perl/5.12.1/darwin-2level/Moose/Exporter.pm line 370
    Moose::has('foo','Str') called at lib/My/Class.pm line 5
    require My/Class.pm called at t.pl line 1
    main::BEGIN() called at lib/My/Class.pm line 0
    eval {...} called at lib/My/Class.pm line 0

MooseX::HasDefaults::RO应该是防止这个错误,但它显然没有被要求完成它的工作.评论MooseX :: Aliases-> init_meta(@_); line“修复”了这个问题,但是a)这是我想要使用的模块之一,b)这进一步强调了这个解决方案的错误. (特别是,init_meta()只应调用一次.)

所以,我愿意接受建议,完全无视我未能成功实施的建议.只要给出本问题开头所述的结果,任何策略都是受欢迎的.

根据@Ether的答案,我现在有以下内容(也不起作用)：

package My::Moose;

use Moose();
use Moose::Exporter;
use MooseX::Aliases();
use MooseX::StrictConstructor();
use MooseX::HasDefaults::RO();

my %class_metaroles = (
    class => [
        'MooseX::StrictConstructor::Trait::Class',],attribute => [
        'MooseX::Aliases::Meta::Trait::Attribute','MooseX::HasDefaults::Meta::IsRO',);

my %role_metaroles = (
    role =>
        [ 'MooseX::Aliases::Meta::Trait::Role' ],application_to_class =>
        [ 'MooseX::Aliases::Meta::Trait::Role::ApplicationToClass' ],application_to_role =>
        [ 'MooseX::Aliases::Meta::Trait::Role::ApplicationToRole' ],);

if (Moose->VERSION >= 1.9900) {
    push(@{$class_metaroles{class}},'MooseX::Aliases::Meta::Trait::Class');

    push(@{$role_metaroles{applied_attribute}},'MooseX::Aliases::Meta::Trait::Attribute','MooseX::HasDefaults::Meta::IsRO');
}
else {
    push(@{$class_metaroles{constructor}},'MooseX::StrictConstructor::Trait::Method::Constructor','MooseX::Aliases::Meta::Trait::Constructor');
}

*alias = \&MooseX::Aliases::alias;

Moose::Exporter->setup_import_methods(
    also => [ 'Moose' ],with_meta => ['alias'],class_metaroles => \%class_metaroles,role_metaroles => \%role_metaroles,);

使用这样的示例类：

package My::Class;

use My::Moose;

has foo => (isa => 'Str');

我收到此错误：

Attribute (foo) of class My::Class has no associated methods (did you mean to provide an "is" argument?) at ...

使用这样的示例类：

package My::Class;

use My::Moose;

has foo => (isa => 'Str',alias => 'bar');

我收到此错误：

Found unknown argument(s) passed to 'foo' attribute constructor in 'Moose::Meta::Attribute': alias at ...

解决方法

如上所述,您不应该直接调用其他扩展的init_meta方法.相反,你应该基本上内联这些扩展的init_meta方法：将所有这些方法所做的事情组合到你自己的init_meta中.这很脆弱,因为现在你将模块绑定到其他模块的内部,这些模块随时都可能发生变化.

例如结合MooseX::HasDefaults::IsRO,MooseX::StrictConstructor和MooseX::Aliases,你会做这样的事情(警告：未经测试)(现已测试！)：

package Mooseish;

use Moose ();
use Moose::Exporter;
use MooseX::StrictConstructor ();
use MooseX::Aliases ();

my %class_metaroles = (
    class => ['MooseX::StrictConstructor::Trait::Class'],);
my %role_metaroles = (
    role =>
        ['MooseX::Aliases::Meta::Trait::Role'],application_to_class =>
        ['MooseX::Aliases::Meta::Trait::Role::ApplicationToClass'],application_to_role =>
        ['MooseX::Aliases::Meta::Trait::Role::ApplicationToRole'],);

if (Moose->VERSION >= 1.9900) {
    push @{$class_metaroles{class}},'MooseX::Aliases::Meta::Trait::Class';
    push @{$role_metaroles{applied_attribute}},'MooseX::Aliases::Meta::Trait::Attribute';
}
else {
    push @{$class_metaroles{constructor}},'MooseX::Aliases::Meta::Trait::Constructor';
}

*alias = \&MooseX::Aliases::alias;

Moose::Exporter->setup_import_methods(
    also => ['Moose'],);

1;

这可以通过这个类和测试进行测试：

package MyObject;
use Mooseish;

sub foo { 1 }

has this => (
    isa => 'Str',alias => 'that',);

1;
use strict;
use warnings;
use MyObject;
use Test::More;
use Test::Fatal;

like(
    exception { MyObject->new(does_not_exist => 1) },qr/unknown attribute.*does_not_exist/,'strict constructor behaviour is present',);

can_ok('MyObject',qw(alias this that has with foo));

my $obj = MyObject->new(this => 'thing');
is($obj->that,'thing','can access attribute by its aliased name');

like(
    exception { $obj->this('new value') },qr/Cannot assign a value to a read-only accessor/,'attribute defaults to read-only',);

done_testing;

哪个印刷品：

ok 1 - strict constructor behaviour is present
ok 2 - MyObject->can(...)
ok 3 - can access attribute by its aliased name
ok 4 - attribute defaults to read-only
1..4

版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。

相关推荐

Perl碎碎念
1. 如何去重 #!/usr/bin/perl use strict; my %hash; while(<>){ chomp; print "$_n" unless
如何用perl将表格中不同列的数据进行拼凑，然后将拼凑后的数据用“|”连接在一起
最近写了一个perl脚本，实现的功能是将表格中其中两列的数据进行拼凑，然后将拼凑后的数据用“|”连接在一起。表格内容如下： 员工号码员工姓名职位入职日期1001张三销售1980/12/17 0:00:
基于表的数据字典构造MySQL建表语句
表的数据字典格式如下：如果手动写MySQL建表语句，确认麻烦，还不能保证书写一定正确。写了个Perl脚本，可快速构造MySQL脚本语句。脚本如下：#!/usr/bin/perluse strict;m
如何用Perl对Excel的数据进行提取并分析
巡检类工作经常会出具日报，最近在原有日报的基础上又新增了一个表的数据量统计日报，主要是针对数据库中使用较频繁，数据量又较大的31张表。该日报有两个sheet组成，第一个sheet是数据填写，第二个sh
如何用Perl截取报文
在实际生产环境中，常常需要从后台日志中截取报文，报文的形式类似于.........一个后台日志有多个报文，每个报文可由操作流水唯一确定。以前用AWK写过一个，程序如下：beginline=`awk &
如何通过关键词匹配统计其出现的频率
最近写的一个perl程序，通过关键词匹配统计其出现的频率，让人领略到perl正则表达式的强大，程序如下：#!/usr/bin/perluse strict;my (%hash,%hash1,@arra
漫谈 Perl 的 web 应用开发框架
忍不住在 PerlChina 邮件列表中盘点了一下 Perl 里的 Web 应用框架（巧的是 PerlBuzz 最近也有一篇相关的讨论帖），于是乎，决定在我自己的 blog 上也贴一下 :) 原生 CGI/FastCGI 的 web app 对于较小的应用非常合适，但稍复杂一些就有些痛苦，但运行效率是最高的 ;) 如果是自己用 Perl 开发高性能的站，多推荐之。 Catalyst, CGI::A
perl中bless的理解
bless有两个参数：对象的引用、类的名称。 类的名称是一个字符串，代表了类的类型信息，这是理解bless的关键。 所谓bless就是把 类型信息 赋予 实例变量。 程序包括5个文件： person.pm ：实现了person类 dog.pm ：实现了dog类 bless.pl ： 正确的使用bless bless.wrong.pl ： 错误的使用bless bless.cc ： 使用C++语言实
PERL GB2312 UTF-8 编码转换
gb2312转Utf的方法： use Encode; my $str = "中文"; $str_cnsoftware = encode("utf-8", decode("gb2312", $str));   Utf转 gb2312的方法： use Encode; my $str = "utf8中文"; $str_cnsoftware = encode("gb2312", decode("utf-8
perl 计算硬盘利用率
  perl 计算硬盘利用率， 以%来查看硬盘资源是否存在IO消耗cpu资源情况； 部份代码参考了iostat源码；     #!/usr/bin/perl use Time::HiRes qw(gettimeofday); use POSIX; $SLEEPTIME=3; sub getDiskUtl() { $clock_ticks = POSIX::sysconf( &POSIX::_SC_
perl之变量
1 简单变量 Perl 的 Hello World 是怎么写的呢？请看下面的程序： #!/usr/bin/perl print "Hello World" 这个程序和前面 BASH 的 Hello World 程序几乎相同，只是第一行换成了 #!/usr/bin/perl ，还有显示的时候用的是 print，而不是 echo。有了前面 BASH 基础和 C 语言的基础，许多 Perl 的知识可以很
perl的简单语法
本文介绍Perl的Perl的简单语法，包括基本输入输出、分支循环控制结构、函数、常用系统调用和文件操作，以及进程管理几部分。 1 基本输入输出 在 BASH 脚本程序中，我们用 read var 来实现从键盘的输入，用 echo $var 来实现输出。那么在 Perl 中将有一点变化。Perl 中将标准输入用关键词 表示；标准输出用 表示，标准错误输出用 表示。故而从标准输入读取数据可以写成： $
Perl 中的正则表达式
正则表达式是 Perl 语言的一大特色，也是 Perl 程序中的一点难点，不过如果大家能够很好的掌握他，就可以轻易地用正则表达式来完成字符串处理的任务，当然在 CGI 程序设计中就更能得心应手了。下面我们列出一些正则表达式书写时的一些基本语法规则。 1 正则表达式的三种形式 首先我们应该知道 Perl 程序中，正则表达式有三种存在形式，他们分别是： 匹配：m/<regexp>/ （还可以简写为 /
Perl和Shell区别
在学习Perl和Shell时，有很多人可能会问这样一个问题，到底先学习哪个或者学习哪个更好！ 每个人都有自己的想法，以下是个人愚见，请多多指教！ Perl是larry wall为解决日常工作中的一个编程问题而产生的，它最初的主要功能是用于分析基于文本的数据和生成这些数据的统计和结果；尽管初衷很简单，但是后来发展了很多特点： 1、Perl是一种借鉴了awk、C、sed、shell、C++、Java等
Perl命令行应用介绍
Perl 有很多命令行参数. 通过它, 我们有机会写出更简单的程序. 在这篇文章里我们来了解一些常用的参数. （重点提示：在window下执行命令行程序的方式为 ： perl -e "some code", 注意：是双引号啊，不是单引号，linux下执行时单引号） Safety Net Options 在使用 Perl 尝试一些聪明( 或 stupid) 的想法时, 错误难免会发生. 有经验的 P
perl的特殊变量
转自： http://bbs.chinaunix.net/thread-1191868-1-1.html# 让你的perl代码看起来更像perl代码，而不是像C或者BASIC代码，最好的办法就是去了解perl的内置变量。perl可以通过这些内置变量可以控制程序运行时的诸多方面。 本文中，我们一起领略一下众多内置变量在文件的输入输出控制上的出色表现。 行计数 我决定写这篇文章的一个原因就是，当我发现
Perl BackConnectShell + Rootlab t00l
2009-02-02 13:07 #!/usr/bin/perl # D.O.M TEAM - 2007 # anonyph; arp; ka0x; xarnuz # 2005 - 2007 # BackConnectShell + Rootlab t00l # priv8! # 3sk0rbut0@gmail.com # # Backconnect by data cha0s (modifica
perl 特殊变量
转自： http://bbs.chinaunix.net/thread-1191868-1-1.html# 让你的perl代码看起来更像perl代码，而不是像C或者BASIC代码，最好的办法就是去了解perl的内置变量。perl可以通过这些内置变量可以控制程序运行时的诸多方面。 本文中，我们一起领略一下众多内置变量在文件的输入输出控制上的出色表现。 行计数 我决定写这篇文章的一个原因就是，当我发现
黑莓手机屏幕发展历程对比 blackberry 各型号屏幕大小
黑莓 手机 屏幕发展历程对比 blackberry 各型号屏幕大小 　　黑莓手 机 一直在不断发展且新机型 也在不断上市. 因此，不同黑莓机型的屏幕分辨率也在不断变化着. 总的来说，屏幕分辨率一直在提高并且越来越清晰.我们对所有的黑莓 机型的屏幕分辨率做了个对比.~51blackberry ~com     可能大家特别感兴趣是新发布的黑莓机型，它的分辨率也是黑莓 机型中前所未有的. 　　黑莓 b
NotePad++ 配置 Perl IDE
      公司里没有我用惯的UltraEdit的lisence了， 只能无奈转向开源的Notepad++， 找了半天才知道配置运行Perl的办法。         1,用Notepad++打开.pl文件，         2, F5或者Run->Run,打开运行窗口，在下面的框框里输入：Perl -w "$(FULL_CURRENT_PATH)"， 然后Save，保存成一个命令就行，名字比如叫R
pythonJavaScriptjavaHTMLPHPreactjsC#AndroidCSSNode.jssqlrpython-3.xMysqLjQueryc++pandasFlutterangularIOSdjangolinuxswifttypescript路由器JSON路由器设置无线路由器h3c华三华三路由器设置华三路由器电脑软件教程arraysdocker软件图文教程Cvue.jslaravelspring-boot