view release on metacpan or  search on metacpan

bin/transpierce  view on Meta::CPAN

SHELL

use constant FILE_DIFF => <<SHELL;
echo "_TO"
diff "_FROM" "_TO"

SHELL

use constant FILE_LS => <<SHELL;
ls -l "_TO"

SHELL

use constant RESTORE_DIR => 'restore';
use constant DEPLOY_DIR => 'deploy';
use constant DEFAULT_CONFIG => 'transpierce.conf';

my $config_filename = undef;
my $describe = !!0;
my $help = !!0;
my $export = !!0;

GetOptions(
	'd|describe' => \$describe,
	'c|config=s' => \$config_filename,
	'e|self-export' => \$export,
	'h|help' => \$help,
) or $help = !!1;

if ($help) {
	pod2usage(1);
}

my $working_directory = shift() // '.';
$config_filename = join_file([$working_directory, DEFAULT_CONFIG])
	unless defined $config_filename;

if ($export) {
	my $export_to = join_file([$working_directory, 'transpierce']);
	my $script_path = join_file([$RealBin, $RealScript]);
	copy $script_path, $export_to or die "could not copy $script_path into $export_to: $!";
	chmod 0774, $export_to;
}
else {
	my $config = read_config();
	print_permissions($config) if $describe;
	run_actions(init_files($config), init_scripts($config));
}

sub read_config
{
	open my $fh, '<:encoding(UTF-8)', $config_filename
		or die "could not open $config_filename for reading: $!";

	if (!-d $working_directory) {
		mkdir $working_directory
			or die "$working_directory did not exist, and couldn't be created: $!";
	}

	my $file_string = qr{ (["']) (?<str> .*) \g1 | (?<str> \S+) }x;
	my $perm_string = qr{ (?<chmod> 0[0-7]{3}) \s (?<chown> \S+) \s (?<chgrp> \S+) }x;

	my $context = undef;
	my @files;

	while (my $line = readline $fh) {
		if ($line =~ m{\A target \s+ $file_string}x) {
			$context = $+{str};
		}
		elsif ($line =~ m{\A \s* (?: (new) \s+ $perm_string \s+ $file_string | $file_string ) \s* \z}x) {
			my $file = {
				parts => [$context, $+{str}],
			};

			if ($1 && $1 eq 'new') {
				$file->{new} = !!1;
				$file->{chmod} = $+{chmod};
				$file->{chown} = $+{chown};
				$file->{chgrp} = $+{chgrp};
			}

			gather_file_info($file);

			push @files, $file;
		}
	}

	close $fh
		or die "could not close $config_filename: $!";

	return \@files;
}

sub gather_file_info
{
	my ($file) = @_;
	my $actual_file = join_file($file->{parts});
	my $relpath = $actual_file;
	my $absolute = File::Spec->file_name_is_absolute($relpath);

	if (!$absolute) {
		$relpath = join_file([$working_directory, $relpath]);
	}

	if (!$file->{new}) {
		die "File $relpath does not seem to exist"
			unless -f $relpath;

		my @stat = stat $relpath;

		$file->{chmod} = substr sprintf("%o", $stat[2]), 2, 4;
		$file->{chown} = $stat[4];
		$file->{chgrp} = $stat[5];
	}

	$file->{path} = $actual_file;
	$file->{relpath} = $relpath;
	$file->{mangled} = join_file([mangle_file($file->{parts})]);

	if ($file->{parts}[0]) {