t/lib/ExternalCatty.pm

   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