line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test::Mojo::WithRoles; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
26673
|
use Mojo::Base -strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
8
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
our $VERSION = '0.02'; |
6
|
|
|
|
|
|
|
$VERSION = eval $VERSION; |
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
646
|
use Role::Tiny (); |
|
1
|
|
|
|
|
3249
|
|
|
1
|
|
|
|
|
35
|
|
9
|
1
|
|
|
1
|
|
972
|
use Test::Mojo; |
|
1
|
|
|
|
|
234527
|
|
|
1
|
|
|
|
|
11
|
|
10
|
|
|
|
|
|
|
|
11
|
1
|
|
|
1
|
|
30
|
use Mojo::JSON 'j'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
260
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub import { |
14
|
3
|
|
|
3
|
|
401
|
my ($class, @roles) = @_; |
15
|
3
|
50
|
|
|
|
4
|
@roles = map { s/^\+// ? $_ : "Test::Mojo::Role::$_" } @roles; |
|
2
|
|
|
|
|
10
|
|
16
|
3
|
|
|
|
|
9
|
$^H{'Test::Mojo::WithRoles/enabled'} = j(\@roles); |
17
|
|
|
|
|
|
|
} |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub unimport { |
20
|
0
|
|
|
0
|
|
0
|
my ($class) = @_; |
21
|
0
|
|
|
|
|
0
|
$^H{'Test::Mojo::WithRoles/enabled'} = '[]'; |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub new { |
25
|
5
|
|
|
5
|
0
|
7207
|
my $class = shift; |
26
|
5
|
|
|
|
|
46
|
my $hints = (caller(0))[10]; |
27
|
5
|
|
50
|
|
|
34
|
my $roles = j($hints->{'Test::Mojo::WithRoles/enabled'} || '[]'); |
28
|
5
|
100
|
|
|
|
436
|
@$roles = 'Test::Mojo::Role::Null' unless @$roles; |
29
|
5
|
|
|
|
|
21
|
return Role::Tiny->create_class_with_roles('Test::Mojo', @$roles)->new(@_); |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
1; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head1 NAME |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
Test::Mojo::WithRoles - Use Test::Mojo roles cleanly and safely |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
=head1 SYNOPSIS |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
package Test::Mojo::Role::MyRole; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
use Role::Tiny; |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
sub is_awesome { |
45
|
|
|
|
|
|
|
my ($t, ...) = @_; |
46
|
|
|
|
|
|
|
# do some test |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
--- |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
# myapp.t |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
use Test::More; |
54
|
|
|
|
|
|
|
use Test::Mojo::WithRoles 'MyRole'; |
55
|
|
|
|
|
|
|
my $t = Test::Mojo::WithRoles->new('MyApp'); |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
$t->get_ok(...) |
58
|
|
|
|
|
|
|
->is_awesome(...); |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
done_testing; |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=head1 DESCRIPTION |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
L builds composite subclasses of L based on a lexically specified set of roles. |
65
|
|
|
|
|
|
|
This is easy to use and plays nicely with others. |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
Of course this is all just sugar for the mechanisms provided by L. |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head1 IMPORTING |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
{ |
72
|
|
|
|
|
|
|
use Test::Mojo::WithRoles qw/MyRole +Test::MyRole/; |
73
|
|
|
|
|
|
|
my $t = Test::Mojo::WithRoles->new('MyApp'); |
74
|
|
|
|
|
|
|
$t->does('Test::Mojo::Role::MyRole'); # true |
75
|
|
|
|
|
|
|
$t->does('Test::MyRole'); # true |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
my $t = Test::Mojo::WithRoles->new; |
79
|
|
|
|
|
|
|
$t->does('Test::Mojo::Role::MyRole'); # false |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
Pass a list of roles when you import L. |
82
|
|
|
|
|
|
|
Those roles will be used to construct a subclass of L with those roles when C is called within that lexical scope. |
83
|
|
|
|
|
|
|
After leaving that lexical scope, the roles specified are no longer in effect I. |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
Roles specified without a leading C<+> sign are assumed to be in the C namespace. |
86
|
|
|
|
|
|
|
Roles specified with a leading C<+> sign are used literally as the fully qualified package name. |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=head1 SEE ALSO |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=over |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=item L |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=item L |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=item L |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=back |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=head1 SOURCE REPOSITORY |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
L |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=head1 AUTHOR |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
Joel Berger, Ejoel.a.berger@gmail.comE |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
Copyright (C) 2015 by Joel Berger |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
113
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
114
|
|
|
|
|
|
|
|