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 # 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 '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     $self->load_plugin($_) for keys %{$self->plugins};
  37 }
  38
  39 sub load_class {
  40     my $self = shift;
  41     my $class = $self->class;
  42
  43     Class::MOP::load_class( $class );
  44
  45     confess 'We can only work with Moose classes with "meta" methods'
  46       if !$class->can('meta');
  47
  48     my $meta = $class->meta;
  49
  50     confess "The metaclass of $class is not a Moose::Meta::Class, it's $meta"
  51       unless $meta->isa('Moose::Meta::Class');
  52
  53     confess 'MooseX::Runnable can only run classes tagged with '.
  54       'the MooseX::Runnable role'
  55         unless $meta->does_role('MooseX::Runnable');
  56
  57     return $meta;
  58 }
  59
  60 sub apply_scheme {
  61     my ($self, $class) = @_;
  62
  63     my @schemes = grep { defined } map {
  64         $self->_convert_role_to_scheme($_)
  65     } $class->calculate_all_roles;
  66
  67     eval {
  68         foreach my $scheme (@schemes) {
  69             $scheme->apply($self);
  70         }
  71     };
  72 }
  73
  74
  75 sub _convert_role_to_scheme {
  76     my ($self, $role) = @_;
  77
  78     my $name = $role->name;
  79     return if $name =~ /\|/;
  80     $name = "MooseX::Runnable::Invocation::Scheme::$name";
  81
  82     return eval {
  83         Class::MOP::load_class($name);
  84         warn "$name was loaded OK, but it's not a role!" and return
  85           unless $name->meta->isa('Moose::Meta::Role');
  86         return $name->meta;
  87     };
  88 }
  89
  90
  91 sub validate_class {
  92     my ($self, $class) = @_;
  93
  94     my @bad_attributes = map { $_->name } grep {
  95         $_->is_required && $_->has_default || $_->has_builder
  96     } $class->get_all_attributes;
  97
  98     confess
  99        'By default, MooseX::Runnable calls the constructor with no'.
 100        ' args, but that will result in an error for your class.  You'.
 101        ' need to provide a MooseX::Runnable::Invocation::Plugin or'.
 102        ' ::Scheme for this class that will satisfy the requirements.'.
 103        "\n".
 104        "The class is @{[$class->name]}, and the required attributes are ".
 105          join ', ', map { "'$_'" } @bad_attributes
 106            if @bad_attributes;
 107
 108     return; # return value is meaningless
 109 }
 110
 111 sub create_instance {
 112     my ($self, $class, @args) = @_;
 113     return ($class->name->new, @args);
 114 }
 115
 116 sub start_application {
 117     my $self = shift;
 118     my $instance = shift;
 119     my @args = @_;
 120
 121     return $instance->run(@args);
 122 }
 123
 124 sub run {
 125     my $self = shift;
 126     my @args = @_;
 127
 128     my $class = $self->load_class;
 129     $self->apply_scheme($class);
 130     $self->validate_class($class);
 131     my ($instance, @more_args) = $self->create_instance($class, @args);
 132     my $exit_code = $self->start_application($instance, @more_args);
 133     return $exit_code;
 134 }
 135
 136 1;