Setup-File
view release on metacpan or search on metacpan
predictable and uniform across systems.
0.15 2012-08-29 Released-By: SHARYANTO
[ENHANCEMENTS]
- Update to Rinci 1.1.28 (transaction protocol v=2).
- Add various simpler functions like rmdir(), mkdir(), rmfile(),
mkfile(), chown(), chmod() (not exported).
[INCOMPATIBLE CHANGES]
- Move setup_dir() from Setup::File::Dir to Setup::File (I'm too lazy to
put fully-qualified function names to the actions).
0.14 2012-03-28 Released-By: SHARYANTO
- No functional changes. Split specification to Setup dist. Split
Makefile.PL
README
dist.ini
lib/Setup/File.pm
lib/Setup/File/Dir.pm
t/00-compile.t
t/author-critic.t
t/author-pod-coverage.t
t/author-pod-syntax.t
t/chmod.t
t/chown.t
t/mkdir.t
t/mkfile.t
t/release-rinci.t
t/rmdir.t
t/rmfile.t
t/setup_dir-chown.t
t/setup_dir.t
t/setup_file-chown.t
t/setup_file.t
weaver.ini
}
},
"runtime" : {
"requires" : {
"Digest::MD5" : "0",
"Exporter" : "5.57",
"File::Slurper" : "0",
"File::Trash::Undoable" : "0.230",
"File::Util::Test" : "0.628",
"File::chmod" : "0",
"Lchown" : "0",
"Log::ger" : "0.038",
"perl" : "5.010001",
"strict" : "0",
"warnings" : "0"
}
},
"test" : {
"requires" : {
"File::Path" : "0",
"File::Spec" : "0",
Setup::File::Dir:
file: lib/Setup/File/Dir.pm
version: '0.240'
requires:
Digest::MD5: '0'
Exporter: '5.57'
File::Slurper: '0'
File::Trash::Undoable: '0.230'
File::Util::Test: '0.628'
File::chmod: '0'
Lchown: '0'
Log::ger: '0.038'
perl: '5.010001'
strict: '0'
warnings: '0'
resources:
bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Setup-File
homepage: https://metacpan.org/release/Setup-File
repository: git://github.com/perlancar/perl-Setup-File.git
version: '0.240'
x_Dist_Zilla:
Makefile.PL view on Meta::CPAN
"LICENSE" => "perl",
"MIN_PERL_VERSION" => "5.010001",
"NAME" => "Setup::File",
"PREREQ_PM" => {
"Digest::MD5" => 0,
"Exporter" => "5.57",
"File::Slurper" => 0,
"File::Trash::Undoable" => "0.230",
"File::Util::Test" => "0.628",
"File::chmod" => 0,
"Lchown" => 0,
"Log::ger" => "0.038",
"strict" => 0,
"warnings" => 0
},
"TEST_REQUIRES" => {
"File::Path" => 0,
"File::Spec" => 0,
"File::Temp" => "0.2307",
"File::chdir" => 0,
"FindBin" => 0,
Makefile.PL view on Meta::CPAN
"File::Slurper" => 0,
"File::Spec" => 0,
"File::Temp" => "0.2307",
"File::Trash::Undoable" => "0.230",
"File::Util::Test" => "0.628",
"File::chdir" => 0,
"File::chmod" => 0,
"FindBin" => 0,
"IO::Handle" => 0,
"IPC::Open3" => 0,
"Lchown" => 0,
"Log::ger" => "0.038",
"Test::More" => "0.98",
"Test::Perinci::Tx::Manager" => "0.56",
"lib" => 0,
"strict" => 0,
"warnings" => 0
);
unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
element ($reason) is a string containing error message, or something
like "OK" if status is 200. Third element ($payload) is the actual
result, but usually not present when enveloped result is an error
response ($status_code is not 2xx). Fourth element (%result_meta) is
called result metadata and is optional, a hash that contains extra
information, much like how HTTP response headers provide additional
metadata.
Return value: (any)
chown
Usage:
chown(%args) -> [$status_code, $reason, $payload, \%result_meta]
Set file's ownership.
Fixed state: "path" exists and ownership is already correct.
Fixable state: "path" exists but ownership is not correct.
Unfixable state: "path" doesn't exist.
This function is not exported.
[Prereqs]
perl=5.010001
strict=0
warnings=0
Digest::MD5=0
Exporter=5.57
File::chmod=0
File::Slurper=0
File::Trash::Undoable=0.230
File::Util::Test=0.628
Lchown=0
Log::ger=0.038
[Prereqs / DevelopX_spec]
-phase=develop
-relationship=x_spec
Rinci=1.1.102
Setup=1.0.2
lib/Setup/File.pm view on Meta::CPAN
log_info("Chmod %s to %04o ...", $path, $want_mode);
if (CORE::chmod($want_mode, $path)) {
return [200, "Fixed"];
} else {
return [500, "Can't chmod $path, $want_mode: $!"];
}
}
[400, "Invalid -tx_action"];
}
$SPEC{chown} = {
v => 1.1,
summary => "Set file's ownership",
description => <<'_',
Fixed state: `path` exists and ownership is already correct.
Fixable state: `path` exists but ownership is not correct.
Unfixable state: `path` doesn't exist.
lib/Setup/File.pm view on Meta::CPAN
orig_group => {
summary=>'If set, confirm if current group is not the same as this',
schema => 'str',
},
},
features => {
tx => {v=>2},
idempotent => 1,
},
};
sub chown {
require Lchown;
return [412, "lchown() is not available on this system"] unless
Lchown::LCHOWN_AVAILABLE();
my %args = @_;
# TMP, schema
my $tx_action = $args{-tx_action} // '';
my $dry_run = $args{-dry_run};
my $path = $args{path};
defined($path) or return [400, "Please specify path"];
my $follow_sym = $args{follow_symlink} // 0;
my $orig_owner = $args{orig_owner};
lib/Setup/File.pm view on Meta::CPAN
my $exists = $is_sym || (-e _);
if ($follow_sym && $exists) {
@st = stat($path);
return [500, "Can't stat $path (2): $!"] unless @st;
}
my $cur_uid = $st[4];
my $cur_gid = $st[5];
if (!$args{-tx_recovery} && !$args{-confirm}) {
my $changed = defined($orig_uid) && $orig_uid != $cur_uid ||
defined($orig_gid) && $orig_gid != $cur_gid;
return [331, "File $path has changed ownership, confirm chown?"]
if $changed;
}
#$log->tracef("path=%s, cur_uid=%s, cur_gid=%s, want_uid=%s, want_uname=%s, want_gid=%s, want_gname=%s", $cur_uid, $cur_gid, $want_uid, $want_uname, $want_gid, $want_gname);
if ($tx_action eq 'check_state') {
my @undo;
return [412, "$path doesn't exist"] if !$exists;
if (defined($want_uid) && $cur_uid != $want_uid ||
defined($want_gid) && $cur_gid != $want_gid) {
log_info("(DRY) Chown %s to (%s, %s)",
$path, $want_owner, $want_group) if $dry_run;
unshift @undo, [chown => {
path => $path,
owner => (defined($want_uid) &&
$cur_uid != $want_uid ? $cur_uid : undef),
group => (defined($want_gid) &&
$cur_gid != $want_gid ? $cur_gid : undef),
orig_owner => $want_owner, orig_group => $want_group,
follow_symlink => $follow_sym,
}];
}
if (@undo) {
return [200, "Path $path needs to be chown'ed to ".
"(".($want_owner // "-").", ".($want_group // "-").")",
undef, {undo_actions=>\@undo}];
} else {
return [304, "Path $path already has correct owner and group"];
}
} elsif ($tx_action eq 'fix_state') {
my $res;
log_info("%schown %path to (%s, %s) ...", $follow_sym ? "" : "l",
$path, $want_uid // -1, $want_gid // -1);
if ($follow_sym) {
$res = CORE::chown ($want_uid // -1, $want_gid // -1, $path);
} else {
$res = Lchown::lchown($want_uid // -1, $want_gid // -1, $path);
}
if ($res) {
return [200, "Fixed"];
} else {
return [500, "Can't chown $path, ".($want_uid // -1).", ".
($want_gid // -1).": $!"];
}
}
[400, "Invalid -tx_action"];
}
$SPEC{rmfile} = {
v => 1.1,
summary => 'Delete file',
description => <<'_',
lib/Setup/File.pm view on Meta::CPAN
if (defined $args{mode}) {
my $cur_mode; $cur_mode = @st ? $st[2] & 07777 : undef; ## no critic: ValuesAndExpressions::ProhibitLeadingZeros
push @do, ["chmod" => {
path=>$path, mode=>$args{mode}}];
unshift @undo, ["chmod" => {
path=>$path, mode=>$cur_mode}] if defined($cur_mode);
}
if (defined $args{owner}) {
my $cur_uid = @st ? $st[4] : undef;
push @do, ["chown" => {
path=>$path, follow_symlink=>$allow_sym,
owner=>$args{owner}}];
unshift @undo, ["chown" => {
path=>$path, follow_symlink=>$allow_sym,
mode=>$cur_uid}] if defined($cur_uid);
}
if (defined $args{group}) {
my $cur_gid =@st ? $st[5] : undef;
push @do, ["chown" => {
path=>$path, follow_symlink=>$allow_sym,
group=>$args{group}}];
unshift @undo, ["chown" => {
path=>$path, follow_symlink=>$allow_sym,
group=>$cur_gid}] if defined($cur_gid);
}
} # block
if (@do) {
[200, "", undef, {do_actions=>\@do, undo_actions=>\@undo}];
} else {
[304, "Already fixed"];
}
lib/Setup/File.pm view on Meta::CPAN
(200 means OK, 4xx caller error, 5xx function error). Second element
($reason) is a string containing error message, or something like "OK" if status is
200. Third element ($payload) is the actual result, but usually not present when enveloped result is an error response ($status_code is not 2xx). Fourth
element (%result_meta) is called result metadata and is optional, a hash
that contains extra information, much like how HTTP response headers provide additional metadata.
Return value: (any)
=head2 chown
Usage:
chown(%args) -> [$status_code, $reason, $payload, \%result_meta]
Set file's ownership.
Fixed state: C<path> exists and ownership is already correct.
Fixable state: C<path> exists but ownership is not correct.
Unfixable state: C<path> doesn't exist.
This function is not exported.
use 5.010;
use strict;
use warnings;
use FindBin '$Bin';
use lib "$Bin/lib";
use File::chdir;
use File::Path qw(remove_tree);
use File::Temp qw(tempdir);
use Lchown;
use Setup::File;
use Test::More 0.98;
use Test::Perinci::Tx::Manager qw(test_tx_action);
plan skip_all => "This test requires running as superuser" if $>;
my $tmpdir = tempdir(CLEANUP=>1);
$CWD = $tmpdir;
test_tx_action(
name => "unfixable (didn't exist)",
tmpdir => $tmpdir,
f => 'Setup::File::chown',
args => {path=>"p", owner=>"root", group=>"root"},
reset_state => sub { remove_tree "p" },
status => 412,
);
test_tx_action(
name => "fixed (owner and group already correct)",
tmpdir => $tmpdir,
f => 'Setup::File::chown',
args => {path=>"p", owner=>"root", group=>"root"},
reset_state => sub {
remove_tree "p";
mkdir "p"; chown 0, 0, "p";
},
status => 304,
);
test_tx_action(
name => "fixable (owner only)",
tmpdir => $tmpdir,
f => 'Setup::File::chown',
args => {path=>"p", owner=>"root", group=>"root"},
reset_state => sub {
remove_tree "p";
mkdir "p"; chown 1, 0, "p";
},
);
test_tx_action(
name => "fixable (group only)",
tmpdir => $tmpdir,
f => 'Setup::File::chown',
args => {path=>"p", owner=>"root", group=>"root"},
reset_state => sub {
remove_tree "p";
mkdir "p"; chown 0, 1, "p";
},
);
test_tx_action(
name => "fixable (owner & group)",
tmpdir => $tmpdir,
f => 'Setup::File::chown',
args => {path=>"p", owner=>"root", group=>"root"},
reset_state => sub {
remove_tree "p";
mkdir "p"; chown 1, 1, "p";
},
);
test_tx_action(
name => "fixable (owner & group, numeric)",
tmpdir => $tmpdir,
f => 'Setup::File::chown',
args => {path=>"p", owner=>3, group=>4},
reset_state => sub {
remove_tree "p";
mkdir "p"; chown 0, 0, "p";
},
);
test_tx_action(
name => "owner changed before undo (w/o confirm)",
tmpdir => $tmpdir,
f => 'Setup::File::chown',
args => {path=>"p", owner=>3},
reset_state => sub { remove_tree "p"; mkdir "p"; chown 0, 0, "p" },
before_undo => sub { chown 4, -1, "p" },
undo_status => 331,
);
test_tx_action(
name => "owner changed before undo (w/ confirm)",
tmpdir => $tmpdir,
f => 'Setup::File::chown',
args => {path=>"p", owner=>3},
confirm => 1,
reset_state => sub { remove_tree "p"; mkdir "p"; chown 0, 0, "p" },
before_undo => sub { chown 4, -1, "p" },
);
subtest "symlink tests" => sub {
plan skip_all => "symlink() not available" unless eval { symlink "",""; 1 };
test_tx_action(
name => "follow_symlink=0 (the default)",
tmpdir => $tmpdir,
f => 'Setup::File::chown',
args => {path=>"s", owner=>4, group=>5},
reset_state => sub {
remove_tree "p";
mkdir "p"; chown 0, 1, "p";
symlink "p", "s"; lchown 2, 3, "s";
},
after_do => sub {
my @stp = stat("p");
my @sts = lstat("s");
is($stp[4], 0, "p's uid is 0 (unchanged)");
is($stp[5], 1, "p's gid is 1 (unchanged)");
is($sts[4], 4, "s's uid is 4 (changed)");
is($sts[5], 5, "s's gid is 5 (changed)");
},
);
test_tx_action(
name => "follow_symlink=1",
tmpdir => $tmpdir,
f => 'Setup::File::chown',
args => {path=>"s", owner=>4, group=>5, follow_symlink=>1},
reset_state => sub {
remove_tree "p";
mkdir "p"; chown 0, 1, "p";
symlink "p", "s"; lchown 2, 3, "s";
},
after_do => sub {
my @stp = stat("p");
my @sts = lstat("s");
is($stp[4], 4, "p's uid is 0 (changed)");
is($stp[5], 5, "p's gid is 1 (changed)");
is($sts[4], 2, "s's uid is 4 (unchanged)");
is($sts[5], 3, "s's gid is 5 (unchanged)");
},
);
t/setup_dir-chown.t view on Meta::CPAN
for my $existed (0, 1) {
test_tx_action(
name => ($existed ? "replace":"create").", owner+group",
tmpdir => $tmpdir,
f => "Setup::File::setup_dir",
args => {path=>"p", should_exist=>1,
owner=>3, group=>4},
reset_state => sub {
remove_tree "p";
do { mkdir "p"; chown 1, 2, "p" } if $existed;
},
after_do => sub {
ok((-d "p"), "file created");
my @st = stat "p";
is($st[4], 3, "owner set");
is($st[5], 4, "group set");
},
after_undo => sub {
if ($existed) {
ok((-d "p"), "dir still exists");
t/setup_file-chown.t view on Meta::CPAN
for my $existed (0, 1) {
test_tx_action(
name => ($existed ? "replace":"create").", owner+group",
tmpdir => $tmpdir,
f => "Setup::File::setup_file",
args => {path=>"p", should_exist=>1, content=>"bar",
owner=>3, group=>4},
reset_state => sub {
remove_tree "p";
do { write_text("p", "foo"); chown 1, 2, "p" } if $existed;
},
after_do => sub {
ok((-f "p"), "file created");
is(read_text("p"), "bar", "content set");
my @st = stat "p";
is($st[4], 3, "owner set");
is($st[5], 4, "group set");
},
after_undo => sub {
if ($existed) {
( run in 2.880 seconds using v1.01-cache-2.11-cpan-5511b514fd6 )