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 # 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
  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