local-lib5/lib/perl5/PPI/Transform.pm

   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