如何在 Perl 中提取和解析带引号的字符串？答案

【问题标题】：How do I extract and parse quoted strings in Perl?如何在 Perl 中提取和解析带引号的字符串？
【发布时间】：2009-12-22 10:40:59
【问题描述】：

美好的一天。

我的文本文件内容如下。 tmp.txt（一个非常大的文件）

constant fixup private AlarmFileName = <A "C:\\TMP\\ALARM.LOG">  /* A Format */

constant fixup ConfigAlarms = <U1 0>         /*  U1 Format  */

constant fixup ConfigEvents = <U2 0>         /*  U2 Format  */

我的解析代码如下。该代码无法在此处处理C:\\TMP\\ALARM.LOG（带引号的字符串）。我不知道如何替换代码 "s+([a-zA-Z0-9])+>" 来处理 [a-zA-Z0-9] (0 above) 字符串和 quated 字符串 (" C:\TMP\ALARM.LOG" 以上）。

$source_file = "tmp.txt";
$dest_xml_file = "my.xml";

#Check existance of root directory
open(SOURCE_FILE, "$source_file") || die "Fail to open file $source_file";
open(DEST_XML_FILE, ">$dest_xml_file") || die "Coult not open output file $dest_xml_file";

$x = 0;

print DEST_XML_FILE  "<!-- from tmp.txt-->\n";
while (<SOURCE_FILE>) 
{
    &ConstantParseAndPrint;

}

sub ConstantParseAndPrint
{
 if ($x == 0)
 {

     if(/^\s*(constant)\s*(fixup|\/\*fixup\*\/|)\s*(private|)\s*(\w+)\s+=\s+<([a-zA-Z0-9]+)\s+([a-zA-Z0-9])+>\s*(\/\*\s*(.*?)\s*\*\/|)(\r|\n|\s)/)
                {
                    $name1 = $1;
                    $name2 = $2;
                    $name3 = $3;
                    $name4 = $4;
                    $name5 = $5;
                    $name6 = $6;
                    $name7 = $7;
                    printf DEST_XML_FILE "\t\t$name1";
                    printf DEST_XML_FILE "\t\t$name2";
                    printf DEST_XML_FILE "\t\t$name3";
                    printf DEST_XML_FILE "\t\t$name4";
                    printf DEST_XML_FILE "\t\t$name5";
                    printf DEST_XML_FILE "\t\t$name6";
                    printf DEST_XML_FILE "\t\t$name7";
                    $x = 1;
  }
 }
}

感谢您的意见。

**大家好，

感谢您提供这么多出色的解决方案。我是新手，我想根据你的帖子做更多的研究。

非常感谢。**

【问题讨论】：

你想达到什么目标，出了什么问题？
您好 n0rd，我不知道如何替换代码“s+([a-zA-Z0-9])+>”来处理 [a-zA-Z0-9] （上面的 0）字符串和带引号的字符串（上面的“C:\TMP\ALARM.LOG”）。
清楚地描述你想要什么。在提出此类问题时显示您想要的示例输出。
@ghostdog74。更新了我上面的帖子。谢谢。
你的$name1 = $1 系列已经告诉我你走错了路。如果你必须用数字后缀命名一个变量，它确实是更大数据结构的一部分。

标签： regex perl parsing

【解决方案1】：

我不会为你编写你的正则表达式，也不会给你一些东西来剪切和粘贴到你的代码中。无论如何，您的正则表达式将在下一个特殊情况下中断。我会给你一个更好的方法。

将每一行分成作业的左右两边。

my($lhs, $rhs) = split m{\s* = \s*}x, $line, 2;

现在单独使用它们要容易得多。您可以从左侧提取信息，只需将其拆分为空格以获取所有标志（常量、修复等...），最后一个单词将是分配给的名称。

my @flags = split /\s+/, $lhs;
my $name  = pop @flags;

如果需要，您可以通过@flags 过滤您的行。

而且大概在括号内的值可以很容易地得到。使用非贪婪正则表达式可确保它正确处理 foo = <bar> /* comment <stuff> */ 之类的内容。

my($value) = $rhs =~ /<(.*?)>/;

从这种方法可以看出，它避免了猜测文件中可能出现的特殊关键字（常量、修复、私有）。

我不知道这个文件中还有什么，你没有说。

【讨论】：

感谢您的建议。实际上它是一个非常大的文件。该文件中还有一些其他关键字。我打算用你的方法练习。

【解决方案2】：

您的代码中有一些主要的设计缺陷。我没有解决你的问题，但我已经清理了你的代码。

最重要的是，不要使用全局变量。在一段相对较短的代码中，您使用了 3 个全局变量。这是在寻找无法追踪的神秘错误。随着您的项目随着时间的推移变得越来越大，这将成为一个更大的问题。

考虑使用Perl::Critic。它将帮助您改进代码。

这是您的代码的带注释的、经过清理的版本：

# Always use strict and warnings.
# It prevents bugs.
use strict;
use warnings;

my $source_file   = "tmp.txt";
my $dest_xml_file = "my.xml";

# You aren't checking the existence of anyting here:
#Check existance of root directory 
# Is this a TODO item?

# Use 3 argument open with a lexical filehandle.
# Adding $! to your error messages makes them more useful.
open my $source_fh, '<', $source_file
    or die "Fail to open file $source_file - $!";

open( my $dest_fh, '>', $dest_xml_file 
    or die "Coult not open output file $dest_xml_file - $!";

my $x = 0;  # What the heck does this do?  Give it a meaningful name or
            # delete it.

print $dest_fh  "<!-- from tmp.txt-->\n";
while (my $line = <$source_fh>)   
{

    # Don't use global variables.
    # Explicitly pass all data your sub needs.
    # Any values that need to be applied to external 
    # data should be applied by the calling function,
    # from data that is returned.

    $x = ConstantParseAndPrint( $line, $x, $dest_fh );

}

sub ConstantParseAndPrint {
    my $line          = shift;
    my $mystery_value = shift;
    my $fh            = shift;

    if($mystery_value == 0) {

        # qr{} is a handy way to build a regex.
        # using {} instead of // to mark the boundaries helps
        # cut down on the escaping required when your pattern
        # contains the '/' character.

        # Use the x regex modifier to allow whitespace and 
        # comments in your regex.
        # This very is important when you can't avoid using a big, complex regex.

        # But really don't do it this way at all.
        # Do what Schwern says.
        my $line_match = qr{
            ^                      \s*  # Skip leading spaces
            (constant)             \s*  # look for the constant keyword
            (fixup|/\*fixup\*/|)   \s*  # look for the fixup keyword
            (private|)             \s*  # look for the prive keyword
            (\w+)                  \s+  # Get parameter name
            =                      \s+  
            <                           # get bracketed values
            ([a-zA-Z0-9]+)         \s+  # First value 
            ([a-zA-Z0-9])+              # Second value
            >                      \s*
            (/\*\s*(.*?)\s*\*/|)        # Find any trailing comment
            (\r|\n|\s)                  # Trailing whitespace
        }x;


        if( $line =~ /$line_match/ ) {

            # Any time you find yourself making variables
            # with names like $foo1, $foo2, etc, use an array.

            my @names = ( $1, $2, $3, $4, $5, $6, $7 );

            # printf is for printing formatted data.  
            # If you aren't using any format codes, use print.

            # Using an array makes it easy to print all the tokens.
            print $fh "\t\t$_" for @names;

            $mystery_value = 1;

        }
    }

    return $mystery_value;
}

至于您的解析问题，请遵循 Schwern 的建议。大而复杂的正则表达式是您需要简化的标志。将大问题分解为可管理的任务。

【讨论】：

“将大问题分解为可管理的任务” - 感谢您的指导。

【解决方案3】：

如前所述，您的正则表达式中需要一些结构。在重新编写您的代码时，我做了几个假设

您不想只以制表符分隔的格式打印出来
$x 变量的唯一原因是您只打印一行。（尽管在循环结束时使用 last 就可以了。）。

假设这些事情，我决定，在解决您的问题时，我会：

向您展示如何制作一个好的可修改正则表达式。
编写非常简单的“语义动作”来存储数据并让您随意使用。

另外应该注意的是，我将输入更改为__DATA__ 部分和输出仅限于 STDERR——通过使用Smart::Comment cmets，帮助我检查我的结构。

首先是代码序言。

use strict;   # always in development!
use warnings; # always in development!
use English qw<$LIST_SEPARATOR>; # It's just helpful.
#use re 'debug';
#use Smart::Comments

注意注释掉的use re....如果你真的想看到一个常规的方式表达式被解析，它会输出很多信息，你可能不想看到（但可以通过 - 稍微了解一下尽管如此，正则表达式解析。）它被注释掉了，因为它不是新手友好，并会垄断你的输出。（有关更多信息，请参阅re。）

use Smart::Comments 行也被注释掉了。我推荐它，但你可以通过使用Data::Dumper 和print Dumper( \%hash ) 行来获得。（见Smart::Comments。）

指定表达式

但是关于正则表达式。我使用了正则表达式的爆炸形式，以便全部解释（见perlre）。我们想要一个字母数字字符或带引号的字符串（允许转义）。

我们还使用了修饰符名称列表，以便“语言”可以进步。

我们在“do 块”中创建的下一个正则表达式，或者我喜欢称之为“本地化” 块”，这样我就可以将$LIST_SEPARATOR（又名$"）本地化为正则表达式交替字符。 ('|')。因此，当我包含要插入的列表时，它被插入为交替。

在讨论第二个正则表达式之前，我会给你时间看看。

# Modifiable list of modifiers
my @mod_names = qw<constant fixup private>;
# Break out the more complex chunks into separate expressions
my $arg2_regex 
    = qr{ \p{IsAlnum}             # accept a single alphanumeric character
        |                         # OR 
          "                       # Starts with a double quote
          (?>                     # -> We just want to group, not capture
                                  # the '?> controls back tracing
              [^\\"\P{IsPrint}]+  # any print character as long as it is not
                                  # a backslash or a double quote
          |   \\"                 # but we will accept a backslash followed by
                                  # a double quote
          |   (\\\\)+             # OR any amount of doubled backslashes
          )*                      # any number of these
          "
        }msx;

my $line_RE 
    = do { local $LIST_SEPARATOR = '|';
           qr{ \A                # the beginning
               \s*               # however much whitespace you need
               # A sequence of modifier names followed by space
               ((?: (?: @mod_names ) \s+ )*)
               ( \p{IsAlnum}+ )  # at least one alphanumeric character
               \s*               # any amount of whitespace
               =                 # an equals sign
               \s*               # any amount of whitespace
               <                 # open angle bracket
                 (\p{IsAlnum}+)  # Alphanumeric identifier
                 \s+             # required whitespace
                 ( $arg2_regex ) # previously specified arg #2 expression
                 [^>]*?
               >                 # close angle bracket
             }msx
             ;   
          };

正则表达式只是说我们想要分隔任意数量的可识别“修饰符” 由空格后跟一个字母数字标识符（我不知道你为什么不想要下划线；无论如何，我不包括它们。）

后面是任意数量的空格和等号。由于集字母数字字符、空格和等号都是不相交的，没有理由需要空格。在等号的另一边，该值由尖括号分隔，所以我看不出有任何理由 require 那一边的空白。在等于之前，你允许的是字母数字和空格，另一方面，它们都必须成角度括号。必需的空白给你什么，而不需要它更多容错。如果您期望，请忽略所有这些并将*s 更改为+ 机器输出。

在等号的另一边，我们需要一个尖括号对。这对由一个字母数字参数组成，第二个参数是 EITHER a 单个字母数字字符（基于您的规范）或可以包含的字符串转义转义或引号，甚至结束尖括号——只要字符串没有结束。

存储数据

制定规范后，您可以执行以下操作之一用它。因为除了打印它我不知道你想用这个做什么出——我将假设这不是脚本的全部目的。

### $line_RE
my %fixup_map;
while ( my $line = <DATA> ) { 
    ### $line
    my ( $mod_text, $identifier, $first_arg, $second_arg ) 
        = ( $line =~ /$line_RE/ )
        ;
    die 'Did not parse!' unless $identifier;
    $fixup_map{$identifier}
        = { modifiers_for => { map { $_ => 1 } split /\s+/, $mod_text }
          , first_arg     => $first_arg
          , second_arg    => $second_arg
          };

    ### $fixup_map{$identifier} : $fixup_map{$identifier}
}
__DATA__
constant fixup ConfigAlarms  = <U1 0>
constant fixup ConfigAlarms2 = <U1 2>
constant fixup private AlarmFileName = <A "C:\\TMP\\ALARM.LOG">

最后你可以看到DATA 部分，当你处于开始阶段时你好像来了，省掉IO逻辑，用内置句柄 DATA 就像我在这里做的那样。

我在哈希中收集修饰符，以便我的语义操作可以是

#...
my $data = $fixup_map{$id};
#...
if ( $data->{modifiers_for}{public} ) {
    #...
}

肥皂盒

然而，主要问题是您似乎没有计划。对于角括号中的第二个“参数”，您有一个正则表达式，它指定 only 单个字母数字字符，但想要扩展它以允许转义字符串。我不得不期望您正在实现一个小子集，并逐渐希望扩展它来做其他事情。如果你从一开始就忽略了一个好的设计，那么实现全功能的“解析器”只会变得越来越令人头疼。

您可能希望在某些时候实现多行值。如果您不了解如何从单个字母数字转换为引号分隔的参数，那么逐行方法和对正则表达式的调整会使复杂性差距相形见绌。

因此我建议您仅将此处的代码用作扩展复杂性的指南。我正在回答一个问题并指出一个方向，而不是设计或编码一个项目，所以我的正则表达式代码不像它应该的那样可扩展。

如果解析工作足够复杂，我会为Parse::RecDescent 指定一个最小的前瞻语法，并坚持对语义动作进行编码。这是另一个建议。

【讨论】：

我有一个书签，有机会我会读的。非常感谢。

【解决方案4】：

#!/usr/bin/perl


$source_file = "tmp.txt";
$dest_xml_file = "my.xml";

#Check existance of root directory
open(SOURCE_FILE, "$source_file") || die "Fail to open file $source_file";
open(DEST_XML_FILE, ">$dest_xml_file") || die "Coult not open output file $dest_xml_file";

$x = 0;

print DEST_CS_FILE  "<!-- from tmp.txt-->\n";
while (<SOURCE_FILE>)   
{
    &ConstantParseAndPrint;

}

sub ConstantParseAndPrint
{
    if ($x == 0)
    {

#        if(/^\s*(constant)\s*(fixup|\/\*fixup\*\/|)\s*(private|)\s*(\w+)\s+=\s+<([a-zA-Z0-9]+)\s+([a-zA-Z0-9])+>\s*(\/\*\s*(.*?)\s*\*\/|)(\r|\n|\s)/)
        if(/^\s*(constant)\s*(fixup|\/\*fixup\*\/|)\s*(private|)\s*(\w+)\s+=\s+<([a-zA-Z0-9]+)\s+(["']?)([a-zA-Z0-9.:\\]+)\6>\s*(\/\*\s*(.*?)\s*\*\/|)(\r|\n|\s)/)

                {
                    $name1 = $1;
                    $name2 = $2;
                    $name3 = $3;
                    $name4 = $4;
                    $name5 = $5;
                    $name6 = $7;
                    $name7 = $8;
                    printf DEST_XML_FILE "\t\t$name1";
                    printf DEST_XML_FILE "\t\t$name2";
                    printf DEST_XML_FILE "\t\t$name3";
                    printf DEST_XML_FILE "\t\t$name4";
                    printf DEST_XML_FILE "\t\t$name5";
                    printf DEST_XML_FILE "\t\t$name6";
                    printf DEST_XML_FILE "\t\t$name7\n";
#                    $x = 1;
        }
    }
}

使用以下解析代码：

if(/^\s*(constant)\s*(fixup|\/\*fixup\*\/|)\s*(private|)\s*(\w+)\s+=\s+<([a-zA-Z0-9]+)\s+(["']?)([a-zA-Z0-9.:\\]+)\6>\s*(\/\*\s*(.*?)\s*\*\/|)(\r|\n|\s)/)

我添加了对单引号和双引号的处理。我使用反向引用进行引号匹配。我还更新了路径的字符类。即它现在包括冒号 (:)、点 (.) 和反斜杠 () 以及字母数字字符。

【讨论】：

你好 RahulJ，我测试了你的代码。它仍然无法工作。顺便说一句，为什么要在代码中添加“\6”？谢谢。
天哪，倾斜的牙签。使用不同的分隔符和 /x 标志！
您好 Nano HE，我已经添加了您文件的代码。按原样使用文件。 \6 用作反向引用，以便捕获要在 url 末尾匹配的引号（无论是双引号还是单引号）。 URL 周围的引号应该相同。
嗨，RahuIj。感谢您的全力支持。顺便提一句。我仍然在您上面的代码中发现问题。代码无法仅获取最后一行的评论内容。比如代码无法解析得到我的tmp.txt文件的/* U2 Format */的值。（我将原始帖子 tmp.txt 文件从两行更新为三行）。幸运的是，所有其他 cmets 都可以成功解析。十分感谢！ ——
嗨 Nano，我已经使用您的文件 tmp.txt 作为输入运行了我的代码，my.xml 文件的输出是： constant fixup private AlarmFileName A C:\\TMP\\ALARM.LOG / * A Format / constant fixup ConfigAlarms U1 0 / U1 Format / constant fixup ConfigEvents U2 0 / U2 Format */ 我觉得没问题，最后一行还包含注释.可能是我在你的问题中遗漏了一些东西。您能否再次澄清一下问题所在。

【解决方案5】：

我有意删除了匹配捕获（如果需要，您可以添加它们）：

m{^\s*constant\s+fixup\s+(?:private\s+)?\w+\s*=\s*<[^>]+>(?:\s*/\*(?:\s*\w*)+\*/)?$};

【讨论】：

【解决方案6】：

先统一！

$yourstring =~ s,\\,/,g;  # transform '\' into '/'
$yourstring =~ s,/+,/,g;  # transform multiple '/' into one '/'

【讨论】：