Factor stuff out into a script role, clean up all the script code
Tomas Doran [Wed, 2 Sep 2009 00:48:54 +0000 (00:48 +0000)]
lib/Catalyst/Script/CGI.pm
lib/Catalyst/Script/Create.pm
lib/Catalyst/Script/FastCGI.pm
lib/Catalyst/Script/Server.pm
lib/Catalyst/Script/Test.pm
lib/Catalyst/ScriptRole.pm [new file with mode: 0644]
lib/Catalyst/ScriptRunner.pm

index 4608a7c..7e090d4 100644 (file)
@@ -1,39 +1,31 @@
 package Catalyst::Script::CGI;
 use Moose;
-
 BEGIN { $ENV{CATALYST_ENGINE} ||= 'CGI' }
-use FindBin qw/$Bin/;
-use lib "$Bin/../lib";
-use Pod::Usage;
-use Moose;
 use namespace::autoclean;
 
-with 'MooseX::Getopt';
+with 'Catalyst::ScriptRole';
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 NAME
+
+Catalyst::Script::CGI - The CGI Catalyst Script
+
+=head1 SYNOPSIS
+
+See L<Catalyst>.
+
+=head1 DESCRIPTION
 
-has _app => (
-    reader   => 'app',
-    init_arg => 'app',
-    traits => [qw(NoGetopt)],
-    isa => 'Str',
-    is => 'ro',
-);
+FIXME
 
-has help => (
-    traits => [qw(Getopt)],
-    cmd_aliases => 'h',
-    isa => 'Bool',
-    is => 'ro',
-    documentation => qq{ display this help and exits },
-);
+=head1 AUTHORS
 
+Catalyst Contributors, see Catalyst.pm
 
-sub run {
-    my $self = shift;
+=head1 COPYRIGHT
 
-    pod2usage() if $self->help;
-    my $app = $self->app;
-    Class::MOP::load_class($app);
-    $app->run;
+This library is free software. You can redistribute it and/or modify it under
+the same terms as Perl itself.
 
-}
-1;
+=cut
index c46f51c..f04995d 100644 (file)
@@ -1,63 +1,40 @@
 package Catalyst::Script::Create;
 use Moose;
-use Pod::Usage;
 use Catalyst::Helper;
-use MooseX::Types::Moose qw/Str Bool/;
+use MooseX::Types::Moose qw/Bool/;
 use namespace::autoclean;
 
-with "MooseX::Getopt";
-#extends qw(MooseX::App::Cmd);
-
-
-has _app => (
-    reader   => 'app',
-    init_arg => 'app',
-    traits => [qw(NoGetopt)],
-    isa => Str,
-    is => 'ro',
-);
+with 'Catalyst::ScriptRole';
 
 has force => (
-    traits => [qw(Getopt)],
     cmd_aliases => 'nonew',
     isa => Bool,
     is => 'ro',
-    documentation => qq{ force new scripts }
-);
-
-has help => (
-    traits => [qw(Getopt)],
-    cmd_aliases => 'h',
-    isa => Bool,
-    is => 'ro',
-    documentation => qq{ display this help and exits },
+    documentation => 'Force new scripts',
 );
 
 has debug => (
-    traits => [qw(Getopt)],
     cmd_aliases => 'd',
     isa => Bool,
     is => 'ro',
-    documentation => qq{ force debug mode }
+    documentation => 'Force debug mode',
 );
 
 has mechanize => (
-    traits => [qw(Getopt)],
     cmd_aliases => 'mech',
     isa => Bool,
     is => 'ro',
-    documentation => qq{ use WWW::Mechanize },
+    documentation => 'use WWW::Mechanize',
 );
 
 sub run {
     my ($self) = @_;
 
-
-    pod2usage(1) if ( $self->help || !$ARGV[0] );
+    $self->_display_help if ( !$ARGV[0] );
 
     my $helper = Catalyst::Helper->new( { '.newfiles' => !$self->force, mech => $self->mech } );
 
-    pod2usage(1) unless $helper->mk_component( $self->app, @ARGV );
+    $self->_display_help unless $helper->mk_component( $self->app, @ARGV );
 
 }
 
@@ -66,11 +43,11 @@ __PACKAGE__->meta->make_immutable;
 
 =head1 NAME
 
-boyosplace_create.pl - Create a new Catalyst Component
+Catalyst::Script::Create - Create a new Catalyst Component
 
 =head1 SYNOPSIS
 
-boyosplace_create.pl [options] model|view|controller name [helper] [options]
+myapp_create.pl [options] model|view|controller name [helper] [options]
 
  Options:
    -force        don't create a .new file where a file to be created exists
@@ -78,16 +55,16 @@ boyosplace_create.pl [options] model|view|controller name [helper] [options]
    -help         display this help and exits
 
  Examples:
-   boyosplace_create.pl controller My::Controller
-   boyosplace_create.pl controller My::Controller BindLex
-   boyosplace_create.pl -mechanize controller My::Controller
-   boyosplace_create.pl view My::View
-   boyosplace_create.pl view MyView TT
-   boyosplace_create.pl view TT TT
-   boyosplace_create.pl model My::Model
-   boyosplace_create.pl model SomeDB DBIC::Schema MyApp::Schema create=dynamic\
+   myapp_create.pl controller My::Controller
+   myapp_create.pl controller My::Controller BindLex
+   myapp_create.pl -mechanize controller My::Controller
+   myapp_create.pl view My::View
+   myapp_create.pl view MyView TT
+   myapp_create.pl view TT TT
+   myapp_create.pl model My::Model
+   myapp_create.pl model SomeDB DBIC::Schema MyApp::Schema create=dynamic\
    dbi:SQLite:/tmp/my.db
-   boyosplace_create.pl model AnotherDB DBIC::Schema MyApp::Schema create=static\
+   myapp_create.pl model AnotherDB DBIC::Schema MyApp::Schema create=static\
    dbi:Pg:dbname=foo root 4321
 
  See also:
index f733171..f9322d2 100644 (file)
@@ -1,95 +1,64 @@
 package Catalyst::Script::FastCGI;
 
 BEGIN { $ENV{CATALYST_ENGINE} ||= 'FastCGI' }
-use FindBin qw/$Bin/;
-use lib "$Bin/../lib";
-use Pod::Usage;
 use Moose;
 use MooseX::Types::Moose qw/Str Bool Int/;
 use namespace::autoclean;
 
-with 'MooseX::Getopt';
-
-has help => (
-    traits => [qw(Getopt)],
-    cmd_aliases => 'h',
-    isa => Bool,
-    is => 'ro',
-    documentation => qq{ display this help and exits },
-);
+with 'Catalyst::ScriptRole';
 
 has listen => (
-    traits => [qw(Getopt)],
     cmd_aliases => 'l',
     isa => Int,
     is => 'ro',
-    default => "3000",
-    documentation => qq{ specify a different listening port }
+    documentation => 'Specify a listening port/socket',
 );
 
 has pidfile => (
-    traits => [qw(Getopt)],
     cmd_aliases => 'pid',
     isa => Str,
     is => 'ro',
-    documentation => qq{ specify a pidfile }
+    documentation => 'Specify a pidfile',
 );
 
 has daemon => ( 
     isa => Bool,   
     is => 'ro', 
-    traits => [qw(Getopt)],
     cmd_aliases => 'd', 
-    documentation => qq{ daemonize }
+    documentation => 'Daemonize',
 );
 
 has manager => ( 
     isa => Str,    
     is => 'ro',
-    traits => [qw(Getopt)],
     cmd_aliases => 'm',
-    documentation => qq{ use a different FastCGI manager } 
+    documentation => 'Use a different FastCGI manager', # FIXME
 );
 
 has keep_stderr => ( 
-    traits => [qw(Getopt)],
     cmd_aliases => 'std', 
     isa => Bool,   
     is => 'ro',  
-    documentation => qq{ log STDERR }
+    documentation => 'Log STDERR',
 );
 
 has nproc => (
-    traits => [qw(Getopt)],
     cmd_aliases => 'np',  
     isa => Int,
     is => 'ro',  
-    documentation => qq{ specify an nproc }
+    documentation => 'Specify an nproc', # FIXME
 );
 
 has detach => ( 
-    traits => [qw(Getopt)],
     cmd_aliases => 'det', 
     isa => Bool,   
     is => 'ro',  
-    documentation => qq{ detach this FastCGI process }
-);
-
-has _app => (
-    reader   => 'app',
-    init_arg => 'app',
-    traits => [qw(NoGetopt)],
-    isa => Str,
-    is => 'ro',
+    documentation => 'Detach this FastCGI process',
 );
 
-sub run {
-    my $self = shift;
-
-    pod2usage() if $self->help;
-    my $app = $self->app;
-    Class::MOP::load_class($app);
-    $app->run(
+sub _application_args {
+    my ($self) = shift;
+    return (
         $self->listen,
         {
             nproc   => $self->nproc,
@@ -99,9 +68,29 @@ sub run {
             keep_stderr => $self->keep_stderr,
         }
     );
-
 }
 
 __PACKAGE__->meta->make_immutable;
 
-1;
+=head1 NAME
+
+Catalyst::Script::FastCGI - The FastCGI Catalyst Script
+
+=head1 SYNOPSIS
+
+See L<Catalyst>.
+
+=head1 DESCRIPTION
+
+FIXME
+
+=head1 AUTHORS
+
+Catalyst Contributors, see Catalyst.pm
+
+=head1 COPYRIGHT
+
+This library is free software. You can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
index 04d5372..718e8c1 100644 (file)
@@ -2,119 +2,88 @@ package Catalyst::Script::Server;
 
 BEGIN {
     $ENV{CATALYST_ENGINE} ||= 'HTTP';
-    $ENV{CATALYST_SCRIPT_GEN} = 31;
     require Catalyst::Engine::HTTP;
 }
 
-use FindBin qw/$Bin/;
-use lib "$Bin/../lib";
-use Pod::Usage;
 use Moose;
 use Catalyst::Restarter;
-use MooseX::Types::Moose qw/Str Bool Int/;
+use MooseX::Types::Moose qw/ArrayRef Str Bool Int/;
 use namespace::autoclean;
 
-with 'MooseX::Getopt';
-#extends qw(MooseX::App::Cmd);
+with 'Catalyst::ScriptRole';
 
 has debug => (
-    traits => [qw(Getopt)],
     cmd_aliases => 'd',
     isa => Bool,
     is => 'ro',
-    documentation => qq{ force debug mode }
-);
-
-has help => (
-    traits => [qw(Getopt)],
-    cmd_aliases => 'h',
-    isa => Bool,
-    is => 'ro',
-    documentation => qq{ display this help and exits },
+    documentation => q{Force debug mode},
 );
 
 has host => (
     isa => Str,
     is => 'ro',
-    default =>  "localhost",
-    documentation => qq{ specify a host for the server to run on }
+    default => 'localhost',
+    documentation => 'Specify a host for the server to run on',
 );
 
 has fork => (
-    traits => [qw(Getopt)],
     cmd_aliases => 'f',
     isa => Bool,
     is => 'ro',
-    documentation => qq{ fork the server }
+    documentation => 'Fork the server',
 );
 
 has listen => (
-    traits => [qw(Getopt)],
     cmd_aliases => 'l',
     isa => Int,
     is => 'ro',
-    default => "3000",
-    documentation => qq{ specify a different listening port }
+    default => 3000,
+    documentation => 'Specify a different listening port',
 );
 
 has pidfile => (
-    traits => [qw(Getopt)],
     cmd_aliases => 'pid',
     isa => Str,
     is => 'ro',
-    documentation => qq{ specify a pidfile }
+    documentation => 'Specify a pidfile',
 );
 
 has keepalive => (
-    traits => [qw(Getopt)],
     cmd_aliases => 'k',
     isa => Bool,
     is => 'ro',
-    documentation => qq{ server keepalive },
+    documentation => 'Server keepalive',
 
 );
 
 has background => (
-    traits => [qw(Getopt)],
     cmd_aliases => 'bg',
     isa => Bool,
     is => 'ro',
-    documentation => qq{ run in the background }
-);
-
-
-has _app => (
-    reader   => 'app',
-    init_arg => 'app',
-    traits => [qw(NoGetopt)],
-    isa => Str,
-    is => 'ro',
+    documentation => 'Run in the background',
 );
 
 has restart => (
-    traits => [qw(Getopt)],
     cmd_aliases => 'r',
     isa => Bool,
     is => 'ro',
-    documentation => qq{ use Catalyst::Restarter to detect code changes }
+    documentation => 'use Catalyst::Restarter to detect code changes',
 );
 
 has restart_directory => (
-    traits => [qw(Getopt)],
     cmd_aliases => 'rdir',
-    isa => 'ArrayRef[Str]',
+    isa => ArrayRef[Str],
     is  => 'ro',
     predicate => '_has_restart_directory',
-    documentation => qq{ restarter directory to watch }
+    documentation => 'Restarter directory to watch',
 );
 
 has restart_delay => (
-    traits => [qw(Getopt)],
     cmd_aliases => 'rdel',
     isa => Int,
     is => 'ro',
     predicate => '_has_restart_delay',
-    documentation => qq{ set a restart delay }
+    documentation => 'Set a restart delay',
 );
 
 has restart_regex => (
@@ -123,7 +92,7 @@ has restart_regex => (
     isa => Str,
     is => 'ro',
     predicate => '_has_restart_regex',
-    documentation => qq{ restart regex }
+    documentation => 'Restart regex',
 );
 
 has follow_symlinks => (
@@ -132,23 +101,13 @@ has follow_symlinks => (
     isa => Bool,
     is => 'ro',
     predicate => '_has_follow_symlinks',
-    documentation => qq{ follow symbolic links }
+    documentation => 'Follow symbolic links',
 
 );
 
-sub usage {
-    my ($self) = shift;
-
-    return pod2usage();
-
-}
-
-
 sub run {
     my ($self) = shift;
 
-    $self->usage if $self->help;
-
     if ( $self->debug ) {
         $ENV{CATALYST_DEBUG} = 1;
     }
@@ -188,32 +147,30 @@ sub run {
         $restarter->run_and_watch;
     }
     else {
-        $self->_run;
+        $self->_run_application;
     }
 
 
 }
 
-sub _run {
+sub _application_args {
     my ($self) = shift;
-
-    my $app = $self->app;
-    Class::MOP::load_class($app);
-
-    $app->run(
-        $self->listen, $self->host,
+    return (
+        $self->listen,
+        $self->host,
         {
-           'fork'            => $self->fork,
-           keepalive         => $self->keepalive,
-           background        => $self->background,
-           pidfile           => $self->pidfile,
-           keepalive         => $self->keepalive,
-           follow_symlinks   => $self->follow_symlinks,
-        }
+           map { $_ => $self->$_ } qw/
+                fork
+                keepalive
+                background
+                pidfile
+                keepalive
+                follow_symlinks
+            /,
+        },
     );
 }
 
-
 __PACKAGE__->meta->make_immutable;
 
 1;
index 4fe10c4..f3da4e1 100644 (file)
@@ -1,30 +1,8 @@
 package Catalyst::Script::Test;
 use Moose;
-use Pod::Usage;
-use FindBin;
-use lib "$FindBin::Bin/../lib";
-with 'MooseX::Getopt';
-use MooseX::Types::Moose qw/Str Bool/;
 use namespace::autoclean;
 
-#extends qw(MooseX::App::Cmd);
-
-has _app => (
-    reader   => 'app',
-    init_arg => 'app',
-    traits => [qw(NoGetopt)],
-    isa => Str,
-    is => 'ro',
-);
-
-has help => (
-    traits => [qw(Getopt)],
-    cmd_aliases => 'h',
-    isa => Bool,
-    is => 'ro',
-    documentation => qq{ display this help and exits },
-);
-
+with 'Catalyst::ScriptRole';
 
 sub run {
     my $self = shift;
@@ -32,11 +10,32 @@ sub run {
     Class::MOP::load_class("Catalyst::Test");
     Catalyst::Test->import($self->app);
 
-    pod2usage(1) if ( $self->help || !$ARGV[1] );
     print request($ARGV[1])->content  . "\n";
 
 }
 
 
 __PACKAGE__->meta->make_immutable;
-1;
+
+=head1 NAME
+
+Catalyst::Script::Test - Test Catalyst application on the command line
+
+=head1 SYNOPSIS
+
+See L<Catalyst>.
+
+=head1 DESCRIPTION
+
+FIXME
+
+=head1 AUTHORS
+
+Catalyst Contributors, see Catalyst.pm
+
+=head1 COPYRIGHT
+
+This library is free software. You can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
diff --git a/lib/Catalyst/ScriptRole.pm b/lib/Catalyst/ScriptRole.pm
new file mode 100644 (file)
index 0000000..ca7055d
--- /dev/null
@@ -0,0 +1,53 @@
+package Catalyst::ScriptRole;
+use Moose::Role;
+use MooseX::Types::Moose qw/Str Bool/;
+use Pod::Usage;
+use namespace::autoclean;
+
+requires 'run';
+
+with 'MooseX::Getopt';
+
+has application_name => (
+    traits => ['NoGetopt'],
+    isa => Str,
+    is => 'ro',
+    required => 1,
+);
+
+has help => (
+    traits => ['Getopt'],
+    cmd_aliases => 'h',
+    isa => Bool,
+    is => 'ro',
+    documentation => q{Display this help and exit},
+);
+
+sub _display_help {
+    my $self = shift;
+    pod2usage();
+    exit 0;
+}
+
+before run => sub {
+    my $self = shift;
+    $self->_display_help if $self->help;
+};
+
+sub run {
+    my $self = shift;
+    $self->_run_application;
+}
+
+sub _application_args {
+    ()
+}
+
+sub _run_application {
+    my $self = shift;
+    my $app = $self->application_name;
+    Class::MOP::load_class($app);
+    $app->run($self->_application_args);
+}
+
+1;
index 0f9aa8f..58a65fc 100644 (file)
@@ -1,7 +1,6 @@
 package Catalyst::ScriptRunner;
 use Moose;
-#extends qw(MooseX::App::Cmd::Command);
-
+use namespace::autoclean;
 
 sub run {
     my ($self, $class, $scriptclass) = @_;
@@ -9,10 +8,36 @@ sub run {
 
     # FIXME - Error handling / reporting
     if ( eval { Class::MOP::load_class($classtoload) } ) {
-    } else {
+    }
+    else {
         $classtoload = "Catalyst::Script::$scriptclass";
         Class::MOP::load_class($classtoload);
     }
     $classtoload->new_with_options( app => $class )->run;
 }
-1;
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 NAME
+
+Catalyst::ScriptRunner - The Catalyst Framework Script runner
+
+=head1 SYNOPSIS
+
+See L<Catalyst>.
+
+=head1 DESCRIPTION
+
+This class is responsible for running scripts, either in the application specific namespace
+(e.g. C<MyApp::Script::Server>), or the Catalyst namespace (e.g. C<Catalyst::Script::Server>)
+
+=head1 AUTHORS
+
+Catalyst Contributors, see Catalyst.pm
+
+=head1 COPYRIGHT
+
+This library is free software. You can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut