Question

我正在尝试清理包含许多子目录的目录，这些子目录实际上属于某些子目录，而不是主目录。

例如，有

Main directory
     sub1
     sub2
     sub3     
     HHH

HHH属于sub3。 HHH里面有多个文本文件（以及一些我想忽略的..txt和...txt个文件），每个文本文件都有一个字符串

  some_pattern [sub3].

因此，我尝试编写一个查看文件的脚本，然后将其移动到相应的目录

中

use File::Find;

use strict;
use warnings;

use File::Copy;

my $DATA = "D:/DATA/DATA_x/*";
my @dirs = grep { -d } glob $DATA;

foreach (@dirs) {

  if ($_ =~ m/HHH/) {
    print "$_\n";
    my $file = "$_/*";
    my @files = grep { -f } glob $file;

    foreach (@files) {
      print "file $_\n";
    }

    foreach (@files) {
      print "\t$_\n";
      my @folders = split('/', $_);

      if ($folders[4] eq '..txt' or $folders[4] eq '...txt') {
        print "$folders[4] ..txt\n";
      }

      foreach (@folders) {
        print "$_\n";
      }

      open(FH, '<', $_);
      my $value;
      while (my $line = <FH>) {
        if ($line =~ m/some_pattern/) {
          ($value) = $line =~ /\[(.+?)\]/;
          ($value) =~ s/\s*$//;
          print "ident'$value'\n";
          my $new_dir = "$folders[0]/$folders[1]/$folders[2]/$value/$folders[3]/$folders[4]";
          print "making $folders[0]/$folders[1]/$folders[2]/$value/$folders[3]\n";
          print "file is $folders[4]\n";
          my $new_over_dir = "$folders[0]/$folders[1]/$value/$folders[2]/$folders[3]";
          mkdir $new_over_dir or die "Can't make it $!";
          print "going to swap\n '$_'\n for\n '$new_dir'\n";
          move($_, $new_dir) or die "Can't $!";
        }
      }
    }
  }
}

这是说

Can't make it No such file or directory at foo.pl line 57, <FH> line 82.

为什么说它不会使文件不存在？

片刻之后：这是我的最终剧本：

use File::Find;

use strict;
use warnings;

use File::Copy;

my $DATA = "D:/DATA/DATA_x/*";
my @dirs = grep { -d } glob $DATA;

foreach (@dirs) {

  if ($_ =~ m/HHH/) {
    my $value; 
    my @folders;
    print "$_\n";
    my $file = "$_/*";
    my @files = grep { -f } glob $file;

    foreach (@files) {
      print "file $_\n";
    }

    foreach (@files) {
      print "\t$_\n";
      @folders = split('/', $_);

      if ($folders[4] eq '..txt' or $folders[4] eq '...txt') {
        print "$folders[4] ..txt\n";
      }

      foreach (@folders) {
        print "$_\n";
      }

      open(FH, '<', $_);
      while (my $line = <FH>) {
        if ($line =~ m/some_pattern/) {
          ($value) = $line =~ /\[(.+?)\]/;
          ($value) =~ s/\s*$//;
          print "ident'$value'\n";
        }
      }


      }
        if($value){
        print "value $value\n";
        my $dir1 = "/$folders[1]/$folders[2]/$folders[3]/$folders[4]/$folders[5]";
    my $dir2 = "/$folders[1]/$folders[2]/$folders[3]/$folders[4]/$value";
        system("cp -r $dir1 $dir2");
      } 

    }
  }
}

这很有效。它看起来像我之前的问题的一部分是我试图在我的D：驱动器中的目录上运行它 - 当我将它移动到C：驱动器时，它工作正常没有任何权限错误或任何东西。我确实尝试用Path::Tiny实现一些东西，但是这个脚本非常接近功能（并且它在Unix环境中起作用），我决定完成它。

Answer 1

你真的应该阅读Path::Tiny doccu。它可能包含您需要的一切。

一些起点，没有错误处理等等......

use strict;
use warnings;
use Path::Tiny;

my $start=path('D:/DATA/DATA_x');
my $iter = path($start)->iterator({recurse => 1});

while ( $curr = $iter->() ) {

    #select here the needed files - add more conditions if need
    next if $curr->is_dir;  #skip directories
    next if $curr =~ m/HHH.*\.{2,3}txt$/;   #skip ...?txt

    #say "$curr";
    my $content = $curr->slurp;
    if( $content =~ m/some_pattern/ ) {
        #do something wih the file
        say "doing something with $curr";

        my $newfilename = path("insert what you need here"); #create the needed new path for the file ..
        path($newfilename->dirname)->mkpath; #make directories
        $curr->move($newfilename);           #move the file
    }
}

Answer 2

您确定要创建的目录路径吗？如果某些中间目录不存在， mkdir 调用可能会失败。如果您的代码是健壮的，以确保变量 $ new_over_dir 包含您必须创建的目录路径，您可以使用perl模块File::Path中的方法 make_path 来创建新目录，而不是'mkdir ”。

来自 make_path 的文档：

如果不是，make_path函数会创建给定的目录以前存在，就像Unix命令mkdir -p。

无法找到试图移动的文件

2 个答案: