Using Regex to match pattern and store into array

Question

I had a similar post on this (see other post), but what I am trying to do has slightly varied since then. I am using the same regex matching /79(week\d+[a-z])/i from that question.

I have a file that contains six lines, each line a different path. As an example, there are 3 lines including the string "cat" and 3 lines including the string "dog".

file.txt

/mypath/sd-urt7-dfc-adfj345h-d0-79week48a-DFC-lk-my_cat.text  
/mypath/sd-urt7-afd-parent-79week46d-AFD-lk-my_cat.text  
/mypath/sd-urt7-ert-parent-79week50c-ERT-lk-my_cat.text 
/mypath/sd-urt7-dfc-adfj345h-d0-79week48a-DFC-lk-my_dog.text  
/mypath/sd-urt7-afd-parent-79week46d-AFD-lk-my_dog.text  
/mypath/sd-urt7-ert-parent-79week49b-ERT-lk-my_dog.text

I want to take the "weekxxX" portion out of each path and print it out into a file. Here is what I have so far:

use strict;
use warnings;
use feature qw(say);
use autodie;

    open (my $fh, '<', "file.txt") or die "Couldn't open `file.txt`\n";

    foreach my $line (<$fh>){ #goes through each line in the file

        chomp $line; #chomps new line character from each line

        if ($line =~ /cat/) { #if the path includes string "cat"
            #use the regex at top of post to get weekxxX of each
            #path containing cat and print all 3 weekxxX into 
            #another file called cat.  

            open (my $cat, '>', "cat.txt") or die;
            print $cat "";
            close $cat; 

        }
        elsif ($line =~ /dog/) { #otherwise if the path includes string "dog"3

            #use the regex at top of post to get weekxxX of each
            #path containing cat and print all 3 weekxxX into 
            #another file called dog.  

            open (my $dog, '>', "dog.txt") or die;
            print $dog "";
            close $dog;
        }
    }
    close $fh;

I am thinking this can be done by using regex on all three paths (depending on whether it is dog or cat), push all three weeks in format weekxxX into an array and then print that array into the file? I'm really not sure how to implement this.

You're never printing $line into the files. You also need to open the files in append mode, so you don't overwrite the previous lines. — Barmar
– Barmar, Commented Dec 24, 2019 at 23:12
@Barmar i dont want to print the lines themselves into the files. — programminglearner
– programminglearner, Commented Dec 24, 2019 at 23:14
Then use a regexp that extracts the portion of the line you want. — Barmar
– Barmar, Commented Dec 24, 2019 at 23:16
OK, autodie does that (what I incidentally used in my answer here while I normally don't). But then you don't need or die at all -- which is why I commented, seeing die without $!. I'd suggest to include that use autodie; in your code here (I'd comment if there weren't die at all, too :), along with warnings and strict -- you'll invariably get comments when they're missing. — zdim
– zdim, Commented Dec 26, 2019 at 20:47

ikegami · Accepted Answer · 2019-12-25 18:38:09Z

5

use warnings;
use strict;
use feature 'say';
use autodie qw(open);

my $file = shift // die "Usage: $0 filename\n";  #/

# Patterns that determine what file to write to    
my ($p1, $p2) = qw(cat dog);

# Open output files, one for each pattern
my %fh_out = map { open my $fh, '>', "$_.txt"; $_ => $fh } ($p1, $p2); 

open my $fh, '<', $file;

while (<$fh>) {
    if ( my ($week, $type) = /79(week\d+[a-z]).*?($p1|$p2)/i ) {
        say {$fh{$type}} $week;
    }
}

edited Dec 25, 2019 at 18:38

ikegami

391k17 gold badges290 silver badges554 bronze badges

answered Dec 25, 2019 at 6:33

zdim

67.2k5 gold badges59 silver badges87 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

zdim Over a year ago

really my ($p1, $p2) = map { my $q = quotemeta; qr/$q/ } qw(cat dog);

ikegami · Accepted Answer · 2019-12-25 04:06:13Z

2

use strict;
use warnings;
use feature 'say';

open(my $in_fh, '<', "file.txt")
   or die("Can't open \"file.txt\": $!\n");    
open(my $cat_fh, '>', "cat.txt")
   or die("Can't create \"cat.txt\": $!\n");
open(my $dog_fh, '>', "dog.txt")
   or die("Can't create \"dog.txt\": $!\n");

while (<$in_fh>) {
   chomp;
   if ( my ($week) = /79(week\d+[a-z])/i) {
      if    (/cat/) { say $cat_fh $week; }
      elsif (/dog/) { say $dog_fh $week; }
   }
}

answered Dec 25, 2019 at 4:06

ikegami

391k17 gold badges290 silver badges554 bronze badges

1 Comment

programminglearner Over a year ago

perfect answer :) My question was finding a way to use the regex in the simplest way possible and this was straight to the point! kudos to @zdim for the mapping method, as well.

Polar Bear · Accepted Answer · 2019-12-25 03:48:11Z

1

Following code does what you are looking for

use strict;
use warnings;

use feature 'say';

use Data::Dumper;

my $debug = 0;

# define match pattern
my $patern = qr/\d{2}(week\d{2}\w).+(cat|dog)/;

my %hash;                               # define hash to store data

while( <DATA> ) {                       # read from DATA block
    next if /^$/;                       # skip empty lines
    chomp;                              # trim newline

    push @{$hash{$2}},$1 if /$patern/;  # fill the hash if match pattern
}

say Dumper(\%hash) if $debug;           # look into hash in debug mode

while( my($k,$v) = each %hash ) {       # go through hash
    my $filename = $k . '.txt';         # define filename

    open FH, "> $filename"              # open file
            or die "Couldn't open $filename";
    print FH join "\n", sort @{$v};     # print data into a file
    close FH;                           # close file
}

__DATA__
/mypath/sd-urt7-dfc-adfj345h-d0-79week48a-DFC-lk-my_cat.text  
/mypath/sd-urt7-afd-parent-79week46d-AFD-lk-my_cat.text  
/mypath/sd-urt7-ert-parent-79week50c-ERT-lk-my_cat.text 
/mypath/sd-urt7-dfc-adfj345h-d0-79week48a-DFC-lk-my_dog.text  
/mypath/sd-urt7-afd-parent-79week46d-AFD-lk-my_dog.text  
/mypath/sd-urt7-ert-parent-79week49b-ERT-lk-my_dog.text

OUTPUT

cat.txt

week46d
week48a
week50c

dog.txt

week46d
week48a
week49b

You need to start read some Perl programming books

edited Dec 25, 2019 at 3:48

answered Dec 25, 2019 at 3:40

Polar Bear

6,8061 gold badge8 silver badges13 bronze badges

2 Comments

Polar Bear Over a year ago

@ikegami please look into the code once more - it opens files 'cat.txt' and 'dog.txt' only once each (once for each hash key).

Toto Over a year ago

Use of bareword as filehandle is strongly discouraged, open

Polar Bear · Accepted Answer · 2019-12-25 08:50:26Z

Code with utilization of map simplifies the code

use strict;
use warnings;

use feature 'say';

use Data::Dumper;

my $debug = 0;

# define match pattern
my $patern = qr/\d{2}(week\d{2}\w).+(cat|dog)/;

my %hash;                               # define hash to store data

# fill the hash if match pattern
map { push @{$hash{$2}},$1 if /$patern/ } <DATA>;

say Dumper(\%hash) if $debug;           # look into hash in debug mode

foreach my $animal (keys %hash) {       # extract 'animal' from hash
    open FH, "> $animal.txt"            # open file
            or die "Couldn't open $animal.txt";
    map { say FH $_ } sort @{$hash{$animal}};       # print data into a file
    close FH;                           # close file
}

__DATA__
/mypath/sd-urt7-dfc-adfj345h-d0-79week48a-DFC-lk-my_cat.text  
/mypath/sd-urt7-afd-parent-79week46d-AFD-lk-my_cat.text  
/mypath/sd-urt7-ert-parent-79week50c-ERT-lk-my_cat.text 
/mypath/sd-urt7-dfc-adfj345h-d0-79week48a-DFC-lk-my_dog.text  
/mypath/sd-urt7-afd-parent-79week46d-AFD-lk-my_dog.text  
/mypath/sd-urt7-ert-parent-79week49b-ERT-lk-my_dog.text

Collectives™ on Stack Overflow

Using Regex to match pattern and store into array

4 Answers 4

1 Comment

1 Comment

2 Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

4 Answers 4

1 Comment

1 Comment

2 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related