add MX::Getopt scheme
Jonathan Rockway [Tue, 31 Mar 2009 08:55:44 +0000 (03:55 -0500)]
lib/MooseX/Runnable/Invocation.pm
lib/MooseX/Runnable/Invocation/Scheme/MooseX/Getopt.pm [new file with mode: 0644]
t/basic-mx-getopt.t [new file with mode: 0644]

index ff74d42..77e3b0b 100644 (file)
@@ -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 (file)
index 0000000..e286151
--- /dev/null
@@ -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 (file)
index 0000000..6bafdb9
--- /dev/null
@@ -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';