lib/Catalyst/Engine/Test.pm

   1 package Catalyst::Engine::Test;
   2
   3 use strict;
   4 use base 'Catalyst::Engine::HTTP::Base';
   5
   6 =head1 NAME
   7
   8 Catalyst::Engine::Test - Catalyst Test Engine
   9
  10 =head1 SYNOPSIS
  11
  12 A script using the Catalyst::Engine::Test module might look like:
  13
  14     #!/usr/bin/perl -w
  15
  16     BEGIN {
  17        $ENV{CATALYST_ENGINE} = 'Test';
  18     }
  19
  20     use strict;
  21     use lib '/path/to/MyApp/lib';
  22     use MyApp;
  23
  24     MyApp->run('/a/path');
  25
  26 =head1 DESCRIPTION
  27
  28 This is the Catalyst engine specialized for testing.
  29
  30 =head1 OVERLOADED METHODS
  31
  32 This class overloads some methods from C<Catalyst::Engine::HTTP::Base>.
  33
  34 =over 4
  35
  36 =item $c->run
  37
  38 =cut
  39
  40 sub run {
  41     my $class   = shift;
  42     my $request = shift || '/';
  43
  44     unless ( ref $request ) {
  45
  46         my $uri =
  47           ( $request =~ m/http/i )
  48           ? URI->new($request)
  49           : URI->new( 'http://localhost' . $request );
  50
  51         $request = $uri->canonical;
  52     }
  53
  54     unless ( ref $request eq 'HTTP::Request' ) {
  55         $request = HTTP::Request->new( 'GET', $request );
  56     }
  57
  58     my $host = sprintf( '%s:%d', $request->uri->host, $request->uri->port );
  59     $request->header( 'Host' => $host );
  60
  61     my $http = Catalyst::Engine::Test::HTTP->new(
  62         address  => '127.0.0.1',
  63         hostname => 'localhost',
  64         request  => $request,
  65         response => HTTP::Response->new
  66     );
  67
  68     $http->response->date(time);
  69
  70     $class->handler($http);
  71
  72     return $http->response;
  73 }
  74
  75 =back
  76
  77 =head1 SEE ALSO
  78
  79 L<Catalyst>.
  80
  81 =head1 AUTHOR
  82
  83 Sebastian Riedel, C<sri@cpan.org>
  84 Christian Hansen, C<ch@ngmedia.com>
  85
  86 =head1 COPYRIGHT
  87
  88 This program is free software, you can redistribute it and/or modify it under
  89 the same terms as Perl itself.
  90
  91 =cut
  92
  93 1;