1 package MooseX::Runnable::Invocation;
3 use MooseX::Types -declare => ['RunnableClass'];
4 use MooseX::Types::Moose qw(Str ClassName);
5 use namespace::autoclean;
9 # we can't load the class until plugins are loaded,
10 # so we have to handle this outside of coerce
12 subtype RunnableClass,
14 where { $_ =~ /^[:A-Za-z_]+$/ };
17 # this class is just as runnable as any other, so I guess we should tag it
18 with 'MooseX::Runnable', 'MooseX::Object::Pluggable';
28 isa => 'ArrayRef[Str]',
29 default => sub { [] },
36 $self->load_plugin($_) for $self->plugins;
41 my $class = $self->class;
43 Class::MOP::load_class( $class );
45 confess 'We can only work with Moose classes with "meta" methods'
46 if !$class->can('meta');
48 my $meta = $class->meta;
50 confess "The metaclass of $class is not a Moose::Meta::Class, it's $meta"
51 unless $meta->isa('Moose::Meta::Class');
53 confess 'MooseX::Runnable can only run classes tagged with '.
54 'the MooseX::Runnable role'
55 unless $meta->does_role('MooseX::Runnable');
61 my ($self, $class) = @_;
63 my @schemes = grep { defined } map {
64 $self->_convert_role_to_scheme($_)
65 } $class->calculate_all_roles;
68 foreach my $scheme (@schemes) {
69 $scheme->apply($self);
75 sub _convert_role_to_scheme {
76 my ($self, $role) = @_;
78 my $name = $role->name;
79 return if $name =~ /\|/;
80 $name = "MooseX::Runnable::Invocation::Scheme::$name";
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');
92 my ($self, $class) = @_;
94 my @bad_attributes = map { $_->name } grep {
95 $_->is_required && $_->has_default || $_->has_builder
96 } $class->get_all_attributes;
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.'.
104 "The class is @{[$class->name]}, and the required attributes are ".
105 join ', ', map { "'$_'" } @bad_attributes
108 return; # return value is meaningless
111 sub create_instance {
112 my ($self, $class, @args) = @_;
113 return ($class->name->new, @args);
116 sub start_application {
118 my $instance = shift;
121 return $instance->run(@args);
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);