File Coverage

blib/lib/App/Perl/Module/CopyrightYears.pm

Criterion	Covered	Total	%
statement	44	84	52.3
branch	1	16	6.2
condition	1	6	16.6
subroutine	12	14	85.7
pod	2	2	100.0
total	60	122	49.1

package App::Perl::Module::CopyrightYears;

use strict;
use warnings;

use Class::Utils qw(set_params);
use File::Find::Rule;
use File::Spec::Functions qw(catfile);
use Getopt::Std;
use IO::Barf qw(barf);
use Pod::CopyrightYears;
use Perl6::Slurp qw(slurp);
use String::UpdateYears qw(update_years);

our $VERSION = 0.03;

# Constructor.
sub new {
	my ($class, @params) = @_;

	# Create object.
	my $self = bless {}, $class;

	# Process parameters.
	set_params($self, @params);

	# Object.
	return $self;
}

# Run.
sub run {
	my $self = shift;

	# Process arguments.
	$self->{'_opts'} = {
		'd' => 0,
		'h' => 0,
		's' => 'LICENSE AND COPYRIGHT',
		'y' => undef,
	};
	if (! getopts('dhy:', $self->{'_opts'})
		|| $self->{'_opts'}->{'h'}) {

		print STDERR "Usage: $0 [-d] [-h] [-s section(s)] [-y last_year] [--version]\n";
		print STDERR "\t-d\t\tDebug mode.\n";
		print STDERR "\t-h\t\tPrint help.\n";
		print STDERR "\t-s section(s)\tSection(s) to look (default is LICENSE AND COPYRIGHT)\n";
		print STDERR "\t-y last_year\tLast year (default value is actual year)\n";
		print STDERR "\t--version\tPrint version.\n";
		return 1;
	}

	# Default year.
	if (! defined $self->{'_opts'}->{'y'}) {
		$self->{'_opts'}->{'y'} = (localtime(time))[5] + 1900;
	}

	# Find all perl module files in actual directory.
	my @pm = $self->_files('.', '*.pm', '*.pod');

	# Dump perl modules in debug mode.
	if ($self->{'_opts'}->{'d'}) {
		require Dumpvalue;
		my $dump = Dumpvalue->new;
		$dump->dumpValues(\@pm);
	}

	# Update years.
	foreach my $perl_module_file (@pm) {
		$self->_update_pod($perl_module_file);
	}

	# Change copyright years in LICENSE file.
	my ($license) = $self->_files('.', 'LICENSE');
	if (defined $license && -r $license) {
		my @license = slurp($license);
		my $opts_hr = {
			'prefix_glob' => '.*\(c\)\s+',
		};
		my $update_file = 0;
		foreach (my $i = 0; $i < @license; $i++) {
			my $updated = update_years($license[$i], $opts_hr,
				$self->{'_opts'}->{'y'});
			if ($updated) {
				$license[$i] = $updated;
				$update_file = 1;
			}
		}
		if ($update_file) {
			barf($license, (join '', @license));
		}
	}

	# Look for scripts with copyright years.
	if (-d 'bin') {
		my @bin = $self->_files('bin', '*');

		# Dump tools in debug mode.
		if ($self->{'_opts'}->{'d'}) {
			require Dumpvalue;
			my $dump = Dumpvalue->new;
			$dump->dumpValues(\@bin);
		}

		# Update years.
		foreach my $bin (@bin) {
			$self->_update_pod($bin);
		}
	}

	return 0;
}

sub _files {
	my ($self, $dir, @file_globs) = @_;

	my $rule = File::Find::Rule->new;
	my @pm = $rule->or(
		$rule->new->directory->name('t')->prune->discard,
		$rule->new->directory->name('inc')->prune->discard,
		$rule->new->directory->name('blib')->prune->discard,
		$rule->new,
	)->name(@file_globs)->in($dir);

	return @pm;
}

sub _update_pod {
	my ($self, $file) = @_;

	my @sections = split m/,/, $self->{'_opts'}->{'s'};
	my $cy = Pod::CopyrightYears->new(
		'pod_file' => $file,
		'section_names' => \@sections,
	);
	$cy->change_years($self->{'_opts'}->{'y'});
	barf($file, $cy->pod);

	return;
}

1;

__END__