使用 Perl 實現 linux 命令“重命名”

Question

Mac Os X 沒有有用的 linux 命令rename ，它具有以下格式：

rename 'perl-regex' list-of-files

所以這是我整理的內容，但它不會重命名任何文件（$new 始終與 $file 相同）：

#!/usr/bin/env perl -w
use strict;
use File::Copy 'move';

my $regex=shift;
my @files=@ARGV;

for my $file (@files)
{
    my $new=$file;
    $new =~ "$regex";    # this is were the problem is !!!
    if ($new ne $file) 
    {
        print STDOUT "$file --> $new \n";
        move $file, ${new} or warn "Could not rename $file to $new";
    }
}

就好像我沒有傳遞正則表達式，如果我硬編碼它

$new =~ s/TMP/tmp;

它會工作得很好......有什么想法嗎？

Answer 1

$operator = 's/TMP/tmp/';
print $operator; 

沒有神奇地評估操作員，所以毫不奇怪

$operator = 's/TMP/tmp/';
$x =~ $operator; 

也沒有。 如果要評估Perl代碼，則必須將其傳遞給Perl解釋器。 您可以使用eval EXPR訪問它。

$operator = 's/TMP/tmp/';
eval('$x =~ '.$operator.'; 1')
   or die $@;

Answer 2

你不能把整個句子放在s/TMP/tmp; 在變量中。 但是，您可以做類似的事情

$new =~ s/$find/$replace;

$find是你的正則表達式和$replace你想要替換匹配的東西。

如果您仍想傳遞整個句子，可能需要查看eval（） 。

Answer 3

有兩種方法可以優雅地解決這個問題

1. 需要兩個單獨的命令行參數：一個用於正則表達式，另一個用於替換。 這是不優雅和限制性的。

    my ($search, $replace, @files) = @ARGV; ...; my $new = $file; $new =~ s/$search/$replace/e; # the /e evals the replacement, # allowing us to interpolate vars 

   像my-rename '(.*)\\.txt' '@{[our $i++]}-$1.foo' *.txt 。 這允許通過字符串變量插值執行幾乎任何代碼。

   _{（1）：舊的perls中沒有嵌套的正則表達式}

2. 只允許任意Perl代碼，類似於perl -ne'...' 。 -n開關的語義是當前行作為$_傳遞。 將文件名作為$_傳遞是有意義的，並使用最后一個語句的值作為新文件名。 這會導致類似的東西

    # somewhat tested my ($eval_content, @files) = @ARGV; my $code = eval q' sub { no strict; # could be helpful ;-) my @_out_; FILENAME: for (@_) { my $_orig_ = $_; push @_out_, [ $_orig_ => do { ' . $eval_content . q' } ]; # or # do { " . $eval_content . " }; # push @_out_, [ $_orig_, $_ ]; # if you want to use $_ as out-argument (like -p). # Can lead to more concise code. } return @_out_; } '; die "Eval error: $@" if $@; for my $rename ($code->(@files)) { my ($from, $to) = @$rename; ... } 

   這可以像my-rename 'next FILENAME if /^\\./; our $i++; s/(.*)\\.txt/$i-$1.foo/; $_' *.txt那樣調用my-rename 'next FILENAME if /^\\./; our $i++; s/(.*)\\.txt/$i-$1.foo/; $_' *.txt my-rename 'next FILENAME if /^\\./; our $i++; s/(.*)\\.txt/$i-$1.foo/; $_' *.txt my-rename 'next FILENAME if /^\\./; our $i++; s/(.*)\\.txt/$i-$1.foo/; $_' *.txt 。 跳過以點開頭的所有文件，注冊一個全局變量$i ，並將一個數字從每個文件名前面的一個向上計數，並更改擴展名。 然后我們在最后一個語句中返回$_ 。

   循環構建原始文件名和新文件名的對，可以在第二個循環中處理。

   這可能非常靈活，而且效率不高。

Answer 4

好吧，它已經是一個Perl實用程序，它在CPAN上： http ： //cpan.me/rename 。 您可以直接使用該實用程序附帶的模塊File :: Rename ：

#!/usr/bin/env perl
use File::Rename qw(rename);
rename @ARGV, sub { s/TMP/tmp/ }, 'verbose';

其他可能性是從該分發連接模塊和腳本，並將生成的文件放在$PATH 。

Answer 5

最好下載沒有依賴關系的真實腳本：

wget https://raw.githubusercontent.com/sputnick-dev/perl-rename/master/rename

#!/usr/bin/perl -w
#
#  This script was developed by Robin Barker (Robin.Barker@npl.co.uk),
#  from Larry Wall's original script eg/rename from the perl source.
#
#  This script is free software; you can redistribute it and/or modify it
#  under the same terms as Perl itself.
#
# Larry(?)'s RCS header:
#  RCSfile: rename,v   Revision: 4.1   Date: 92/08/07 17:20:30 
#
# $RCSfile: rename,v $$Revision: 1.5 $$Date: 1998/12/18 16:16:31 $
#
# $Log: rename,v $
# Revision 1.5  1998/12/18 16:16:31  rmb1
# moved to perl/source
# changed man documentation to POD
#
# Revision 1.4  1997/02/27  17:19:26  rmb1
# corrected usage string
#
# Revision 1.3  1997/02/27  16:39:07  rmb1
# added -v
#
# Revision 1.2  1997/02/27  16:15:40  rmb1
# *** empty log message ***
#
# Revision 1.1  1997/02/27  15:48:51  rmb1
# Initial revision
#

use strict;

use Getopt::Long;
Getopt::Long::Configure('bundling');

my ($verbose, $no_act, $force, $op);

die "Usage: rename [-v] [-n] [-f] perlexpr [filenames]\n"
    unless GetOptions(
    'v|verbose' => \$verbose,
    'n|no-act'  => \$no_act,
    'f|force'   => \$force,
    ) and $op = shift;

$verbose++ if $no_act;

if (!@ARGV) {
    print "reading filenames from STDIN\n" if $verbose;
    @ARGV = <STDIN>;
    chop(@ARGV);
}

for (@ARGV) {
    my $was = $_;
    eval $op;
    die $@ if $@;
    next if $was eq $_; # ignore quietly
    if (-e $_ and !$force)
    {
    warn  "$was not renamed: $_ already exists\n";
    }
    elsif ($no_act or rename $was, $_)
    {
    print "$was renamed as $_\n" if $verbose;
    }
    else
    {
    warn  "Can't rename $was $_: $!\n";
    }
}

__END__

=head1 NAME

rename - renames multiple files

=head1 SYNOPSIS

B<rename> S<[ B<-v> ]> S<[ B<-n> ]> S<[ B<-f> ]> I<perlexpr> S<[ I<files> ]>

=head1 DESCRIPTION

C<rename>
renames the filenames supplied according to the rule specified as the
first argument.
The I<perlexpr> 
argument is a Perl expression which is expected to modify the C<$_>
string in Perl for at least some of the filenames specified.
If a given filename is not modified by the expression, it will not be
renamed.
If no filenames are given on the command line, filenames will be read
via standard input.

For example, to rename all files matching C<*.bak> to strip the extension,
you might say

    rename 's/\.bak$//' *.bak

To translate uppercase names to lower, you'd use

    rename 'y/A-Z/a-z/' *

=head1 OPTIONS

=over 8

=item B<-v>, B<--verbose>

Verbose: print names of files successfully renamed.

=item B<-n>, B<--no-act>

No Action: show what files would have been renamed.

=item B<-f>, B<--force>

Force: overwrite existing files.

=back

=head1 ENVIRONMENT

No environment variables are used.

=head1 AUTHOR

Larry Wall

=head1 SEE ALSO

mv(1), perl(1)

=head1 DIAGNOSTICS

If you give an invalid Perl expression you'll get a syntax error.

=head1 BUGS

The original C<rename> did not check for the existence of target filenames,
so had to be used with care.  I hope I've fixed that (Robin Barker).

=cut