App-Transpierce

 view release on metacpan or  search on metacpan

bin/transpierce  view on Meta::CPAN


use Getopt::Long;
use Pod::Usage;
use File::Spec;
use File::Copy qw(copy);
use FindBin qw($RealBin $RealScript);
use File::Basename qw(fileparse);

use constant FILE_COPY => <<SHELL;
cp "_FROM" "_TO"
chmod _MODE "_TO"
chown _UID "_TO"
chgrp _GID "_TO"

SHELL

use constant FILE_CREATE => <<SHELL . FILE_COPY;
mkdir -p "_DIR"
SHELL

use constant FILE_DELETE => <<SHELL;

bin/transpierce  view on Meta::CPAN

}

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

bin/transpierce  view on Meta::CPAN

	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]) {
		$file->{dir} = (mangle_file($file->{parts}))[0];

bin/transpierce  view on Meta::CPAN

	my ($type) = @_;

	if ($type eq 'restore') {
		return sub {
			my ($file) = @_;

			return process_template(
				$file->{new} ? FILE_DELETE : FILE_COPY,
				_FROM => join_file([RESTORE_DIR, $file->{mangled}]),
				_TO => $file->{path},
				_MODE => $file->{chmod},
				_UID => $file->{chown},
				_GID => $file->{chgrp},
			);
		};
	}
	elsif ($type eq 'deploy') {
		return sub {
			my ($file) = @_;

			return process_template(
				$file->{new} ? FILE_CREATE : FILE_COPY,
				_FROM => join_file([DEPLOY_DIR, $file->{mangled}]),
				_TO => $file->{path},
				_MODE => $file->{chmod},
				_UID => $file->{chown},
				_GID => $file->{chgrp},
				_DIR => (fileparse($file->{path}))[1],
			);
		};
	}
	elsif ($type eq 'diff') {
		return sub {
			my ($file) = @_;

bin/transpierce  view on Meta::CPAN


			my $inner_sub = get_script_generator($action{type});

			$action{code} = sub {
				my $output = '';
				foreach my $file (@{$action{files}}) {
					$output .= $inner_sub->($file);
				}

				spurt($action{dest}, $output);
				chmod 0774, $action{dest};
			};
		}
	);

	($types{$type} // die "invalid action type $type")->();

	return \%action;
}

sub run_actions

bin/transpierce  view on Meta::CPAN

	}
}

sub print_permissions
{
	my ($config) = @_;

	say "Files specified in the config file";
	foreach my $file (@$config) {
		say $file->{relpath};
		say "  mode -> $file->{chmod}";
		say "  uid -> $file->{chown}";
		say "  gid -> $file->{chgrp}";
		say '-------';
	}

	say '';
}

__END__

lib/App/Transpierce.pm  view on Meta::CPAN

=item * they will be created (empty) in C<deploy> directory

=item * they will not exist in C<restore> directory

=item * C<deploy.sh> will create full directory path to them with default permissions

=item * C<restore.sh> will remove these files altogether (but not the directories)

=item * C<diff.sh> will C<ls -l> these files

=item * three words used after C<new> will be used for C<chmod>, C<chown> and C<chgrp> respectively and are required

=item * file permissions must be octal number in form of C<0NNN> (cannot be C<+x> for example)

=back

=head2 Scripts

C<transpierce> script is only used once during initialization. After that, work
is performed using generated shell scripts.

t/01-script.t  view on Meta::CPAN

		my $value = $compare{$key};

		files_content_same($key, $value);
	}

	files_content_same(
		$dir . '/deploy.sh',
		qr{
			\A \s*
			cp [ ] "deploy/UP__data__f3\.txt" [ ] "\.\./data/f3\.txt" \v
			chmod [ ] 0[0-7]{3} [ ] "\.\./data/f3\.txt" \v
			chown [ ] \d+ [ ] "\.\./data/f3\.txt" \v
			chgrp [ ] \d+ [ ] "\.\./data/f3\.txt" \v
			\v
			cp [ ] "deploy/UP__data__d1__d11/f1\.txt" [ ] "\.\./data/d1/d11/f1\.txt" \v
			chmod [ ] 0[0-7]{3} [ ] "\.\./data/d1/d11/f1\.txt" \v
			chown [ ] \d+ [ ] "\.\./data/d1/d11/f1\.txt" \v
			chgrp [ ] \d+ [ ] "\.\./data/d1/d11/f1\.txt" \v
			\v
			cp [ ] "deploy/UP__data__d2__d21/f2\.txt" [ ] "\.\./data/d2/d21/f2\.txt" \v
			chmod [ ] 0[0-7]{3} [ ] "\.\./data/d2/d21/f2\.txt" \v
			chown [ ] \d+ [ ] "\.\./data/d2/d21/f2\.txt" \v
			chgrp [ ] \d+ [ ] "\.\./data/d2/d21/f2\.txt" \v
			\v
			mkdir [ ] -p [ ] "\.\./data/d2/d21/newdir/" \v
			cp [ ] "deploy/UP__data__d2__d21/newdir__fnew\.txt" [ ] "\.\./data/d2/d21/newdir/fnew\.txt" \v
			chmod [ ] 0666 [ ] "\.\./data/d2/d21/newdir/fnew\.txt" \v
			chown [ ] user [ ] "\.\./data/d2/d21/newdir/fnew\.txt" \v
			chgrp [ ] group [ ] "\.\./data/d2/d21/newdir/fnew\.txt" \v
			\s* \z
		}x
	);

	files_content_same(
		$dir . '/restore.sh',
		qr{
			\A \s*
			cp [ ] "restore/UP__data__f3\.txt" [ ] "\.\./data/f3\.txt" \v
			chmod [ ] 0[0-7]{3} [ ] "\.\./data/f3\.txt" \v
			chown [ ] \d+ [ ] "\.\./data/f3\.txt" \v
			chgrp [ ] \d+ [ ] "\.\./data/f3\.txt" \v
			\v
			cp [ ] "restore/UP__data__d1__d11/f1\.txt" [ ] "\.\./data/d1/d11/f1\.txt" \v
			chmod [ ] 0[0-7]{3} [ ] "\.\./data/d1/d11/f1\.txt" \v
			chown [ ] \d+ [ ] "\.\./data/d1/d11/f1\.txt" \v
			chgrp [ ] \d+ [ ] "\.\./data/d1/d11/f1\.txt" \v
			\v
			cp [ ] "restore/UP__data__d2__d21/f2\.txt" [ ] "\.\./data/d2/d21/f2\.txt" \v
			chmod [ ] 0[0-7]{3} [ ] "\.\./data/d2/d21/f2\.txt" \v
			chown [ ] \d+ [ ] "\.\./data/d2/d21/f2\.txt" \v
			chgrp [ ] \d+ [ ] "\.\./data/d2/d21/f2\.txt" \v
			\v
			rm [ ] "\.\./data/d2/d21/newdir/fnew\.txt"
			\s* \z
		}x
	);

	files_content_same(
		$dir . '/diff.sh',



( run in 0.525 second using v1.01-cache-2.11-cpan-496ff517765 )