t/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 'no_plan';
   8 use Test::Exception;
   9
  10 use Catalyst::Script::Server;
  11
  12 my $testopts;
  13
  14 # Test default (no opts/args behaviour)
  15 testOption( [ qw// ], ['3000', 'localhost', opthash()] );
  16
  17 # Old version supports long format opts with either one or two dashes.  New version only supports two.
  18 #                Old                       New
  19 # help           -? -help --help           -h --help
  20 # debug          -d -debug --debug         -d --debug
  21 # host           -host --host              --host
  22 testOption( [ qw/--host testhost/ ], ['3000', 'testhost', opthash()] );
  23 testOption( [ qw/-h testhost/ ], ['3000', 'testhost', opthash()] );
  24
  25 # port           -p -port --port           -l --listen
  26 testOption( [ qw/-p 3001/ ], ['3001', 'localhost', opthash()] );
  27 testOption( [ qw/--port 3001/ ], ['3001', 'localhost', opthash()] );
  28
  29 # fork           -f -fork --fork           -f --fork
  30 $testopts = opthash();
  31 $testopts->{fork} = 1;
  32 testOption( [ qw/--fork/ ], ['3000', 'localhost', $testopts] );
  33 testOption( [ qw/-f/ ], ['3000', 'localhost', $testopts] );
  34
  35 # pidfile        -pidfile                  --pid --pidfile
  36 $testopts = opthash();
  37 $testopts->{pidfile} = "cat.pid";
  38 testOption( [ qw/--pidfile cat.pid/ ], ['3000', 'localhost', $testopts] );
  39
  40 # keepalive      -k -keepalive --keepalive -k --keepalive
  41 $testopts = opthash();
  42 $testopts->{keepalive} = 1;
  43 testOption( [ qw/-k/ ], ['3000', 'localhost', $testopts] );
  44 testOption( [ qw/--keepalive/ ], ['3000', 'localhost', $testopts] );
  45
  46 # symlinks       -follow_symlinks          --sym --follow_symlinks
  47 $testopts = opthash();
  48 $testopts->{follow_symlinks} = 1;
  49 testOption( [ qw/--follow_symlinks/ ], ['3000', 'localhost', $testopts] );
  50
  51 # background     -background               --bg --background
  52 $testopts = opthash();
  53 $testopts->{background} = 1;
  54 testOption( [ qw/--background/ ], ['3000', 'localhost', $testopts] );
  55
  56 # Restart stuff requires a threaded perl, apparently.
  57 # restart        -r -restart --restart     -R --restart
  58 # restart dly    -rd -restartdelay         --rdel --restart_delay
  59 # restart dir    -restartdirectory         --rdir --restart_directory
  60 # restart regex  -rr -restartregex         --rxp --restart_regex
  61
  62
  63 sub testOption {
  64     my ($argstring, $resultarray) = @_;
  65
  66     subtest "Test for ARGV: @$argstring" => sub
  67         {
  68             plan tests => 2;
  69             local @ARGV = @$argstring;
  70             local @TestAppToTestScripts::RUN_ARGS;
  71             lives_ok {
  72                 Catalyst::Script::Server->new_with_options(application_name => 'TestAppToTestScripts')->run;
  73             } "new_with_options";
  74             # First element of RUN_ARGS will be the script name, which we don't care about
  75             shift @TestAppToTestScripts::RUN_ARGS;
  76             is_deeply \@TestAppToTestScripts::RUN_ARGS, $resultarray, "is_deeply comparison";
  77             done_testing;
  78         };
  79 }
  80
  81 # Returns the hash expected when no flags are passed
  82 sub opthash {
  83     return { 'pidfile' => undef,
  84              'fork' => undef,
  85              'follow_symlinks' => undef,
  86              'background' => undef,
  87              'keepalive' => undef,
  88          }
  89 }