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';
+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';
--- /dev/null
+* $ARGV[0] has slipped to $ARGV[1] in ::Test
+* ScriptRunner tests for MyApp::Script::DoesNotCompile
+* Sort out help so that it shows what you fucked up.
+* Fix horrible hacking around MX::Getopt's help display - probably by fixing MX::Getopt.
+* Tests for ::Create
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
+
+See L<Catalyst>.
+
+=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 Catalyst::Helper;
+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',
+);
+
+sub run {
+ my ($self) = @_;
+
+ $self->_exit_with_usage if !$ARGV[0];
+
+ my $helper = Catalyst::Helper->new( { '.newfiles' => !$self->force, mech => $self->mech } );
+
+ $self->_display_help unless $helper->mk_component( $self->app, @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';
+
+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 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 %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;
+ $args{filter} = qr/$self->restart_regex/
+ if $self->_has_restart_regex;
+
+ my $restarter = $subclass->new(
+ %args,
+ start_sub => sub { $self->_run_application },
+ argv => $self->ARGV,
+ );
+
+ $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)
+ -h --help display this help and exits
+ --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 namespace::autoclean;
+
+with 'Catalyst::ScriptRole';
+
+sub run {
+ my $self = shift;
+
+ Class::MOP::load_class("Catalyst::Test");
+ Catalyst::Test->import($self->application_name);
+
+ print request($ARGV[1])->content . "\n";
+
+}
+
+
+__PACKAGE__->meta->make_immutable;
+
+=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
--- /dev/null
+package Catalyst::ScriptRole;
+use Moose::Role;
+use MooseX::Types::Moose qw/Str Bool/;
+use Pod::Usage;
+use namespace::autoclean;
+
+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 _exit_with_usage {
+ my $self = shift;
+ pod2usage();
+ exit 0;
+}
+
+before run => sub {
+ my $self = shift;
+ $self->_exit_with_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);
+}
+
+# GROSS HACK, temporary until MX::Getopt gets some proper refactoring and unfucking..
+around '_parse_argv' => sub {
+ my ($orig, $self, @args) = @_;
+ my %data = eval { $self->$orig(@args) };
+ $self->_exit_with_usage($@) if $@;
+ $data{usage} = Catalyst::ScriptRole::Useage->new(code => sub { shift; $self->_exit_with_usage(@_) });
+ return %data;
+};
+
+# This package is going away.
+package # Hide from PAUSE
+ Catalyst::ScriptRole::Useage;
+use Moose;
+use namespace::autoclean;
+
+has code => ( is => 'ro', required => 1 );
+
+sub die { shift->code->(@_) }
+
+1;
+
+=head1 NAME
+
+Catalyst::ScriptRole - Common functionality for Catalyst scripts.
+
+=head1 SYNOPSIS
+
+ package MyApp::Script::Foo;
+ use Moose;
+ use namespace::autoclean;
+
+ with 'Catalyst::Script::Role';
+
+ 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'));
+
+ # FIXME - Error handling / reporting
+ if ( eval { Class::MOP::load_class($classtoload) } ) {
+ }
+ else {
+ $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
+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 _exit_with_usage { $help++ }
+}
+
+test('-h');
+test('--help');
+
+TODO: {
+ local $TODO = 'This is bork';
+ test('-?');
+}
+
+sub test {
+ local $TestHelpScript::help;
+ local @ARGV = (@_);
+ lives_ok {
+ TestHelpScript->new_with_options(application_name => 'TestAppToTestScripts')->run;
+ };
+ ok $TestHelpScript::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 stuff requires a threaded perl, apparently.
+# restart -r -restart --restart -R --restart
+# restart dly -rd -restartdelay --rdel --restart_delay
+# restart dir -restartdirectory --rdir --restart_directory
+# restart regex -rr -restartregex --rxp --restart_regex
+
+done_testing;
+
+sub testOption {
+ my ($argstring, $resultarray) = @_;
+
+ local @ARGV = @$argstring;
+ local @TestAppToTestScripts::RUN_ARGS;
+ lives_ok {
+ Catalyst::Script::Server->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,
+ 'fork' => 0,
+ 'follow_symlinks' => 0,
+ 'background' => 0,
+ 'keepalive' => 0,
+ @_,
+ };
+}
--- /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;
+
+my ($fh, $fn) = tempfile();
+
+binmode( $fh );
+binmode( STDOUT );
+
+{
+ local @ARGV = ('/');
+ 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;
+
+is $data, "root index\n", 'correct content printed';
+
+done_testing;
+
--- /dev/null
+use strict;
+use warnings;
+use Test::More tests => 5;
+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
+
--- /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