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