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