Perl: iterate through multiline match
Question
I would like iterate through a multiline pattern in Perl, but I'm struggling with the syntax.
My input string is:
+++ STAR-WARS 2020-01-01 00:00:00+00:00
S&W #00000000
%%SHOW NAME: Q=Kenobi;%%
RETCODE = 0 Operation success
In-universe information
-----------------------
Species = Human
Gender = Male
television series of num = whatever
(Number of results = 1)
Personal Details
----------------
First Name = Obi-Wan
Last Name = Kenobi
Alias = Padawan
= Jedi Knight
= Jedi General
= Jedi Master
Points to other set of information = whatever
(Number of results = 1)
Other attribute
---------------
Significant other = Satine Kryze
Affiliation = Jedi Order
= Galactic Republic
= Rebel Alliance
Occupation = Jedi
(Number of results = 1)
--- END
My desired resulting hash would be:
$VAR1 = {
'In-universe information' => {
'Gender' => 'Male',
'Species' => 'Human',
'results' => '1',
'television series of num' => 'whatever'
},
'Other attribute' => {
'Affiliation' => [
'Jedi Order',
'Galactic Republic',
'Rebel Alliance'
],
'Occupation' => 'Jedi',
'Significant other' => 'Satine Kryze',
'results' => '1'
},
'Personal Details' => {
'Alias' => [
'Padawan',
'Jedi Knight',
'Jedi General',
'Jedi Master'
],
'First Name' => 'Obi-Wan',
'Last Name' => 'Kenobi',
'Points to other set of information' => 'whatever',
'results' => '1'
},
'code' => '0',
'description' => 'Operation success'
};
What I have come up with works well for a "single block" (eg Personal Details above). However, if the data contains multiple blocks, I can't figure out how to iterate through every matching block. (eg use while with /g )
#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
local $/;
my $output = <DATA>;
my %hash;
($hash{'code'}, $hash{'description'}) = $output =~ /^RETCODE = (\d+)\s+(.*)\n/m;
if ($hash{'code'} eq "0") {
my ($type,$data, $results) = $output =~ /([^\n]+)\n-+\n(.*)\n\n\(Number of results = (\d+)\)\n\n/sm;
my $previousKey = "";
while ($data =~ /(.+)$/mg) {
my $line = $1;
$line =~ s/(?:^ +)//g;
my ($key, $value);
if ($line =~ /^\s*= /) {
($value) = $line =~ /^\s*= (.*)$/;
$hash{$type}{$previousKey} = [ $hash{$type}{$previousKey} ] unless ref($hash{$type}{$previousKey});
push (@{$hash{$type}{$previousKey}}, $value);
} else {
($key, $value) = split(/ = /, $line);
$hash{$type}{$key} = $value;
$previousKey = $key;
}
}
say STDERR Dumper(\%hash);
}
__DATA__
+++ STAR-WARS 2020-01-01 00:00:00+00:00
S&W #00000000
%%SHOW NAME: Q=Kenobi;%%
RETCODE = 0 Operation success
In-universe information
-----------------------
Species = Human
Gender = Male
television series of num = whatever
(Number of results = 1)
Personal Details
----------------
First Name = Obi-Wan
Last Name = Kenobi
Alias = Padawan
= Jedi Knight
= Jedi General
= Jedi Master
Points to other set of information = whatever
(Number of results = 1)
Other attribute
---------------
Significant other = Satine Kryze
Affiliation = Jedi Order
= Galactic Republic
= Rebel Alliance
Occupation = Jedi
(Number of results = 1)
--- END
Few facts:
- every "block" always contains a header, followed by newline and dashes equal to the length of the header.
- every "block" always ends with
\n, followed by(Number of results = \d+), followed by\n. - each key / value pair always have two spaces before and after the equal sign. ie
/ = / - when no key exists, assume it's an [array], and append the value to the previous key . eg
Aliasin my example above. - the string will always ends with
--- ENDfollowed by a\n
1 answers
solution1
1 ACCPTED 2022-06-18 01:07:26
According your description the section is starting with +++ ... and ending with --- END .
Based on this information the input can be devided with regex into blocks of interest which then processed individually in a loop with a parser to build a hash.
NOTE: the parser was slightly modified and put into subroutine
use strict;
use warnings;
use feature 'say';
use Data::Dumper;
my @shows;
my $data = do { local $/; <DATA> };
my @blocks = $data =~ /^(\+\+\+ .*?^--- END)/msg;
push @shows, parse($_) for @blocks;
say Dumper(\@shows);
exit 0;
sub parse {
my $data = shift;
my(@sections,$re,$r);
# Alternative block to extract show info section
# $re = qr/^\+\+\+\s+(\S+)\s+(\S+)\s+(\S+)\s+\S+\s+(\S+)\s+%%[^:]+?:\s+([^;]+?);%%\s+RETCODE = (\d+)\s+([^\n]+)/;
# $r->{info}->@{qw/show day time sw show_name code description/} = $data =~ /$re/;
$re = qr/RETCODE = (\d+)\s+([^\n]+)/;
$r->@{qw/code description/} = $data =~ /$re/;
@sections = $data =~ /\n\n(.+?\n-+.*?\(Number of results = \d+\))/gs;
for my $block ( @sections ) {
my($section,@lines,$key,$value);
@lines = split("\n",$block);
$section = $lines[0];
for my $line (@lines[2..$#lines-2] ) {
$line =~ s/^\s+//;
if( $line =~ /^=\s+(.+)/ ) {
$r->{$section}{$key} = [ $r->{$section}{$key} ] unless ref $r->{$section}{$key} eq 'ARRAY';
push @{$r->{$section}{$key}}, $1;
} else {
($key,$value) = split(/ = /,$line);
$r->{$section}{$key} = $value;
}
}
$r->{$section}{results} = $block =~ /\(Number of results = (\d+)\)/gs;
}
return $r;
}
__DATA__
+++ STAR-WARS 2020-01-01 00:00:00+00:00
S&W #00000000
%%SHOW NAME: Q=Kenobi;%%
RETCODE = 0 Operation success
In-universe information
-----------------------
Species = Human
Gender = Male
television series of num = whatever
(Number of results = 1)
Personal Details
----------------
First Name = Obi-Wan
Last Name = Kenobi
Alias = Padawan
= Jedi Knight
= Jedi General
= Jedi Master
Points to other set of information = whatever
(Number of results = 1)
Other attribute
---------------
Significant other = Satine Kryze
Affiliation = Jedi Order
= Galactic Republic
= Rebel Alliance
Occupation = Jedi
(Number of results = 1)
--- END
+++ STAR-WARS 2020-01-01 00:00:00+00:00
S&W #00000000
%%SHOW NAME: Q=Kenobi;%%
RETCODE = 0 Operation success
In-universe information
-----------------------
Species = Human
Gender = Male
television series of num = whatever
(Number of results = 1)
Personal Details
----------------
First Name = Obi-Wan
Last Name = Kenobi
Alias = Padawan
= Jedi Knight
= Jedi General
= Jedi Master
Points to other set of information = whatever
(Number of results = 1)
Other attribute
---------------
Significant other = Satine Kryze
Affiliation = Jedi Order
= Galactic Republic
= Rebel Alliance
Occupation = Jedi
(Number of results = 1)
--- END
Output
$VAR1 = [
{
'Other attribute' => {
'Significant other' => 'Satine Kryze',
'Occupation' => 'Jedi',
'results' => 1,
'Affiliation' => [
'Jedi Order',
'Galactic Republic',
'Rebel Alliance'
]
},
'Personal Details' => {
'results' => 1,
'First Name' => 'Obi-Wan',
'Alias' => [
'Padawan',
'Jedi Knight',
'Jedi General',
'Jedi Master'
],
'Points to other set of information' => 'whatever',
'Last Name' => 'Kenobi'
},
'code' => '0',
'description' => 'Operation success',
'In-universe information' => {
'television series of num' => 'whatever',
'Gender' => 'Male',
'results' => 1,
'Species' => 'Human'
}
},
{
'Other attribute' => {
'Affiliation' => [
'Jedi Order',
'Galactic Republic',
'Rebel Alliance'
],
'results' => 1,
'Significant other' => 'Satine Kryze',
'Occupation' => 'Jedi'
},
'Personal Details' => {
'First Name' => 'Obi-Wan',
'results' => 1,
'Last Name' => 'Kenobi',
'Alias' => [
'Padawan',
'Jedi Knight',
'Jedi General',
'Jedi Master'
],
'Points to other set of information' => 'whatever'
},
'code' => '0',
'description' => 'Operation success',
'In-universe information' => {
'television series of num' => 'whatever',
'results' => 1,
'Gender' => 'Male',
'Species' => 'Human'
}
}
];
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.
Related Question
Perl iterate through each match
RegEx match for multiline in Perl
Perl - Match multiline pattern with wildcard
perl Match multiline pattern in a file
Iterate through an array in Perl
Match multiline pattern in bash using Perl on macOS
Perl regex multiline match without dot
Perl multiline pattern match using grep
How to iterate over a multiline string with perl's regex
perl regex to match multiline with space and non-word characters
Related Tags