00dani/stow
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Strip superfluous quotes from $hash{'lookups'}

Browse source
This commit is contained in:
Adam Spiers 2011-11-24 00:45:29 +00:00
parent 6534b21d29
commit 0db112441f
4 changed files with 84 additions and 84 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
bin/stow.in
View file

@ -433,7 +433,7 @@ sub main {
if (scalar @conflicts) {
warn "WARNING: conflicts detected.\n";
if ($options->{'conflicts'}) {
if ($options->{conflicts}) {
warn $_ foreach @conflicts;
}
warn "WARNING: all operations aborted.\n";
@ -472,19 +472,19 @@ sub process_options {
sub {
# FIXME: do we really need strip_quotes here?
my $regex = strip_quotes($_[1]);
push @{$options{'ignore'}}, qr($regex\z);
push @{$options{ignore}}, qr($regex\z);
},
'override=s' =>
sub {
my $regex = strip_quotes($_[1]);
push @{$options{'override'}}, qr(\A$regex);
push @{$options{override}}, qr(\A$regex);
},
'defer=s' =>
sub {
my $regex = strip_quotes($_[1]);
push @{$options{'defer'}}, qr(\A$regex);
push @{$options{defer}}, qr(\A$regex);
},
# a little craziness so we can do different actions on the same line:
@ -510,8 +510,8 @@ sub process_options {
},
) or usage();
usage() if $options{'help'};
version() if $options{'version'};
usage() if $options{help};
version() if $options{version};
sanitize_path_options(\%options);
check_packages(\@pkgs_to_unstow, \@pkgs_to_stow);
@ -522,20 +522,20 @@ sub process_options {
sub sanitize_path_options {
my ($options) = @_;
if (exists $options->{'dir'}) {
$options->{'dir'} =~ s/\A +//;
$options->{'dir'} =~ s/ +\z//;
if (exists $options->{dir}) {
$options->{dir} =~ s/\A +//;
$options->{dir} =~ s/ +\z//;
}
else {
$options->{'dir'} = exists $ENV{STOW_DIR} ? $ENV{STOW_DIR} : getcwd();
$options->{dir} = exists $ENV{STOW_DIR} ? $ENV{STOW_DIR} : getcwd();
}
if (exists $options->{'target'}) {
$options->{'target'} =~ s/\A +//;
$options->{'target'} =~ s/ +\z//;
if (exists $options->{target}) {
$options->{target} =~ s/\A +//;
$options->{target} =~ s/ +\z//;
}
else {
$options->{'target'} = parent($options->{'dir'});
$options->{target} = parent($options->{dir});
}
}
@ -568,7 +568,7 @@ sub check_packages {
#=============================================================================
sub get_config_file_options {
my @defaults = ();
for my $file ("$ENV{'HOME'}/.stowrc", '.stowrc') {
for my $file ("$ENV{HOME}/.stowrc", '.stowrc') {
if (-r $file) {
warn "Loading defaults from $file\n";
open my $FILE, '<', $file

128
lib/Stow.pm.in
View file

@ -125,7 +125,7 @@ sub new {
join(", ", keys %opts), "\n";
}
$opts{'simulate'} = 1 if $opts{'conflicts'};
$opts{simulate} = 1 if $opts{conflicts};
set_debug_level($new->get_verbosity());
set_test_mode($new->{test_mode});
@ -239,7 +239,7 @@ sub plan_unstow {
error("The given package name ($package) is not in your stow path $self->{stow_path}");
}
debug(2, "Planning unstow of package $package...");
if ($self->{'compat'}) {
if ($self->{compat}) {
$self->unstow_contents_orig(
$self->{stow_path},
$package,
@ -302,8 +302,8 @@ sub within_target_do {
my ($code) = @_;
my $cwd = getcwd();
chdir($self->{'target'})
or error("Cannot chdir to target tree: $self->{'target'}");
chdir($self->{target})
or error("Cannot chdir to target tree: $self->{target}");
debug(3, "cwd now $self->{target}");
$self->$code();
@ -1099,7 +1099,7 @@ sub ignore {
internal_error(__PACKAGE__ . "::ignore() called with empty target")
unless length $target;
for my $suffix (@{ $self->{'ignore'} }) {
for my $suffix (@{ $self->{ignore} }) {
if ($target =~ m/$suffix/) {
debug(4, " Ignoring path $target due to --ignore=$suffix");
return 1;
@ -1279,7 +1279,7 @@ sub defer {
my $self = shift;
my ($path) = @_;
for my $prefix (@{ $self->{'defer'} }) {
for my $prefix (@{ $self->{defer} }) {
return 1 if $path =~ m/$prefix/;
}
return 0;
@ -1297,7 +1297,7 @@ sub override {
my $self = shift;
my ($path) = @_;
for my $regex (@{ $self->{'override'} }) {
for my $regex (@{ $self->{override} }) {
return 1 if $path =~ m/$regex/;
}
return 0;
@ -1323,13 +1323,13 @@ sub process_tasks {
debug(2, "Processing tasks...");
if ($self->{'simulate'}) {
if ($self->{simulate}) {
warn "WARNING: simulating so all operations are deferred.\n";
return;
}
# Strip out all tasks with a skip action
$self->{tasks} = [ grep { $_->{'action'} ne 'skip' } @{ $self->{tasks} } ];
$self->{tasks} = [ grep { $_->{action} ne 'skip' } @{ $self->{tasks} } ];
if (not @{ $self->{tasks} }) {
warn "There are no outstanding operations to perform.\n";
@ -1359,38 +1359,38 @@ sub process_task {
my $self = shift;
my ($task) = @_;
if ($task->{'action'} eq 'create') {
if ($task->{'type'} eq 'dir') {
mkdir($task->{'path'}, 0777)
or error(qq(Could not create directory: $task->{'path'}));
if ($task->{action} eq 'create') {
if ($task->{type} eq 'dir') {
mkdir($task->{path}, 0777)
or error(qq(Could not create directory: $task->{path}));
}
elsif ($task->{'type'} eq 'link') {
symlink $task->{'source'}, $task->{'path'}
elsif ($task->{type} eq 'link') {
symlink $task->{source}, $task->{path}
or error(
q(Could not create symlink: %s => %s),
$task->{'path'},
$task->{'source'}
$task->{path},
$task->{source}
);
}
else {
internal_error(qq(bad task type: $task->{'type'}));
internal_error(qq(bad task type: $task->{type}));
}
}
elsif ($task->{'action'} eq 'remove') {
if ($task->{'type'} eq 'dir') {
rmdir $task->{'path'}
or error(qq(Could not remove directory: $task->{'path'}));
elsif ($task->{action} eq 'remove') {
if ($task->{type} eq 'dir') {
rmdir $task->{path}
or error(qq(Could not remove directory: $task->{path}));
}
elsif ($task->{'type'} eq 'link') {
unlink $task->{'path'}
or error(qq(Could not remove link: $task->{'path'}));
elsif ($task->{type} eq 'link') {
unlink $task->{path}
or error(qq(Could not remove link: $task->{path}));
}
else {
internal_error(qq(bad task type: $task->{'type'}));
internal_error(qq(bad task type: $task->{type}));
}
}
else {
internal_error(qq(bad task action: $task->{'action'}));
internal_error(qq(bad task action: $task->{action}));
}
}
@ -1411,7 +1411,7 @@ sub link_task_action {
return '';
}
my $action = $self->{link_task_for}{$path}->{'action'};
my $action = $self->{link_task_for}{$path}->{action};
internal_error("bad task action: $action")
unless $action eq 'remove' or $action eq 'create';
@ -1436,7 +1436,7 @@ sub dir_task_action {
return '';
}
my $action = $self->{dir_task_for}{$path}->{'action'};
my $action = $self->{dir_task_for}{$path}->{action};
internal_error("bad task action: $action")
unless $action eq 'remove' or $action eq 'create';
@ -1462,7 +1462,7 @@ sub parent_link_scheduled_for_removal {
$prefix = join_paths($prefix, $part);
debug(4, " parent_link_scheduled_for_removal($path): prefix $prefix");
if (exists $self->{link_task_for}{$prefix} and
$self->{link_task_for}{$prefix}->{'action'} eq 'remove') {
$self->{link_task_for}{$prefix}->{action} eq 'remove') {
debug(4, " parent_link_scheduled_for_removal($path): link scheduled for removal");
return 1;
}
@ -1630,7 +1630,7 @@ sub read_a_link {
debug(4, " read_a_link($path): task exists with action $action");
if ($action eq 'create') {
return $self->{link_task_for}{$path}->{'source'};
return $self->{link_task_for}{$path}->{source};
}
elsif ($action eq 'remove') {
internal_error(
@ -1662,8 +1662,8 @@ sub do_link {
if (exists $self->{dir_task_for}{$newfile}) {
my $task_ref = $self->{dir_task_for}{$newfile};
if ($task_ref->{'action'} eq 'create') {
if ($task_ref->{'type'} eq 'dir') {
if ($task_ref->{action} eq 'create') {
if ($task_ref->{type} eq 'dir') {
internal_error(
"new link (%s => %s) clashes with planned new directory",
$newfile,
@ -1671,23 +1671,23 @@ sub do_link {
);
}
}
elsif ($task_ref->{'action'} eq 'remove') {
elsif ($task_ref->{action} eq 'remove') {
# We may need to remove a directory before creating a link so continue.
}
else {
internal_error("bad task action: $task_ref->{'action'}");
internal_error("bad task action: $task_ref->{action}");
}
}
if (exists $self->{link_task_for}{$newfile}) {
my $task_ref = $self->{link_task_for}{$newfile};
if ($task_ref->{'action'} eq 'create') {
if ($task_ref->{'source'} ne $oldfile) {
if ($task_ref->{action} eq 'create') {
if ($task_ref->{source} ne $oldfile) {
internal_error(
"new link clashes with planned new link: %s => %s",
$task_ref->{'path'},
$task_ref->{'source'},
$task_ref->{path},
$task_ref->{source},
)
}
else {
@ -1695,18 +1695,18 @@ sub do_link {
return;
}
}
elsif ($task_ref->{'action'} eq 'remove') {
if ($task_ref->{'source'} eq $oldfile) {
elsif ($task_ref->{action} eq 'remove') {
if ($task_ref->{source} eq $oldfile) {
# No need to remove a link we are going to recreate
debug(1, "LINK: $newfile => $oldfile (reverts previous action)");
$self->{link_task_for}{$newfile}->{'action'} = 'skip';
$self->{link_task_for}{$newfile}->{action} = 'skip';
delete $self->{link_task_for}{$newfile};
return;
}
# We may need to remove a link to replace it so continue
}
else {
internal_error("bad task action: $task_ref->{'action'}");
internal_error("bad task action: $task_ref->{action}");
}
}
@ -1738,26 +1738,26 @@ sub do_unlink {
if (exists $self->{link_task_for}{$file}) {
my $task_ref = $self->{link_task_for}{$file};
if ($task_ref->{'action'} eq 'remove') {
if ($task_ref->{action} eq 'remove') {
debug(1, "UNLINK: $file (duplicates previous action)");
return;
}
elsif ($task_ref->{'action'} eq 'create') {
elsif ($task_ref->{action} eq 'create') {
# Do need to create a link then remove it
debug(1, "UNLINK: $file (reverts previous action)");
$self->{link_task_for}{$file}->{'action'} = 'skip';
$self->{link_task_for}{$file}->{action} = 'skip';
delete $self->{link_task_for}{$file};
return;
}
else {
internal_error("bad task action: $task_ref->{'action'}");
internal_error("bad task action: $task_ref->{action}");
}
}
if (exists $self->{dir_task_for}{$file} and $self->{dir_task_for}{$file} eq 'create') {
internal_error(
"new unlink operation clashes with planned operation: %s dir %s",
$self->{dir_task_for}{$file}->{'action'},
$self->{dir_task_for}{$file}->{action},
$file
);
}
@ -1796,36 +1796,36 @@ sub do_mkdir {
if (exists $self->{link_task_for}{$dir}) {
my $task_ref = $self->{link_task_for}{$dir};
if ($task_ref->{'action'} eq 'create') {
if ($task_ref->{action} eq 'create') {
internal_error(
"new dir clashes with planned new link (%s => %s)",
$task_ref->{'path'},
$task_ref->{'source'},
$task_ref->{path},
$task_ref->{source},
);
}
elsif ($task_ref->{'action'} eq 'remove') {
elsif ($task_ref->{action} eq 'remove') {
# May need to remove a link before creating a directory so continue
}
else {
internal_error("bad task action: $task_ref->{'action'}");
internal_error("bad task action: $task_ref->{action}");
}
}
if (exists $self->{dir_task_for}{$dir}) {
my $task_ref = $self->{dir_task_for}{$dir};
if ($task_ref->{'action'} eq 'create') {
if ($task_ref->{action} eq 'create') {
debug(1, "MKDIR: $dir (duplicates previous action)");
return;
}
elsif ($task_ref->{'action'} eq 'remove') {
elsif ($task_ref->{action} eq 'remove') {
debug(1, "MKDIR: $dir (reverts previous action)");
$self->{dir_task_for}{$dir}->{'action'} = 'skip';
$self->{dir_task_for}{$dir}->{action} = 'skip';
delete $self->{dir_task_for}{$dir};
return;
}
else {
internal_error("bad task action: $task_ref->{'action'}");
internal_error("bad task action: $task_ref->{action}");
}
}
@ -1859,27 +1859,27 @@ sub do_rmdir {
my $task_ref = $self->{link_task_for}{$dir};
internal_error(
"rmdir clashes with planned operation: %s link %s => %s",
$task_ref->{'action'},
$task_ref->{'path'},
$task_ref->{'source'}
$task_ref->{action},
$task_ref->{path},
$task_ref->{source}
);
}
if (exists $self->{dir_task_for}{$dir}) {
my $task_ref = $self->{link_task_for}{$dir};
if ($task_ref->{'action'} eq 'remove') {
if ($task_ref->{action} eq 'remove') {
debug(1, "RMDIR $dir (duplicates previous action)");
return;
}
elsif ($task_ref->{'action'} eq 'create') {
elsif ($task_ref->{action} eq 'create') {
debug(1, "MKDIR $dir (reverts previous action)");
$self->{link_task_for}{$dir}->{'action'} = 'skip';
$self->{link_task_for}{$dir}->{action} = 'skip';
delete $self->{link_task_for}{$dir};
return;
}
else {
internal_error("bad task action: $task_ref->{'action'}");
internal_error("bad task action: $task_ref->{action}");
}
}

2
t/chkstow.t
View file

@ -70,7 +70,7 @@ stderr_like(
"Skip directories containing .stow");
# squelch warn so that check_stow doesn't carp about skipping .stow all the time
$SIG{'__WARN__'} = sub { };
$SIG{__WARN__} = sub { };
@ARGV = ('-t', '.', '-l');
stdout_like(

8
t/stow.t
View file

@ -58,7 +58,7 @@ local @ARGV = (
'dummy'
);
($options, $pkgs_to_delete, $pkgs_to_stow) = process_options();
is_deeply($options->{'defer'}, [ qr(\Aman), qr(\Ainfo) ] => 'defer man and info');
is_deeply($options->{defer}, [ qr(\Aman), qr(\Ainfo) ] => 'defer man and info');
#
# Check setting override paths
@ -69,7 +69,7 @@ local @ARGV = (
'dummy'
);
($options, $pkgs_to_delete, $pkgs_to_stow) = process_options();
is_deeply($options->{'override'}, [qr(\Aman), qr(\Ainfo)] => 'override man and info');
is_deeply($options->{override}, [qr(\Aman), qr(\Ainfo)] => 'override man and info');
#
# Check stripping any matched quotes
@ -80,7 +80,7 @@ local @ARGV = (
'dummy'
);
($options, $pkgs_to_delete, $pkgs_to_stow) = process_options();
is_deeply($options->{'override'}, [qr(\Aman), qr(\Ainfo)] => 'strip shell quoting');
is_deeply($options->{override}, [qr(\Aman), qr(\Ainfo)] => 'strip shell quoting');
#
# Check setting ignored paths
@ -91,7 +91,7 @@ local @ARGV = (
'dummy'
);
($options, $pkgs_to_delete, $pkgs_to_stow) = process_options();
is_deeply($options->{'ignore'}, [ qr(~\z), qr(\.#.*\z) ] => 'ignore temp files');
is_deeply($options->{ignore}, [ qr(~\z), qr(\.#.*\z) ] => 'ignore temp files');
# vim:ft=perl