requires 'List::MoreUtils';
requires 'namespace::autoclean' => '0.09';
requires 'namespace::clean';
+requires 'namespace::autoclean';
requires 'B::Hooks::EndOfScope' => '0.08';
requires 'MooseX::Emulate::Class::Accessor::Fast' => '0.00903';
requires 'Class::MOP' => '0.83';
requires 'Task::Weaken';
requires 'Text::Balanced'; # core in 5.8.x but mentioned for completeness
requires 'MRO::Compat';
+requires 'MooseX::Getopt' => '0.25';
+requires 'MooseX::Types';
requires 'String::RewritePrefix' => '0.004'; # Catalyst::Utils::resolve_namespace
-recommends 'B::Hooks::OP::Check::StashChange';
-
test_requires 'Class::Data::Inheritable';
test_requires 'Test::Exception';
test_requires 'Test::More' => '0.88';
David E. Wheeler
+dhoss: Devin Austin <dhoss@cpan.org>
+
dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
Drew Taylor
Make sure you get it from there to ensure you have the latest version.
-=head2 5.80000 1st Quarter 2009
-
-Next major planned release, ports Catalyst to Moose, and does some refactoring
-to help app/ctx.
-
=head2 5.81000
=over
--- /dev/null
+package Catalyst::Script::CGI;
+use Moose;
+BEGIN { $ENV{CATALYST_ENGINE} ||= 'CGI' }
+use namespace::autoclean;
+
+with 'Catalyst::ScriptRole';
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 NAME
+
+Catalyst::Script::CGI - The CGI Catalyst Script
+
+=head1 SYNOPSIS
+
+ myapp_cgi.pl [options]
+
+ Options:
+ -h --help display this help and exits
+
+=head1 DESCRIPTION
+
+This is a script to run the Catalyst engine specialized for the CGI environment.
+
+=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
--- /dev/null
+package Catalyst::Script::Create;
+use Moose;
+use MooseX::Types::Moose qw/Bool/;
+use namespace::autoclean;
+
+with 'Catalyst::ScriptRole';
+
+has force => (
+ traits => [qw(Getopt)],
+ cmd_aliases => 'nonew',
+ isa => Bool,
+ is => 'ro',
+ documentation => 'Force new scripts',
+);
+
+has debug => (
+ traits => [qw(Getopt)],
+ cmd_aliases => 'd',
+ isa => Bool,
+ is => 'ro',
+ documentation => 'Force debug mode',
+);
+
+has mechanize => (
+ traits => [qw(Getopt)],
+ cmd_aliases => 'mech',
+ isa => Bool,
+ is => 'ro',
+ documentation => 'use WWW::Mechanize',
+);
+
+has helper_class => ( isa => 'Str', is => 'ro', default => 'Catalyst::Helper' );
+
+sub run {
+ my ($self) = @_;
+
+ $self->_exit_with_usage if !$self->ARGV->[0];
+
+ my $helper_class = $self->helper_class;
+ Class::MOP::load_class($helper_class);
+ my $helper = $helper_class->new( { '.newfiles' => !$self->force, mech => $self->mechanize } );
+
+ $self->_exit_with_usage unless $helper->mk_component( $self->application_name, @ARGV );
+
+}
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 NAME
+
+Catalyst::Script::Create - Create a new Catalyst Component
+
+=head1 SYNOPSIS
+
+ 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
+ -mechanize use Test::WWW::Mechanize::Catalyst for tests if available
+ -help display this help and exits
+
+ Examples:
+ 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
+ myapp_create.pl model AnotherDB DBIC::Schema MyApp::Schema create=static\
+ dbi:Pg:dbname=foo root 4321
+
+ See also:
+ perldoc Catalyst::Manual
+ perldoc Catalyst::Manual::Intro
+
+=head1 DESCRIPTION
+
+Create a new Catalyst Component.
+
+Existing component files are not overwritten. If any of the component files
+to be created already exist the file will be written with a '.new' suffix.
+This behavior can be suppressed with the C<-force> option.
+
+=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
+
--- /dev/null
+package Catalyst::Script::FastCGI;
+
+BEGIN { $ENV{CATALYST_ENGINE} ||= 'FastCGI' }
+use Moose;
+use MooseX::Types::Moose qw/Str Bool Int/;
+use namespace::autoclean;
+
+with 'Catalyst::ScriptRole';
+
+has listen => (
+ traits => [qw(Getopt)],
+ cmd_aliases => 'l',
+ isa => Str,
+ is => 'ro',
+ documentation => 'Specify a listening port/socket',
+);
+
+has pidfile => (
+ traits => [qw(Getopt)],
+ cmd_aliases => 'pid',
+ isa => Str,
+ is => 'ro',
+ documentation => 'Specify a pidfile',
+);
+
+has daemon => (
+ traits => [qw(Getopt)],
+ isa => Bool,
+ is => 'ro',
+ cmd_aliases => 'd',
+ documentation => 'Daemonize (go into the background)',
+);
+
+has manager => (
+ traits => [qw(Getopt)],
+ isa => Str,
+ is => 'ro',
+ cmd_aliases => 'M',
+ documentation => 'Use a different FastCGI process manager class',
+);
+
+has keeperr => (
+ traits => [qw(Getopt)],
+ cmd_aliases => 'e',
+ isa => Bool,
+ is => 'ro',
+ documentation => 'Log STDERR',
+);
+
+has nproc => (
+ traits => [qw(Getopt)],
+ cmd_aliases => 'n',
+ isa => Int,
+ is => 'ro',
+ documentation => 'Specify a number of child processes',
+);
+
+has detach => (
+ traits => [qw(Getopt)],
+ cmd_aliases => 'det',
+ isa => Bool,
+ is => 'ro',
+ documentation => 'Detach this FastCGI process',
+);
+
+sub _application_args {
+ my ($self) = shift;
+ return (
+ $self->listen,
+ {
+ nproc => $self->nproc,
+ pidfile => $self->pidfile,
+ manager => $self->manager,
+ detach => $self->detach,
+ keep_stderr => $self->keeperr,
+ }
+ );
+}
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 NAME
+
+Catalyst::Script::FastCGI - The FastCGI Catalyst Script
+
+=head1 SYNOPSIS
+
+ myapp_fastcgi.pl [options]
+
+ Options:
+ -? -help display this help and exits
+ -l -listen Socket path to listen on
+ (defaults to standard input)
+ can be HOST:PORT, :PORT or a
+ filesystem path
+ -n -nproc specify number of processes to keep
+ to serve requests (defaults to 1,
+ requires -listen)
+ -p -pidfile specify filename for pid file
+ (requires -listen)
+ -d -daemon daemonize (requires -listen)
+ -M -manager specify alternate process manager
+ (FCGI::ProcManager sub-class)
+ or empty string to disable
+ -e -keeperr send error messages to STDOUT, not
+ to the webserver
+
+=head1 DESCRIPTION
+
+Run a Catalyst application as fastcgi.
+
+=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
--- /dev/null
+package Catalyst::Script::Server;
+
+BEGIN {
+ $ENV{CATALYST_ENGINE} ||= 'HTTP';
+ require Catalyst::Engine::HTTP;
+}
+
+use Moose;
+use MooseX::Types::Moose qw/ArrayRef Str Bool Int/;
+use namespace::autoclean;
+
+with 'Catalyst::ScriptRole';
+
+__PACKAGE__->meta->get_attribute('help')->cmd_aliases('?');
+
+has debug => (
+ traits => [qw(Getopt)],
+ cmd_aliases => 'd',
+ isa => Bool,
+ is => 'ro',
+ documentation => q{Force debug mode},
+);
+
+has host => (
+ traits => [qw(Getopt)],
+ cmd_aliases => 'h',
+ isa => Str,
+ is => 'ro',
+ default => 'localhost',
+ documentation => 'Specify an IP on this host for the server to bind to',
+);
+
+has fork => (
+ traits => [qw(Getopt)],
+ cmd_aliases => 'f',
+ isa => Bool,
+ is => 'ro',
+ default => 0,
+ documentation => 'Fork the server to be able to serve multiple requests at once',
+);
+
+has port => (
+ traits => [qw(Getopt)],
+ cmd_aliases => 'p',
+ isa => Int,
+ is => 'ro',
+ default => 3000,
+ documentation => 'Specify a different listening port (to the default port 3000)',
+);
+
+has pidfile => (
+ traits => [qw(Getopt)],
+ cmd_aliases => 'pid',
+ isa => Str,
+ is => 'ro',
+ documentation => 'Specify a pidfile',
+);
+
+has keepalive => (
+ traits => [qw(Getopt)],
+ cmd_aliases => 'k',
+ isa => Bool,
+ is => 'ro',
+ default => 0,
+ documentation => 'Support keepalive',
+);
+
+has background => (
+ traits => [qw(Getopt)],
+ cmd_aliases => 'bg',
+ isa => Bool,
+ is => 'ro',
+ default => 0,
+ documentation => 'Run in the background',
+);
+
+has restart => (
+ traits => [qw(Getopt)],
+ cmd_aliases => 'r',
+ isa => Bool,
+ is => 'ro',
+ default => 0,
+ documentation => 'use Catalyst::Restarter to detect code changes and restart the application',
+);
+
+has restart_directory => (
+ traits => [qw(Getopt)],
+ cmd_aliases => 'rdir',
+ isa => ArrayRef[Str],
+ is => 'ro',
+ documentation => 'Restarter directory to watch',
+ predicate => '_has_restart_directory',
+);
+
+has restart_delay => (
+ traits => [qw(Getopt)],
+ cmd_aliases => 'rd',
+ isa => Int,
+ is => 'ro',
+ documentation => 'Set a restart delay',
+ predicate => '_has_restart_delay',
+);
+
+has restart_regex => (
+ traits => [qw(Getopt)],
+ cmd_aliases => 'rr',
+ isa => Str,
+ is => 'ro',
+ documentation => 'Restart regex',
+ predicate => '_has_restart_regex',
+);
+
+has follow_symlinks => (
+ traits => [qw(Getopt)],
+ cmd_aliases => 'sym',
+ isa => Bool,
+ is => 'ro',
+ default => 0,
+ documentation => 'Follow symbolic links',
+);
+
+sub _restarter_args {
+ my $self = shift;
+ my %args;
+ $args{follow_symlinks} = $self->follow_symlinks
+ if $self->follow_symlinks;
+ $args{directories} = $self->restart_directory
+ if $self->_has_restart_directory;
+ $args{sleep_interval} = $self->restart_delay
+ if $self->_has_restart_delay;
+ if ($self->_has_restart_regex) {
+ my $regex = $self->restart_regex;
+ $args{filter} = qr/$regex/;
+ }
+ $args{start_sub} = sub { $self->_run_application };
+ $args{argv} = $self->ARGV;
+ return %args;
+}
+
+sub run {
+ my $self = shift;
+
+ local $ENV{CATALYST_DEBUG} = 1
+ if $self->debug;
+
+ if ( $self->restart ) {
+ die "Cannot run in the background and also watch for changed files.\n"
+ if $self->background;
+
+ # If we load this here, then in the case of a restarter, it does not
+ # need to be reloaded for each restart.
+ require Catalyst;
+
+ # If this isn't done, then the Catalyst::Devel tests for the restarter
+ # fail.
+ $| = 1 if $ENV{HARNESS_ACTIVE};
+
+ require Catalyst::Restarter;
+
+ my $subclass = Catalyst::Restarter->pick_subclass;
+
+
+ my $restarter = $subclass->new(
+ $self->_restarter_args()
+ );
+
+ $restarter->run_and_watch;
+ }
+ else {
+ $self->_run_application;
+ }
+
+
+}
+
+sub _application_args {
+ my ($self) = shift;
+ return (
+ $self->port,
+ $self->host,
+ {
+ map { $_ => $self->$_ } qw/
+ fork
+ keepalive
+ background
+ pidfile
+ keepalive
+ follow_symlinks
+ /,
+ },
+ );
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+=head1 NAME
+
+Catalyst::Script::Server - Catalyst test server
+
+=head1 SYNOPSIS
+
+ myapp_server.pl [options]
+
+ Options:
+ -d --debug force debug mode
+ -f --fork handle each request in a new process
+ (defaults to false)
+ --help display this help and exits
+ -h --host host (defaults to all)
+ -p --port port (defaults to 3000)
+ -k --keepalive enable keep-alive connections
+ -r --restart restart when files get modified
+ (defaults to false)
+ --rd --restartdelay delay between file checks
+ (ignored if you have Linux::Inotify2 installed)
+ --rr --restartregex regex match files that trigger
+ a restart when modified
+ (defaults to '\.yml$|\.yaml$|\.conf|\.pm$')
+ --rdir --restartdirectory the directory to search for
+ modified files, can be set mulitple times
+ (defaults to '[SCRIPT_DIR]/..')
+ --sym --follow_symlinks follow symlinks in search directories
+ (defaults to false. this is a no-op on Win32)
+ --bg --background run the process in the background
+ --pid --pidfile specify filename for pid file
+
+ See also:
+ perldoc Catalyst::Manual
+ perldoc Catalyst::Manual::Intro
+
+=head1 DESCRIPTION
+
+Run a Catalyst test server for this application.
+
+=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
--- /dev/null
+package Catalyst::Script::Test;
+use Moose;
+use Catalyst::Test ();
+use namespace::autoclean;
+
+with 'Catalyst::ScriptRole';
+
+sub run {
+ my $self = shift;
+
+ Catalyst::Test->import($self->application_name);
+
+ print request($self->ARGV->[0])->content . "\n";
+}
+
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 NAME
+
+Catalyst::Script::Test - Test Catalyst application on the command line
+
+=head1 SYNOPSIS
+
+ myapp_test.pl [options] /path
+
+ Options:
+ -h --help display this help and exits
+
+=head1 DESCRIPTION
+
+Script to perform a test hit against your application and display the output.
+
+=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
--- /dev/null
+package Catalyst::ScriptRole;
+use Moose::Role;
+use MooseX::Types::Moose qw/Str Bool/;
+use Pod::Usage;
+use MooseX::Getopt;
+use namespace::autoclean;
+
+with 'MooseX::Getopt' => {
+ excludes => [qw/
+ _getopt_spec_warnings
+ _getopt_spec_exception
+ _getopt_full_usage
+ /],
+};
+
+has application_name => (
+ traits => ['NoGetopt'],
+ isa => Str,
+ is => 'ro',
+ required => 1,
+);
+
+has help => (
+ traits => ['Getopt'],
+ isa => Bool,
+ is => 'ro',
+ documentation => q{Display this help and exit},
+ cmd_aliases => ['?', 'h'],
+);
+
+sub _getopt_spec_exception {}
+
+sub _getopt_spec_warnings {
+ shift;
+ warn @_;
+}
+
+sub _getopt_full_usage {
+ my $self = shift;
+ pod2usage();
+ exit 0;
+}
+
+before run => sub {
+ my $self = shift;
+ $self->_getopt_full_usage 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;
+
+=head1 NAME
+
+Catalyst::ScriptRole - Common functionality for Catalyst scripts.
+
+=head1 SYNOPSIS
+
+ package MyApp::Script::Foo;
+ use Moose;
+ use namespace::autoclean;
+
+ with 'Catalyst::ScriptRole';
+
+ sub _application_args { ... }
+
+=head1 DESCRIPTION
+
+Role with the common functionality of Catalyst scripts.
+
+=head1 METHODS
+
+=head2 run
+
+The method invoked to run the application.
+
+=head1 ATTRIBUTES
+
+=head2 application_name
+
+The name of the application class, e.g. MyApp
+
+=head1 SEE ALSO
+
+L<Catalyst>
+
+L<MooseX::Getopt>
+
+=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
+
--- /dev/null
+package Catalyst::ScriptRunner;
+use Moose;
+use FindBin;
+use lib;
+use File::Spec;
+use namespace::autoclean;
+
+sub run {
+ my ($self, $class, $scriptclass) = @_;
+ my $classtoload = "${class}::Script::$scriptclass";
+
+ lib->import(File::Spec->catdir($FindBin::Bin, '..', 'lib'));
+
+ unless ( eval { Class::MOP::load_class($classtoload) } ) {
+ warn("Could not load $classtoload - falling back to Catalyst::Script::$scriptclass : $@\n")
+ if $@ !~ /Can't locate/;
+ $classtoload = "Catalyst::Script::$scriptclass";
+ Class::MOP::load_class($classtoload);
+ }
+ $classtoload->new_with_options( application_name => $class )->run;
+}
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 NAME
+
+Catalyst::ScriptRunner - The Catalyst Framework script runner
+
+=head1 SYNOPSIS
+
+ # Will run MyApp::Script::Server if it exists, otherwise
+ # will run Catalyst::Script::Server.
+ Catalyst::ScriptRunner->run('MyApp', 'Server');
+
+=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 METHODS
+
+=head2 run ($application_class, $scriptclass)
+
+Called with two parameters, the application classs (e.g. MyApp)
+and the script class, (i.e. one of Server/FastCGI/CGI/Create/Test)
+
+=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
--- /dev/null
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use FindBin qw/$Bin/;
+use lib "$Bin/../lib";
+
+use Test::More;
+use Test::Exception;
+
+use Catalyst::Script::CGI;
+
+local @ARGV;
+lives_ok {
+ Catalyst::Script::CGI->new_with_options(application_name => 'TestAppToTestScripts')->run;
+} "new_with_options";
+shift @TestAppToTestScripts::RUN_ARGS;
+is_deeply \@TestAppToTestScripts::RUN_ARGS, [], "no args";
+
+done_testing;
--- /dev/null
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+
+use FindBin qw/$Bin/;
+use lib "$Bin/../lib";
+
+{
+ package TestCreateScript;
+ use Moose;
+ extends 'Catalyst::Script::Create';
+ our $help;
+ sub _exit_with_usage { $help++ }
+}
+
+{
+ package TestHelperClass;
+ use Moose;
+
+ has 'newfiles' => ( is => 'ro', init_arg => '.newfiles' );
+ has 'mech' => ( is => 'ro' );
+ our @ARGS;
+ our %p;
+ sub mk_component {
+ my $self = shift;
+ @ARGS = @_;
+ %p = ( '.newfiles' => $self->newfiles, mech => $self->mech);
+ return $self->_mk_component_return;
+ }
+ sub _mk_component_return { 1 }
+}
+{
+ package TestHelperClass::False;
+ use Moose;
+ extends 'TestHelperClass';
+ sub _mk_component_return { 0 }
+}
+
+{
+ local $TestCreateScript::help;
+ local @ARGV;
+ lives_ok {
+ TestCreateScript->new_with_options(application_name => 'TestAppToTestScripts', helper_class => 'TestHelperClass')->run;
+ } "no argv";
+ ok $TestCreateScript::help, 'Exited with usage info';
+}
+{
+ local $TestCreateScript::help;
+ local @ARGV = 'foo';
+ local @TestHelperClass::ARGS;
+ local %TestHelperClass::p;
+ lives_ok {
+ TestCreateScript->new_with_options(application_name => 'TestAppToTestScripts', helper_class => 'TestHelperClass')->run;
+ } "with argv";
+ ok !$TestCreateScript::help, 'Did not exit with usage into';
+ is_deeply \@TestHelperClass::ARGS, ['TestAppToTestScripts', 'foo'], 'Args correct';
+ is_deeply \%TestHelperClass::p, { '.newfiles' => 1, mech => undef }, 'Params correct';
+}
+
+{
+ local $TestCreateScript::help;
+ local @ARGV = 'foo';
+ local @TestHelperClass::ARGS;
+ local %TestHelperClass::p;
+ lives_ok {
+ TestCreateScript->new_with_options(application_name => 'TestAppToTestScripts', helper_class => 'TestHelperClass::False')->run;
+ } "with argv";
+ ok $TestCreateScript::help, 'Did exit with usage into as mk_component returned false';
+ is_deeply \@TestHelperClass::ARGS, ['TestAppToTestScripts', 'foo'], 'Args correct';
+ is_deeply \%TestHelperClass::p, { '.newfiles' => 1, mech => undef }, 'Params correct';
+}
+
+done_testing;
--- /dev/null
+use strict;
+use warnings;
+
+use FindBin qw/$Bin/;
+use lib "$Bin/../lib";
+
+use Test::More;
+use Test::Exception;
+
+use Catalyst::Script::FastCGI;
+
+my $testopts;
+
+# Test default (no opts/args behaviour)
+testOption( [ qw// ], [undef, opthash()] );
+
+# listen socket
+testOption( [ qw|-l /tmp/foo| ], ['/tmp/foo', opthash()] );
+testOption( [ qw/-l 127.0.0.1:3000/ ], ['127.0.0.1:3000', opthash()] );
+
+#daemonize -d --daemon
+testOption( [ qw/-d/ ], [undef, opthash()] );
+testOption( [ qw/--daemon/ ], [undef, opthash()] );
+
+# pidfile -pidfile --pid --pidfile
+testOption( [ qw/--pidfile cat.pid/ ], [undef, opthash(pidfile => 'cat.pid')] );
+testOption( [ qw/--pid cat.pid/ ], [undef, opthash(pidfile => 'cat.pid')] );
+
+# manager
+testOption( [ qw/--manager foo::bar/ ], [undef, opthash(manager => 'foo::bar')] );
+testOption( [ qw/-M foo::bar/ ], [undef, opthash(manager => 'foo::bar')] );
+
+# keeperr
+testOption( [ qw/--keeperr/ ], [undef, opthash(keep_stderr => 1)] );
+testOption( [ qw/-e/ ], [undef, opthash(keep_stderr => 1)] );
+
+# nproc
+testOption( [ qw/--nproc 6/ ], [undef, opthash(nproc => 6)] );
+testOption( [ qw/--n 6/ ], [undef, opthash(nproc => 6)] );
+
+# detach
+testOption( [ qw/--detach/ ], [undef, opthash(detach => 1)] );
+testOption( [ qw/--det/ ], [undef, opthash(detach => 1)] );
+
+done_testing;
+
+sub testOption {
+ my ($argstring, $resultarray) = @_;
+
+ local @ARGV = @$argstring;
+ local @TestAppToTestScripts::RUN_ARGS;
+ lives_ok {
+ Catalyst::Script::FastCGI->new_with_options(application_name => 'TestAppToTestScripts')->run;
+ } "new_with_options";
+ # First element of RUN_ARGS will be the script name, which we don't care about
+ shift @TestAppToTestScripts::RUN_ARGS;
+ is_deeply \@TestAppToTestScripts::RUN_ARGS, $resultarray, "is_deeply comparison";
+}
+
+# Returns the hash expected when no flags are passed
+sub opthash {
+ return {
+ pidfile => undef,
+ keep_stderr => undef,
+ detach => undef,
+ nproc => undef,
+ manager => undef,
+ @_,
+ };
+}
--- /dev/null
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+
+use FindBin qw/$Bin/;
+use lib "$Bin/../lib";
+
+{
+ package TestHelpScript;
+ use Moose;
+ with 'Catalyst::ScriptRole';
+ our $help;
+ sub _getopt_full_usage { $help++ }
+}
+
+test('-h');
+test('--help');
+test('-?');
+
+sub test {
+ local $TestHelpScript::help;
+ local @ARGV = (@_);
+ lives_ok {
+ TestHelpScript->new_with_options(application_name => 'TestAppToTestScripts')->run;
+ } 'Lives';
+ ok $TestHelpScript::help, 'Got help';
+}
+
+done_testing;
--- /dev/null
+use strict;
+use warnings;
+
+use FindBin qw/$Bin/;
+use lib "$Bin/../lib";
+
+use Test::More;
+use Test::Exception;
+
+use Catalyst::Script::Server;
+
+my $testopts;
+
+# Test default (no opts/args behaviour)
+testOption( [ qw// ], ['3000', 'localhost', opthash()] );
+
+# Old version supports long format opts with either one or two dashes. New version only supports two.
+# Old New
+# help -? -help --help -? --help
+# debug -d -debug --debug -d --debug
+# host -host --host --host
+testOption( [ qw/--host testhost/ ], ['3000', 'testhost', opthash()] );
+testOption( [ qw/-h testhost/ ], ['3000', 'testhost', opthash()] );
+
+# port -p -port --port -l --listen
+testOption( [ qw/-p 3001/ ], ['3001', 'localhost', opthash()] );
+testOption( [ qw/--port 3001/ ], ['3001', 'localhost', opthash()] );
+
+# fork -f -fork --fork -f --fork
+testOption( [ qw/--fork/ ], ['3000', 'localhost', opthash(fork => 1)] );
+testOption( [ qw/-f/ ], ['3000', 'localhost', opthash(fork => 1)] );
+
+# pidfile -pidfile --pid --pidfile
+testOption( [ qw/--pidfile cat.pid/ ], ['3000', 'localhost', opthash(pidfile => "cat.pid")] );
+testOption( [ qw/--pid cat.pid/ ], ['3000', 'localhost', opthash(pidfile => "cat.pid")] );
+
+# keepalive -k -keepalive --keepalive -k --keepalive
+testOption( [ qw/-k/ ], ['3000', 'localhost', opthash(keepalive => 1)] );
+testOption( [ qw/--keepalive/ ], ['3000', 'localhost', opthash(keepalive => 1)] );
+
+# symlinks -follow_symlinks --sym --follow_symlinks
+testOption( [ qw/--follow_symlinks/ ], ['3000', 'localhost', opthash(follow_symlinks => 1)] );
+testOption( [ qw/--sym/ ], ['3000', 'localhost', opthash(follow_symlinks => 1)] );
+
+# background -background --bg --background
+testOption( [ qw/--background/ ], ['3000', 'localhost', opthash(background => 1)] );
+testOption( [ qw/--bg/ ], ['3000', 'localhost', opthash(background => 1)] );
+
+# restart -r -restart --restart -R --restart
+testRestart( ['-r'], restartopthash() );
+# restart dly -rd -restartdelay --rd --restart_delay
+testRestart( ['-r', '--rd', 30], restartopthash(sleep_interval => 30) );
+testRestart( ['-r', '--restart_delay', 30], restartopthash(sleep_interval => 30) );
+
+# restart dir -restartdirectory --rdir --restart_directory
+testRestart( ['-r', '--rdir', 'root'], restartopthash(directories => ['root']) );
+testRestart( ['-r', '--rdir', 'root', '--rdir', 'lib'], restartopthash(directories => ['root', 'lib']) );
+testRestart( ['-r', '--restart_directory', 'root'], restartopthash(directories => ['root']) );
+
+# restart regex -rr -restartregex --rr --restart_regex
+testRestart( ['-r', '--rr', 'foo'], restartopthash(filter => qr/foo/) );
+testRestart( ['-r', '--restart_regex', 'foo'], restartopthash(filter => qr/foo/) );
+
+done_testing;
+
+sub testOption {
+ my ($argstring, $resultarray) = @_;
+ my $app = _build_testapp($argstring);
+ lives_ok {
+ $app->run;
+ };
+ # First element of RUN_ARGS will be the script name, which we don't care about
+ shift @TestAppToTestScripts::RUN_ARGS;
+ is_deeply \@TestAppToTestScripts::RUN_ARGS, $resultarray, "is_deeply comparison " . join(' ', @$argstring);
+}
+
+sub testRestart {
+ my ($argstring, $resultarray) = @_;
+ my $app = _build_testapp($argstring);
+ my $args = {$app->_restarter_args};
+ is_deeply delete $args->{argv}, $argstring, 'argv is arg string';
+ is ref(delete $args->{start_sub}), 'CODE', 'Closure to start app present';
+ is_deeply $args, $resultarray, "is_deeply comparison of restarter args " . join(' ', @$argstring);
+}
+
+sub _build_testapp {
+ my ($argstring, $resultarray) = @_;
+
+ local @ARGV = @$argstring;
+ local @TestAppToTestScripts::RUN_ARGS;
+ my $i;
+ lives_ok {
+ $i = Catalyst::Script::Server->new_with_options(application_name => 'TestAppToTestScripts');
+ } "new_with_options " . join(' ', @$argstring);;
+ ok $i;
+ return $i;
+}
+
+# Returns the hash expected when no flags are passed
+sub opthash {
+ return {
+ 'pidfile' => undef,
+ 'fork' => 0,
+ 'follow_symlinks' => 0,
+ 'background' => 0,
+ 'keepalive' => 0,
+ @_,
+ };
+}
+
+sub restartopthash {
+ return {
+ @_,
+ };
+}
--- /dev/null
+use strict;
+use warnings;
+
+use FindBin qw/$Bin/;
+use lib "$Bin/../lib";
+
+use Test::More;
+use Test::Exception;
+
+use Catalyst::Script::Test;
+use File::Temp qw/tempfile/;
+use IO::Handle;
+
+is run_test('/'), "root index\n", 'correct content printed';
+is run_test('/moose/get_attribute'), "42\n", 'Correct content printed for non root action';
+
+done_testing;
+
+sub run_test {
+ my $url = shift;
+
+ my ($fh, $fn) = tempfile();
+
+ binmode( $fh );
+ binmode( STDOUT );
+
+ {
+ local @ARGV = ($url);
+ my $i;
+ lives_ok {
+ $i = Catalyst::Script::Test->new_with_options(application_name => 'TestApp');
+ } "new_with_options";
+ ok $i;
+ my $saved;
+ open( $saved, '<&'. STDIN->fileno )
+ or croak("Can't dup stdin: $!");
+ open( STDOUT, '>&='. $fh->fileno )
+ or croak("Can't open stdout: $!");
+ eval { $i->run };
+ ok !$@, 'Ran ok';
+
+ STDOUT->flush
+ or croak("Can't flush stdout: $!");
+
+ open( STDOUT, '>&'. fileno($saved) )
+ or croak("Can't restore stdout: $!");
+ }
+
+ my $data = do { my $fh; open($fh, '<', $fn) or die $!; local $/; <$fh>; };
+ $fh = undef;
+ unlink $fn if -r $fn;
+
+ return $data;
+}
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+use FindBin qw/$Bin/;
+use lib "$Bin/../lib";
+
+use_ok('Catalyst::ScriptRunner');
+
+is Catalyst::ScriptRunner->run('ScriptTestApp', 'Foo'), 'ScriptTestApp::Script::Foo',
+ 'Script existing only in app';
+is Catalyst::ScriptRunner->run('ScriptTestApp', 'Bar'), 'ScriptTestApp::Script::Bar',
+ 'Script existing in both app and Catalyst - prefers app';
+is Catalyst::ScriptRunner->run('ScriptTestApp', 'Baz'), 'Catalyst::Script::Baz',
+ 'Script existing only in Catalyst';
+# +1 test for the params passed to new_with_options in t/lib/Catalyst/Script/Baz.pm
+{
+ my $warnings = '';
+ local $SIG{__WARN__} = sub { $warnings .= shift };
+ is 'Catalyst::Script::CompileTest', Catalyst::ScriptRunner->run('ScriptTestApp', 'CompileTest');
+ like $warnings, qr/Does not compile/;
+ like $warnings, qr/Could not load ScriptTestApp::Script::CompileTest - falling back to Catalyst::Script::CompileTest/;
+}
+
+done_testing;
# spawn the standalone HTTP server
my $port = 30000 + int rand(1 + 10000);
my @cmd = ($^X, "-I$FindBin::Bin/../../lib",
- "$FindBin::Bin/../../t/tmp/TestApp/script/testapp_server.pl", '-port', $port );
+ "$FindBin::Bin/../../t/tmp/TestApp/script/testapp_server.pl", '--port', $port );
my $pid = open3( undef, my $server, undef, @cmd)
or die "Unable to spawn standalone HTTP server: $!";
--- /dev/null
+package Catalyst::Script::Bar;
+use Moose;
+use namespace::autoclean;
+
+with 'Catalyst::ScriptRole';
+
+sub run { __PACKAGE__ }
+
+1;
--- /dev/null
+package Catalyst::Script::Baz;
+use Moose;
+use namespace::autoclean;
+
+use Test::More;
+
+with 'Catalyst::ScriptRole';
+
+sub run { __PACKAGE__ }
+
+after new_with_options => sub {
+ my ($self, %args) = @_;
+ is_deeply \%args, { application_name => 'ScriptTestApp' }, 'App name correct';
+};
+
+1;
--- /dev/null
+package ScriptTestApp::Script::Bar;
+use Moose;
+use namespace::autoclean;
+
+with 'Catalyst::ScriptRole';
+
+sub run { __PACKAGE__ }
+
+1;
\ No newline at end of file
--- /dev/null
+package ScriptTestApp::Script::Foo;
+use Moose;
+use namespace::autoclean;
+
+with 'Catalyst::ScriptRole';
+
+sub run { __PACKAGE__ }
+
+1;
--- /dev/null
+package TestAppToTestScripts;
+use strict;
+use warnings;
+use Carp;
+
+our @RUN_ARGS;
+
+sub run {
+ @RUN_ARGS = @_;
+ 1; # Does this work?
+}
+
+1;
+
projects / catagits/Catalyst-Runtime.git / commitdiff