File Coverage

blib/lib/MooX/Object/Pluggable.pm

Criterion	Covered	Total	%
statement	87	91	95.6
branch	24	26	92.3
condition	3	3	100.0
subroutine	15	17	88.2
pod	3	5	60.0
total	132	142	92.9

package MooX::Object::Pluggable;
use Moo::Role;
use Modern::Perl;
use Scalar::Util 'refaddr';
require Module::Pluggable::Object;
use namespace::clean;

our $VERSION = '0.0.5'; # VERSION
# ABSTRACT: Moo eXtension to inject plugins to exist objects as a role


sub _apply_roles {
  my ($self, @roles) = @_;
  map {
    my $role = $_;
    Moo::Role->apply_roles_to_object($self, $role) unless $self->does($role)
  } @roles;
  return $self;
}

sub load_plugin { load_plugins(@_) }

sub load_plugins {
  my ($self, @plugin_options) = @_;
  my $pluggable_object = $self->_pluggable_object;
  my @plugins = $pluggable_object->plugins;
  # Provide ability for roles in a real package, with syntax: '+MooX::ConfigFromFile'
  map {
    my $option = $_; $option=~s/^\+//;
    $self->_apply_roles($option);
  } grep { /^\+/ } @plugin_options;
  return $self unless @plugins;
  for my $plugin_option (@plugin_options) {
    if ($plugin_option eq '-all') {
      $self->_apply_roles(@plugins);
    } elsif (ref $plugin_option eq 'ARRAY') {
      $self->load_plugins(@$plugin_option);
    } elsif (ref $plugin_option eq 'Regexp') {
      my @load_plugins = grep { $plugin_option } @plugins;
      return $self unless @load_plugins;
      $self->_apply_roles(@load_plugins);
    } else {
      my @load_plugins = map { $_.'::'.$plugin_option } @{$pluggable_object->{search_path}};
      my %all_plugins = map { $_ => 1 } @plugins;
      my @real_roles = grep { $all_plugins{$_} } @load_plugins;
      return $self unless @real_roles;
      $self->_apply_roles(@real_roles)
    }
  }
  return $self;
}


sub plugins {
  my ($self) = @_;
  $self->_pluggable_object->plugins;
}


sub loaded_plugins {
  my $self = shift;
  grep { $self->does($_) } $self->plugins;
}


my %pluggable_objects = (); # key: object, value: loaded plugins

sub BUILD { }  # BUILD() will be override by consumers, so we use afterBuild

after BUILD => sub {
  my ($self, $opts) = @_;
  if (defined $opts->{pluggable_options}) {
    my $pluggable_options = $opts->{pluggable_options};
    $pluggable_options->{package} = ref $self ? ref $self : $self;
    $pluggable_objects{refaddr($self)} = Module::Pluggable::Object->new(%$pluggable_options);
  }
  if (defined $self->_build_load_plugins and scalar @{$self->_build_load_plugins} > 0) {
    $self->load_plugins(@{$self->_build_load_plugins});
  }
  if (defined $opts->{load_plugins}) {
    $self->load_plugins(ref $opts->{load_plugins} eq 'ARRAY' ?
      @{$opts->{load_plugins}} : $opts->{load_plugins}
    );
  }
};

sub _build_pluggable_options { {} }

sub _build_load_plugins { [] }

sub _pluggable_object {
  my $self = shift;
  my ($class, $addr);
  if (ref $self) {
    $class = ref $self;
    $addr = refaddr $self;
  } else {
    $class = $self;
  }
  # Find self pluggable object;
  return $pluggable_objects{$addr} if defined $addr and defined $pluggable_objects{$addr};
  # Find package pluggable object;
  $class=~s/__WITH__.*//g; # use parent package name as class name.
  return $pluggable_objects{$class} if defined $pluggable_objects{$class};
  # Not found, create a new one for package.
  my $pluggable_options = $self->_build_pluggable_options;
  $pluggable_options->{package} = $class;
  $pluggable_objects{$class} = Module::Pluggable::Object->new(
    %$pluggable_options,
  );
}


sub _inject_roles_to {
  my ($target, $import_options) = @_;
  my $with = $target->can("with");
  return unless $with; # Do nothing unless it's a Moo(se) object or role.

  $with->('MooX::Object::Pluggable');
  my $around = $target->can("around");
  for my $builder (qw/pluggable_options load_plugins/) {
    my ($key) = grep /$builder/, keys %$import_options;
    next unless $key;
    $around->("_build_$builder" => sub { $import_options->{$key} });
  }
}

sub import
{
  my ( undef, %import_options ) = @_;
  my $target = caller;
  # Inject roles to target namespace
  &_inject_roles_to($target, \%import_options);

  # Compatible for MooX
  my $around = $target->can("around");
  return unless $around;
  $around->("import" => sub {
      my ($orig, $self, @opts) = @_;
      my %pluggable_opts = map { $opts[$_] => $opts[$_ + 1] } grep { $opts[$_] =~/^-(pluggable_options|load_plugins)$/ } 0..$#opts;
      &_inject_roles_to($target, \%pluggable_opts);
      my %hash = map { $_ => 1 } %pluggable_opts;
      my @remains = grep { ! defined $hash{$_} } @opts;
      $self->$orig(@remains);
    });
  return;
}


1;

__END__