1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
use strict;
use warnings;
use FindBin qw/$Bin/;
use lib "$Bin/../lib";
use Test::More;
use Test::Exception;
use Catalyst::Script::Server;
my $testopts;
# Test default (no opts/args behaviour)
# Note undef for host means we bind to all interfaces.
testOption( [ qw// ], ['3000', undef, opthash()] );
# Old version supports long format opts with either one or two dashes. New version only supports two.
# Old New
# help -? -help --help -? --help
# debug -d -debug --debug -d --debug
# host -host --host --host
testOption( [ qw/--host testhost/ ], ['3000', 'testhost', opthash()] );
testOption( [ qw/-h testhost/ ], ['3000', 'testhost', opthash()] );
# port -p -port --port -l --listen
testOption( [ qw/-p 3001/ ], ['3001', undef, opthash()] );
testOption( [ qw/--port 3001/ ], ['3001', undef, opthash()] );
{
local $ENV{TESTAPPTOTESTSCRIPTS_PORT} = 5000;
testOption( [ qw// ], [5000, undef, opthash()] );
}
{
local $ENV{CATALYST_PORT} = 5000;
testOption( [ qw// ], [5000, undef, opthash()] );
}
# fork -f -fork --fork -f --fork
testOption( [ qw/--fork/ ], ['3000', undef, opthash(fork => 1)] );
testOption( [ qw/-f/ ], ['3000', undef, opthash(fork => 1)] );
# pidfile -pidfile --pid --pidfile
testOption( [ qw/--pidfile cat.pid/ ], ['3000', undef, opthash(pidfile => "cat.pid")] );
testOption( [ qw/--pid cat.pid/ ], ['3000', undef, opthash(pidfile => "cat.pid")] );
# keepalive -k -keepalive --keepalive -k --keepalive
testOption( [ qw/-k/ ], ['3000', undef, opthash(keepalive => 1)] );
testOption( [ qw/--keepalive/ ], ['3000', undef, opthash(keepalive => 1)] );
# symlinks -follow_symlinks --sym --follow_symlinks
testOption( [ qw/--follow_symlinks/ ], ['3000', undef, opthash(follow_symlinks => 1)] );
testOption( [ qw/--sym/ ], ['3000', undef, opthash(follow_symlinks => 1)] );
# background -background --bg --background
testOption( [ qw/--background/ ], ['3000', undef, opthash(background => 1)] );
testOption( [ qw/--bg/ ], ['3000', undef, opthash(background => 1)] );
# restart -r -restart --restart -R --restart
testRestart( ['-r'], restartopthash() );
{
local $ENV{TESTAPPTOTESTSCRIPTS_RELOAD} = 1;
testRestart( [], restartopthash() );
}
{
local $ENV{CATALYST_RELOAD} = 1;
testRestart( [], restartopthash() );
}
# restart dly -rd -restartdelay --rd --restart_delay
testRestart( ['-r', '--rd', 30], restartopthash(sleep_interval => 30) );
testRestart( ['-r', '--restart_delay', 30], restartopthash(sleep_interval => 30) );
# restart dir -restartdirectory --rdir --restart_directory
testRestart( ['-r', '--rdir', 'root'], restartopthash(directories => ['root']) );
testRestart( ['-r', '--rdir', 'root', '--rdir', 'lib'], restartopthash(directories => ['root', 'lib']) );
testRestart( ['-r', '--restart_directory', 'root'], restartopthash(directories => ['root']) );
# restart regex -rr -restartregex --rr --restart_regex
testRestart( ['-r', '--rr', 'foo'], restartopthash(filter => qr/foo/) );
testRestart( ['-r', '--restart_regex', 'foo'], restartopthash(filter => qr/foo/) );
done_testing;
sub testOption {
my ($argstring, $resultarray) = @_;
my $app = _build_testapp($argstring);
lives_ok {
$app->run;
};
# First element of RUN_ARGS will be the script name, which we don't care about
shift @TestAppToTestScripts::RUN_ARGS;
# Mangle argv into the options..
$resultarray->[-1]->{argv} = $argstring;
is_deeply \@TestAppToTestScripts::RUN_ARGS, $resultarray, "is_deeply comparison " . join(' ', @$argstring);
}
sub testRestart {
my ($argstring, $resultarray) = @_;
my $app = _build_testapp($argstring);
ok $app->restart, 'App is in restart mode';
my $args = {$app->_restarter_args};
is_deeply delete $args->{argv}, $argstring, 'argv is arg string';
is ref(delete $args->{start_sub}), 'CODE', 'Closure to start app present';
is_deeply $args, $resultarray, "is_deeply comparison of restarter args " . join(' ', @$argstring);
}
sub _build_testapp {
my ($argstring, $resultarray) = @_;
local @ARGV = @$argstring;
local @TestAppToTestScripts::RUN_ARGS;
my $i;
lives_ok {
$i = Catalyst::Script::Server->new_with_options(application_name => 'TestAppToTestScripts');
} "new_with_options " . join(' ', @$argstring);;
ok $i;
return $i;
}
# Returns the hash expected when no flags are passed
sub opthash {
return {
'pidfile' => undef,
'fork' => 0,
'follow_symlinks' => 0,
'background' => 0,
'keepalive' => 0,
@_,
};
}
sub restartopthash {
return {
follow_symlinks => 0,
@_,
};
}
|
