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