Commit | Line | Data |
60b86a55 |
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 | |
f3bf2976 |
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 | }; |
60b86a55 |
79 | } |
80 | |
f3bf2976 |
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 | } |
60b86a55 |
89 | } |