X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Faggregate%2Funit_core_script_server.t;h=5414fd1d56825d8afbd015e05c40946078a70c09;hb=d5a8ec3cc9d3b850be74eccb609aaf055d3c4e4c;hp=e129f193aff895e950146c72fe8568b30356a53c;hpb=6ec45f3776a574c07ffa70b69001f121c78afb57;p=catagits%2FCatalyst-Runtime.git diff --git a/t/aggregate/unit_core_script_server.t b/t/aggregate/unit_core_script_server.t index e129f19..5414fd1 100644 --- a/t/aggregate/unit_core_script_server.t +++ b/t/aggregate/unit_core_script_server.t @@ -12,7 +12,8 @@ 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 @@ -23,48 +24,110 @@ 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 -testOption( [ qw/--fork/ ], ['3000', 'localhost', opthash(fork => 1)] ); -testOption( [ qw/-f/ ], ['3000', 'localhost', opthash(fork => 1)] ); +testOption( [ qw/--fork/ ], ['3000', undef, opthash(fork => 1)] ); +testOption( [ qw/-f/ ], ['3000', undef, 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")] ); +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 -testOption( [ qw/-k/ ], ['3000', 'localhost', opthash(keepalive => 1)] ); -testOption( [ qw/--keepalive/ ], ['3000', 'localhost', opthash(keepalive => 1)] ); +testOption( [ qw/-k/ ], ['3000', undef, opthash(keepalive => 1)] ); +testOption( [ qw/--keepalive/ ], ['3000', undef, 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)] ); +testOption( [ qw/--follow_symlinks/ ], ['3000', undef, opthash(follow_symlinks => 1)] ); +testOption( [ qw/--sym/ ], ['3000', undef, opthash(follow_symlinks => 1)] ); # background -background --bg --background -testOption( [ qw/--background/ ], ['3000', 'localhost', opthash(background => 1)] ); -testOption( [ qw/--bg/ ], ['3000', 'localhost', opthash(background => 1)] ); +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 -# restart dir -restartdirectory --rdir --restart_directory -# restart regex -rr -restartregex --rxp --restart_regex +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 +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/) ); + +local $ENV{TESTAPPTOTESTSCRIPTS_RESTARTER}; +local $ENV{CATALYST_RESTARTER}; +{ + is _build_testapp([])->restarter_class, 'Catalyst::Restarter', 'default restarter with no $ENV{CATALYST_RESTARTER}'; +} +{ + local $ENV{CATALYST_RESTARTER} = "CatalystX::Restarter::Other"; + is _build_testapp([])->restarter_class, $ENV{CATALYST_RESTARTER}, 'override restarter with $ENV{CATALYST_RESTARTER}'; +} +{ + local $ENV{TESTAPPTOTESTSCRIPTS_RESTARTER} = "CatalystX::Restarter::Other2"; + is _build_testapp([])->restarter_class, $ENV{TESTAPPTOTESTSCRIPTS_RESTARTER}, 'override restarter with $ENV{TESTAPPTOTESTSCRIPTS_RESTARTER}'; +} 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); +} + +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 { - 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"; + $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 @@ -78,3 +141,10 @@ sub opthash { @_, }; } + +sub restartopthash { + return { + follow_symlinks => 0, + @_, + }; +}