From: Jonathan Rockway <jon@jrock.us>
Date: Tue, 31 Mar 2009 08:43:23 +0000 (-0500)
Subject: add non-hack MX::Runnable
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Runnable.git;a=commitdiff_plain;h=c527660eed3782550a204710ad1292dbd5d36a69

add non-hack MX::Runnable
---

diff --git a/Makefile.PL b/Makefile.PL
index 951d9d8..ff4b00f 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -8,4 +8,6 @@ build_requires 'Test::WWW::Mechanize::Catalyst';
 build_requires 'Test::More';
 build_requires 'ok';
 
+install_script 'bin/mx-run';
+
 WriteAll();
diff --git a/bin/mx-run b/bin/mx-run
new file mode 100644
index 0000000..d841427
--- /dev/null
+++ b/bin/mx-run
@@ -0,0 +1,13 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use MooseX::Runnable::Run;
+&run_application(@ARGV); # the prototype is ($app, @args), but that's what ARGV is
+
+__END__
+
+=head1 NAME
+
+mx-run - script to run MooseX::Runnable classes
diff --git a/lib/MooseX/Runnable.pm b/lib/MooseX/Runnable.pm
index d33a31d..7080702 100644
--- a/lib/MooseX/Runnable.pm
+++ b/lib/MooseX/Runnable.pm
@@ -1,22 +1,72 @@
 package MooseX::Runnable;
 use Moose::Role;
 
-our $RUNNING_APP;
-
 requires 'run';
 
-sub run_as_application {
-    my $class = shift;
-    my @args = @_;
+1;
+
+__END__
+
+=head1 NAME
+
+MooseX::Runnable - tag a class as a runnable application
+
+=head1 SYNOPSIS
 
-    if($class->does('MooseX::Getopt')){
-        my $self = $class->new_with_options(@args);
-        local $RUNNING_APP = $self;
-        exit $self->run( $self->extra_argv );
+Create a class, tag it runnable, and provide a C<run> method:
+
+    package App::HelloWorld;
+    use Moose;
+
+    with 'MooseX::Runnable';
+
+    sub run {
+       my $name = shift;
+       say "Hello, $name.";
+       return 0;
     }
 
-    local $RUNNING_APP = $class->new(@args);
-    exit $RUNNING_APP->run;
-}
+Then you can run this class as an application with the included
+C<mx-run> script:
 
-1;
+    $ mx-run App::HelloWorld jrockway
+    Hello, jrockway.
+    $
+
+C<MooseX::Runnable> supports L<MooseX::Getopt|MooseX::Getopt>, and
+other similar systems (and is extensible, in case you have written
+such a system).
+
+=head1 DESCRIPTION
+
+MooseX::Runnable is a framework for making classes runnable
+applications.  This role doesn't do anything other than tell the rest
+of the framework that your class is a runnable application that has a
+C<run> method which accepts arguments and returns the process' exit
+code.
+
+This is a convention that the community has been using for a while.
+This role tells the computer that your class uses this convention, and
+let's the computer abstract away some of the tedium this entails.
+
+=head1 REQUIRED METHODS
+
+=head1 THINGS YOU GET
+
+=head2 C<mx-run>
+
+This is a script that accepts a C<MooseX::Runnable> class and tries to
+run it, using C<MooseX::Runnable::Run>.
+
+The syntax is:
+
+  mx-run <args for mx-run> Class::Name <args for Class::Name>
+
+for example:
+
+  mx-run -Ilib App::HelloWorld --args --go --here
+
+=head2 C<MooseX::Runnable::Run>
+
+If you don't want to invoke your app with C<mx-run>, you can write a
+custom version using L<MooseX::Runnable::Run|MooseX::Runnable::Run>.
diff --git a/lib/MooseX/Runnable/Invocation.pm b/lib/MooseX/Runnable/Invocation.pm
new file mode 100644
index 0000000..ff74d42
--- /dev/null
+++ b/lib/MooseX/Runnable/Invocation.pm
@@ -0,0 +1,127 @@
+package MooseX::Runnable::Invocation;
+use Moose;
+use MooseX::Types -declare => ['RunnableClass'];
+use MooseX::Types::Moose qw(Str ClassName);
+
+require Class::MOP;
+
+# we can't load the class until plugins are loaded,
+# so we have to handle this outside of coerce
+
+subtype RunnableClass,
+  as Str,
+  where { $_ =~ /^[:A-Za-z_]+$/ };
+
+use namespace::clean -except => 'meta';
+
+# this class is just as runnable as any other, so I guess we should tag it
+with 'MooseX::Runnable', 'MooseX::Object::Pluggable';
+
+has '+_plugin_ns' => ( default => 'MooseX::Runnable::Invocation::Plugin' );
+
+has 'class' => (
+    is       => 'ro',
+    isa      => RunnableClass,
+    required => 1,
+);
+
+has 'plugins' => (
+    is         => 'ro',
+    isa        => 'ArrayRef[Str]',
+    default    => sub { [] },
+    required   => 1,
+    auto_deref => 1,
+);
+
+sub BUILD {
+    my $self = shift;
+    $self->load_plugin($_) for $self->plugins;
+}
+
+sub load_class {
+    my $self = shift;
+    my $class = $self->class;
+
+    Class::MOP::load_class( $class );
+
+    confess 'We can only work with Moose classes with "meta" methods'
+      if !$class->can('meta');
+
+    my $meta = $class->meta;
+
+    confess "The metaclass of $class is not a Moose::Meta::Class, it's $meta"
+      unless $meta->isa('Moose::Meta::Class');
+
+    confess 'MooseX::Runnable can only run classes tagged with '.
+      'the MooseX::Runnable role'
+        unless $meta->does_role('MooseX::Runnable');
+
+    return $meta;
+}
+
+sub apply_scheme {
+    my ($self, $class) = @_;
+
+    my @schemes = grep { defined } map {
+        $self->_convert_role_to_scheme($_)
+    } $class->calculate_all_roles;
+
+    foreach my $scheme (@schemes) {
+        $scheme->apply($self);
+    }
+}
+
+sub validate_class {
+    my ($self, $class) = @_;
+
+    my @bad_attributes = map { $_->name } grep {
+        $_->is_required && $_->has_default || $_->has_builder
+    } $class->compute_all_applicable_attributes;
+
+    confess
+       'By default, MooseX::Runnable calls the constructor with no'.
+       ' args, but that will result in an error for your class.  You'.
+       ' need to provide a MooseX::Runnable::Invocation::Plugin or'.
+       ' ::Scheme for this class that will satisfy the requirements.'.
+       "\n".
+       "The class is @{[$class->name]}, and the required attributes are ".
+         join ', ', map { "'$_'" } @bad_attributes
+           if @bad_attributes;
+
+    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);
+}
+
+sub start_application {
+    my $self = shift;
+    my $instance = shift;
+    my @args = @_;
+
+    return $instance->run(@args);
+}
+
+sub run {
+    my $self = shift;
+    my @args = @_;
+
+    my $class = $self->load_class;
+    $self->apply_scheme($class);
+    $self->validate_class($class);
+    my ($instance, @more_args) = $self->create_instance($class, @args);
+    my $exit_code = $self->start_application($instance, @more_args);
+    return $exit_code;
+}
+
+1;
diff --git a/lib/MooseX/Runnable/Run.pm b/lib/MooseX/Runnable/Run.pm
index 4fe5759..9e1ab01 100644
--- a/lib/MooseX/Runnable/Run.pm
+++ b/lib/MooseX/Runnable/Run.pm
@@ -2,23 +2,70 @@ package MooseX::Runnable::Run;
 use strict;
 use warnings;
 
-use Class::MOP;
+use MooseX::Runnable::Invocation;
 
-use Sub::Exporter -setup => {
-    exports => ['run_as_application'],
-    groups  => {
-        default => ['run_as_application'],
-    },
-};
-
-sub run_as_application($;@){
+sub run_application($;@) {
     my ($app, @args) = @_;
 
-    eval 'package main; use FindBin qw($Bin); use lib "$Bin/../lib"; 1;' or die;
+    exit MooseX::Runnable::Invocation->new(
+        class => $app,
+    )->run(@args);
+}
+
+sub import {
+    my ($class, $app) = @_;
 
-    Class::MOP::load_class($app);
-    die "$app is not runnable" unless $app->does('MooseX::Runnable');
-    $app->run_as_application(@args);
+    if($app){
+        run_application $app, @ARGV;
+    }
+    else {
+        my $c = caller;
+        no strict 'refs';
+        *{ $c. '::run_application' } = \&run_application;
+    }
 }
 
 1;
+
+__END__
+
+=head1 NAME
+
+MooseX::Runnable::Run - run a MooseX::Runnable class as an application
+
+=head1 SYNOPSIS
+
+Write an app:
+
+   package MyApp;
+   use Moose; with 'MooseX::Runnable';
+   sub run { say 'Hello, world.'; return 0 } # (UNIX exit code)
+
+Write a wrapper script, C<myapp.pl>.  With sugar:
+
+   #!/usr/bin/env perl
+   use MooseX::Runnable::Run 'MyApp';
+
+Or without:
+
+   #!/usr/bin/env perl
+   use MooseX::Runnable::Run;
+
+   run_application 'MyApp', @ARGV;
+
+Then, run your app:
+
+   $ ./myapp.pl
+   Hello, world.
+   $ echo $?
+   0
+
+=head1 DESCRIPTION
+
+This is a utility module that runs a L<MooseX::Runnable|MooseX::Runnable> class with
+L<MooseX::Runnable::Invocation|MooseX::Runnable::Invocation>.
+
+=head1 SEE ALSO
+
+L<mx-run>, a script that will run MooseX::Runnable apps, saving you
+valuable seconds!
diff --git a/t/basic.t b/t/basic.t
new file mode 100644
index 0000000..cafd6d7
--- /dev/null
+++ b/t/basic.t
@@ -0,0 +1,56 @@
+use strict;
+use warnings;
+use Test::Exception;
+use Test::More tests => 8;
+
+use ok 'MooseX::Runnable';
+use ok 'MooseX::Runnable::Invocation';
+
+{ package Class;
+  use Moose;
+  with 'MooseX::Runnable';
+
+  sub run {
+      my ($self, @args) = @_;
+      my $result;
+      $result += $_ for @args;
+      return $result;
+  }
+}
+
+my $invocation = MooseX::Runnable::Invocation->new(
+    class => 'Class',
+);
+
+ok $invocation;
+
+my $code;
+lives_ok {
+    $code = $invocation->run(1,2,3);
+} 'run lived';
+
+is $code, 6, 'run worked';
+
+{ package MooseX::Runnable::Invocation::Plugin::ExitFixer;
+  use Moose::Role;
+
+  around run => sub {
+      my ($next, $self, @args) = @_;
+      my $code = $self->$next(@args);
+      if($code){ return 0 }
+      else { confess "Exited with error." }
+  };
+}
+
+$invocation = MooseX::Runnable::Invocation->new(
+    class   => 'Class',
+    plugins => ['+MooseX::Runnable::Invocation::Plugin::ExitFixer'],
+);
+
+ok $invocation;
+
+lives_ok {
+    $code = $invocation->run(1,2,3);
+} 'run lived';
+
+is $code, 0, 'run worked, and plugin changed the return code';