perl 正则表达式多行

Question

我正在尝试编写一个 perl 脚本，用其他几行替换几行文本，我是 perl 新手，感谢您的帮助。

需要更换

'ENTITLEMENT_EVS_V',
NULL,
NULL,

与：

'ENTITLEMENT_EVS_V',
ENTITLEMENT_CATEGORY_CODE,
6,

我做不到，尤其是正则表达式部分。我尝试了很多东西，但脚本目前位于：

#!/usr/bin/env perl
my ($lopen_fh, $lwrite_fh);

# my $l_reg_evs = qq{
#'ENTITLEMENT_EVS_V',
#NULL,
#NULL,
#};
my $l_reg_evs = qr/(\'ENTITLEMENT_EVS_V\',
                     NULL,
                     NULL,
                    )/;


        my $l_evs=qq{
                     'ENTITLEMENT_EVS_V',
                      ENTITLEMENT_CATEGORY_CODE,
                      6,
                    };

open ($lopen_fh, '<', "/home/cbdev2/imp/dev/src/deli/entfreeunits/config/entfreeunits/stubs/DirectVariables_evEntlCategory.exp") or die $!;
open ($lwrite_fh, '>', "/home/cbdev2/imp/dev/src/deli/entfreeunits/config/entfreeunits/stubs/DirectVariables_evEntlCategory.new.exp") or die $!;

while(<$lopen_fh>) {
    $_ =~ s/$l_reg_evs/$l_evs/m;
    print $lwrite_fh $_;
}

close $lopen_fh;
close $lwrite_fh;

Answer 1

我不太清楚你想做什么，但我试图将你问题的本质提炼成一个独立的脚本。在一个真实的程序中，你会读取和解析变量名到类别和代码的映射，但在这里，我只是从字符串中读取。这样做的目的是表明可以在不使用文件的情况下完成任务。

#!/usr/bin/env perl

use strict;
use warnings;

my $entitlement_map_file = <<EOF_MAP_FILE;
'ENTITLEMENT_EVS_V'
ENTITLEMENT_CATEGORY_CODE
6
EOF_MAP_FILE

my $entitlement_input_file = <<EOF_INPUT_FILE;
'ENTITLEMENT_EVS_V',
NULL,
NULL,
EOF_INPUT_FILE

# read and parse the file containing mapping of
# variables to category names and codes

open my $map_fh, '<', $entitlement_map_file
    or die $!;

my %map;

while (my $var = <$map_fh>) {
    chomp $var;
    chomp( my $mnemonic = <$map_fh> );
    chomp( my $code = <$map_fh>);
    @{ $map{$var} }{qw(mnemonic code)} = ($mnemonic, $code);
}

close $map_fh;

# read the input file, look up variable name in the map
# if there, follow with category name and code
# skip two lines from input, continue where you left off

open my $in, '<', $entitlement_input_file
    or die $!;

while (my $var = <$in>) {
    $var =~ s/,\s+\z//;
    next unless exists $map{ $var };

    for (1 .. 2) {
        die unless <$in> =~ /^NULL/;
    }

    print join(",\n", $var, @{ $map{$var} }{qw(mnemonic code)}), "\n";
}

close $in;

输出：

'ENTITLEMENT_EVS_V',
ENTITLEMENT_CATEGORY_CODE,
6

将其概括为 reader 的练习。

Answer 2

我想我会写这样的东西。它期望输入文件的路径作为命令行上的参数并将结果打印到 STDOUT

需要满足以下所有条件

要搜索的块的第一行和要替换的块始终相同
要搜索的块中的行数和要替换的块总是相同的
输入文件始终包含块的第一行以恰好搜索一次
不需要检查块中第一行之后的文件中的行是否为NULL,，只需定位第一行并删除以下内容就足够了包含的行

它通过读取输入文件并将其复制到 STDOUT 来工作。如果它遇到包含替换块第一行的行，则它会读取并丢弃行，直到读取的行数等于替换块的大小。然后将替换块中的文本打印到 STDOUT 并继续复制

use strict;
use warnings 'all';
no warnings 'qw';  # avoid warning about commas in qw//

my @replacement = qw/
    'ENTITLEMENT_EVS_V',
    ENTITLEMENT_CATEGORY_CODE,
    6,
/;

open my $fh, '<', $ARGV[0];

while ( <$fh> ) {
    if ( /$replacement[0]/ ) {
        <$fh> for 1 .. $#replacement;
        print "$_\n" for @replacement;
    }
    else {
        print;
    }
}

这适用于我创建的一些样本数据，但我无法知道上面列出的规定是否适用于您的实际数据。如果有什么需要调整的，我相信你会告诉我的

Answer 3

这是我所做的：

#!/usr/bin/env perl
my ($lopen_fh, $lwrite_fh);
my $l_stub_dir = "/home/cbdev2/imp/dev/src/deli/entfreeunits/config/entfreeunits/stubs";
my $l_stub = "DirectVariables_evEntlCategory.exp";
my $l_filename = "$l_stub_dir/$l_stub";
my $search_evs = 'ENTITLEMENT_EVS_V';
my $search_tre = 'ENTITLEMENT_TRE_V';

my @replacement_evs = qw/
    'ENTITLEMENT_EVS_V',
    ENTITLEMENT_CATEGORY_CODE,
    6,
    /;
my @replacement_tre = qw/
    'ENTITLEMENT_TRE_V',
    ENTITLEMENT_CATEGORY_CODE,
    6,
    /;

open ($lopen_fh, "<$l_filename") or die $!;
open ($lwrite_fh, ">$l_filename.new") or die $!;

while(<$lopen_fh>) {
    if ( /'ENTITLEMENT_EVS_V'/ ) {
        <$lopen_fh> for 1 .. $#replacement_evs;
        print $lwrite_fh "    $_\n" for @replacement_evs;
    }
    elsif ( /'ENTITLEMENT_TRE_V'/ ) {
        <$lopen_fh> for 1 .. $#replacement_tre;
        print $lwrite_fh "    $_\n" for @replacement_tre;
    }
    else {
        print $lwrite_fh $_;
    }
}

close $lopen_fh;
close $lwrite_fh;

unlink($l_filename) or die "Failed to delete $l_filename: $!";
link("$l_filename.new", $l_filename) or die "Failed to copy $l_filename";
unlink("$l_filename.new") or die "Failed to delete $l_filename.new: $!";

perl 正则表达式多行

perl regex multiline

regex

perl

multiline