lib/Reaction/Test.pm

   1 package Reaction::Test;
   2
   3 use base qw/Test::Class Reaction::Object/;
   4 use Reaction::Class;
   5
   6 sub simple_mock_context {
   7   my ($q_p, $b_p, $path) = ({}, {}, 'test/path');
   8   my $req = bless({
   9     query_parameters => sub { $q_p }, body_parameters => sub { $b_p },
  10     path => sub { shift; $path = shift if @_; $path; },
  11   }, 'Reaction::Test::Mock::Request');
  12   my %res_info = (content_type => '', body => '', status => 200, headers => {});
  13   my $res = bless({
  14     (map {
  15       my $key = $_;
  16       ($key => sub { shift; $res_info{$key} = shift if @_; $res_info{$key} });
  17     } keys %res_info),
  18     header => sub {
  19       shift; my $h = shift;
  20       $res_info{headers}{$h} = shift if @_;
  21       $res_info{headers}{$h};
  22     },
  23   }, 'Reaction::Test::Mock::Response');
  24   return bless({
  25     req => sub { $req }, res => sub { $res },
  26   }, 'Reaction::Test::Mock::Context');
  27 }
  28
  29 =head1 NAME
  30
  31 Reaction::Test
  32
  33 =head1 DESCRIPTION
  34
  35 =head1 AUTHORS
  36
  37 See L<Reaction::Class> for authors.
  38
  39 =head1 LICENSE
  40
  41 See L<Reaction::Class> for the license.
  42
  43 =cut
  44
  45
  46 package Reaction::Test::Mock::Context;
  47
  48 sub isa {
  49   shift; return 1 if (shift eq 'Catalyst');
  50 }
  51
  52 sub view {
  53   return $_[0]->{view}->(@_);
  54 }
  55
  56 sub req {
  57   return $_[0]->{req}->(@_);
  58 }
  59
  60 sub res {
  61   return $_[0]->{res}->(@_);
  62 }
  63
  64 package Reaction::Test::Mock::Request;
  65
  66 sub query_parameters {
  67   return $_[0]->{query_parameters}->(@_);
  68 }
  69
  70 sub body_parameters {
  71   return $_[0]->{body_parameters}->(@_);
  72 }
  73
  74 sub path {
  75   return $_[0]->{path}->(@_);
  76 }
  77
  78 package Reaction::Test::Mock::Response;
  79
  80 sub body {
  81   return $_[0]->{body}->(@_);
  82 }
  83
  84 sub content_type {
  85   return $_[0]->{content_type}->(@_);
  86 }
  87
  88 sub status {
  89   return $_[0]->{status}->(@_);
  90 }
  91
  92 sub headers {
  93   return $_[0]->{headers}->(@_);
  94 }
  95
  96 sub header {
  97   return $_[0]->{header}->(@_);
  98 }
  99
 100 1;