lib/Catalyst/Test.pm

   1 package Catalyst::Test;
   2
   3 use strict;
   4 use UNIVERSAL::require;
   5
   6 require Catalyst;
   7
   8 my $class;
   9 $ENV{CATALYST_ENGINE} = 'Test';
  10
  11 =head1 NAME
  12
  13 Catalyst::Test - Test Catalyst applications
  14
  15 =head1 SYNOPSIS
  16
  17     # Helper
  18     script/test.pl
  19
  20     # Tests
  21     use Catalyst::Test 'TestApp';
  22     request('index.html');
  23     get('index.html');
  24
  25     # Request
  26     perl -MCatalyst::Test=MyApp -e1 index.html
  27
  28 =head1 DESCRIPTION
  29
  30 Test Catalyst applications.
  31
  32 =head2 METHODS
  33
  34 =head3 get
  35
  36 Returns the content.
  37
  38     my $content = get('foo/bar?test=1');
  39
  40 =head3 request
  41
  42 Returns a C<HTTP::Response> object.
  43
  44     my $res =request('foo/bar?test=1');
  45
  46 =cut
  47
  48 {
  49     no warnings;
  50     CHECK {
  51         if ( ( caller(0) )[1] eq '-e' ) {
  52             print request( $ARGV[0] || 'http://localhost' )->content;
  53         }
  54     }
  55 }
  56
  57 sub import {
  58     my $self = shift;
  59     if ( $class = shift ) {
  60         $class->require;
  61         unless ( $INC{'Test/Builder.pm'} ) {
  62             die qq/Couldn't load "$class", "$@"/ if $@;
  63         }
  64
  65         no strict 'refs';
  66
  67         unless ( $class->engine->isa('Catalyst::Engine::Test') ) {
  68             require Catalyst::Engine::Test;
  69             splice( @{"$class\::ISA"}, @{"$class\::ISA"} - 1,
  70                 0, 'Catalyst::Engine::Test' );
  71         }
  72
  73         my $caller = caller(0);
  74         *{"$caller\::request"} = sub { $class->run(@_) };
  75         *{"$caller\::get"}     = sub { $class->run(@_)->content };
  76     }
  77 }
  78
  79 =head1 SEE ALSO
  80
  81 L<Catalyst>.
  82
  83 =head1 AUTHOR
  84
  85 Sebastian Riedel, C<sri@cpan.org>
  86
  87 =head1 COPYRIGHT
  88
  89 This program is free software, you can redistribute it and/or modify it under
  90 the same terms as Perl itself.
  91
  92 =cut
  93
  94 1;