From: Tomas Doran Date: Mon, 23 Nov 2009 23:06:27 +0000 (+0000) Subject: Merge 'trunk' into 'better_scripts' X-Git-Tag: 5.80014_02~38 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=49fe75ffc9bab4595f2644c192b120f1506b7035;hp=69db240eb72e649e5bad28e9e1cc7656c3fcf9e8 Merge 'trunk' into 'better_scripts' r11978@t0mlaptop (orig r11943): rafl | 2009-11-20 06:22:44 +0000 Fix a doc typo. Also trim some trailing whitespace. r11979@t0mlaptop (orig r11944): rafl | 2009-11-20 06:22:51 +0000 Remove some docs for Exception::Go and ::Detach. Users really shouldn't care. r11980@t0mlaptop (orig r11945): rafl | 2009-11-20 07:05:08 +0000 Depend on MX::Role::WithOverloading 0.03 to make sure things work out on 5.8.8 and older. r11986@t0mlaptop (orig r11951): rafl | 2009-11-21 01:30:07 +0000 Remove duplicate changelog entry. r11987@t0mlaptop (orig r11952): rafl | 2009-11-21 01:43:12 +0000 Improve Exception::Interface docs. r11988@t0mlaptop (orig r11953): rafl | 2009-11-21 01:43:28 +0000 More changelogging. r11989@t0mlaptop (orig r11954): rafl | 2009-11-21 01:43:57 +0000 Refer to the right ticket in Changes. r11990@t0mlaptop (orig r11955): rafl | 2009-11-21 02:31:02 +0000 Version 5.80014. r11996@t0mlaptop (orig r11961): zby | 2009-11-21 13:03:43 +0000 warning for plugins inheriting from Catayst::Component r11998@t0mlaptop (orig r11963): t0m | 2009-11-22 12:57:30 +0000 Chop out that crap, not needed r11999@t0mlaptop (orig r11964): t0m | 2009-11-22 13:01:09 +0000 Do not be @ISA Controller, that's hideous dumb and now warns r12000@t0mlaptop (orig r11965): t0m | 2009-11-22 13:01:48 +0000 Do not use NEXT, like it says in the comments r12001@t0mlaptop (orig r11966): t0m | 2009-11-22 13:04:50 +0000 Fix unicode issues in CGI and FastCGI engines r12002@t0mlaptop (orig r11967): t0m | 2009-11-22 13:08:47 +0000 Changelog, adjust warning text, bump versions for a dev release. The 'we do get Class::C3::Adopt::NEXT warnings test is now broken, no idea why, will look later. r12003@t0mlaptop (orig r11968): t0m | 2009-11-22 19:42:30 +0000 Different phrasing for different versions r12004@t0mlaptop (orig r11969): t0m | 2009-11-22 19:53:00 +0000 Whoops, fix typo r12005@t0mlaptop (orig r11970): t0m | 2009-11-22 19:58:31 +0000 It actually wants 'true', make that more explicit r12006@t0mlaptop (orig r11971): t0m | 2009-11-22 19:59:04 +0000 release 5.80014_01 r12008@t0mlaptop (orig r11973): t0m | 2009-11-22 20:08:28 +0000 Notabs is author only r12009@t0mlaptop (orig r11974): t0m | 2009-11-22 20:11:17 +0000 Pod tests are also author only r12010@t0mlaptop (orig r11975): t0m | 2009-11-22 20:13:06 +0000 Changelog r12013@t0mlaptop (orig r11978): t0m | 2009-11-23 21:25:19 +0000 Don't do bytes::length, just use length, tests to demonstrate the issue r12014@t0mlaptop (orig r11979): t0m | 2009-11-23 21:45:55 +0000 Nasty hack for fastcgi, fixes gitalist r12021@t0mlaptop (orig r11986): t0m | 2009-11-23 22:57:40 +0000 Have a new conflict statement --- diff --git a/Makefile.PL b/Makefile.PL index d851efd..790e8f8 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -18,6 +18,7 @@ all_from 'lib/Catalyst/Runtime.pm'; 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'; @@ -47,10 +48,10 @@ requires 'URI' => '1.35'; 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'; diff --git a/TODO.scripts b/TODO.scripts new file mode 100644 index 0000000..1096520 --- /dev/null +++ b/TODO.scripts @@ -0,0 +1,5 @@ +* $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 diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index ef3d082..296cf43 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -2892,6 +2892,8 @@ David Naughton, C David E. Wheeler +dhoss: Devin Austin + dkubb: Dan Kubb Drew Taylor diff --git a/lib/Catalyst/ROADMAP.pod b/lib/Catalyst/ROADMAP.pod index e872e5e..9c29d1d 100644 --- a/lib/Catalyst/ROADMAP.pod +++ b/lib/Catalyst/ROADMAP.pod @@ -8,11 +8,6 @@ in the the catalyst trunk, currently at 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 diff --git a/lib/Catalyst/Script/CGI.pm b/lib/Catalyst/Script/CGI.pm new file mode 100644 index 0000000..c37dfdc --- /dev/null +++ b/lib/Catalyst/Script/CGI.pm @@ -0,0 +1,31 @@ +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. + +=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 diff --git a/lib/Catalyst/Script/Create.pm b/lib/Catalyst/Script/Create.pm new file mode 100644 index 0000000..6191d72 --- /dev/null +++ b/lib/Catalyst/Script/Create.pm @@ -0,0 +1,94 @@ +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 + diff --git a/lib/Catalyst/Script/FastCGI.pm b/lib/Catalyst/Script/FastCGI.pm new file mode 100644 index 0000000..d76727d --- /dev/null +++ b/lib/Catalyst/Script/FastCGI.pm @@ -0,0 +1,121 @@ +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 diff --git a/lib/Catalyst/Script/Server.pm b/lib/Catalyst/Script/Server.pm new file mode 100644 index 0000000..ef1f818 --- /dev/null +++ b/lib/Catalyst/Script/Server.pm @@ -0,0 +1,237 @@ +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 diff --git a/lib/Catalyst/Script/Test.pm b/lib/Catalyst/Script/Test.pm new file mode 100644 index 0000000..7d5e978 --- /dev/null +++ b/lib/Catalyst/Script/Test.pm @@ -0,0 +1,41 @@ +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. + +=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 index 0000000..bea26de --- /dev/null +++ b/lib/Catalyst/ScriptRole.pm @@ -0,0 +1,118 @@ +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 + +L + +=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/ScriptRunner.pm b/lib/Catalyst/ScriptRunner.pm new file mode 100644 index 0000000..63d153d --- /dev/null +++ b/lib/Catalyst/ScriptRunner.pm @@ -0,0 +1,57 @@ +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), or the Catalyst namespace (e.g. C) + +=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 diff --git a/t/aggregate/unit_core_script_cgi.t b/t/aggregate/unit_core_script_cgi.t new file mode 100644 index 0000000..ba187e1 --- /dev/null +++ b/t/aggregate/unit_core_script_cgi.t @@ -0,0 +1,20 @@ +#!/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; diff --git a/t/aggregate/unit_core_script_fastcgi.t b/t/aggregate/unit_core_script_fastcgi.t new file mode 100644 index 0000000..7d4da0f --- /dev/null +++ b/t/aggregate/unit_core_script_fastcgi.t @@ -0,0 +1,70 @@ +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, + @_, + }; +} diff --git a/t/aggregate/unit_core_script_help.t b/t/aggregate/unit_core_script_help.t new file mode 100644 index 0000000..26a3a92 --- /dev/null +++ b/t/aggregate/unit_core_script_help.t @@ -0,0 +1,35 @@ +#!/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; diff --git a/t/aggregate/unit_core_script_server.t b/t/aggregate/unit_core_script_server.t new file mode 100644 index 0000000..e129f19 --- /dev/null +++ b/t/aggregate/unit_core_script_server.t @@ -0,0 +1,80 @@ +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, + @_, + }; +} diff --git a/t/aggregate/unit_core_script_test.t b/t/aggregate/unit_core_script_test.t new file mode 100644 index 0000000..cc91a3a --- /dev/null +++ b/t/aggregate/unit_core_script_test.t @@ -0,0 +1,48 @@ +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; + diff --git a/t/aggregate/unit_core_scriptrunner.t b/t/aggregate/unit_core_scriptrunner.t new file mode 100644 index 0000000..1dfe255 --- /dev/null +++ b/t/aggregate/unit_core_scriptrunner.t @@ -0,0 +1,16 @@ +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 + diff --git a/t/lib/Catalyst/Script/Bar.pm b/t/lib/Catalyst/Script/Bar.pm new file mode 100644 index 0000000..18e699c --- /dev/null +++ b/t/lib/Catalyst/Script/Bar.pm @@ -0,0 +1,9 @@ +package Catalyst::Script::Bar; +use Moose; +use namespace::autoclean; + +with 'Catalyst::ScriptRole'; + +sub run { __PACKAGE__ } + +1; diff --git a/t/lib/Catalyst/Script/Baz.pm b/t/lib/Catalyst/Script/Baz.pm new file mode 100644 index 0000000..d699fe6 --- /dev/null +++ b/t/lib/Catalyst/Script/Baz.pm @@ -0,0 +1,16 @@ +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; diff --git a/t/lib/ScriptTestApp/Script/Bar.pm b/t/lib/ScriptTestApp/Script/Bar.pm new file mode 100644 index 0000000..1d01fad --- /dev/null +++ b/t/lib/ScriptTestApp/Script/Bar.pm @@ -0,0 +1,9 @@ +package ScriptTestApp::Script::Bar; +use Moose; +use namespace::autoclean; + +with 'Catalyst::ScriptRole'; + +sub run { __PACKAGE__ } + +1; \ No newline at end of file diff --git a/t/lib/ScriptTestApp/Script/Foo.pm b/t/lib/ScriptTestApp/Script/Foo.pm new file mode 100644 index 0000000..8d61c63 --- /dev/null +++ b/t/lib/ScriptTestApp/Script/Foo.pm @@ -0,0 +1,9 @@ +package ScriptTestApp::Script::Foo; +use Moose; +use namespace::autoclean; + +with 'Catalyst::ScriptRole'; + +sub run { __PACKAGE__ } + +1; diff --git a/t/lib/TestAppToTestScripts.pm b/t/lib/TestAppToTestScripts.pm new file mode 100644 index 0000000..f32154a --- /dev/null +++ b/t/lib/TestAppToTestScripts.pm @@ -0,0 +1,14 @@ +package TestAppToTestScripts; +use strict; +use warnings; +use Carp; + +our @RUN_ARGS; + +sub run { + @RUN_ARGS = @_; + 1; # Does this work? +} + +1; +