Perl 正则表达式捕获组并停止匹配

Question

我需要一些关于这个 perl 正则表达式的帮助

s/.*?<\?lsmb if\s*?(\S*)\s*?\?>/$1/

在下面的代码中解析出一些非空白字符 [A-Z][a-z][0-9][_]被任意数量的空格和其他字符包围。我尝试了各种 Perl 正则表达式，这些正则表达式在下面的程序中都被注释掉了。

我认为我的主要问题是在最后停止匹配。

下面的代码运行了 8 次测试，我希望找到能够通过全部 8 次的代码。

#!/usr/bin/perl

use strict;
use warnings;
use diagnostics;

my $count = 0;
my $t = 0;
#examples of things I need to match, match => catagory
my $self = {  'customerfax' => 'alpha',
             '_____' => 'Underscore',
             '000000' => 'numeric',
             'letter_reason_4' => 'alfa-numeric-underscore',
             'customerphone7' => 'alfa-numeric', 
             'customer_phone' => 'alfa-underscore',
           };
# must contain   <?lsmb 'varname from $self' ?> 
# may contain any amount of whitespace chars where one is depected
# will end with \n that is removed by chop below         
my $test1 = qq|<?lsmb if customerfax ?>  caacaacac\n|;
my $test2 = qq|<?lsmb if _____ ?> bbb\n|;
my $test3 = qq|<?lsmb if 000000 ?> cccc\n|;
my $test4 = qq|<?lsmb if letter_reason_4 ?><t \></'><><><>\n|;  # /
my $test5 = qq| <?lsmb if customerfax ?> |;
my $test6 = qq|<?lsmb if  customerphone7   ?> \<?lsmb ignore this >n|;
my $test7 = qq|<?lsmb if  customer_phone  ?>\n|;
my $test8 = qq| avcscc 34534534 <?lsmb if letter_reason_4 ?> 0xffff\n|;

strip_markup($test1);
strip_markup($test2);
strip_markup($test3);
strip_markup($test4);
strip_markup($test5);
strip_markup($test6);
strip_markup($test7);
strip_markup($test8);

if ($count == 8) { print "Passed All done\n";}
else { print "All done passed  $count out of 8 Try again \n"; }


sub strip_markup { 
    $_= shift;
    #print "strip_markup $_ \n";
    if (/<\?lsmb if /) {
        chop; # gets rid ot the new line
        #original
        #s/.*?<\?lsmb if (.+?) \?>/$1/;
        #What I have tried:
        #s/.*?<\?lsmb if(?:\s)*?(\S+?)(?:\s)*?\?>\b/$1/;
        s/.*?<\?lsmb if\s*?(\S*)\s*?\?>/$1/;
        #s/.*?<\?lsmb if\s*?([A-Za-z0-9_]*?)\s*?\?>/$1/;
        #s/.*?<\?lsmb if[\s]*?(\S*?)[\s]*?\?>/$1/;
        #s/.*?<\?lsmb if (\S*?) \?>/$1/;
        #s/.*?<\?lsmb if (\S+?) \?>/$1/;
        #s/.*?<\?lsmb if ([\S]+?)([\s]+?)\?>/$1/;
        #s/.*?<\?lsmb if[\s]+([\S]+)[\s]+\?>/$1/;
        #s/.*?<\?lsmb if\s*?([\S]*?)\s*?\?>/$1/;
        #s/.*?<\?lsmb if\s+?([\S]+?)[\s]+?\?>/$1/;
        #s/.*?<\?lsmb if ([\S]+?) \?>/$1/;
        #s/.*?<\?lsmb if\s*?([\S_]*?)\s*?\?>/$1/;
        #s/.*?<\?lsmb if\s*?([[a-zA-Z]|[\d]|[_]]*?)\s*?\?>/$1/;
        #s/.*?<\?lsmb if\s*?([a-zA-Z\d_]*?)\s*?\?>/$1/;
        #s/.*?<\?lsmb if\s*?([^[:space:]]+?)\s*?\?>/$1/;

        $t++;
        print "Test $t ";
        #look up the result as the hash key
        my $ok = $self->{$_};
        if ($ok) { 
                $count++;
                print "OK passed $ok,";
        }
        print qq|Test Value : '$_' \n|;
    }
}

以下是一些测试以及它们应该返回的内容:

• 测试 1 = <?lsmb if customerfax ?> caacaacac\n应该返回 customerfax
• 测试 2 = <?lsmb if _____ ?> bbb\n应该返回 _____
• 测试 8 = avcscc 34534534 <?lsmb if letter_reason_4 ?> 0xffff\n应该返回 letter_reason_4

Answer 1

如果我对您的要求的理解是正确的，则通过简单的方式提取所需的短语

my ($match) = $string =~ /<\?lsmb \s+ if \s+ (\w+)/x

在列表上下文中，匹配运算符 m//返回包含匹配项的列表。即使它只是一个，我们也需要列表上下文——在标量上下文中它的行为是不同的。列表上下文来自从中分配给列表，my (...) = . /x 修饰符 仅允许我们在内部使用空格，以提高可读性。参见 perlretut对于初学者。

<? 之前可能是什么不必指定，因为模式匹配字符串中的任何位置。 \w用于 [A-Za-z0-9_] (参见 perlrecharclass )，似乎与您的示例和描述相符。 \S更宽容。 \w+ 之后不需要任何内容.

另外，也不需要先测试pattern是否存在

sub strip_markup 
{
    my ($test_res) = $_[0] =~ /<\?lsmb if (\w+)/;

    if ($test_res) {
        # ...
    }

    return $test_res;         # return something!
}

没有理由进行替换，所以我们使用匹配。

我知道您正在使用无法更改的代码，但仍想发表评论

• 这里不需要去掉换行符。但是当你这样做时，使用 chomp而不是 chop

• sub 使用全局变量。这可能会导致错误。小范围声明。通过

• sub 修改全局变量。这通常会导致错误，而很少需要

• 使用数组重复相同的事情

• 这可以以不同的方式组织，以更清楚地分离工作

---

例如

my @tests = (
    qq|<?lsmb if customerfax ?>  caacaacac\n|,
    # ...
);

my ($cnt, $t);

foreach my $test (@tests) 
{
    my $test_res = strip_markup($test);

    if (defined $test_res) {
        $t++;
        print "Test $t ";
        #look up the result as the hash key
        my $ok = $self->{$test_res};
        if ($ok) { 
                $count++;
                print "OK passed $ok,";
        }
        print qq|Test Value : '$_' \n|;
    }
    else { }  # report failure
}

sub strip_markup {
    my ($test_res) = $_[0] =~ /<\?lsmb \s+ if \s+ (\w+)/x;
    return $test_res;
}

defined $test_res 的测试允许错误的东西(如 0 或 '' )成为有效结果。

报告代码可以而且应该在另一个子例程中。