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 HashRef ArrayRef);
   5 use List::MoreUtils qw(uniq);
   6 use Params::Util qw(_CLASS);
   7 use Module::Runtime 'use_module';
   8 use namespace::autoclean;
   9
  10 # we can't load the class until plugins are loaded,
  11 # so we have to handle this outside of coerce
  12
  13 subtype RunnableClass,
  14   as Str,
  15   where { _CLASS($_) };
  16
  17
  18 with 'MooseX::Runnable'; # this class technically follows
  19                          # MX::Runnable's protocol
  20
  21 has 'class' => (
  22     is       => 'ro',
  23     isa      => RunnableClass,
  24     required => 1,
  25 );
  26
  27 has 'plugins' => (
  28     is         => 'ro',
  29     isa        => HashRef[ArrayRef[Str]],
  30     default    => sub { +{} },
  31     required   => 1,
  32     auto_deref => 1,
  33 );
  34
  35 sub BUILD {
  36     my $self = shift;
  37
  38     # it would be nice to use MX::Object::Pluggable, but our plugins
  39     # are too configurable
  40
  41     my $plugin_ns = 'MooseX::Runnable::Invocation::Plugin::';
  42     for my $plugin (keys %{$self->plugins}){
  43         my $orig = $plugin;
  44         $plugin = "$plugin_ns$plugin" unless $plugin =~ /^[+]/;
  45         $plugin =~ s/^[+]//g;
  46
  47         use_module( $plugin );
  48
  49         my $does_cmdline = $plugin->meta->
  50           does_role('MooseX::Runnable::Invocation::Plugin::Role::CmdlineArgs');
  51
  52         my $args;
  53         if($does_cmdline){
  54             $args = eval {
  55                 $plugin->_build_initargs_from_cmdline(
  56                     @{$self->plugins->{$orig}},
  57                 );
  58             };
  59
  60             if($@) {
  61                 confess "Error building initargs for $plugin: $@";
  62             }
  63         }
  64         elsif(!$does_cmdline && scalar @{$self->plugins->{$orig}} > 0){
  65             confess "You supplied arguments to the $orig plugin, but it".
  66               " does not know how to accept them.  Perhaps the plugin".
  67               " should consume the".
  68               " 'MooseX::Runnable::Invocation::Plugin::Role::CmdlineArgs'".
  69               " role?";
  70         }
  71
  72         $plugin->meta->apply(
  73             $self,
  74             defined $args ? (rebless_params => $args) : (),
  75         );
  76     }
  77 }
  78
  79 sub load_class {
  80     my $self = shift;
  81     my $class = $self->class;
  82
  83     use_module( $class );
  84
  85     confess 'We can only work with Moose classes with "meta" methods'
  86       if !$class->can('meta');
  87
  88     my $meta = $class->meta;
  89
  90     confess "The metaclass of $class is not a Moose::Meta::Class, it's $meta"
  91       unless $meta->isa('Moose::Meta::Class');
  92
  93     confess 'MooseX::Runnable can only run classes tagged with '.
  94       'the MooseX::Runnable role'
  95         unless $meta->does_role('MooseX::Runnable');
  96
  97     return $meta;
  98 }
  99
 100 sub apply_scheme {
 101     my ($self, $class) = @_;
 102
 103     my @schemes = grep { defined } map {
 104         eval { $self->_convert_role_to_scheme($_) }
 105     } map {
 106         eval { $_->meta->calculate_all_roles };
 107     } $class->linearized_isa;
 108
 109     eval {
 110         foreach my $scheme (uniq @schemes) {
 111             $scheme->apply($self);
 112         }
 113     };
 114 }
 115
 116
 117 sub _convert_role_to_scheme {
 118     my ($self, $role) = @_;
 119
 120     my $name = $role->name;
 121     return if $name =~ /\|/;
 122     $name = "MooseX::Runnable::Invocation::Scheme::$name";
 123
 124     return eval {
 125         use_module($name);
 126         warn "$name was loaded OK, but it's not a role!" and return
 127           unless $name->meta->isa('Moose::Meta::Role');
 128         return $name->meta;
 129     };
 130 }
 131
 132 sub validate_class {
 133     my ($self, $class) = @_;
 134
 135     my @bad_attributes = map { $_->name } grep {
 136         $_->is_required && !($_->has_default || $_->has_builder)
 137     } $class->get_all_attributes;
 138
 139     confess
 140        'By default, MooseX::Runnable calls the constructor with no'.
 141        ' args, but that will result in an error for your class.  You'.
 142        ' need to provide a MooseX::Runnable::Invocation::Plugin or'.
 143        ' ::Scheme for this class that will satisfy the requirements.'.
 144        "\n".
 145        "The class is @{[$class->name]}, and the required attributes are ".
 146          join ', ', map { "'$_'" } @bad_attributes
 147            if @bad_attributes;
 148
 149     return; # return value is meaningless
 150 }
 151
 152 sub create_instance {
 153     my ($self, $class, @args) = @_;
 154     return ($class->name->new, @args);
 155 }
 156
 157 sub start_application {
 158     my $self = shift;
 159     my $instance = shift;
 160     my @args = @_;
 161
 162     return $instance->run(@args);
 163 }
 164
 165 sub run {
 166     my $self = shift;
 167     my @args = @_;
 168
 169     my $class = $self->load_class;
 170     $self->apply_scheme($class);
 171     $self->validate_class($class);
 172     my ($instance, @more_args) = $self->create_instance($class, @args);
 173     my $exit_code = $self->start_application($instance, @more_args);
 174     return $exit_code;
 175 }
 176
 177 1;