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