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