change results from the CPAN

ADAMK-Release

package ADAMK::Release;

use 5.10.0;
use strict;
use warnings;
use Carp                          ();
use CPAN::Uploader       0.103003 ();
use Devel::PPPort            3.21 ();
use File::Spec::Functions    0.80 ':ALL';
use File::Slurp           9999.19 ();
use File::Find::Rule         0.32 ();
use File::Flat               1.04 ();
use File::ShareDir           1.03 ();
use File::LocalizeNewlines   1.12 ();
use GitHub::Extract          0.02 ();
use IO::Prompt::Tiny        0.002 ();
use Module::Extract::VERSION 1.01 ();
use Params::Util             1.00 ':ALL';
use Term::ReadKey            2.14 ();
use YAML::Tiny               1.51 ();

our $VERSION = '0.02';

use constant TOOLS => qw{
	cat
	chmod
	make
	touch
	sudo
	bash
};

use Object::Tiny 1.01 qw{
	module
	github
	verbose
	release
	no_rt
	no_changes
	no_copyright
	no_test
}, map { "bin_$_" } TOOLS;






######################################################################
# Constructor

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

	# Check module
	unless ( _CLASS($self->module) ) {
		$self->error("Missing or invalid module");
	}

	# Inflate and check the github object
	if ( Params::Util::_HASH($self->github) ) {
		$self->{github} = GitHub::Extract->new( %{$self->github} );
	}
	unless ( Params::Util::_INSTANCE($self->github, 'GitHub::Extract')) {
		$self->error("Missing or invalid GitHub specification");
	}

	# Release options
	$self->{release} = !!$self->{release};

	# Find all of the command line tools
	foreach my $tool ( TOOLS ) {
		$self->{ "bin_" . $tool } = $self->which($tool);
	}

	return $self;
}





######################################################################
# Command Methods

sub run {
	my $self = shift;

	# Export from GitHub and change to the directory
	my $pushd = $self->github->pushd;
	unless ( $pushd ) {
		$self->error(
			"Failed to download and extract %s: %s",
			$self->github->url,
			$self->github->error,
		);
	}

	# This is total bulldozer coding, there is no reason whatsoever why
	# this stuff should be in seperate methods except that it provides
	# a little cleaner logical breakup, and maybe I want to subclass this
	# someday or something.
	$self->validate;
	$self->assemble;
	$self->build;

	# Release the distribution
	$self->upload if $self->release;

	return;
}

sub validate {
	my $self = shift;

	unless ( $self->dist_version ) {
		$self->error("Failed to find version number in main module");
	}
	unless ( $self->makefile_pl or $self->build_pl ) {
		$self->error("Failed to find Makefile.PL or Build.PL");
	}

	return;
}

sub assemble {
	my $self = shift;

	# Create MANIFEST.SKIP
	if ( -f $self->dist_manifest_add ) {
		$self->shell(
			$self->bin_cat,
			$self->shared_manifest_skip,
			$self->dist_manifest_add,
			'>',
			$self->dist_manifest_skip,
			"Failed to merge common MANIFEST.SKIP with extra one",
		);

	} elsif ( not -f $self->dist_manifest ) {
		$self->copy( $self->shared_manifest_skip => $self->dist_manifest_skip );
	}

	# Apply a default LICENSE file
	unless ( -f $self->dist_license ) {
		$self->copy( $self->shared_license => $self->dist_license );
	}

	# Add ppport.h if any XS files use it

lib/ADAMK/Release.pm view on Meta::CPAN

	unless ( -f $self->dist_99_author ) {
		foreach my $xt ( qw{ pod.t pmv.t } ) {
			next if -f catfile( $self->dist_xt, $xt );
			$self->copy(
				catfile( $self->shared_dir, $xt ),
				catfile( $self->dist_xt,     $xt ),
			);
		}
	}

	# Create the README file
	unless ( -f $self->dist_readme ) {
		my $dist_readme = $self->dist_readme;
		my $module_pod = -f $self->module_pod ? $self->module_pod : $self->module_pm;
		$self->shell(
			$self->bin_cat,
			$module_pod,
			"| pod2text >",
			$dist_readme,
			"Error while generating README file '$dist_readme'",
		)
	}

	# Localise all newlines in text files
	$self->file_localize->localize( $self->dist_dir );
	
	# Check for various unsafe things in Makefile.PL
	if ( $self->makefile_pl ) {
		if ( $self->makefile_pl =~ /use inc::Module::Install/ ) {
			if ( $self->makefile_pl =~ /\bauto_install\b/ ) {
				$self->error("Makefile.PL contains dangerous auto_install");
			}
		} else {
			unless ( $self->makefile_pl =~ /use strict/ ) {
				$self->error("Makefile.PL does not use strict");
			}
			unless ( $self->makefile_pl =~ /(?:use|require) \d/ ) {
				$self->error("Makefile.PL does not declare a minimum Perl version");
			}
		}
	}

	# Check file permissions
	foreach my $file ( sort $self->find_0644->in( $self->dist_dir ) ) {
		my $mode = (stat($file))[2] & 07777;
		next if $mode == 0644;
		$self->shell(
			$self->bin_chmod,
			'0644',	
			$file,
			"Error setting $file to 0644 permissions",
		);
	}

	# Make sure exe files are marked with executable permissions
	if ( $self->find_executable->in( $self->dist_dir ) ) {
		$self->error("Found at least one .exe file without -x unix permissions");
	}

	# Check the Changes file
	unless ( $self->no_changes ) {
		# Read in the Changes file
		unless ( -f $self->dist_changes ) {
			$self->error("Distribution does not have a Changes file");
		}
		unless ( open( CHANGES, $self->dist_changes ) ) {
			$self->error("Failed to open Changes file");
		}
		my @lines = <CHANGES>;
		close CHANGES;
		unless ( @lines >= 3 ) {
			$self->error("Changes file is empty or too small");
		}

		# The Changes version should be the first thing on the third line
		my $current   = $lines[2];
		my ($version) = split /\s+/, $current;
		unless ( $version =~ /[\d\._]{3}/ ) {
			$self->error(
				"Failed to find current version, or too short, in '%2'",
				$current,
			);
		}

		# Does it match the version in the main module
		unless ( $version eq $self->dist_version ) {
			$self->error(
				"Version in Changes file (%s) does not match module version (%s)",
				$version,
				$self->dist_version,
			);
		}
	}

	# Check that the main module documentation Copyright is the current year
	unless ( $self->no_copyright ) {
		# Read the file
		unless ( open( MODULE, $self->module_doc ) ) {
			$self->error(
				"Failed to open '%s'",
				$self->module_doc,
			);
		}
		my @lines = <MODULE>;
		close MODULE;

		# Look for the current year
		my $year = 1900 + (localtime time)[5];
		unless ( grep { /copyright/i and /$year/ } @lines ) {
			$self->error("Missing Copyright, or does not refer to current year");
		}

		# Merge the module to a single string
		my $merged = join "\n", @lines;
		unless ( $self->no_rt ) {
			my $dist_name = $self->dist;
			unless ( $merged =~ /L\<http\:\/\/rt\.cpan\.org\/.+?=([\w-]+)\>/ ) {
				$self->error("Failed to find a link to the public RT queue");
			}
			unless ( $dist_name eq $1 ) {
				$self->error("Expected a public link to $dist_name RT queue, but found a link to the $1 queue");
			}
		}
	}

	# Touch all files to correct any potential time skews

lib/ADAMK/Release.pm view on Meta::CPAN

		META.yml
		*.t
		*.pm
		*.pod
	} )->file;
}

sub find_executable {
	File::Find::Rule->name('*.exe')->not_executable->file;
}

sub find_localize {
	File::Find::Rule->file->not_binary->writable;
}

sub file_localize {
	File::LocalizeNewlines->new(
		filter  => $_[0]->find_localize,
		verbose => 1,
	);
}





######################################################################
# Paths and Files

sub dist {
	my $self   = shift;
	my $dist = $self->module;
	$dist =~ s/::/-/g;
	return $dist;
}

sub dist_dir {
	curdir();
}

sub dist_tardist {
	$_[0]->dist_file;
}

sub dist_file {
	$_[0]->dist . '-' . $_[0]->dist_version . '.tar.gz';
}

sub dist_version {
	$_[0]->module_version;
}

sub dist_makefile_pl {
	'Makefile.PL';
}

sub dist_build_pl {
	'Build.PL';
}

sub dist_changes {
	'Changes';
}

sub dist_license {
	'LICENSE';
}

sub dist_readme {
	'README';
}

sub dist_meta_yml {
	'META.yml';
}

sub dist_manifest {
	'MANIFEST';
}

sub dist_manifest_skip {
	'MANIFEST.SKIP';
}

sub dist_manifest_add {
	'MANIFEST.SKIP.add';
}

sub dist_ppport {
	'ppport.h';
}

sub dist_t {
	't';
}

sub dist_data {
	catdir('t', 'data');
}

sub dist_99_author {
	catfile('t', '99_author.t');
}

sub dist_xt {
	'xt';
}

sub module_pm {
	catfile( 'lib', $_[0]->module_subpath ) . '.pm';
}

sub module_pod {
	catfile( 'lib', $_[0]->module_subpath ) . '.pod';
}

sub module_subpath {
	catdir( split /::/, $_[0]->module );
}

sub shared_manifest_skip {

( run in 0.814 second using v1.01-cache-2.11-cpan-0bb4e1dffa6 )