http://qs321.pair.com?node_id=1224235


in reply to Loop through all directory and files and lines

Hi, here is a script I use often to search thru my files, it's not the best code, but it works. Notice the commented out lines which skip binary files. Usually, you don't want to search a binary file. 
#!/usr/bin/perl
use warnings;
use strict;
use File::Find;

$|++;

# defaults are case-insensitive, no recurse, open and search files (no
+t filename) 

if ($#ARGV < 0){die "Usage zgrep 'pattern' c(case sensitive optional) 
+r(recurse optional) n(search name only optional)
                   examples: zgrep 'debug me' r 
           will recursively search all files for 'debug me'\n";  
               }

my ($recurse, $name, $case) =(0,0,0);
if( grep{/\bn\b/} @ARGV ){@ARGV = grep { $_ ne 'n' } @ARGV; $name = 1 
+};
if( grep{/\br\b/} @ARGV ){@ARGV = grep { $_ ne 'r' } @ARGV; $recurse =
+ 1 };
if( grep{/\bc\b/} @ARGV ){@ARGV = grep { $_ ne 'c' } @ARGV; $case = 1 
+};

#print "$name $recurse $case @ARGV\n";

my $path = '.';

#only accept 1 search string, so quote phrases
my $search = $ARGV[0];

my $regex;  #defaults to case insensitive
if ($case){$regex =  qr/\Q$search\E/}
      else{$regex =  qr/\Q$search\E/i}
# use s modifier for multiline match

find (sub { 
       #skip directories which begin with 1
       if (-d && $_ =~ /^1.*$/) {
        $File::Find::prune = 1;
            return;
        }

     if( ! $recurse ){
      my $n = ($File::Find::name) =~ tr!/!!; #count slashes in file
      return $File::Find::prune = 1 if ($n > 1);
      }

     return if -d;
#     return unless (-f and -T ); # don't waste time on binaries

    if($name){
         if ($_ =~ /$regex/){print "$File::Find::name\n"};
     
     }else{
         return unless (-f and -T ); # don't waste time on binaries
         open (FH,"< $_");
         while(<FH>){
           print "$File::Find::name: $. :$_\n "  if /$regex/;
          }
         close FH;
      }
      
 }, $path);
    
exit;

[download]
I'm not really a human, but I play one on earth. ..... an animated JAPH

Replies are listed 'Best First'.
Re^2: Loop through all directory and files and lines
by MissPerl (Sexton) on Oct 18, 2018 at 14:58 UTC
    thank you for the help !

    I'll have a look ! that's very nice.

    However, my priority now is to understand what is wrong with my code, which I still cant figure out till now.. :(
[reply]
      what is wrong with my code

      My guess is you need to refresh @store_array within the @first_directory loop

      foreach my $first (@first_directory){
  my @store_array = qw (1 2 3 4 5 6); # here
  while(my ($i,$j) = splice(@store_array,0,2)){
    my $second_directory = "$first/$i/$j";
  ..

      [download]

      try

      #!/usr/bin/perl
use strict; use warnings;
use File::Glob 'bsd_glob';

my $store_location = '/path/to/file/store.txt';
open my $fh_log, '>', $store_location
   or die "Fail to open file '$store_location' $!";
  
my $Dir1 = "/somewhere";
my $Dir2 = "/somewhereelse";
my @first_directory = ( $Dir1, $Dir2 );

foreach my $first (@first_directory){
  my @store_array = qw (1 2 3 4 5 6 7 8);
  while (my ($i,$j) = splice(@store_array,0,2)){
    my $second_directory = "$first/$i/$j";
    if (-e $second_directory and -d $second_directory){      
       my @files = bsd_glob("$first/$i/$j/*");    
       foreach my $file (@files){
         my $lines = 0;
         my $match = 0;
         open(FILE, "<" , $file) or die "Can't open file '$file': $!";
+    
         while (<FILE>){
            if (/TbhODK|octuov|qas_uop/) {
              ++$match;
            }
            ++$lines;
         }
         print "$file : $lines lines read. $match matches found\n";
         close FILE;    
         print $fh_log "File $file has $match matches\n";
       }
    } else {                
       print $fh_log "Directory $first/$i/$j (fail to exist)\n"; 
    }
    
  }    
}
close $fh_log;

      [download]
      poj
[reply]
[d/l]
[select]

      The problem is your code contains no subroutines , yet contains four loops -- it should contain three subroutines minimum

[reply]

In Section Seekers of Perl Wisdom