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

128
lib/Stow.pm.in
View file

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

8
t/stow.t
View file

@ -58,7 +58,7 @@ local @ARGV = (
'dummy' 'dummy'
); );
($options, $pkgs_to_delete, $pkgs_to_stow) = process_options(); ($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 # Check setting override paths
@ -69,7 +69,7 @@ local @ARGV = (
'dummy' 'dummy'
); );
($options, $pkgs_to_delete, $pkgs_to_stow) = process_options(); ($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 # Check stripping any matched quotes
@ -80,7 +80,7 @@ local @ARGV = (
'dummy' 'dummy'
); );
($options, $pkgs_to_delete, $pkgs_to_stow) = process_options(); ($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 # Check setting ignored paths
@ -91,7 +91,7 @@ local @ARGV = (
'dummy' 'dummy'
); );
($options, $pkgs_to_delete, $pkgs_to_stow) = process_options(); ($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 # vim:ft=perl