add MX::Getopt scheme
[gitmo/MooseX-Runnable.git] / 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 ClassName);
5
6 require Class::MOP;
7
8 # we can't load the class until plugins are loaded,
9 # so we have to handle this outside of coerce
10
11 subtype RunnableClass,
12   as Str,
13   where { $_ =~ /^[:A-Za-z_]+$/ };
14
15 use namespace::clean -except => 'meta';
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 '+_plugin_ns' => ( default => 'MooseX::Runnable::Invocation::Plugin' );
21
22 has 'class' => (
23     is       => 'ro',
24     isa      => RunnableClass,
25     required => 1,
26 );
27
28 has 'plugins' => (
29     is         => 'ro',
30     isa        => 'ArrayRef[Str]',
31     default    => sub { [] },
32     required   => 1,
33     auto_deref => 1,
34 );
35
36 sub BUILD {
37     my $self = shift;
38     $self->load_plugin($_) for $self->plugins;
39 }
40
41 sub load_class {
42     my $self = shift;
43     my $class = $self->class;
44
45     Class::MOP::load_class( $class );
46
47     confess 'We can only work with Moose classes with "meta" methods'
48       if !$class->can('meta');
49
50     my $meta = $class->meta;
51
52     confess "The metaclass of $class is not a Moose::Meta::Class, it's $meta"
53       unless $meta->isa('Moose::Meta::Class');
54
55     confess 'MooseX::Runnable can only run classes tagged with '.
56       'the MooseX::Runnable role'
57         unless $meta->does_role('MooseX::Runnable');
58
59     return $meta;
60 }
61
62 sub apply_scheme {
63     my ($self, $class) = @_;
64
65     my @schemes = grep { defined } map {
66         $self->_convert_role_to_scheme($_)
67     } $class->calculate_all_roles;
68
69     foreach my $scheme (@schemes) {
70         $scheme->apply($self);
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->compute_all_applicable_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;