From: Jonathan Rockway Date: Tue, 31 Mar 2009 08:55:44 +0000 (-0500) Subject: add MX::Getopt scheme X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=780724cb955ff7f2f2f62f23a8068603c1fd3219;p=gitmo%2FMooseX-Runnable.git add MX::Getopt scheme --- diff --git a/lib/MooseX/Runnable/Invocation.pm b/lib/MooseX/Runnable/Invocation.pm index ff74d42..77e3b0b 100644 --- a/lib/MooseX/Runnable/Invocation.pm +++ b/lib/MooseX/Runnable/Invocation.pm @@ -71,6 +71,23 @@ sub apply_scheme { } } + +sub _convert_role_to_scheme { + my ($self, $role) = @_; + + my $name = $role->name; + return if $name =~ /\|/; + $name = "MooseX::Runnable::Invocation::Scheme::$name"; + + return eval { + Class::MOP::load_class($name); + warn "$name was loaded OK, but it's not a role!" and return + unless $name->meta->isa('Moose::Meta::Role'); + return $name->meta; + }; +} + + sub validate_class { my ($self, $class) = @_; @@ -91,14 +108,6 @@ sub validate_class { return; # return value is meaningless } -sub _convert_role_to_scheme { - my ($self, $role) = @_; - - my $name = - - return; -} - sub create_instance { my ($self, $class, @args) = @_; return ($class->name->new, @args); diff --git a/lib/MooseX/Runnable/Invocation/Scheme/MooseX/Getopt.pm b/lib/MooseX/Runnable/Invocation/Scheme/MooseX/Getopt.pm new file mode 100644 index 0000000..e286151 --- /dev/null +++ b/lib/MooseX/Runnable/Invocation/Scheme/MooseX/Getopt.pm @@ -0,0 +1,19 @@ +package MooseX::Runnable::Invocation::Scheme::MooseX::Getopt; +use Moose::Role; + +around validate_class => sub { + return; # always valid +}; + +around create_instance => sub { + my ($next, $self, $class, @args) = @_; + + local @ARGV = @args; # ugly! + my $instance = $class->name->new_with_options(); + + my $more_args = $instance->extra_argv; + + return ($instance, @$more_args); +}; + +1; diff --git a/t/basic-mx-getopt.t b/t/basic-mx-getopt.t new file mode 100644 index 0000000..6bafdb9 --- /dev/null +++ b/t/basic-mx-getopt.t @@ -0,0 +1,41 @@ +use strict; +use warnings; +use Test::Exception; +use Test::More tests => 5; + +use MooseX::Runnable::Invocation; +use ok 'MooseX::Runnable::Invocation::Scheme::MooseX::Getopt'; + +my $foo; + +{ package Class; + use Moose; + with 'MooseX::Runnable', 'MooseX::Getopt'; + + has 'foo' => ( + is => 'ro', + isa => 'Str', + required => 1, + ); + + sub run { + my ($self, $code) = @_; + $foo = $self->foo; + return $code; + } +} + +my $invocation = MooseX::Runnable::Invocation->new( + class => 'Class', +); + +ok $invocation; + +my $code; +lives_ok { + $code = $invocation->run('--foo', '42', 0); +} 'run lived'; + +is $foo, '42', 'got foo from cmdline'; + +is $code, 0, 'exit status ok';