are a collection of small and simple utilities (rename files, search for duplicate files, ...).
| lcuc.in (littleutils-1.2.4.tar.lz) | : | lcuc.in (littleutils-1.2.5.tar.lz) |
|---|
| #! PROGPERL | | #! PROGPERL |
| # vim: set filetype=perl: | | # vim: set filetype=perl: |
| | |
| # PROGNAME: rename files to all PROGNAME filenames | | # PROGNAME: rename files to all PROGNAME filenames |
| | |
|
| # 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 PROGNAME utility is free software; you can redistribute it and/or modify | | # The PROGNAME 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 | | # it 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 PROGNAME utility is distributed in the hope that it will be useful, but | | # The PROGNAME 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 63 | | skipping to change at line 63 |
|---|
| 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; |
| } | | } |
| # split into base and filename if requested | | # split into base and filename if requested |
| my $base = ''; my $ext = ''; my $trying = 0; | | my $base = ''; my $ext = ''; my $trying = 0; |
| if ($opt_x) { | | if ($opt_x) { |
| if ($name =~ /^(.+)\.([^.]+)$/) { | | if ($name =~ /^(.+)\.([^.]+)$/) { |
| $base = $1; | | $base = $1; |
| $ext = $2; | | $ext = $2; |
| $trying = 1; | | $trying = 1; |
| | |
| skipping to change at line 116 | | skipping to change at line 114 |
|---|
| else { | | else { |
| if (($opt_x || $opt_X) && $trying) { | | if (($opt_x || $opt_X) && $trying) { |
| $new_name = $path . '/' . $base . '.' . KEYFUNC($ext); | | $new_name = $path . '/' . $base . '.' . KEYFUNC($ext); |
| } | | } |
| else { | | else { |
| $new_name = $path . '/' . KEYFUNC($name); | | $new_name = $path . '/' . KEYFUNC($name); |
| } | | } |
| } | | } |
| # determine if rename should actually happen | | # determine if rename should actually happen |
| if (($opt_x || $opt_X) && (not $trying)) { | | if (($opt_x || $opt_X) && (not $trying)) { |
|
| if ($opt_v) { | | print STDOUT "PROGNAME message: skipping $old_name\n" if ($opt_v); |
| print STDOUT "PROGNAME message: skipping $old_name\n"; | | |
| } | | |
| } | | } |
| elsif ($new_name eq $old_name) { | | elsif ($new_name eq $old_name) { |
|
| if ($opt_v) { | | print STDOUT "PROGNAME message: $old_name already PROGNAME\n" if ($opt_v); |
| print STDOUT "PROGNAME message: $old_name already PROGNAME\n"; | | |
| } | | |
| } | | } |
| elsif ((not $dos_win) && (-e $new_name)) { | | elsif ((not $dos_win) && (-e $new_name)) { |
| print STDERR "PROGNAME warning: new name for $old_name already exists\n"; | | print STDERR "PROGNAME warning: new name for $old_name already exists\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 "PROGNA |
| or die "PROGNAME ERROR: possible SYMLINK ATTACK!!\n"; | | ME ERROR: possible SYMLINK ATTACK!!\n"; |
| close(HANDLE); | | close(HANDLE); |
| } | | } |
|
| rename($old_name, $new_name) | | rename($old_name, $new_name) or die "PROGNAME ERROR: move from $old_name to |
| or die "PROGNAME ERROR: move from $old_name to $new_name FAILED!!\n"; | | $new_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. |
|---|
| 18 lines changed or deleted | | 10 lines changed or added |
|---|
"Fossies" - the Fresh Open Source Software Archive 