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