1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
package TestApp;
use strict;
use Catalyst qw/
Test::MangleDollarUnderScore
Test::Errors
Test::Headers
Test::Plugin
Test::Inline
+TestApp::Plugin::FullyQualified
+TestApp::Plugin::AddDispatchTypes
+TestApp::Role
/;
use Catalyst::Utils;
use Class::Load 'try_load_class';
use Moose;
use namespace::clean -except => [ 'meta' ];
# -----------
# t/aggregate/unit_core_ctx_attr.t pukes until lazy is true
package Greeting;
use Moose;
sub hello_notlazy { 'hello there' }
sub hello_lazy { 'hello there' }
package TestApp;
has 'my_greeting_obj_notlazy' => (
is => 'ro',
isa => 'Greeting',
default => sub { Greeting->new() },
handles => [ qw( hello_notlazy ) ],
lazy => 0,
);
has 'my_greeting_obj_lazy' => (
is => 'ro',
isa => 'Greeting',
default => sub { Greeting->new() },
handles => [ qw( hello_lazy ) ],
lazy => 1,
);
# -----------
our $VERSION = '0.01';
TestApp->config(
name => 'TestApp',
root => '/some/dir',
use_request_uri_for_path => 1,
'Controller::Action::Action' => {
action_args => {
action_action_nine => { another_extra_arg => 13 }
}
},
encoding => 'UTF-8',
abort_chain_on_error_fix => 1,
);
# Test bug found when re-adjusting the metaclass compat code in Moose
# in 292360. Test added to Moose in 4b760d6, but leave this attribute
# above ->setup so we have some generated methods to be double sure.
has an_attribute_before_we_change_base_classes => ( is => 'ro');
if ($::setup_leakchecker) {
require Scalar::Util;
require Devel::Cycle;
has leaks => (
is => 'ro',
default => sub { [] },
);
sub count_leaks {
my ($ctx) = @_;
return scalar @{ $ctx->leaks };
}
after finalize => sub {
my ($ctx) = @_;
my @leaks;
my $weak_ctx = $ctx;
Scalar::Util::weaken $weak_ctx;
Devel::Cycle::find_cycle($ctx, sub {
my ($path) = @_;
push @leaks, $path
if $path->[0]->[2] == $weak_ctx;
});
push @{ $ctx->leaks }, @leaks;
};
}
TestApp->setup;
sub execute {
my $c = shift;
my $class = ref( $c->component( $_[0] ) ) || $_[0];
my $action = $_[1]->reverse;
my $method;
if ( $action =~ /->(\w+)$/ ) {
$method = $1;
}
elsif ( $action =~ /\/(\w+)$/ ) {
$method = $1;
}
elsif ( $action =~ /^(\w+)$/ ) {
$method = $action;
}
if ( $class && $method && $method !~ /^_/ ) {
my $executed = sprintf( "%s->%s", $class, $method );
my @executed = $c->response->headers->header('X-Catalyst-Executed');
push @executed, $executed;
$c->response->headers->header(
'X-Catalyst-Executed' => join ', ',
@executed
);
}
no warnings 'recursion';
return $c->SUPER::execute(@_);
}
# Replace the very large HTML error page with
# useful info if something crashes during a test
sub finalize_error {
my $c = shift;
$c->next::method(@_);
$c->res->status(500);
$c->res->body( 'FATAL ERROR: ' . join( ', ', @{ $c->error } ) );
}
{
no warnings 'redefine';
sub Catalyst::Log::error { }
}
# Pretend to be Plugin::Session and hook finalize_headers to send a header
sub finalize_headers {
my $c = shift;
$c->res->header('X-Test-Header', 'valid');
my $call_count = $c->stash->{finalize_headers_call_count} || 0;
$call_count++;
$c->stash(finalize_headers_call_count => $call_count);
$c->res->header('X-Test-Header-Call-Count' => $call_count);
return $c->maybe::next::method(@_);
}
# Make sure we can load Inline plugins.
package Catalyst::Plugin::Test::Inline;
use Moose;
1;
|
