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