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 | |
97ae89ab |
16 | # redirect to a redirect |
17 | sub hello: Global { |
18 | my ( $self, $context ) = @_; |
19 | my $where = $context->uri_for('/'); |
20 | $context->response->redirect($where); |
21 | return; |
22 | } |
23 | |
6bc86362 |
24 | sub html { |
25 | my ( $title, $body ) = @_; |
26 | return qq[ |
27 | <html> |
28 | <head> |
29 | <meta http-equiv="Content-Type" content="text/html; charset=utf-8" /> |
30 | <title>$title</title> |
31 | </head> |
32 | <body>$body</body> |
33 | </html> |
34 | ]; |
35 | } |
36 | |
37 | # The Cat HTTP server background option is useless here :-( |
38 | # Thus we have to provide our own background method. |
39 | sub background { |
40 | my $self = shift; |
41 | my $port = shift; |
42 | my $child = fork; |
43 | die "Can't fork Cat HTTP server: $!" unless defined $child; |
44 | return $child if $child; |
45 | |
46 | if ( $^O !~ /MSWin32/ ) { |
47 | require POSIX; |
48 | POSIX::setsid() or die "Can't start a new session: $!"; |
49 | } |
50 | |
51 | $self->run($port); |
52 | } |
53 | |
54 | 1; |
55 | |