ADAMK-Release

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

	# all of the following checks should be included in import(),
	# to allow "eval 'require Module::Install; 1' to test
	# installation of Module::Install. (RT #51267)
	#-------------------------------------------------------------

	# Whether or not inc::Module::Install is actually loaded, the
	# $INC{inc/Module/Install.pm} is what will still get set as long as
	# the caller loaded module this in the documented manner.
	# If not set, the caller may NOT have loaded the bundled version, and thus
	# they may not have a MI version that works with the Makefile.PL. This would
	# result in false errors or unexpected behaviour. And we don't want that.
	my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
	unless ( $INC{$file} ) { die <<"END_DIE" }

Please invoke ${\__PACKAGE__} with:

	use inc::${\__PACKAGE__};

not:

	use ${\__PACKAGE__};

inc/Module/Install.pm  view on Meta::CPAN

	# is unreliable on some platforms and requires write permissions)
	# for now we should catch this and refuse to run.
	if ( -f $0 ) {
		my $s = (stat($0))[9];

		# If the modification time is only slightly in the future,
		# sleep briefly to remove the problem.
		my $a = $s - time;
		if ( $a > 0 and $a < 5 ) { sleep 5 }

		# Too far in the future, throw an error.
		my $t = time;
		if ( $s > $t ) { die <<"END_DIE" }

Your installer $0 has a modification time in the future ($s > $t).

This is known to create infinite loops in make.

Please correct this, then run $0 again.

END_DIE

inc/Module/Install.pm  view on Meta::CPAN

			goto &$code unless $cwd eq $pwd;
		}
		unless ($$sym =~ s/([^:]+)$//) {
			# XXX: it looks like we can't retrieve the missing function
			# via $$sym (usually $main::AUTOLOAD) in this case.
			# I'm still wondering if we should slurp Makefile.PL to
			# get some context or not ...
			my ($package, $file, $line) = caller;
			die <<"EOT";
Unknown function is found at $file line $line.
Execution of $file aborted due to runtime errors.

If you're a contributor to a project, you may need to install
some Module::Install extensions from CPAN (or other repository).
If you're a user of a module, please contact the author.
EOT
		}
		my $method = $1;
		if ( uc($method) eq $method ) {
			# Do nothing
			return;

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

######################################################################
# 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);
	}

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

######################################################################
# 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;

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

	# 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 ) {

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

		)
	}

	# 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
	foreach my $file ( $self->find_files->in( $self->dist_dir ) ) {
		$self->shell(
			$self->bin_touch,
			$file,
			"Error while touching $file to prevent clock skew",

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

	local $ENV{RELEASE_TESTING}   = '';

	# Run either of the build protocols
	if ( $self->makefile_pl ) {
		$self->build_make;

	} elsif ( $self->build_pl ) {
		$self->build_perl;

	} else {
		$self->error("Module does not have a Makefile.PL or Build.PL");
	}

	# Double check that the build produced a tarball where we expect it to be
	unless ( -f $self->dist_tardist ) {
		$self->error(
			"Failed to create tardist at '%s'",
			$self->dist_tardist,
		);
	}

	return;
}

sub build_make {
	my $self = shift;

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

	);

	return;
}

sub upload {
	my $self = shift;

	my $pauseid = $self->prompt("PAUSEID:");
	unless (_STRING($pauseid) and $pauseid =~ /^[A-Z]{3,}$/) {
		$self->error("Missing or invalid PAUSEID");
	}

	my $password = $self->password("Password:");
	unless (_STRING($password) and $password =~ /^\S{5,}$/) {
		$self->error("Missing or invalid CPAN password");
	}

	# Execute the upload to CPAN
	CPAN::Uploader->upload_file( $self->dist_tardist, {
		user     => $pauseid,
		password => $password,
	});
}

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

sub shared_manifest_skip {
	catfile( $_[0]->shared_dir, 'MANIFEST.SKIP' );
}

sub shared_license {
	catfile( $_[0]->shared_dir, 'LICENSE' );
}

sub shared_dir {
	File::ShareDir::dist_dir('ADAMK-Release')
	or $_[0]->error("Failed to find share directory");	
}




######################################################################
# Support Methods

# Is a particular program installed, and where
sub which {
	my $self    = shift;
	my $program = shift;
	my ($location) = (`which $program`);
	chomp $location;
	unless ( $location ) {
		$self->error("Can't find the required program '$program'. Please install it");
	}
	unless ( -r $location and -x $location ) {
		$self->error("The required program '$program' is installed, but I do not have permission to read or execute it");
	}
	return $location;
}

sub copy {
	my $self = shift;
	my $from = shift;
	my $to   = shift;
	File::Flat->copy( $from => $to ) and return 1;
	$self->error("Failed to copy '$from' to '$to'");
}

sub move {
	my $self = shift;
	my $from = shift;
	my $to   = shift;
	File::Flat->copy( $from => $to ) and return 1;
	$self->error("Failed to move '$from' to '$to'");
}

sub remove {
	my $self = shift;
	my $path = shift;
	if ( -e $path ) {
		$self->sudo(
			"rm -rf $path",
			"Failed to remove '$path'"
		);

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

		ADAMK_RELEASE     => 1,
		RELEASE_TESTING   => $ENV{RELEASE_TESTING}   ? 1 : 0,
		AUTOMATED_TESTING => $ENV{AUTOMATED_TESTING} ? 1 : 0,
	);
	print "> (sudo) $cmd\n" if $self->verbose;
	my $sudo = $self->bin_sudo;
	my $rv   = ! system( "$sudo bash -c '$env $cmd'" );
	if ( $rv or ! @_ ) {
		return $rv;
	}
	$self->error($message);
}

sub shell {
	my $self    = shift;
	my $message = pop @_;
	my $cmd     = join ' ', @_;
	my $env     = $self->env(
		ADAMK_RELEASE     => 1,
		RELEASE_TESTING   => $ENV{RELEASE_TESTING}   ? 1 : 0,
		AUTOMATED_TESTING => $ENV{AUTOMATED_TESTING} ? 1 : 0,
	);
	print "> $cmd\n" if $self->verbose;
	my $rv = ! system( "$env $cmd" );
	if ( $rv or ! @_ ) {
		return $rv;
	}
	$self->error($message);
}

sub env {
	my $self = shift;
	my %env  = @_;
	join ' ', map { "$_=$env{$_}" } sort keys %env;
}

sub error {
	my $self    = shift;
	my $message = sprintf(shift, @_);
	Carp::croak($message);
}

sub prompt {
	my $self = shift;
	return IO::Prompt::Tiny::prompt(@_);
}