Padre::PPI::UpdateCopyright - Demonstration transform

Padre documentation Contained in the Padre distribution.

Index

Code Index:

NAME

Top

Padre::PPI::UpdateCopyright - Demonstration transform

SYNOPSIS

Top

  my $transform = Padre::PPI::UpdateCopyright->new(
      name => 'Adam Kennedy'
  );
  $transform->apply( Padre::Current->document );

DESCRIPTION

Top

Padre::PPI::UpdateCopyright provides a demonstration of a typical Padre::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.

METHODS

Top

new

  my $transform = Padre::PPI::UpdateCopyright->new(
      name => 'Adam Kennedy'
  );

The new constructor creates a new transform object for a specific author. It takes a single 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.

name

The name accessor returns the author name that the transform will be searching for copyright statements of.

TO DO

Top

May need to overload some methods to forcefully prevent Document objects becoming children of another Node.

SUPPORT

Top

See the support section in the main module.

AUTHOR

Top

Adam Kennedy <adamk@cpan.org>

COPYRIGHT

Top

Copyright 2009-2010 The Padre development team as listed in Padre.pm.

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.

Padre documentation Contained in the Padre distribution. 
package Padre::PPI::UpdateCopyright;


use 5.008;
use strict;
use warnings;
use Params::Util          ();
use Padre::Current        ();
use Padre::PPI::Transform ();

our $VERSION = '0.86';
our @ISA     = 'Padre::PPI::Transform';





#####################################################################
# Constructor and Accessors


sub new {
	my $self = shift->SUPER::new(@_);

	# We need a name
	unless ( defined Params::Util::_STRING( $self->name ) ) {

		# Try to pull a name from your config
		$self->{name} = Padre::Current->config->identity_name;
	}
	unless ( defined Params::Util::_STRING( $self->name ) ) {
		die 'Did not provide a valid name param';
	}

	return $self;
}


sub name {
	$_[0]->{name};
}





#####################################################################
# Transform Methods

sub document {
	my $self = shift;
	my $document = Params::Util::_INSTANCE( shift, 'PPI::Document' ) or return;

	# Find things to transform
	my $name     = quotemeta $self->name;
	my $regexp   = qr/\bcopyright\b.*$name/mi;
	my $elements = $document->find(
		sub {
			$_[1]->isa('PPI::Token::Pod') or return '';
			$_[1]->content =~ $regexp or return '';
			return 1;
		}
	);
	return   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->{content} =~ s/$pattern/$1 . $change->($2) . $3/eg;
	}

	return $changes;
}

1;


# Copyright 2008-2011 The Padre development team as listed in Padre.pm.
# LICENSE
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl 5 itself.