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

   1 package PPI::Transform::UpdateCopyright;
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 PPI::Transform::UpdateCopyright - Demonstration PPI::Transform class
   8
   9 =head1 SYNOPSIS
  10
  11   my $transform = PPI::Transform::UpdateCopyright->new(
  12       name => 'Adam Kennedy'
  13   );
  14
  15   $transform->file('Module.pm');
  16
  17 =head1 DESCRIPTION
  18
  19 B<PPI::Transform::UpdateCopyright> provides a demonstration of a typical
  20 L<PPI::Transform> class.
  21
  22 This class implements a document transform that will take the name of an
  23 author and update the copyright statement to refer to the current year,
  24 if it does not already do so.
  25
  26 =head1 METHODS
  27
  28 =cut
  29
  30 use strict;
  31 use Params::Util   qw{_STRING};
  32 use PPI::Transform ();
  33
  34 use vars qw{$VERSION};
  35 BEGIN {
  36         $VERSION = '1.206';
  37 }
  38
  39
  40
  41
  42
  43 #####################################################################
  44 # Constructor and Accessors
  45
  46 =pod
  47
  48 =head2 new
  49
  50   my $transform = PPI::Transform::UpdateCopyright->new(
  51       name => 'Adam Kennedy'
  52   );
  53
  54 The C<new> constructor creates a new transform object for a specific
  55 author. It takes a single C<name> parameter that should be the name
  56 (or longer string) for the author.
  57
  58 Specifying the name is required to allow the changing of a subset of
  59 copyright statements that refer to you from a larger set in a file.
  60
  61 =cut
  62
  63 sub new {
  64         my $self = shift->SUPER::new(@_);
  65
  66         # Must provide a name
  67         unless ( defined _STRING($self->name) ) {
  68                 PPI::Exception->throw("Did not provide a valid name param");
  69         }
  70
  71         return $self;
  72 }
  73
  74 =pod
  75
  76 =head2 name
  77
  78 The C<name> accessor returns the author name that the transform will be
  79 searching for copyright statements of.
  80
  81 =cut
  82
  83 sub name {
  84         $_[0]->{name};
  85 }
  86
  87
  88
  89
  90
  91 #####################################################################
  92 # Transform
  93
  94 sub document {
  95         my $self     = shift;
  96         my $document = _INSTANCE(shift, 'PPI::Document') or return undef;
  97
  98         # Find things to transform
  99         my $name     = quotemeta $self->name;
 100         my $regexp   = qr/\bcopyright\b.*$name/m;
 101         my $elements = $document->find( sub {
 102                 $_[1]->isa('PPI::Token::Pod') or return '';
 103                 $_[1]->content =~ $regexp     or return '';
 104                 return 1;
 105         } );
 106         return undef unless defined $elements;
 107         return 0 unless $elements;
 108
 109         # Try to transform any elements
 110         my $changes = 0;
 111         my $change  = sub {
 112                 my $copyright = shift;
 113                 my $thisyear  = (localtime time)[5] + 1900;
 114                 my @year      = $copyright =~ m/(\d{4})/g;
 115
 116                 if ( @year == 1 ) {
 117                         # Handle the single year format
 118                         if ( $year[0] == $thisyear ) {
 119                                 # No change
 120                                 return $copyright;
 121                         } else {
 122                                 # Convert from single year to multiple year
 123                                 $changes++;
 124                                 $copyright =~ s/(\d{4})/$1 - $thisyear/;
 125                                 return $copyright;
 126                         }
 127                 }
 128
 129                 if ( @year == 2 ) {
 130                         # Handle the range format
 131                         if ( $year[1] == $thisyear ) {
 132                                 # No change
 133                                 return $copyright;
 134                         } else {
 135                                 # Change the second year to the current one
 136                                 $changes++;
 137                                 $copyright =~ s/$year[1]/$thisyear/;
 138                                 return $copyright;
 139                         }
 140                 }
 141
 142                 # huh?
 143                 die "Invalid or unknown copyright line '$copyright'";
 144         };
 145
 146         # Attempt to transform each element
 147         my $pattern = qr/\b(copyright.*\d)({4}(?:\s*-\s*\d{4})?)(.*$name)/mi;
 148         foreach my $element ( @$elements ) {
 149                 $element =~ s/$pattern/$1 . $change->($2) . $2/eg;
 150         }
 151
 152         return $changes;
 153 }
 154
 155 1;
 156
 157 =pod
 158
 159 =head1 TO DO
 160
 161 - May need to overload some methods to forcefully prevent Document
 162 objects becoming children of another Node.
 163
 164 =head1 SUPPORT
 165
 166 See the L<support section|PPI/SUPPORT> in the main module.
 167
 168 =head1 AUTHOR
 169
 170 Adam Kennedy E<lt>adamk@cpan.orgE<gt>
 171
 172 =head1 COPYRIGHT
 173
 174 Copyright 2009 Adam Kennedy.
 175
 176 This program is free software; you can redistribute
 177 it and/or modify it under the same terms as Perl itself.
 178
 179 The full text of the license can be found in the
 180 LICENSE file included with this module.
 181
 182 =cut