line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test::Inline::Content::Legacy; |
2
|
|
|
|
|
|
|
# ABSTRACT: Test::Inline 2 Content Handler for legacy functions |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
#pod =pod |
5
|
|
|
|
|
|
|
#pod |
6
|
|
|
|
|
|
|
#pod =head1 SYNOPSIS |
7
|
|
|
|
|
|
|
#pod |
8
|
|
|
|
|
|
|
#pod Custom script content generation using Test::Inline 2.000+ with a |
9
|
|
|
|
|
|
|
#pod custom generator functions |
10
|
|
|
|
|
|
|
#pod |
11
|
|
|
|
|
|
|
#pod my $header = "...."; |
12
|
|
|
|
|
|
|
#pod my $function = sub { |
13
|
|
|
|
|
|
|
#pod my $Object = shift; |
14
|
|
|
|
|
|
|
#pod my $Script = shift; |
15
|
|
|
|
|
|
|
#pod return $header . $Script->merged_content; |
16
|
|
|
|
|
|
|
#pod }; |
17
|
|
|
|
|
|
|
#pod |
18
|
|
|
|
|
|
|
#pod my $Inline = Test::Inline->new( |
19
|
|
|
|
|
|
|
#pod ... |
20
|
|
|
|
|
|
|
#pod file_content => $function, |
21
|
|
|
|
|
|
|
#pod ); |
22
|
|
|
|
|
|
|
#pod |
23
|
|
|
|
|
|
|
#pod Migrating this same code to Test::Inline 2.100+ ContentHandler objects |
24
|
|
|
|
|
|
|
#pod |
25
|
|
|
|
|
|
|
#pod my $header = "...."; |
26
|
|
|
|
|
|
|
#pod my $function = sub { |
27
|
|
|
|
|
|
|
#pod my $Object = shift; |
28
|
|
|
|
|
|
|
#pod my $Script = shift; |
29
|
|
|
|
|
|
|
#pod return $header . $Script->merged_content; |
30
|
|
|
|
|
|
|
#pod }; |
31
|
|
|
|
|
|
|
#pod |
32
|
|
|
|
|
|
|
#pod my $ContentHandler = Test::Inline::Content::Legacy->new( $function ); |
33
|
|
|
|
|
|
|
#pod |
34
|
|
|
|
|
|
|
#pod my $Inline = Test::Inline->new( |
35
|
|
|
|
|
|
|
#pod ... |
36
|
|
|
|
|
|
|
#pod ContentHandler => $ContentHandler, |
37
|
|
|
|
|
|
|
#pod ); |
38
|
|
|
|
|
|
|
#pod |
39
|
|
|
|
|
|
|
#pod =head1 DESCRIPTION |
40
|
|
|
|
|
|
|
#pod |
41
|
|
|
|
|
|
|
#pod This class exists to provide a migration path for anyone using the custom |
42
|
|
|
|
|
|
|
#pod script generators in Test::Inline via the C param. |
43
|
|
|
|
|
|
|
#pod |
44
|
|
|
|
|
|
|
#pod The synopsis above pretty much says all you need to know. |
45
|
|
|
|
|
|
|
#pod |
46
|
|
|
|
|
|
|
#pod =head1 METHODS |
47
|
|
|
|
|
|
|
#pod |
48
|
|
|
|
|
|
|
#pod =cut |
49
|
|
|
|
|
|
|
|
50
|
12
|
|
|
12
|
|
1145
|
use strict; |
|
12
|
|
|
|
|
27
|
|
|
12
|
|
|
|
|
404
|
|
51
|
12
|
|
|
12
|
|
66
|
use Params::Util qw{_CODE _INSTANCE}; |
|
12
|
|
|
|
|
63
|
|
|
12
|
|
|
|
|
581
|
|
52
|
12
|
|
|
12
|
|
81
|
use Test::Inline::Content (); |
|
12
|
|
|
|
|
43
|
|
|
12
|
|
|
|
|
2632
|
|
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
our $VERSION = '2.214'; |
55
|
|
|
|
|
|
|
our @ISA = 'Test::Inline::Content'; |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
#pod =pod |
58
|
|
|
|
|
|
|
#pod |
59
|
|
|
|
|
|
|
#pod =head2 new $CODE_ref |
60
|
|
|
|
|
|
|
#pod |
61
|
|
|
|
|
|
|
#pod The C constructor for C takes a single |
62
|
|
|
|
|
|
|
#pod parameter of a C reference, as you would have previously provided |
63
|
|
|
|
|
|
|
#pod directly to C. |
64
|
|
|
|
|
|
|
#pod |
65
|
|
|
|
|
|
|
#pod Returns a new C object, or C if not |
66
|
|
|
|
|
|
|
#pod passed a C reference. |
67
|
|
|
|
|
|
|
#pod |
68
|
|
|
|
|
|
|
#pod =cut |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
sub new { |
71
|
5
|
50
|
|
5
|
1
|
865
|
my $class = ref $_[0] ? ref shift : shift; |
72
|
5
|
|
|
|
|
22
|
my $self = $class->SUPER::new(@_); |
73
|
5
|
100
|
|
|
|
42
|
$self->{coderef} = _CODE(shift) or return undef; |
74
|
1
|
|
|
|
|
3
|
$self; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
#pod =pod |
78
|
|
|
|
|
|
|
#pod |
79
|
|
|
|
|
|
|
#pod =head2 coderef |
80
|
|
|
|
|
|
|
#pod |
81
|
|
|
|
|
|
|
#pod The C accessor returns the C reference for the object |
82
|
|
|
|
|
|
|
#pod |
83
|
|
|
|
|
|
|
#pod =cut |
84
|
|
|
|
|
|
|
|
85
|
2
|
|
|
2
|
1
|
12
|
sub coderef { $_[0]->{coderef} } |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
#pod =pod |
88
|
|
|
|
|
|
|
#pod |
89
|
|
|
|
|
|
|
#pod =head2 process $Inline $Script |
90
|
|
|
|
|
|
|
#pod |
91
|
|
|
|
|
|
|
#pod The C method works with the legacy function by passing the |
92
|
|
|
|
|
|
|
#pod L and L arguments straight through |
93
|
|
|
|
|
|
|
#pod to the legacy function, and returning it's result as the return value. |
94
|
|
|
|
|
|
|
#pod |
95
|
|
|
|
|
|
|
#pod =cut |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
sub process { |
98
|
1
|
|
|
1
|
1
|
3
|
my $self = shift; |
99
|
1
|
50
|
|
|
|
10
|
my $Inline = _INSTANCE(shift, 'Test::Inline') or return undef; |
100
|
1
|
50
|
|
|
|
9
|
my $Script = _INSTANCE(shift, 'Test::Inline::Script') or return undef; |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
# Pass through the params, pass back the result |
103
|
1
|
|
|
|
|
11
|
$self->coderef->( $Inline, $Script ); |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
1; |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
__END__ |