lib/MooseX/Runnable/Invocation.pm

   1 package MooseX::Runnable::Invocation;
   2 use Moose;
   3 use MooseX::Types -declare => ['RunnableClass'];
   4 use MooseX::Types::Moose qw(Str ClassName);
   5
   6 require Class::MOP;
   7
   8 # we can't load the class until plugins are loaded,
   9 # so we have to handle this outside of coerce
  10
  11 subtype RunnableClass,
  12   as Str,
  13   where { $_ =~ /^[:A-Za-z_]+$/ };
  14
  15 use namespace::clean -except => 'meta';
  16
  17 # this class is just as runnable as any other, so I guess we should tag it
  18 with 'MooseX::Runnable', 'MooseX::Object::Pluggable';
  19
  20 has '+_plugin_ns' => ( default => 'MooseX::Runnable::Invocation::Plugin' );
  21
  22 has 'class' => (
  23     is       => 'ro',
  24     isa      => RunnableClass,
  25     required => 1,
  26 );
  27
  28 has 'plugins' => (
  29     is         => 'ro',
  30     isa        => 'ArrayRef[Str]',
  31     default    => sub { [] },
  32     required   => 1,
  33     auto_deref => 1,
  34 );
  35
  36 sub BUILD {
  37     my $self = shift;
  38     $self->load_plugin($_) for $self->plugins;
  39 }
  40
  41 sub load_class {
  42     my $self = shift;
  43     my $class = $self->class;
  44
  45     Class::MOP::load_class( $class );
  46
  47     confess 'We can only work with Moose classes with "meta" methods'
  48       if !$class->can('meta');
  49
  50     my $meta = $class->meta;
  51
  52     confess "The metaclass of $class is not a Moose::Meta::Class, it's $meta"
  53       unless $meta->isa('Moose::Meta::Class');
  54
  55     confess 'MooseX::Runnable can only run classes tagged with '.
  56       'the MooseX::Runnable role'
  57         unless $meta->does_role('MooseX::Runnable');
  58
  59     return $meta;
  60 }
  61
  62 sub apply_scheme {
  63     my ($self, $class) = @_;
  64
  65     my @schemes = grep { defined } map {
  66         $self->_convert_role_to_scheme($_)
  67     } $class->calculate_all_roles;
  68
  69     eval {
  70         foreach my $scheme (@schemes) {
  71             $scheme->apply($self);
  72         }
  73     };
  74 }
  75
  76
  77 sub _convert_role_to_scheme {
  78     my ($self, $role) = @_;
  79
  80     my $name = $role->name;
  81     return if $name =~ /\|/;
  82     $name = "MooseX::Runnable::Invocation::Scheme::$name";
  83
  84     return eval {
  85         Class::MOP::load_class($name);
  86         warn "$name was loaded OK, but it's not a role!" and return
  87           unless $name->meta->isa('Moose::Meta::Role');
  88         return $name->meta;
  89     };
  90 }
  91
  92
  93 sub validate_class {
  94     my ($self, $class) = @_;
  95
  96     my @bad_attributes = map { $_->name } grep {
  97         $_->is_required && $_->has_default || $_->has_builder
  98     } $class->compute_all_applicable_attributes;
  99
 100     confess
 101        'By default, MooseX::Runnable calls the constructor with no'.
 102        ' args, but that will result in an error for your class.  You'.
 103        ' need to provide a MooseX::Runnable::Invocation::Plugin or'.
 104        ' ::Scheme for this class that will satisfy the requirements.'.
 105        "\n".
 106        "The class is @{[$class->name]}, and the required attributes are ".
 107          join ', ', map { "'$_'" } @bad_attributes
 108            if @bad_attributes;
 109
 110     return; # return value is meaningless
 111 }
 112
 113 sub create_instance {
 114     my ($self, $class, @args) = @_;
 115     return ($class->name->new, @args);
 116 }
 117
 118 sub start_application {
 119     my $self = shift;
 120     my $instance = shift;
 121     my @args = @_;
 122
 123     return $instance->run(@args);
 124 }
 125
 126 sub run {
 127     my $self = shift;
 128     my @args = @_;
 129
 130     my $class = $self->load_class;
 131     $self->apply_scheme($class);
 132     $self->validate_class($class);
 133     my ($instance, @more_args) = $self->create_instance($class, @args);
 134     my $exit_code = $self->start_application($instance, @more_args);
 135     return $exit_code;
 136 }
 137
 138 1;