Perl 如何从模式中获取未知数量的捕获？

假设我有一个模式：

<cell> cell1=cell2 <pin> pin1=pin2 pin3=pin4 <type> type1=type2

cell1=cell2pin1=pin2pin3=pin4type1=type2

如您所见，该图案可能有多个值（在本例中，管脚有两组管脚名称）。数额不详

我将如何解析它？这里是我到目前为止所拥有的，但它没有帮助，因为它没有考虑到模式是否有两组以上的管脚

my $pattern = "<cell> cell1=cell2 <pin> pin1=pin2 pin3=pin4 <type> type1=type2";

if ( $pattern =~ m#\<cell\> (\w*=\w*) \<pin\> (\w*=\w*) \<type\> (\w*=\w*)#) {

my $cell_name = $1;
my $pin_name = $2;
my $type_name = $3;
}

my$pattern=“cell1=cell2pin1=pin2pin3=pin4type1=type2”；
如果（$pattern=~m\（\w*=\w*）\（\w*=\w*）\（\w*=\w*）\（\w*=\w*））\）{
我的$cell_name=$1；
我的$pin_name=$2；
我的$type_name=$3；
}

如您所见，只有当只有一组pin名称时，这才起作用。不过，我希望它能够调整到多个未知的引脚名称集。我想我必须像数组或散列那样构造，但考虑到未知的多个管脚集，我不确定获取这些值的最佳方法是什么

---

我希望能够将单元格名称、pin名称和键入名称存储为数组或带有值集的散列。

您的问题比存储有点棘手，但其中一些想法可能会有所帮助。诀窍是不要再考虑用单一的模式做任何事情

如果这真的是您的输入，我会尝试匹配

=

周围的事物组。列表上下文中的匹配（例如分配给哈希）返回匹配列表：

use Data::Dumper;

my $input = "<cell> cell1=cell2 <pin> pin1=pin2 pin3=pin4 <type> type1=type2";
my %values = $input =~ m/ (\S+) = (\S+) /gx;

print Dumper( \%values );

但生活可能没那么容易。示例名称可能没有真正的

pin

、

cell

，等等

不过，我还喜欢做另一件事，因为我怀念使用

sscan

的所有乐趣。您可以通过一次匹配字符串的一部分来遍历字符串，然后在下一次匹配时，从您停止的地方开始。首先是整个事情：

use v5.10;

use Data::Dumper;

my $input = "<cell> cell1=cell2 <pin> pin1=pin2 pin3=pin4 <type> type1=type2";

my %hash;
while( 1 ) {
    state $type;

    if( $input =~ /\G < (.*?) > \s* /xgc ) {
        $type = $1;
        }
    elsif( $input =~ /\G (\S+) = (\S+) \s* /xgc ) {
        $hash{$type}{$1}{$2}++;
        }
    else { last }
    }

print Dumper( \%hash );

但让我们先谈谈他的。首先，所有匹配都在标量上下文中，因为它们位于

if-elsif-else

分支的条件部分。这意味着他们只能参加下一场比赛

但是，我已经用

\G

锚定了每个模式的开头。这使得模式匹配在字符串的开头，或者在标量上下文中使用

/g

标志时上一次成功匹配结束的位置

但是，我想尝试几种模式，所以其中一些会失败。这就是

/c

标志的作用。失败时不会重置匹配位置。这意味着

\G

锚定不会在不成功的匹配中重置。所以，我可以尝试一种模式，如果不起作用，从下一种模式的相同位置开始

所以，当我遇到尖括号里的东西时，我记得那类型。在我匹配尖括号中的另一个对象之前，这就是我匹配的对象类型。现在，当我匹配

（\S+）=（\S+）

时，我可以将匹配项分配给正确的类型

要观察这种情况发生，可以输出记住的字符串位置。每个标量都保持自己的光标，并且

pos（VAR）

返回该位置：

use v5.10;

use Data::Dumper;

my $input = "<cell> cell1=cell2 <pin> pin1=pin2 pin3=pin4 <type> type1=type2";

my %hash;
while( 1 ) {
    state $type;

    say "Starting matches at " . ( pos($input) // 0 );
    if( $input =~ /\G < (.*?) > \s* /xgc ) {
        $type = $1;
        say "Matched <$type>, left off at " . pos($input);
        }
    elsif( $input =~ /\G (\S+) = (\S+) \s* /xgc ) {
        $hash{$type}{$1}{$2}++;
        say "Matched <$1|$2>, left off at " . pos($input);
        }
    else {
        say "Nothing left to do, left off at " . pos($input);
        last;
        }
    }

print Dumper( \%hash );

使用v5.10；
使用数据：：转储程序；
my$input=“cell1=cell2 pin1=pin2 pin3=pin4 type1=type2”；
我的%hash；
而(1){
state$类型；
说“开始匹配在”。（pos（$input）//0）；
如果（$input=~/\G<（.*）>\s*/xgc）{
$type=$1；
说“匹配，停在“.pos（$input）”；
}
elsif（$input=~/\G（\S+）=（\S+）\S*/xgc）{
$hash{$type}{$1}{$2}++；
说“匹配，停在“.pos（$input）”；
}
否则{
说“无事可做，在“.pos”处停止（$input）；
最后；
}
}
打印转储程序（\%hash）；

在转储程序输出之前，您现在可以看到标量上下文中的全局匹配：

Starting matches at 0
Matched <cell>, left off at 7
Starting matches at 7
Matched <cell1|cell2>, left off at 19
Starting matches at 19
Matched <pin>, left off at 25
Starting matches at 25
Matched <pin1|pin2>, left off at 35
Starting matches at 35
Matched <pin3|pin4>, left off at 45
Starting matches at 45
Matched <type>, left off at 52
Starting matches at 52
Matched <type1|type2>, left off at 63
Starting matches at 63
Nothing left to do, left off at 63

在0处开始匹配
匹配，7点结束
7点开始比赛
匹配，在19点结束
19岁开始比赛
匹配，在25点结束
25岁开始比赛
匹配，在35岁时停止
35岁开始比赛
匹配，在45时停止
45岁开始比赛
匹配，在52时停止
52岁开始比赛
匹配，在63岁时停止
63岁开始比赛
没什么要做的了，63岁就结束了

---

最后，作为奖励，这里有一个递归语法可以实现这一点。对于你所提供的东西来说，这当然是矫枉过正了，但在更棘手的情况下效果更好。我不会解释它，只会说它产生相同的数据结构：

use v5.10;

use Parse::RecDescent;
use Data::Dumper;

my $grammar = <<~'HERE';
    startrule: context_pairlist(s)
    context_pairlist: context /\s*/ pair(s)
    context: '<' /[^>]+/ '>'
        { $::context = $item[2] }
    pair: /[A-Za-z0-9]+/ '=' /[A-Za-z0-9]+/
        { main::build_hash( $::context, @item[1,3] ) }
    HERE

my $parser = Parse::RecDescent->new( $grammar );

my %hash;
sub build_hash {
    my( $context, $name, $value ) = @_;
    $hash{$context}{$name}{$value}++;
    }

my $input = "<cell> cell1=cell2 <pin> pin1=pin2 pin3=pin4 <type> type1=type2";
$parser->startrule( $input );

say Dumper( \%hash );

使用v5.10；
使用Parse：：RecDescent；
使用数据：：转储程序；
my$grammar=新（$grammar）；
我的%hash；
子构建散列{
我的（$context，$name，$value）=@；
$hash{$context}{$name}{$value}++；
}
my$input=“cell1=cell2 pin1=pin2 pin3=pin4 type1=type2”；
$parser->startrule（$input）；
说转储程序（\%hash）；

另一种方法是将$pattern拆分为一个数组，每个标记在该数组中开始一个新行。这使得提取相关数据变得更容易，如本例所示：

#!/usr/bin/perl

$pattern="<cell> cell1=1234567890 <pin> pin1=pin2 pin3=pin4 <type> type1=type2";
%cell=%pin=%type=();

print "Original pattern =$pattern\n";

($pattern_split=$pattern) =~ s/</\n</g;
@array=split(/\n/, $pattern_split);

# Extract relevant data (NOTE: finetune regex here) and store them in appropriate hashes indexed by $cnum (cellphone number)
for $_ (@array) {
  /<cell>\s*\w+=(\w+)/ && do { $cnum = $1; $cell{$cnum} = $cnum };
  /<pin>\s*(.+?)\s*$/ && do { $pin_list=$1; $pin{$cnum} = $pin_list };
  /<type>\s*\w+=(\w+)/ && do { $type{$cnum} = $1 };
}

$cn="1234567890";
print "Result: Cellnumber '$cell{$cn}' has pin_list='$pin{$cn}' and type='$type{$cn}'\n";

#/usr/bin/perl
$pattern=“cell1=1234567890 pin1=pin2 pin3=pin4 type1=type2”；
%单元格=%pin=%type=（）；
打印“原始图案=$pattern\n”；
（$pattern_split=$pattern）=~s/您有空格分隔的令牌。一些标记表示一个新范围，一些标记表示在该范围内设置的值。我发现在这种情况下，最简单的方法是浏览令牌列表：

#!/usr/bin/env perl

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

my $s = q{<cell> cell1=cell2 <pin> pin1=pin2 pin3=pin4 <type> type1=type2};

my (%h, $k);
while ($s =~ /(\S+)/g) {
    my ($x, $y)= split /=/, $1;

    if (defined $y) {
     push $h{$k}->@*, {key => $x, value => $y};
     next;
    }

    $h{$k = $x} = [];
}

use Data::Dumper;
print Dumper \%h;

#!/usr/bin/perl

$pattern="<cell> cell1=1234567890 <pin> pin1=pin2 pin3=pin4 <type> type1=type2";
%cell=%pin=%type=();

print "Original pattern =$pattern\n";

($pattern_split=$pattern) =~ s/</\n</g;
@array=split(/\n/, $pattern_split);

# Extract relevant data (NOTE: finetune regex here) and store them in appropriate hashes indexed by $cnum (cellphone number)
for $_ (@array) {
  /<cell>\s*\w+=(\w+)/ && do { $cnum = $1; $cell{$cnum} = $cnum };
  /<pin>\s*(.+?)\s*$/ && do { $pin_list=$1; $pin{$cnum} = $pin_list };
  /<type>\s*\w+=(\w+)/ && do { $type{$cnum} = $1 };
}

$cn="1234567890";
print "Result: Cellnumber '$cell{$cn}' has pin_list='$pin{$cn}' and type='$type{$cn}'\n";

Original pattern =<cell> cell1=1234567890 <pin> pin1=pin2 pin3=pin4 <type> type1=type2
Result: Cellnumber '1234567890' has pin_list='pin1=pin2 pin3=pin4' and type='type2'

#!/usr/bin/env perl

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

my $s = q{<cell> cell1=cell2 <pin> pin1=pin2 pin3=pin4 <type> type1=type2};

my (%h, $k);
while ($s =~ /(\S+)/g) {
    my ($x, $y)= split /=/, $1;

    if (defined $y) {
     push $h{$k}->@*, {key => $x, value => $y};
     next;
    }

    $h{$k = $x} = [];
}

use Data::Dumper;
print Dumper \%h;

$VAR1 = {
          '<cell>' => [
                        {
                          'value' => 'cell2',
                          'key' => 'cell1'
                        }
                      ],
          '<pin>' => [
                       {
                         'value' => 'pin2',
                         'key' => 'pin1'
                       },
                       {
                         'value' => 'pin4',
                         'key' => 'pin3'
                       }
                     ],
          '<type>' => [
                        {
                          'key' => 'type1',
                          'value' => 'type2'
                        }
                      ]
        };