File Coverage

blib/lib/PPI/Transform.pm
Criterion Covered Total %
statement 48 49 97.9
branch 21 38 55.2
condition n/a
subroutine 14 14 100.0
pod 4 5 80.0
total 87 106 82.0


line stmt bran cond sub pod time code
1             package PPI::Transform;
2              
3             =pod
4              
5             =head1 NAME
6              
7             PPI::Transform - Abstract base class for document transformation classes
8              
9             =head1 DESCRIPTION
10              
11             C provides an API for the creation of classes and objects
12             that modify or transform PPI documents.
13              
14             =head1 METHODS
15              
16             =cut
17              
18 1     1   536 use strict;
  1         3  
  1         29  
19 1     1   5 use Carp ();
  1         2  
  1         12  
20 1     1   4 use List::Util ();
  1         3  
  1         11  
21 1     1   4 use PPI::Document ();
  1         2  
  1         18  
22 1     1   8 use Params::Util qw{_INSTANCE _CLASS _CODE _SCALAR0};
  1         9  
  1         928  
23              
24             our $VERSION = '1.277';
25              
26              
27              
28              
29              
30             #####################################################################
31             # Apply Handler Registration
32              
33             my %HANDLER;
34             my @ORDER;
35              
36             # Yes, you can use this yourself.
37             # I'm just leaving it undocumented for now.
38             sub register_apply_handler {
39 3     3 0 1222 my $class = shift;
40 3 50       15 my $handler = _CLASS(shift) or Carp::croak("Invalid PPI::Transform->register_apply_handler param");
41 3 50       78 my $get = _CODE(shift) or Carp::croak("Invalid PPI::Transform->register_apply_handler param");
42 3 50       11 my $set = _CODE(shift) or Carp::croak("Invalid PPI::Transform->register_apply_handler param");
43 3 50       9 if ( $HANDLER{$handler} ) {
44 0         0 Carp::croak("PPI::Transform->apply handler '$handler' already exists");
45             }
46              
47             # Register the handler
48 3         9 $HANDLER{$handler} = [ $get, $set ];
49 3         12 unshift @ORDER, $handler;
50             }
51              
52             # Register the default handlers
53             __PACKAGE__->register_apply_handler( 'SCALAR', \&_SCALAR_get, \&_SCALAR_set );
54             __PACKAGE__->register_apply_handler( 'PPI::Document', sub { $_[0] }, sub() { 1 } );
55              
56              
57              
58              
59              
60             #####################################################################
61             # Constructor
62              
63             =pod
64              
65             =head2 new
66              
67             my $transform = PPI::Transform->new(
68             param1 => 'value1',
69             param2 => 'value2',
70             );
71              
72             The C constructor creates a new object for your C
73             subclass. A default constructor is provided for you which takes no params
74             and creates a basic, empty, object.
75              
76             If you wish to have your transform constructor take params, these B
77             be in the form of a list of key/value pairs.
78              
79             Returns a new C-compatible object, or returns
80             C on error.
81              
82             =cut
83              
84             sub new {
85 4     4 1 8 my $class = shift;
86 4         20 bless { @_ }, $class;
87             }
88              
89             =pod
90              
91             =head2 document
92              
93             The C method should be implemented by each subclass, and
94             takes a single argument of a L object, modifying it
95             B as appropriate for the particular transform class.
96              
97             That's right, this method B and B
98             the document object. If you do not want the original to be modified,
99             you need to clone it yourself before passing it in.
100              
101             Returns the numbers of changes made to the document. If the transform
102             is unable to track the quantity (including the situation where it cannot
103             tell B it made a change) it should return 1. Returns zero if no
104             changes were made to the document, or C if an error occurs.
105              
106             By default this error is likely to only mean that you passed in something
107             that wasn't a L, but may include additional errors
108             depending on the subclass.
109              
110             =cut
111              
112             sub document {
113 1     1 1 13 my $class = shift;
114 1         21 die "$class does not implement the required ->document method";
115             }
116              
117             =pod
118              
119             =head2 apply
120              
121             The C method is used to apply the transform to something. The
122             argument must be a L, or something which can be turned
123             into one and then be written back to again.
124              
125             Currently, this list is limited to a C reference, although a
126             handler registration process is available for you to add support for
127             additional types of object should you wish (see the source for this module).
128              
129             Returns true if the transform was applied, false if there is an error in the
130             transform process, or may die if there is a critical error in the apply
131             handler.
132              
133             =cut
134              
135             sub apply {
136 2     2 1 107 my $self = _SELF(shift);
137 2 50       9 my $it = defined $_[0] ? shift : return undef;
138              
139             # Try to find an apply handler
140             my $class = _SCALAR0($it) ? 'SCALAR'
141 1     1   10 : List::Util::first { _INSTANCE($it, $_) } @ORDER
142 2 100       22 or return undef;
    50          
143 2 50       14 my $handler = $HANDLER{$class}
144             or die("->apply handler for $class missing! Panic");
145              
146             # Get, change, set
147 2 50       16 my $Document = _INSTANCE($handler->[0]->($it), 'PPI::Document')
148             or Carp::croak("->apply handler for $class failed to get a PPI::Document");
149 2 50       1162 $self->document( $Document ) or return undef;
150 2 50       15 $handler->[1]->($it, $Document)
151             or Carp::croak("->apply handler for $class failed to save the changed document");
152 2         9 1;
153             }
154              
155             =pod
156              
157             =head2 file
158              
159             # Read from one file and write to another
160             $transform->file( 'Input.pm' => 'Output.pm' );
161            
162             # Change a file in place
163             $transform->file( 'Change.pm' );
164              
165             The C method modifies a Perl document by filename. If passed a single
166             parameter, it modifies the file in-place. If provided a second parameter,
167             it will attempt to save the modified file to the alternative filename.
168              
169             Returns true on success, or C on error.
170              
171             =cut
172              
173             sub file {
174 2     2 1 1102 my $self = _SELF(shift);
175              
176             # Where do we read from and write to
177 2 50       7 my $input = defined $_[0] ? shift : return undef;
178 2 50       9 my $output = @_ ? defined $_[0] ? "$_[0]" : undef : $input or return undef;
    100          
    50          
179              
180             # Process the file
181 2 50       11 my $Document = PPI::Document->new( "$input" ) or return undef;
182 2 50       21 $self->document( $Document ) or return undef;
183 2         36 $Document->save( $output );
184             }
185              
186              
187              
188              
189              
190             #####################################################################
191             # Apply Hander Methods
192              
193             sub _SCALAR_get {
194 1     1   10 PPI::Document->new( $_[0] );
195             }
196              
197             sub _SCALAR_set {
198 1     1   3 my $it = shift;
199 1         4 $$it = $_[0]->serialize;
200 1         4 1;
201             }
202              
203              
204              
205              
206              
207             #####################################################################
208             # Support Functions
209              
210             sub _SELF {
211 4 50   4   14 return shift if ref $_[0];
212 4 50       16 my $self = $_[0]->new or Carp::croak(
213             "Failed to auto-instantiate new $_[0] object"
214             );
215 4         9 $self;
216             }
217              
218             1;
219              
220             =pod
221              
222             =head1 SUPPORT
223              
224             See the L in the main module.
225              
226             =head1 AUTHOR
227              
228             Adam Kennedy Eadamk@cpan.orgE
229              
230             =head1 COPYRIGHT
231              
232             Copyright 2001 - 2011 Adam Kennedy.
233              
234             This program is free software; you can redistribute
235             it and/or modify it under the same terms as Perl itself.
236              
237             The full text of the license can be found in the
238             LICENSE file included with this module.
239              
240             =cut