File Coverage

blib/lib/Test/Inline/Content/Legacy.pm
Criterion Covered Total %
statement 18 18 100.0
branch 5 8 62.5
condition n/a
subroutine 6 6 100.0
pod 3 3 100.0
total 32 35 91.4


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__