t/aggregate/unit_core_script_server.t

   1 use strict;
   2 use warnings;
   3
   4 use FindBin qw/$Bin/;
   5 use lib "$Bin/../lib";
   6
   7 use Test::More;
   8 use Try::Tiny;
   9
  10 use Catalyst::Script::Server;
  11
  12 my $testopts;
  13
  14 # Test default (no opts/args behaviour)
  15 # Note undef for host means we bind to all interfaces.
  16 testOption( [ qw// ], ['3000', undef, opthash()] );
  17
  18 # Old version supports long format opts with either one or two dashes.  New version only supports two.
  19 #                Old                       New
  20 # help           -? -help --help           -? --help
  21 # debug          -d -debug --debug         -d --debug
  22 # host           -host --host              --host
  23 testOption( [ qw/--host testhost/ ], ['3000', 'testhost', opthash()] );
  24 testOption( [ qw/-h testhost/ ], ['3000', 'testhost', opthash()] );
  25
  26 # port           -p -port --port           -l --listen
  27 testOption( [ qw/-p 3001/ ], ['3001', undef, opthash()] );
  28 testOption( [ qw/--port 3001/ ], ['3001', undef, opthash()] );
  29 {
  30     local $ENV{TESTAPPTOTESTSCRIPTS_PORT} = 5000;
  31     testOption( [ qw// ], [5000, undef, opthash()] );
  32 }
  33 {
  34     local $ENV{CATALYST_PORT} = 5000;
  35     testOption( [ qw// ], [5000, undef, opthash()] );
  36 }
  37
  38 if (try { require Starman; 1; }) {
  39     # fork           -f -fork --fork           -f --fork
  40     testOption( [ qw/--fork/ ], ['3000', undef, opthash(fork => 1)] );
  41     testOption( [ qw/-f/ ], ['3000', undef, opthash(fork => 1)] );
  42 }
  43
  44 if (try { require MooseX::Daemonize; 1; }) {
  45     # pidfile        -pidfile                  --pid --pidfile
  46     testOption( [ qw/--pidfile cat.pid/ ], ['3000', undef, opthash(pidfile => "cat.pid")] );
  47     testOption( [ qw/--pid cat.pid/ ], ['3000', undef, opthash(pidfile => "cat.pid")] );
  48 }
  49
  50 if (try { require Starman; 1; }) {
  51     # keepalive      -k -keepalive --keepalive -k --keepalive
  52     testOption( [ qw/-k/ ], ['3000', undef, opthash(keepalive => 1)] );
  53     testOption( [ qw/--keepalive/ ], ['3000', undef, opthash(keepalive => 1)] );
  54 }
  55
  56 # symlinks       -follow_symlinks          --sym --follow_symlinks
  57 #
  58 testOption( [ qw/--sym/ ], ['3000', undef, opthash(follow_symlinks => 1)] );
  59 testOption( [ qw/--follow_symlinks/ ], ['3000', undef, opthash(follow_symlinks => 1)] );
  60
  61 if (try { require MooseX::Daemonize; 1; }) {
  62     # background     -background               --bg --background
  63     testOption( [ qw/--background/ ], ['3000', undef, opthash(background => 1)] );
  64     testOption( [ qw/--bg/ ], ['3000', undef, opthash(background => 1)] );
  65 }
  66
  67 # restart        -r -restart --restart     -R --restart
  68 testRestart( ['-r'], restartopthash() );
  69 {
  70     local $ENV{TESTAPPTOTESTSCRIPTS_RELOAD} = 1;
  71     testRestart( [], restartopthash() );
  72 }
  73 {
  74     local $ENV{CATALYST_RELOAD} = 1;
  75     testRestart( [], restartopthash() );
  76 }
  77
  78 # restart dly    -rd -restartdelay         --rd --restart_delay
  79 testRestart( ['-r', '--rd', 30], restartopthash(sleep_interval => 30) );
  80 testRestart( ['-r', '--restart_delay', 30], restartopthash(sleep_interval => 30) );
  81
  82 # restart dir    -restartdirectory         --rdir --restart_directory
  83 testRestart( ['-r', '--rdir', 'root'], restartopthash(directories => ['root']) );
  84 testRestart( ['-r', '--rdir', 'root', '--rdir', 'lib'], restartopthash(directories => ['root', 'lib']) );
  85 testRestart( ['-r', '--restart_directory', 'root'], restartopthash(directories => ['root']) );
  86
  87 # restart regex  -rr -restartregex         --rr --restart_regex
  88 testRestart( ['-r', '--rr', 'foo'], restartopthash(filter => qr/foo/) );
  89 testRestart( ['-r', '--restart_regex', 'foo'], restartopthash(filter => qr/foo/) );
  90
  91 local $ENV{TESTAPPTOTESTSCRIPTS_RESTARTER};
  92 local $ENV{CATALYST_RESTARTER};
  93 {
  94     is _build_testapp([])->restarter_class, 'Catalyst::Restarter', 'default restarter with no $ENV{CATALYST_RESTARTER}';
  95 }
  96 {
  97     local $ENV{CATALYST_RESTARTER} = "CatalystX::Restarter::Other";
  98     is _build_testapp([])->restarter_class, $ENV{CATALYST_RESTARTER}, 'override restarter with $ENV{CATALYST_RESTARTER}';
  99 }
 100 {
 101     local $ENV{TESTAPPTOTESTSCRIPTS_RESTARTER} = "CatalystX::Restarter::Other2";
 102     is _build_testapp([])->restarter_class, $ENV{TESTAPPTOTESTSCRIPTS_RESTARTER}, 'override restarter with $ENV{TESTAPPTOTESTSCRIPTS_RESTARTER}';
 103 }
 104 done_testing;
 105
 106 sub testOption {
 107     my ($argstring, $resultarray) = @_;
 108     my $app = _build_testapp($argstring);
 109     try {
 110         $app->run;
 111     }
 112     catch {
 113         fail $_;
 114     };
 115     # First element of RUN_ARGS will be the script name, which we don't care about
 116     shift @TestAppToTestScripts::RUN_ARGS;
 117     my $server = pop @TestAppToTestScripts::RUN_ARGS;
 118     like ref($server), qr/^Plack::Handler/, 'Is a Plack::Handler';
 119
 120     my @run_args =  @TestAppToTestScripts::RUN_ARGS;
 121     $run_args[-1]->{pidfile} = $run_args[-1]->{pidfile}->file->stringify
 122       if scalar(@run_args) && $run_args[-1]->{pidfile};
 123
 124
 125     # Mangle argv into the options..
 126     $resultarray->[-1]->{argv} = $argstring;
 127     is_deeply \@run_args, $resultarray, "is_deeply comparison " . join(' ', @$argstring);
 128 }
 129
 130 sub testRestart {
 131     my ($argstring, $resultarray) = @_;
 132     my $app = _build_testapp($argstring);
 133     ok $app->restart, 'App is in restart mode';
 134     my $args = {$app->_restarter_args};
 135     is_deeply delete $args->{argv}, $argstring, 'argv is arg string';
 136     is ref(delete $args->{start_sub}), 'CODE', 'Closure to start app present';
 137     is_deeply $args, $resultarray, "is_deeply comparison of restarter args " . join(' ', @$argstring);
 138 }
 139
 140 sub _build_testapp {
 141     my ($argstring, $resultarray) = @_;
 142
 143     local @ARGV = @$argstring;
 144     local @TestAppToTestScripts::RUN_ARGS;
 145     my $i;
 146     try {
 147         $i = Catalyst::Script::Server->new_with_options(application_name => 'TestAppToTestScripts');
 148         pass "new_with_options " . join(' ', @$argstring);
 149     }
 150     catch {
 151         fail "new_with_options " . join(' ', @$argstring) . " " . $_;
 152     };
 153     ok $i;
 154     return $i;
 155 }
 156
 157 # Returns the hash expected when no flags are passed
 158 sub opthash {
 159     return {
 160         'pidfile' => undef,
 161         'fork' => 0,
 162         'follow_symlinks' => 0,
 163         'background' => 0,
 164         'keepalive' => 0,
 165         @_,
 166     };
 167 }
 168
 169 sub restartopthash {
 170     my $opthash = opthash(@_);
 171     my $val = {
 172         application_name => 'TestAppToTestScripts',
 173         port => '3000',
 174         debug => undef,
 175         host => undef,
 176         %$opthash,
 177     };
 178     return $val;
 179 }