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     testBackgroundOptionWithFork( [ qw/--background/ ]);
  64     testBackgroundOptionWithFork( [ qw/--bg/ ]);
  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
 117     shift @TestAppToTestScripts::RUN_ARGS;
 118     my $server = pop @TestAppToTestScripts::RUN_ARGS;
 119     like ref($server), qr/^Plack::Handler/, 'Is a Plack::Handler';
 120
 121     my @run_args =  @TestAppToTestScripts::RUN_ARGS;
 122     $run_args[-1]->{pidfile} = $run_args[-1]->{pidfile}->file->stringify
 123       if scalar(@run_args) && $run_args[-1]->{pidfile};
 124
 125
 126     # Mangle argv into the options..
 127     $resultarray->[-1]->{argv} = $argstring;
 128     is_deeply \@run_args, $resultarray, "is_deeply comparison " . join(' ', @$argstring);
 129 }
 130
 131 sub testBackgroundOptionWithFork {
 132     my ($argstring) = @_;
 133
 134     ## First, make sure we can get an app
 135     my $app = _build_testapp($argstring);
 136
 137     ## Sorry, don't really fork since this cause trouble in Test::Aggregate
 138     $app->meta->add_around_method_modifier('daemon_fork', sub { return; });
 139
 140     try {
 141         $app->run;
 142     }
 143     catch {
 144         fail $_;
 145     };
 146
 147     ## Check a few args
 148     is_deeply $app->{ARGV}, $argstring;
 149     is $app->{port}, '3000';
 150     is($app->{background}, 1);
 151 }
 152
 153 sub testRestart {
 154     my ($argstring, $resultarray) = @_;
 155     my $app = _build_testapp($argstring);
 156     ok $app->restart, 'App is in restart mode';
 157     my $args = {$app->_restarter_args};
 158     is_deeply delete $args->{argv}, $argstring, 'argv is arg string';
 159     is ref(delete $args->{start_sub}), 'CODE', 'Closure to start app present';
 160     is_deeply $args, $resultarray, "is_deeply comparison of restarter args " . join(' ', @$argstring);
 161 }
 162
 163 sub _build_testapp {
 164     my ($argstring, $resultarray) = @_;
 165
 166     local @ARGV = @$argstring;
 167     local @TestAppToTestScripts::RUN_ARGS;
 168     my $i;
 169     try {
 170         $i = Catalyst::Script::Server->new_with_options(application_name => 'TestAppToTestScripts');
 171         pass "new_with_options " . join(' ', @$argstring);
 172     }
 173     catch {
 174         fail "new_with_options " . join(' ', @$argstring) . " " . $_;
 175     };
 176     ok $i;
 177     return $i;
 178 }
 179
 180 # Returns the hash expected when no flags are passed
 181 sub opthash {
 182     return {
 183         'pidfile' => undef,
 184         'fork' => 0,
 185         'follow_symlinks' => 0,
 186         'background' => 0,
 187         'keepalive' => 0,
 188         @_,
 189     };
 190 }
 191
 192 sub restartopthash {
 193     my $opthash = opthash(@_);
 194     my $val = {
 195         application_name => 'TestAppToTestScripts',
 196         port => '3000',
 197         debug => undef,
 198         host => undef,
 199         %$opthash,
 200     };
 201     return $val;
 202 }
 203
 204 1;
 205