The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Any::Moose;
our $VERSION = '0.09';

# ABSTRACT: use Moose or Mouse modules

use strict;
use warnings;

our $PREFERRED = $ENV{'ANY_MOOSE'};

sub import {
    my $self = shift;
    my $pkg  = caller;

    # Any::Moose gives you strict and warnings (but only the first time, in case
    # you do something like: use Any::Moose; no strict 'refs')
    if (!defined(_backer_of($pkg))) {
        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 $self = shift;
    my $pkg  = caller;

    my $backer = _backer_of($pkg);

    eval "package $pkg;\n"
       . '$backer->unimport(@_);';
}

sub _backer_of {
    my $pkg = shift;

    return 'Mouse' if $INC{'Mouse.pm'}
                   && Mouse::Meta::Class->_metaclass_cache($pkg);
    return 'Mouse::Role' if $INC{'Mouse/Role.pm'}
                         && Mouse::Meta::Role->_metaclass_cache($pkg);

    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;

    eval "package $options->{package};\n"
       . '$module->import(@{ $options->{imports} });';
}

sub any_moose {
    my $fragment = _canonicalize_fragment(shift);
    my $package  = shift || caller;

    # Mouse gets first dibs because it doesn't introspect existing classes

    if ((_backer_of($package)||'') =~ /^Mouse/) {
        $fragment =~ s/^Moose/Mouse/;
        return $fragment;
    }

    return $fragment if (_backer_of($package)||'') =~ /^Moose/;

    # If we're loading up the backing class...
    if ($fragment eq 'Moose' || $fragment eq 'Moose::Role') {
        if (!$PREFERRED) {
            $PREFERRED = _is_moose_loaded() ? 'Moose' : 'Mouse';

            (my $file = $PREFERRED . '.pm') =~ s{::}{/}g;
            require $file;
        }

        $fragment =~ s/^Moose/Mouse/ if mouse_is_preferred();
        return $fragment;
    }

    require Carp;
    Carp::croak("Neither Moose nor Mouse backs the '$package' package.");
}

sub load_class {
    my ($class_name) = @_;
    return Class::MOP::load_class($class_name) if moose_is_preferred();
    return Mouse::load_class($class_name);
}

sub is_class_loaded {
    my ($class_name) = @_;
    return Class::MOP::is_class_loaded($class_name) if moose_is_preferred();
    return Mouse::is_class_loaded($class_name);
}

sub moose_is_preferred { $PREFERRED eq 'Moose' }
sub mouse_is_preferred { $PREFERRED eq 'Mouse' }

sub _is_moose_loaded { !!$INC{'Class/MOP.pm'} }

sub is_moose_loaded {
    Carp::carp("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 !defined($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::/;

    # any_moose("Moose::") (via any_moose("")) -> any_moose("Moose")
    $fragment =~ s/^Moose::$/Moose/;

    return $fragment;
}

1;


__END__
=head1 NAME

Any::Moose - use Moose or Mouse modules

=head1 VERSION

version 0.09

=head1 SYNOPSIS

=head2 BASIC

    package Class;

    # uses Moose if it's loaded, Mouse otherwise
    use Any::Moose;

=head2 OTHER MODULES

    package Other::Class;
    use Any::Moose;

    # uses Moose::Util::TypeConstraints if the class has loaded Moose,
    # Mouse::Util::TypeConstraints otherwise.
    use Any::Moose '::Util::TypeConstraints';

=head2 COMPLEX USAGE

    package My::Meta::Class;
    use Any::Moose;

    # uses subtype from Moose::Util::TypeConstraints if the class loaded Moose,
    # subtype from Mouse::Util::TypeConstraints otherwise.
    # similarly for Mo*se::Util's does_role
    use Any::Moose (
        '::Util::TypeConstraints' => ['subtype'],
        '::Util' => ['does_role'],
    );

    # uses MouseX::Types
    use Any::Moose 'X::Types';

    # gives you the right class name depending on which Mo*se was loaded
    extends any_moose('::Meta::Class');

=head1 DESCRIPTION

Actual documentation is forthcoming, once we solidify all the bits of the API.
The examples above are very likely to continue working.

=head1 AUTHORS

  Shawn M Moore <sartak@bestpractical.com>
  Florian Ragwitz <rafl@debian.org>
  Stevan Little <stevan@iinteractive.com>
  Tokuhiro Matsuno <tokuhirom@gmail.com>

=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 perl itself.