Created
October 1, 2009 20:15
-
-
Save bobtfish/199215 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
use strict; | |
use warnings; | |
use Test::More; | |
use Test::Exception; | |
use Moose (); | |
use Moose::Object; | |
use Class::MOP::Class; | |
use Catalyst::Request; | |
use Catalyst::Response; | |
use Catalyst::Utils; | |
my $mock_ctx_meta = Class::MOP::Class->create_anon_class( superclasses => ['Moose::Object'] ); | |
$mock_ctx_meta->add_attribute('stash', accessor => 'stash', required => 1, default => sub { {} }); | |
$mock_ctx_meta->add_around_method_modifier( stash => sub { # Nicked straight from Catalyst.pm | |
my $orig = shift; | |
my $c = shift; | |
my $stash = $orig->($c); | |
if (@_) { | |
my $new_stash = @_ > 1 ? {@_} : $_[0]; | |
croak('stash takes a hash or hashref') unless ref $new_stash; | |
foreach my $key ( keys %$new_stash ) { | |
$stash->{$key} = $new_stash->{$key}; | |
} | |
} | |
return $stash; | |
}); | |
$mock_ctx_meta->add_attribute($_, accessor => $_, required => 1) for qw/request response/; | |
{ | |
my $ctx = $mock_ctx_meta->new_object; | |
ok $ctx; | |
$ctx->stash->{foo} = 'bar'; | |
is_deeply $ctx->stash, { foo => 'bar' }; | |
$ctx->stash(baz => 'quux'); | |
is_deeply $ctx->stash, { foo => 'bar', baz => 'quux' }; | |
} | |
our $ctx_gen = sub { | |
my ($cb, $stash) = @_; | |
$stash ||= {}; | |
my $ctx = $mock_ctx_meta->new_object( | |
response => Catalyst::Response->new, | |
request => Catalyst::Request->new, | |
stash => { %$stash }, # Shallow copy to try and help the user out. Should we clone? | |
); | |
$ctx->response->_context($ctx); | |
$ctx->request->_context($ctx); | |
$cb->($ctx) if $cb; | |
return $ctx; | |
}; | |
{ | |
my $ctx = $ctx_gen->(undef, { foo => 'bar' }); | |
ok $ctx; | |
$ctx->stash->{baz} = 'quux'; | |
is_deeply $ctx->stash, { foo => 'bar', baz => 'quux' }; | |
} | |
{ | |
my $ctx = $ctx_gen->(sub { shift->request->header('Allow', 'application/json') }); | |
is $ctx->request->header('Allow'), 'application/json'; | |
} | |
my $curry_ctx_gen = sub { | |
my ($ctx_gen, $cb, $stash) = @_; | |
sub { | |
my ($later_cb, $stash_rhs) = @_; | |
my $ctx = $ctx_gen->($cb, Catalyst::Utils::merge_hashes($stash, $stash_rhs)); | |
$later_cb->($ctx) if $later_cb; | |
return $ctx; | |
}; | |
}; | |
{ | |
local $ctx_gen = $curry_ctx_gen->( | |
$ctx_gen, | |
sub { | |
$_[0]->request->header('X-Set-First', 1); | |
$_[0]->request->header('X-Set-Second', 1); | |
}, | |
{ foo => 'baz', bar => 'quux' }, | |
); | |
# Note that the stuff curried in should happen _before_ the stuff in the ctx you get back | |
my $ctx = $ctx_gen->( | |
sub { shift->request->header('X-Set-First', 2) }, | |
{ foo => 'quux', frob => 'fnoo' } | |
); | |
is_deeply $ctx->stash, { foo => 'quux', bar => 'quux', frob => 'fnoo' }; | |
is $ctx->request->header('X-Set-First'), 2; | |
is $ctx->request->header('X-Set-Second'), 1; | |
# And lets take our already curried ctx generator and curry it again. | |
{ | |
local $ctx_gen = $curry_ctx_gen->( | |
$ctx_gen, | |
sub { shift->request->header('X-Set-Second', 2) }, | |
{ bar => 'fnoo' }, | |
); | |
# This is where we get powerful. Lets wrap some tests up in a function.. | |
my $combine_tests = sub { | |
my @tests = @_; | |
sub { | |
my $ctx = shift; | |
foreach my $t (@tests) { | |
$t->($ctx); | |
} | |
}; | |
}; | |
my $some_tests = sub { | |
my $ctx = shift; | |
is_deeply $ctx->stash, { foo => 'baz', bar => 'fnoo' }; | |
is $ctx->request->header('X-Set-First'), 1; | |
}; | |
my $some_more_tests = sub { | |
my $ctx = shift; | |
is $ctx->request->header('X-Set-Second'), 2; | |
}; | |
# And run a combined set of tests against a context | |
$combine_tests->($some_tests, $some_more_tests)->($ctx_gen->()); | |
} | |
} | |
done_testing; |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment