Commit | Line | Data |
6bc86362 |
1 | package ExternalCatty; |
2 | use strict; |
3 | use warnings; |
4 | use Catalyst qw/-Engine=HTTP/; |
5 | our $VERSION = '0.01'; |
6 | |
7 | __PACKAGE__->config( name => 'ExternalCatty' ); |
8 | __PACKAGE__->setup; |
9 | |
10 | sub default : Private { |
11 | my ( $self, $c ) = @_; |
12 | $c->response->content_type('text/html; charset=utf-8'); |
13 | $c->response->output( html( 'Root', 'Hello, test ☺!' ) ); |
14 | } |
15 | |
16 | sub html { |
17 | my ( $title, $body ) = @_; |
18 | return qq[ |
19 | <html> |
20 | <head> |
21 | <meta http-equiv="Content-Type" content="text/html; charset=utf-8" /> |
22 | <title>$title</title> |
23 | </head> |
24 | <body>$body</body> |
25 | </html> |
26 | ]; |
27 | } |
28 | |
29 | # The Cat HTTP server background option is useless here :-( |
30 | # Thus we have to provide our own background method. |
31 | sub background { |
32 | my $self = shift; |
33 | my $port = shift; |
34 | my $child = fork; |
35 | die "Can't fork Cat HTTP server: $!" unless defined $child; |
36 | return $child if $child; |
37 | |
38 | if ( $^O !~ /MSWin32/ ) { |
39 | require POSIX; |
40 | POSIX::setsid() or die "Can't start a new session: $!"; |
41 | } |
42 | |
43 | $self->run($port); |
44 | } |
45 | |
46 | 1; |
47 | |