diff --git a/recipes/prename/Makefile b/recipes/prename/Makefile new file mode 100644 index 0000000..875182d --- /dev/null +++ b/recipes/prename/Makefile @@ -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 diff --git a/recipes/prename/prename b/recipes/prename/prename new file mode 100755 index 0000000..39b930a --- /dev/null +++ b/recipes/prename/prename @@ -0,0 +1,278 @@ +#!/usr/bin/perl +use strict; +use warnings; + +=head1 NAME + +rename - renames multiple files + +=head1 SYNOPSIS + +F +B<-h> + +F +S> +S> +S> +S> +S> +S> +S> +S> +S> +S> + +=head1 DESCRIPTION + +C 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 match in a filename with F, not F! 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, 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 + +=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 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.> + +=item B<-L>, B<--hardlink> + +Create hard links from the new names to the existing ones, instead of ++renaming the files. B.> + +=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 to C. The C ++ and C parameters must immediately follow the argument. + +This is equivalent to supplying a C of C. + +=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"; + } + ; + }; + 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( !~ /^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; \ No newline at end of file