Beta Shell
v2.0 · web2.us.cloudlogin.co
[FM]
[CMD]
[PHP]
[DB]
[INFO]
[SEC]
File Manager
~
/
usr
/
share
/
perl5
/
vendor_perl
/
Any
Upload
4 items
Name
Size
Perms
Modified
Actions
[ .. / .. ]
Moose.pm
7.78 KB
-rw-r--r--
2016-11-08 03:37:08
Edit
Del
URI
-
drwxr-xr-x
2022-02-23 11:31:41
Del
Editing: Moose.pm
(7.78 KB)
Path: /usr/share/perl5/vendor_perl/Any/Moose.pm
Back
package Any::Moose; # git description: v0.26-20-g4c2f951 # ABSTRACT: (DEPRECATED) use Moo instead! # KEYWORDS: deprecated Moose Mouse abstraction layer object-oriented # vim: set ts=8 sts=4 sw=4 tw=115 et : use 5.006_002; use strict; use warnings; our $VERSION = '0.27'; warnings::warnif('deprecated', 'Any::Moose is deprecated. Please use Moo instead'); # decide which backend to use our $PREFERRED; do { local $@; if ($ENV{ANY_MOOSE}) { $PREFERRED = $ENV{'ANY_MOOSE'}; warn "ANY_MOOSE is not set to Moose or Mouse" unless $PREFERRED eq 'Moose' || $PREFERRED eq 'Mouse'; # if we die here, then perl gives "unknown error" which doesn't tell # you what the problem is at all. argh. if ($PREFERRED eq 'Moose' && !eval { require Moose }) { warn "\$ANY_MOOSE is set to Moose but we cannot load it"; } elsif ($PREFERRED eq 'Mouse' && !eval { require Mouse }) { warn "\$ANY_MOOSE is set to Mouse but we cannot load it"; } } elsif ( $INC{'Moo.pm'} && eval { require Moose } ) { $PREFERRED = 'Moose'; } elsif (_is_moose_loaded()) { $PREFERRED = 'Moose'; } elsif (eval { require Mouse; require Mouse::Util; Mouse::Util->can('get_metaclass_by_name') }) { $PREFERRED = 'Mouse'; } elsif (eval { require Moose }) { $PREFERRED = 'Moose'; } else { require Carp; warn "Unable to locate Mouse or Moose in INC"; } }; sub import { my $self = shift; my $pkg = caller; # Any::Moose gives you strict and warnings strict->import; warnings->import; # first options are for Mo*se unshift @_, 'Moose' if !@_ || ref($_[0]); while (my $module = shift) { my $options = @_ && ref($_[0]) ? shift : []; $options = $self->_canonicalize_options( module => $module, options => $options, package => $pkg, ); $self->_install_module($options); } # give them any_moose too no strict 'refs'; *{$pkg.'::any_moose'} = \&any_moose; } sub unimport { my $sel = shift; my $pkg = caller; my $module; if(@_){ $module = any_moose(shift, $pkg); } else { $module = _backer_of($pkg); } my $e = do{ local $@; eval "package $pkg;\n" . '$module->unimport();'; $@; }; if ($e) { require Carp; Carp::croak("Cannot unimport Any::Moose: $e"); } return; } sub _backer_of { my $pkg = shift; if(exists $INC{'Mouse.pm'} and Mouse::Util->can('get_metaclass_by_name') ){ my $meta = Mouse::Util::get_metaclass_by_name($pkg); if ($meta) { return 'Mouse::Role' if $meta->isa('Mouse::Meta::Role'); return 'Mouse' if $meta->isa('Mouse::Meta::Class'); } } if (_is_moose_loaded()) { my $meta = Class::MOP::get_metaclass_by_name($pkg); if ($meta) { return 'Moose::Role' if $meta->isa('Moose::Meta::Role'); return 'Moose' if $meta->isa('Moose::Meta::Class'); } } return undef; } sub _canonicalize_options { my $self = shift; my %args = @_; my %options; if (ref($args{options}) eq 'HASH') { %options = %{ $args{options} }; } else { %options = ( imports => $args{options}, ); } $options{package} = $args{package}; $options{module} = any_moose($args{module}, $args{package}); return \%options; } sub _install_module { my $self = shift; my $options = shift; my $module = $options->{module}; (my $file = $module . '.pm') =~ s{::}{/}g; require $file; my $e = do { local $@; eval "package $options->{package};\n" . '$module->import(@{ $options->{imports} });'; $@; }; if ($e) { require Carp; Carp::croak("Cannot import Any::Moose: $e"); } return; } sub any_moose { my $fragment = _canonicalize_fragment(shift); my $package = shift || caller; # Mouse gets first dibs because it doesn't introspect existing classes my $backer = _backer_of($package) || ''; if ($backer =~ /^Mouse/) { $fragment =~ s/^Moose/Mouse/; return $fragment; } return $fragment if $backer =~ /^Moose/; $fragment =~ s/^Moose/Mouse/ if mouse_is_preferred(); return $fragment; } for my $name (qw/ load_class is_class_loaded class_of get_metaclass_by_name get_all_metaclass_instances get_all_metaclass_names load_first_existing_class /) { no strict 'refs'; *{__PACKAGE__."::$name"} = moose_is_preferred() ? *{"Class::MOP::$name"} : *{"Mouse::Util::$name"}; } sub moose_is_preferred { $PREFERRED eq 'Moose' } sub mouse_is_preferred { $PREFERRED eq 'Mouse' } sub _is_moose_loaded { exists $INC{'Moose.pm'} } sub is_moose_loaded { warnings::warnif('deprecated', "Any::Moose::is_moose_loaded is deprecated. Please use Any::Moose::moose_is_preferred instead"); goto \&_is_moose_loaded; } sub _canonicalize_fragment { my $fragment = shift; return 'Moose' if !$fragment; # any_moose("X::Types") -> any_moose("MooseX::Types") $fragment =~ s/^X::/MooseX::/; # any_moose("::Util") -> any_moose("Moose::Util") $fragment =~ s/^::/Moose::/; # any_moose("Mouse::Util") -> any_moose("Moose::Util") $fragment =~ s/^Mouse(X?)\b/Moose$1/; # any_moose("Util") -> any_moose("Moose::Util") $fragment =~ s/^(?!Moose)/Moose::/; return $fragment; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Any::Moose - (DEPRECATED) use Moo instead! =head1 VERSION version 0.27 =head1 DEPRECATION 日本語翻訳: http://blog.64p.org/entry/2013/02/06/094906 Please use L<Moo> instead of Any::Moose for new code. Moo classes and roles will transparently and correctly upgrade to Moose when needed. This is a fundamentally better design than what Any::Moose offers. Mouse metaclasses do not interact with Moose metaclasses which leaks abstractions all over the place. Any::Moose had a good run. It was a simplistic but expedient answer for getting Moose syntax on the cheap but with the transparent upgrade path to Moose when you needed it. But really, please don't use it any more. :) You may find L<MooX::late> useful for porting your code from Any::Moose to Moo. For the sparse documentation Any::Moose used to include, see L<https://metacpan.org/module/SARTAK/Any-Moose-0.18/lib/Any/Moose.pm> =head1 SUPPORT Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Any-Moose> (or L<bug-Any-Moose@rt.cpan.org|mailto:bug-Any-Moose@rt.cpan.org>). There is also a mailing list available for users of this distribution, at L<http://lists.perl.org/list/moose.html>. There is also an irc channel available for users of this distribution, at L<C<#moose> on C<irc.perl.org>|irc://irc.perl.org/#moose>. =head1 AUTHORS =over 4 =item * Shawn M Moore <code@sartak.org> =item * Florian Ragwitz <rafl@debian.org> =item * Stevan Little <stevan@iinteractive.com> =item * 藤 吾郎 (Fuji Goro) <gfuji@cpan.org> =back =head1 CONTRIBUTORS =for stopwords Karen Etheridge Tokuhiro Matsuno Ricardo Signes Graham Knop Stevan Little Chris 'BinGOs' Williams =over 4 =item * Karen Etheridge <ether@cpan.org> =item * Tokuhiro Matsuno <tokuhirom@gmail.com> =item * Ricardo Signes <rjbs@cpan.org> =item * Graham Knop <haarg@haarg.org> =item * Stevan Little <stevan.little@iinteractive.com> =item * Chris 'BinGOs' Williams <chris@bingosnet.co.uk> =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2009 by Best Practical Solutions. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut