local-lib5/lib/perl5/Any/Moose.pm

   1 package Any::Moose;
   2 our $VERSION = '0.10';
   3
   4 # ABSTRACT: use Moose or Mouse modules
   5
   6 use strict;
   7 use warnings;
   8
   9 our $PREFERRED = $ENV{'ANY_MOOSE'};
  10
  11 sub import {
  12     my $self = shift;
  13     my $pkg  = caller;
  14
  15     # Any::Moose gives you strict and warnings (but only the first time, in case
  16     # you do something like: use Any::Moose; no strict 'refs')
  17     if (!defined(_backer_of($pkg))) {
  18         strict->import;
  19         warnings->import;
  20     }
  21
  22     # first options are for Mo*se
  23     unshift @_, 'Moose' if !@_ || ref($_[0]);
  24
  25     while (my $module = shift) {
  26         my $options = @_ && ref($_[0]) ? shift : [];
  27
  28         $options = $self->_canonicalize_options(
  29             module  => $module,
  30             options => $options,
  31             package => $pkg,
  32         );
  33
  34         $self->_install_module($options);
  35     }
  36
  37     # give them any_moose too
  38     no strict 'refs';
  39     *{$pkg.'::any_moose'} = \&any_moose;
  40 }
  41
  42 sub unimport {
  43     my $self = shift;
  44     my $pkg  = caller;
  45
  46     my $backer = _backer_of($pkg);
  47
  48     eval "package $pkg;\n"
  49        . '$backer->unimport(@_);';
  50 }
  51
  52 sub _backer_of {
  53     my $pkg = shift;
  54
  55     return 'Mouse' if $INC{'Mouse.pm'}
  56                    && Mouse::Meta::Class->_metaclass_cache($pkg);
  57     return 'Mouse::Role' if $INC{'Mouse/Role.pm'}
  58                          && Mouse::Meta::Role->_metaclass_cache($pkg);
  59
  60     if (_is_moose_loaded()) {
  61         my $meta = Class::MOP::get_metaclass_by_name($pkg);
  62         if ($meta) {
  63             return 'Moose::Role' if $meta->isa('Moose::Meta::Role');
  64             return 'Moose'       if $meta->isa('Moose::Meta::Class');
  65         }
  66     }
  67
  68     return undef;
  69 }
  70
  71 sub _canonicalize_options {
  72     my $self = shift;
  73     my %args = @_;
  74
  75     my %options;
  76     if (ref($args{options}) eq 'HASH') {
  77         %options = %{ $args{options} };
  78     }
  79     else {
  80         %options = (
  81             imports => $args{options},
  82         );
  83     }
  84
  85     $options{package} = $args{package};
  86     $options{module}  = any_moose($args{module}, $args{package});
  87
  88     return \%options;
  89 }
  90
  91 sub _install_module {
  92     my $self    = shift;
  93     my $options = shift;
  94
  95     my $module = $options->{module};
  96     (my $file = $module . '.pm') =~ s{::}{/}g;
  97
  98     require $file;
  99
 100     eval "package $options->{package};\n"
 101        . '$module->import(@{ $options->{imports} });';
 102 }
 103
 104 sub any_moose {
 105     my $fragment = _canonicalize_fragment(shift);
 106     my $package  = shift || caller;
 107
 108     # Mouse gets first dibs because it doesn't introspect existing classes
 109
 110     if ((_backer_of($package)||'') =~ /^Mouse/) {
 111         $fragment =~ s/^Moose/Mouse/;
 112         return $fragment;
 113     }
 114
 115     return $fragment if (_backer_of($package)||'') =~ /^Moose/;
 116
 117     # If we're loading up the backing class...
 118     if ($fragment eq 'Moose' || $fragment eq 'Moose::Role') {
 119         if (!$PREFERRED) {
 120             $PREFERRED = _is_moose_loaded() ? 'Moose' : 'Mouse';
 121
 122             (my $file = $PREFERRED . '.pm') =~ s{::}{/}g;
 123             require $file;
 124         }
 125
 126         $fragment =~ s/^Moose/Mouse/ if mouse_is_preferred();
 127         return $fragment;
 128     }
 129
 130     require Carp;
 131     Carp::croak("Neither Moose nor Mouse backs the '$package' package.");
 132 }
 133
 134 sub load_class {
 135     my ($class_name) = @_;
 136     return Class::MOP::load_class($class_name) if moose_is_preferred();
 137     return Mouse::load_class($class_name);
 138 }
 139
 140 sub is_class_loaded {
 141     my ($class_name) = @_;
 142     return Class::MOP::is_class_loaded($class_name) if moose_is_preferred();
 143     return Mouse::is_class_loaded($class_name);
 144 }
 145
 146 sub moose_is_preferred { $PREFERRED eq 'Moose' }
 147 sub mouse_is_preferred { $PREFERRED eq 'Mouse' }
 148
 149 sub _is_moose_loaded { !!$INC{'Class/MOP.pm'} }
 150
 151 sub is_moose_loaded {
 152     Carp::carp("Any::Moose::is_moose_loaded is deprecated. Please use Any::Moose::moose_is_preferred instead");
 153     goto \&_is_moose_loaded;
 154 }
 155
 156 sub _canonicalize_fragment {
 157     my $fragment = shift;
 158
 159     return 'Moose' if !defined($fragment);
 160
 161     # any_moose("X::Types") -> any_moose("MooseX::Types")
 162     $fragment =~ s/^X::/MooseX::/;
 163
 164     # any_moose("::Util") -> any_moose("Moose::Util")
 165     $fragment =~ s/^::/Moose::/;
 166
 167     # any_moose("Mouse::Util") -> any_moose("Moose::Util")
 168     $fragment =~ s/^Mouse(X?)\b/Moose$1/;
 169
 170     # any_moose("Util") -> any_moose("Moose::Util")
 171     $fragment =~ s/^(?!Moose)/Moose::/;
 172
 173     # any_moose("Moose::") (via any_moose("")) -> any_moose("Moose")
 174     $fragment =~ s/^Moose::$/Moose/;
 175
 176     return $fragment;
 177 }
 178
 179 1;
 180
 181
 182 __END__
 183 =head1 NAME
 184
 185 Any::Moose - use Moose or Mouse modules
 186
 187 =head1 VERSION
 188
 189 version 0.10
 190
 191 =head1 SYNOPSIS
 192
 193 =head2 BASIC
 194
 195     package Class;
 196
 197     # uses Moose if it's loaded, Mouse otherwise
 198     use Any::Moose;
 199
 200 =head2 OTHER MODULES
 201
 202     package Other::Class;
 203     use Any::Moose;
 204
 205     # uses Moose::Util::TypeConstraints if the class has loaded Moose,
 206     # Mouse::Util::TypeConstraints otherwise.
 207     use Any::Moose '::Util::TypeConstraints';
 208
 209 =head2 COMPLEX USAGE
 210
 211     package My::Meta::Class;
 212     use Any::Moose;
 213
 214     # uses subtype from Moose::Util::TypeConstraints if the class loaded Moose,
 215     # subtype from Mouse::Util::TypeConstraints otherwise.
 216     # similarly for Mo*se::Util's does_role
 217     use Any::Moose (
 218         '::Util::TypeConstraints' => ['subtype'],
 219         '::Util' => ['does_role'],
 220     );
 221
 222     # uses MouseX::Types
 223     use Any::Moose 'X::Types';
 224
 225     # gives you the right class name depending on which Mo*se was loaded
 226     extends any_moose('::Meta::Class');
 227
 228 =head1 DESCRIPTION
 229
 230 Actual documentation is forthcoming, once we solidify all the bits of the API.
 231 The examples above are very likely to continue working.
 232
 233 =head1 AUTHORS
 234
 235   Shawn M Moore <sartak@bestpractical.com>
 236   Florian Ragwitz <rafl@debian.org>
 237   Stevan Little <stevan@iinteractive.com>
 238   Tokuhiro Matsuno <tokuhirom@gmail.com>
 239
 240 =head1 COPYRIGHT AND LICENSE
 241
 242 This software is copyright (c) 2009 by Best Practical Solutions.
 243
 244 This is free software; you can redistribute it and/or modify it under
 245 the same terms as perl itself.
 246