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 )