"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "extra/pren.in" between
littleutils-1.2.4.tar.lz and littleutils-1.2.5.tar.lz

About: littleutils are a collection of small and simple utilities (rename files, search for duplicate files, ...).

pren.in  (littleutils-1.2.4.tar.lz):pren.in  (littleutils-1.2.5.tar.lz)
#! PROGPERL #! PROGPERL
# vim: set filetype=perl: # vim: set filetype=perl:
# pren: renames files using Perl regular expressions (perl rename) # pren: renames files using Perl regular expressions (perl rename)
# Copyright (C) 2005-2020 by Brian Lindholm. This file is part of the # Copyright (C) 2005-2021 by Brian Lindholm. This file is part of the
# littleutils utility set. # littleutils utility set.
# #
# The pren utility is free software; you can redistribute it and/or modify it # The pren utility is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free # under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later version. # Software Foundation; either version 3, or (at your option) any later version.
# #
# The pren utility is distributed in the hope that it will be useful, but # The pren utility is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
# more details. # more details.
skipping to change at line 70 skipping to change at line 70
my $path = ''; my $name = ''; my $path = ''; my $name = '';
if ($old_name =~ /^(.*)\/(.+?)$/) { if ($old_name =~ /^(.*)\/(.+?)$/) {
$path = $1; $path = $1;
$name = $2; $name = $2;
} }
else { else {
$path = '.'; $path = '.';
$name = $old_name; $name = $old_name;
} }
# determine if path is writeable # determine if path is writeable
if (not defined($path_writeable{$path})) { $path_writeable{$path} = (-w $path) unless (defined($path_writeable{$path}));
$path_writeable{$path} = (-w $path); unless ($path_writeable{$path}) {
}
if (not $path_writeable{$path}) {
print STDERR "pren warning: you don't have write permissions in $path\n"; print STDERR "pren warning: you don't have write permissions in $path\n";
next LOOP; next LOOP;
} }
# determine new filename # determine new filename
my $new_name = $name; my $new_name = $name;
eval_regex ($opt_e, $new_name); eval_regex ($opt_e, $new_name);
if ($path ne '.') { $new_name = $path . '/' . $new_name if ($path ne '.');
$new_name = $path . '/' . $new_name;
}
# determine if rename should actually happen # determine if rename should actually happen
if ($new_name eq '') { if ($new_name eq '') {
print STDERR "pren warning: new filename for $name has zero length\n"; print STDERR "pren warning: new filename for $name has zero length\n";
} }
elsif ($new_name eq $old_name) { elsif ($new_name eq $old_name) {
if ($opt_v) { print STDOUT "pren message: old and new filenames for $name are the same\n"
print STDOUT "pren message: old and new filenames for $name are the same\n if ($opt_v);
";
}
} }
elsif ((not $dos_win) && (-e $new_name)) { elsif ((not $dos_win) && (-e $new_name)) {
print STDERR "pren warning: new name for $old_name already exists\n"; print STDERR "pren warning: new name for $old_name already exists\n";
} }
elsif (($dos_win) && (lc($old_name) ne lc($new_name)) && (-e $new_name)) { elsif (($dos_win) && (lc($old_name) ne lc($new_name)) && (-e $new_name)) {
print STDERR "pren warning: new name for $old_name already exists\n"; print STDERR "pren warning: new name for $old_name already exists\n";
} }
elsif ($opt_n) { elsif ($opt_n) {
print STDOUT "echo: rename $old_name $new_name\n"; print STDOUT "echo: rename $old_name $new_name\n";
} }
else { else {
if ((not $dos_win) && (-f $old_name)) { if ((not $dos_win) && (-f $old_name)) {
# the sysopen is for security in world-writeable directories # the sysopen is for security in world-writeable directories
sysopen(HANDLE, $new_name, O_RDWR | O_CREAT | O_EXCL, 0600) sysopen(HANDLE, $new_name, O_RDWR | O_CREAT | O_EXCL, 0600) or die "pren E
or die "pren ERROR: possible SYMLINK ATTACK!!\n"; RROR: possible SYMLINK ATTACK!!\n";
close(HANDLE); close(HANDLE);
} }
rename($old_name, $new_name) rename($old_name, $new_name) or die "pren ERROR: move from $old_name to $new
or die "pren ERROR: move from $old_name to $new_name FAILED!!\n"; _name FAILED!!\n";
if (not $opt_q) { print STDOUT "$old_name moved to $new_name\n" unless ($opt_q);
print STDOUT "$old_name moved to $new_name\n";
}
} }
} }
 End of changes. 6 change blocks. 
19 lines changed or deleted 11 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)