view release on metacpan or  search on metacpan

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

	die("Sorry, you're already running a binary/packed instance\n") if $IS_PACKED;
	
	my $scriptFile = slashify(File::Spec->rel2abs($opts->{_pp_script}));
	die("The path '$scriptFile' already exists\n") if -e $scriptFile;
	
	my $x_input = slashify("$RealBin/$RealScript", '/');
	my $x_output = __construct_outfilename($version);
	my $x_verbose = $opts->{verbose} ? 1 : 0;
	my $x_fsep = $FILE_SEP;
	$x_fsep .= "\\" if $x_fsep eq "\\";

	my $x_liblocs = "my \@liblocs;\n";
	foreach my $libloc (@INC)
	{
		next if ($libloc eq '.' || ref($libloc));
		$x_liblocs .= "push(\@liblocs, '-I', '" . slashify(File::Spec->rel2abs($libloc), '/') . "');\n";
	}
	chomp($x_liblocs);
	
	my $script = <<SCRIPT;
#! $^X
use strict;
use warnings;

use Config qw(myconfig);
use ExtUtils::Installed;
use File::Basename;
use File::Slurp qw(write_file);
use File::Spec;
use File::Temp qw(tempfile);
use Getopt::Long;
use Net::Domain qw(hostfqdn);

\$| = 1;

eval "require PAR::Packer";
die("Sorry, PAR:Packer is not installed/working!\\n") if \$@;

my \$IS_WINDOWS = \$^O eq 'MSWin32';

my \$_argsPodInput = slashify(File::Spec->rel2abs('$x__argsPodInput'));
my \$argsPodInput = slashify(File::Spec->rel2abs('$x_argsPodInput'));
my \$manualPodInput = slashify(File::Spec->rel2abs('$x_manualPodInput'));

my \$outfile = slashify(File::Spec->rel2abs('$x_output'));
my \$verbose = $x_verbose;
my \$debug = 0;
my \$info = 1;
GetOptions('outfile=s' => \\\$outfile, 'verbose!' => \\\$verbose, 'info!' => \\\$info, 'debug' => \\\$debug) || usage();
\$verbose = 1 if \$debug; 

my \$outdir = dirname(\$outfile);
die("The output directory doesn't exist: '\$outdir'\\n") unless -d \$outdir;
die("The outfile exists: '\$outfile'\\n") if -e \$outfile;

print "Getting username...\\n" if \$verbose;
my (undef, \$usernameFile) = tempfile('testontap_username_XXXX', TMPDIR => 1, UNLINK => 1);
if (\$info)
{
	my \$username = \$IS_WINDOWS ? getlogin() : scalar(getpwuid(\$<));
	write_file(\$usernameFile, "\$username\\n") || die("Failed to write '\$usernameFile': $!\\n");
}

print "Getting hostname...\\n" if \$verbose;
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'))
	);