view release on metacpan or  search on metacpan

lib/App/TestOnTap/PackInfo.pm  view on Meta::CPAN

my (undef, \$hostnameFile) = tempfile('testontap_hostname_XXXX', TMPDIR => 1, UNLINK => 1);
if (\$info)
{
	my \$hostname = hostfqdn();
	write_file(\$hostnameFile, "\$hostname\\n") || die("Failed to write '\$hostnameFile': $!\\n");
}

print "Getting environment...\\n" if \$verbose;
my (undef, \$envFile) = tempfile('testontap_env_XXXX', TMPDIR => 1, UNLINK => 1);
if (\$info)
{
	my \$env = getEnv();
	write_file(\$envFile, \$env) || die("Failed to write '\$envFile': $!\\n");
}

print "Getting config...\\n" if \$verbose;
my (undef, \$configFile) = tempfile('testontap_config_XXXX', TMPDIR => 1, UNLINK => 1);
if (\$info)
{
	my \$config = myconfig();
	write_file(\$configFile, \$config) || die("Failed to write '\$configFile': \$!\\n");
}
 
print "Getting modules...\\n" if \$verbose;
my (undef, \$modulesFile) = tempfile('testontap_modules_XXXX', TMPDIR => 1, UNLINK => 1);
if (\$info)
{
	my \$modules = find_modules();
	write_file(\$modulesFile, \$modules) || die("Failed to write '\$modulesFile': $!\\n");
}

print "Getting cmd...\\n" if \$verbose;
my (undef, \$cmdFile) = tempfile('testontap_cmd_XXXX', TMPDIR => 1, UNLINK => 1);

$x_liblocs
\$_ = slashify(\$_) foreach (\@liblocs);

my \@cmd =
	(
		'pp',
		\$verbose ? ("--verbose=\$verbose") : (),
		\@liblocs,
		'-a', "\$_argsPodInput;lib/$_argsPodName",
		'-a', "\$argsPodInput;lib/$argsPodName",
		'-a', "\$manualPodInput;lib/$manualPodName",
		'-a', "\$cmdFile;TESTONTAP_CMD_FILE",
		'-a', "\$configFile;TESTONTAP_CONFIG_FILE",
		'-a', "\$modulesFile;TESTONTAP_MODULES_FILE",
		'-a', "\$usernameFile;TESTONTAP_USERNAME_FILE",
		'-a', "\$hostnameFile;TESTONTAP_HOSTNAME_FILE",
		'-a', "\$envFile;TESTONTAP_ENV_FILE",
		'-M', 'Encode::*',
		'-o', \$outfile,
		slashify(File::Spec->rel2abs('$x_input'))
	);

my \@cmdCopy = \@cmd;
\$_ .= "\\n" foreach (\@cmdCopy);
if (\$info)
{
	write_file(\$cmdFile, { binmode => ':raw' }, \@cmdCopy) || die("Failed to write '\$cmdFile': \$!\\n");
}

if (\$verbose)
{
	print "Packing to '\$outfile' using:\\n";
	print "  \$_\\n" foreach (\@cmd);
}
else
{
	print "Packing to '\$outfile'...";
}

if (\$debug)
{
	print "username file     : \$usernameFile\\n";
	print "hostname file     : \$hostnameFile\\n";
	print "config file       : \$configFile\\n";
	print "env file          : \$envFile\\n";
	print "modules file      : \$modulesFile\\n";
	print "cmd file          : \$cmdFile\\n";
	print "Continue? (no) : ";
	my \$ans = <STDIN>;
	exit(1) unless \$ans =~ /^\\s*yes\\s*\$/i;
}

my \$xit = system(\@cmd) >> 8;
die("\\nError during packing: \$xit\\n") if \$xit;
print "done\\n";

exit(0);

###

sub getEnv
{
	my \$env = '';
	\$env .= "\$_ => '\$ENV{\$_}'\\n" foreach (sort(keys(\%ENV)));
	
	return \$env;
}

sub find_modules
{
	my \$ei = ExtUtils::Installed->new(skip_cwd => 1);

	my \$modules = '';
	foreach my \$module (sort(\$ei->modules()))
	{
		my \$ver = \$ei->version(\$module);
		\$modules .= "\$module => \$ver\\n";
	}
		
	return \$modules;
}

sub slashify
{
	my \$s = shift;
	my \$fsep = shift || '$x_fsep';