Add built local::lib
[catagits/Gitalist.git] / local-lib5 / lib / perl5 / PPI / Transform.pm
CommitLineData
3fea05b9 1package PPI::Transform;
2
3=pod
4
5=head1 NAME
6
7PPI::Transform - Abstract base class for document transformation classes
8
9=head1 DESCRIPTION
10
11C<PPI::Transform> provides an API for the creation of classes and objects
12that modify or transform PPI documents.
13
14=head1 METHODS
15
16=cut
17
18use strict;
19use Carp ();
20use List::Util ();
21use PPI::Document ();
22use Params::Util qw{_INSTANCE _CLASS _CODE _SCALAR0};
23
24use vars qw{$VERSION};
25BEGIN {
26 $VERSION = '1.206';
27}
28
29
30
31
32
33#####################################################################
34# Apply Handler Registration
35
36my %HANDLER = ();
37my @ORDER = ();
38
39# Yes, you can use this yourself.
40# I'm just leaving it undocumented for now.
41sub 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
75The C<new> constructor creates a new object for your C<PPI::Transform>
76subclass. A default constructor is provided for you which takes no params
77and creates a basic, empty, object.
78
79If you wish to have your transform constructor take params, these B<must>
80be in the form of a list of key/value pairs.
81
82Returns a new C<PPI::Transform>-compatible object, or returns
83C<undef> on error.
84
85=cut
86
87sub new {
88 my $class = shift;
89 bless { @_ }, $class;
90}
91
92=pod
93
94=head2 document
95
96The C<document> method should be implemented by each subclass, and
97takes a single argument of a L<PPI::Document> object, modifying it
98B<in place> as appropriate for the particular transform class.
99
100That's right, this method B<will not clone> and B<should not clone>
101the document object. If you do not want the original to be modified,
102you need to clone it yourself before passing it in.
103
104Returns the numbers of changes made to the document. If the transform
105is unable to track the quantity (including the situation where it cannot
106tell B<IF> it made a change) it should return 1. Returns zero if no
107changes were made to the document, or C<undef> if an error occurs.
108
109By default this error is likely to only mean that you passed in something
110that wasn't a L<PPI::Document>, but may include additional errors
111depending on the subclass.
112
113=cut
114
115sub document {
116 my $class = shift;
117 die "$class does not implement the required ->document method";
118}
119
120=pod
121
122=head2 apply
123
124The C<apply> method is used to apply the transform to something. The
125argument must be a L<PPI::Document>, or something which can be turned
126into a one and then be written back to again.
127
128Currently, this list is limited to a C<SCALAR> reference, although a
129handler registration process is available for you to add support for
130additional types of object should you wish (see the source for this module).
131
132Returns true if the transform was applied, false if there is an error in the
133transform process, or may die if there is a critical error in the apply
134handler.
135
136=cut
137
138sub 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
168The C<file> method modifies a Perl document by filename. If passed a single
169parameter, it modifies the file in-place. If provided a second parameter,
170it will attempt to save the modified file to the alternative filename.
171
172Returns true on success, or C<undef> on error.
173
174=cut
175
176sub 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
196sub _SCALAR_get {
197 PPI::Document->new( $_[0] );
198}
199
200sub _SCALAR_set {
201 my $it = shift;
202 $$it = $_[0]->serialize;
203 1;
204}
205
206
207
208
209
210#####################################################################
211# Support Functions
212
213sub _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
2211;
222
223=pod
224
225=head1 SUPPORT
226
227See the L<support section|PPI/SUPPORT> in the main module.
228
229=head1 AUTHOR
230
231Adam Kennedy E<lt>adamk@cpan.orgE<gt>
232
233=head1 COPYRIGHT
234
235Copyright 2001 - 2009 Adam Kennedy.
236
237This program is free software; you can redistribute
238it and/or modify it under the same terms as Perl itself.
239
240The full text of the license can be found in the
241LICENSE file included with this module.
242
243=cut