Add prename recipe
This commit is contained in:
parent
005f2f8c00
commit
cf0c5ad30a
17
recipes/prename/Makefile
Normal file
17
recipes/prename/Makefile
Normal file
@ -0,0 +1,17 @@
|
||||
name = prename
|
||||
version = 1.0
|
||||
release = 0
|
||||
|
||||
dependencies = perl
|
||||
|
||||
# skip download, configuration, build, install
|
||||
create_steps = create_fake_root_dir fake_root_install_custom package_base clean_working_dir
|
||||
|
||||
fake_root_install_custom:
|
||||
#$(Q)install -d -m0555 "$(pkg_fake_root_dir)/$(BINDIR)/"
|
||||
$(Q)mkdir -p "$(pkg_fake_root_dir)/$(BINDIR)/"
|
||||
$(Q)cp prename "$(pkg_fake_root_dir)/$(BINDIR)/"
|
||||
|
||||
|
||||
SYSCONF ?= ../../
|
||||
include $(SYSCONF)/package.mk
|
||||
278
recipes/prename/prename
Executable file
278
recipes/prename/prename
Executable file
@ -0,0 +1,278 @@
|
||||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
rename - renames multiple files
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
F<rename>
|
||||
B<-h>
|
||||
|
||||
F<rename>
|
||||
S<B<[ -0 ]>>
|
||||
S<B<[ -c | -C ]>>
|
||||
S<B<[ -e code ]>>
|
||||
S<B<[ -f ]>>
|
||||
S<B<[ -i ]>>
|
||||
S<B<[ -l | -L ]>>
|
||||
S<B<[ -n ]>>
|
||||
S<B<[ -s from to ]>>
|
||||
S<B<[ -v ]>>
|
||||
S<B<[ files ]>>
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
C<rename> renames the filenames supplied according to the rules specif
|
||||
+ied. If a given filename is not modified, it will not be renamed. If
|
||||
+no filenames are given on the command line, filenames will be read vi
|
||||
+a standard input.
|
||||
|
||||
For example, to rename all files matching C<*.bak> to strip the extens
|
||||
+ion, you might say
|
||||
|
||||
rename 's/\.bak$//' *.bak
|
||||
|
||||
If are confident that none of the filenames has C<.bak> anywhere else
|
||||
+than at the end, you can also use the much easier typed
|
||||
|
||||
rename -s .bak '' *.bak
|
||||
|
||||
You can always do multiple changes in one ago:
|
||||
|
||||
rename -s .tgz .tar.gz -s .tbz2 .tar.bz2 *.tar.*
|
||||
|
||||
Note however that expressive options are order sensitive. The followin
|
||||
+g would probably surprise you:
|
||||
|
||||
rename -s foo bar -s bar baz *
|
||||
|
||||
Because changes are cumulative, this would end up substituting a F<foo
|
||||
+> match in a filename with F<baz>, not F<bar>! To get the intended re
|
||||
+sults in the above example, you could reverse the order of options:
|
||||
|
||||
rename -s bar baz -s foo bar *
|
||||
|
||||
If you placed the C<-c> after the C<-e> in the above example, files wi
|
||||
+th F<.zip> and F<.ZIP> extensions would be (attempted to be) moved to
|
||||
+ different directories.
|
||||
|
||||
To translate uppercase names to lower, you'd use
|
||||
|
||||
rename -c *
|
||||
|
||||
If you have files with control characters and blanks in their names, C
|
||||
+<-z> will clean them up.
|
||||
|
||||
rename -z *
|
||||
|
||||
You can combine all of these to suit your needs. F.ex files from Windo
|
||||
+ws systems often have blanks and (sometimes nothing but) capital lett
|
||||
+ers. Let's say you have a bunch of such files to clean up, and you al
|
||||
+so want to move them to subdirectories based on extension. The follow
|
||||
+ing command should help, provided all directories already exist:
|
||||
|
||||
rename -cz -e '$_ = "$1/$_" if /(\..*)\z/' *
|
||||
|
||||
Again you need to pay attention to order sensitivity for expressive op
|
||||
+tions. If you placed the C<-c> after the C<-e> in the above example,
|
||||
+files with F<.zip> and F<.ZIP> extensions would be (attempted to be)
|
||||
+moved to different directories because the directory name prefix woul
|
||||
+d be added before the filenames were normalized.
|
||||
|
||||
=head1 ARGUMENTS
|
||||
|
||||
=over 4
|
||||
|
||||
=item B<-h>, B<--help>
|
||||
|
||||
Browse the manpage.
|
||||
|
||||
=back
|
||||
|
||||
=head1 OPTIONS
|
||||
|
||||
=over 4
|
||||
|
||||
=item B<-0>, B<--null>
|
||||
|
||||
When reading file names from C<STDIN>, split on null bytes instead of
|
||||
+newlines. This is useful in combination with GNU find's C<-print0> op
|
||||
+tion, GNU grep's C<-Z> option, and GNU sort's C<-z> option, to name j
|
||||
+ust a few. B<Only valid if no filenames have been given on the comman
|
||||
+dline.>
|
||||
|
||||
=item B<-c>, B<--lower-case>
|
||||
|
||||
Converts file names to all lower case.
|
||||
|
||||
=item B<-C>, B<--upper-case>
|
||||
|
||||
Converts file names to all upper case.
|
||||
|
||||
=item B<-e>, B<--expr>
|
||||
|
||||
The C<code> argument to this option should be a Perl expression that a
|
||||
+ssumes the filename in the C<$_> variable and modifies it for the fil
|
||||
+enames to be renamed. When no other C<-c>, C<-C>, C<-e>, C<-s>, or C<
|
||||
+-z> options are given, you can omit the C<-e> from infront of the cod
|
||||
+e.
|
||||
|
||||
=item B<-f>, B<--force>
|
||||
|
||||
Rename even when a file with the destination name already exists.
|
||||
|
||||
=item B<-i>, B<--interactive>
|
||||
|
||||
Ask the user to confirm every action before it is taken.
|
||||
|
||||
=item B<-l>, B<--symlink>
|
||||
|
||||
Create symlinks from the new names to the existing ones, instead of re
|
||||
+naming the files. B<Cannot be used in conjunction with C<-L>.>
|
||||
|
||||
=item B<-L>, B<--hardlink>
|
||||
|
||||
Create hard links from the new names to the existing ones, instead of
|
||||
+renaming the files. B<Cannot be used in conjunction with C<-l>.>
|
||||
|
||||
=item B<-n>, B<--dry-run>, B<--just-print>
|
||||
|
||||
Show how the files would be renamed, but don't actually do anything.
|
||||
|
||||
=item B<-s>, B<--subst>, B<--simple>
|
||||
|
||||
Perform a simple textual substitution of C<from> to C<to>. The C<from>
|
||||
+ and C<to> parameters must immediately follow the argument.
|
||||
|
||||
This is equivalent to supplying a C<perlexpr> of C<s/\Qfrom/to/>.
|
||||
|
||||
=item B<-v>, B<--verbose>
|
||||
|
||||
Print additional information about the operations (not) executed.
|
||||
|
||||
=item B<-z>, B<--sanitize>
|
||||
|
||||
Replaces consecutive blanks, shell meta characters, and control charac
|
||||
+ters in filenames with underscores.
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
mv(1), perl(1), find(1), grep(1), sort(1)
|
||||
|
||||
=head1 AUTHORS
|
||||
|
||||
Aristotle Pagaltzis
|
||||
|
||||
Original code from Larry Wall and Robin Barker.
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
None currently known.
|
||||
|
||||
=cut
|
||||
|
||||
use Pod::Usage;
|
||||
use Getopt::Long;
|
||||
|
||||
sub DEBUG { print "@_\n" if $::LEVEL >= 2 }
|
||||
sub INFO { print "@_\n" if $::LEVEL >= 1 }
|
||||
sub ERROR { print "@_\n" }
|
||||
|
||||
my @perlexpr;
|
||||
|
||||
Getopt::Long::Configure(qw(bundling no_ignore_case));
|
||||
GetOptions(
|
||||
'h|help' => sub { pod2usage( -verbose => 2 ) },
|
||||
'0|null' => \my $opt_null,
|
||||
'c|lower-case' => sub { push @perlexpr, 's/([[:upper:]]+)/\L$1/g' },
|
||||
'C|upper-case' => sub { push @perlexpr, 's/([[:lower:]]+)/\U$1/g' },
|
||||
'e|expr=s' => \@perlexpr,
|
||||
'f|force' => \my $opt_force,
|
||||
'i|interactive' => \my $opt_interactive,
|
||||
'l|symlink' => \my $opt_symlink,
|
||||
'L|hardlink' => \my $opt_hardlink,
|
||||
'n|just-print|dry-run' => \my $opt_dryrun,
|
||||
's|subst|simple' => sub {
|
||||
pod2usage( -verbose => 1 ) if @ARGV < 2;
|
||||
my @param = map(quotemeta, splice @ARGV, 0, 2);
|
||||
# NB: ${\"..."} is necessary because unknown backslash escapes are not
|
||||
# treated the same in pattern- vs doublequote-quoting context, and we need
|
||||
# the latter to do the right thing with user input like 'foo{bar}baz'
|
||||
push @perlexpr, sprintf 's/\Q${\"%s"}\E/%s/', @param;
|
||||
},
|
||||
'v|verbose+' => \my $opt_verbose,
|
||||
'z|sanitize' => sub { push @perlexpr, 's/[!"$&()=?`*\';<>|_[:cntrl:][:blank:]]+/_/g' },
|
||||
) or pod2usage( -verbose => 1 );
|
||||
|
||||
pod2usage( -verbose => 1 ) if $opt_hardlink and $opt_symlink;
|
||||
|
||||
if(not @perlexpr) {
|
||||
if(@ARGV) { push @perlexpr, shift }
|
||||
else { pod2usage( -verbose => 1 ) }
|
||||
}
|
||||
|
||||
pod2usage( -verbose => 1 ) if $opt_null and @ARGV;
|
||||
|
||||
$::LEVEL = ($opt_verbose || 0) + ($opt_dryrun || 0);
|
||||
|
||||
my $code = do {
|
||||
my $cat = "sub { ".join('; ', @perlexpr)." }";
|
||||
DEBUG("Using expression: $cat");
|
||||
my $evaled = eval $cat;
|
||||
die $@ if $@;
|
||||
die "Could not evaluate to code ref\n" unless 'CODE' eq ref $evaled;
|
||||
$evaled;
|
||||
};
|
||||
|
||||
if (!@ARGV) {
|
||||
INFO("Reading filenames from STDIN");
|
||||
@ARGV = do {
|
||||
if($opt_null) {
|
||||
INFO("Splitting on null bytes");
|
||||
local $/ = "\0";
|
||||
}
|
||||
<STDIN>;
|
||||
};
|
||||
chomp @ARGV;
|
||||
}
|
||||
|
||||
my ($verb, $verbed, $action) =
|
||||
$opt_hardlink ? ( qw(link linked), sub { link shift, shift } ) :
|
||||
$opt_symlink ? ( qw(symlink symlinked), sub { symlink shift, shift } ) :
|
||||
do { qw(rename renamed), sub { rename shift, shift } };
|
||||
|
||||
for (@ARGV) {
|
||||
my $oldname = $_;
|
||||
|
||||
$code->();
|
||||
|
||||
if($oldname eq $_) {
|
||||
DEBUG("'$oldname' unchanged");
|
||||
next;
|
||||
}
|
||||
|
||||
ERROR("'$oldname' not $verbed: '$_' already exists"), next
|
||||
if not $opt_force and -e;
|
||||
|
||||
if($opt_interactive and not $opt_dryrun) {
|
||||
print "\u$verb '$oldname' to '$_' (y/n)? ";
|
||||
if(<STDIN> !~ /^y/i) {
|
||||
DEBUG("Skipping '$oldname'.");
|
||||
next;
|
||||
}
|
||||
}
|
||||
|
||||
if ($opt_dryrun or $action->($oldname, $_)) {
|
||||
INFO("'$oldname' $verbed to '$_'");
|
||||
}
|
||||
else {
|
||||
ERROR("Can't $verb '$oldname' to '$_': $!");
|
||||
}
|
||||
}
|
||||
|
||||
INFO('Dry run, no changes were made.') if $opt_dryrun;
|
||||
Loading…
Reference in New Issue
Block a user