X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Faggregate%2Funit_core_script_server.t;h=b9ad60b8e546fe4b48ac59c456a7916b440123af;hb=30b7090311be68aa1d366c2314af426d24a8f0a3;hp=b2ea3f9b25229db3975142955780cabd2db8fb3a;hpb=04f4497ce7970ce629d1028861d0f3a9906c950a;p=catagits%2FCatalyst-Runtime.git diff --git a/t/aggregate/unit_core_script_server.t b/t/aggregate/unit_core_script_server.t index b2ea3f9..b9ad60b 100644 --- a/t/aggregate/unit_core_script_server.t +++ b/t/aggregate/unit_core_script_server.t @@ -4,7 +4,7 @@ use warnings; use FindBin qw/$Bin/; use lib "$Bin/../lib"; -use Test::More 'no_plan'; +use Test::More; use Test::Exception; use Catalyst::Script::Server; @@ -12,78 +12,126 @@ use Catalyst::Script::Server; my $testopts; # Test default (no opts/args behaviour) -testOption( [ qw// ], ['3000', 'localhost', opthash()] ); +# Note undef for host means we bind to all interfaces. +testOption( [ qw// ], ['3000', undef, opthash()] ); # Old version supports long format opts with either one or two dashes. New version only supports two. # Old New -# help -? -help --help -h --help +# 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()] ); +testOption( [ qw/-p 3001/ ], ['3001', undef, opthash()] ); +testOption( [ qw/--port 3001/ ], ['3001', undef, opthash()] ); +{ + local $ENV{TESTAPPTOTESTSCRIPTS_PORT} = 5000; + testOption( [ qw// ], [5000, undef, opthash()] ); +} +{ + local $ENV{CATALYST_PORT} = 5000; + testOption( [ qw// ], [5000, undef, opthash()] ); +} # fork -f -fork --fork -f --fork -$testopts = opthash(); -$testopts->{fork} = 1; -testOption( [ qw/--fork/ ], ['3000', 'localhost', $testopts] ); -testOption( [ qw/-f/ ], ['3000', 'localhost', $testopts] ); +testOption( [ qw/--fork/ ], ['3000', undef, opthash(fork => 1)] ); +testOption( [ qw/-f/ ], ['3000', undef, opthash(fork => 1)] ); # pidfile -pidfile --pid --pidfile -$testopts = opthash(); -$testopts->{pidfile} = "cat.pid"; -testOption( [ qw/--pidfile cat.pid/ ], ['3000', 'localhost', $testopts] ); +testOption( [ qw/--pidfile cat.pid/ ], ['3000', undef, opthash(pidfile => "cat.pid")] ); +testOption( [ qw/--pid cat.pid/ ], ['3000', undef, opthash(pidfile => "cat.pid")] ); # keepalive -k -keepalive --keepalive -k --keepalive -$testopts = opthash(); -$testopts->{keepalive} = 1; -testOption( [ qw/-k/ ], ['3000', 'localhost', $testopts] ); -testOption( [ qw/--keepalive/ ], ['3000', 'localhost', $testopts] ); +testOption( [ qw/-k/ ], ['3000', undef, opthash(keepalive => 1)] ); +testOption( [ qw/--keepalive/ ], ['3000', undef, opthash(keepalive => 1)] ); # symlinks -follow_symlinks --sym --follow_symlinks -$testopts = opthash(); -$testopts->{follow_symlinks} = 1; -testOption( [ qw/--follow_symlinks/ ], ['3000', 'localhost', $testopts] ); +testOption( [ qw/--follow_symlinks/ ], ['3000', undef, opthash(follow_symlinks => 1)] ); +testOption( [ qw/--sym/ ], ['3000', undef, opthash(follow_symlinks => 1)] ); # background -background --bg --background -$testopts = opthash(); -$testopts->{background} = 1; -testOption( [ qw/--background/ ], ['3000', 'localhost', $testopts] ); +testOption( [ qw/--background/ ], ['3000', undef, opthash(background => 1)] ); +testOption( [ qw/--bg/ ], ['3000', undef, opthash(background => 1)] ); -# Restart stuff requires a threaded perl, apparently. # restart -r -restart --restart -R --restart -# restart dly -rd -restartdelay --rdel --restart_delay +testRestart( ['-r'], restartopthash() ); +{ + local $ENV{TESTAPPTOTESTSCRIPTS_RELOAD} = 1; + testRestart( [], restartopthash() ); +} +{ + local $ENV{CATALYST_RELOAD} = 1; + testRestart( [], 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 -# restart regex -rr -restartregex --rxp --restart_regex +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; + # Mangle argv into the options.. + $resultarray->[-1]->{argv} = $argstring; + is_deeply \@TestAppToTestScripts::RUN_ARGS, $resultarray, "is_deeply comparison " . join(' ', @$argstring); +} - subtest "Test for ARGV: @$argstring" => sub - { - plan tests => 2; - 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"; - done_testing; - }; +sub testRestart { + my ($argstring, $resultarray) = @_; + my $app = _build_testapp($argstring); + ok $app->restart, 'App is in restart mode'; + 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, - } + return { + 'pidfile' => undef, + 'fork' => 0, + 'follow_symlinks' => 0, + 'background' => 0, + 'keepalive' => 0, + @_, + }; +} + +sub restartopthash { + return { + follow_symlinks => 0, + @_, + }; }