Скрипт для переименования файлов с именем папки?

Question

Я хочу рекурсивно переименовывать файлы, добавляя перед ними имя папки.Пример: c:\test\foo\a.txt станет c:\test\foo\foo-a.txt.

Answer 1

use File::Find::Rule qw( );
use Path::Class      qw( dir file );

my $base = dir('.')->absolute;
for my $qfn (File::Find::Rule->file->in($base)) {
   my $file = file($qfn);
   my $dir  = $file->dir;

   my $src = $file;
   my $dst = $dir->file($dir->basename . '-' . $file->basename);

   if (-e $dst) {
      warn("Can't rename $src to $dst: Already exists\n");
   } 
   elsif (!rename($src, $dst)) {
      warn("Can't rename $src to $dst: $!\n");
   } 
}

Answer 2

Для вас может работать следующий Perl-скрипт:

#!/usr/bin/env perl

use strict;
use warnings;

use File::Basename;
use File::Find;
use File::Spec;

sub rename {
    my ($dir_name) = ( File::Spec->splitdir($File::Find::dir) )[-1];
    my $file_name = basename $_;
    if ( -f $_ ) {
        $file_name = "$dir_name-$file_name";
        rename $_, File::Spec->catdir( $File::Find::dir, $file_name );
    }
}

find { 'wanted' => \&rename, 'no_chdir' => 1 }, 'C:/test/foo';

Рекомендации:

• File::Basename
• File::Find
• File::Spec

Answer 3

    #!/usr/bin/perl

    use strict;
    use warnings;

    use File::Basename;
    use File::Find;
    use File::Spec;

    ($#ARGV == 0) or die "Usage: $0 [directory]\n"; 

    my $input_file_dir = $ARGV[0];

    sub process_file 
    {
      my $dir_name = (File::Spec -> splitdir ($File::Find::dir)) [-1];
      my $file_name = basename $_;
      my $extension = ($file_name =~ m/([^.]+)$/)[0];        
      if ( -f $_ ) 
      {
        print "$dir_name.$extension\n";
        rename $_, "$dir_name.$extension";
      }
    }

    finddepth { 'wanted' => \&process_file, 'no_chdir' => 0 }, $input_file_dir;

Answer 4

use strict;
use warnings;

use File::Spec;
use File::Copy qw(move);
use File::Glob qw(:glob);

my $folder_path = qw( c:\test\foo\ );
my @file_paths  = bsd_glob( $folder_path . '*' );

foreach my $old_path (@file_paths) {
    if ( -f $old_path ) {
        my ( $volume, $directories, $file ) = File::Spec->splitpath($old_path);
        my @dirs = File::Spec->splitdir($directories);
        my $prepend;
        while ( !( $prepend = pop @dirs ) ) { } # see notes below
        my $new_fname = $prepend . '-' . $file;
        my $new_path = File::Spec->catpath( $volume, $directories, $new_fname );
        move( $old_path, $new_path );
    }
}

Я использую while, чтобы вытолкнуть последнее имя каталога перед именем файла, потому что splitdir содержит предупреждение в Windows.Похоже, вы имеете дело с файлом Windows.