perl regex multiline

Question

I am trying to write a perl script that replaces a few lines of text with a few other lines, I am a perl newbie, appreciate any help.

Need to replace

'ENTITLEMENT_EVS_V',
NULL,
NULL,

with:

'ENTITLEMENT_EVS_V',
ENTITLEMENT_CATEGORY_CODE,
6,

I am unable to do so, especially the regex part. I tried many things, but the script currently stands at:

#!/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

I am not quite clear what you are trying to do, but I tried to distill the essence of your problem into a self-contained script. In a real program, you'd be reading and parsing the mapping of variable names to categories and codes, but here, I am just going to read from strings. The purpose of that is to show that the task can be accomplished without slurping files.

#!/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;

Output:

'ENTITLEMENT_EVS_V',
ENTITLEMENT_CATEGORY_CODE,
6

Generalizing this is left as an exercise to the reader.

Answer 2

I think I'd write something like this. It expects the path to the input file as a parameter on the command line and prints the result to STDOUT

It requires all of the following to be true

• The first line of the block to search for and the block to be replaced are always identical

• The number of lines in the block to search for and the block to be replaced are always the same

• The input file always contains the first line of the block to search for exactly once

• There is no need to check that the lines in the file after the first one in the block are NULL, , and it is sufficient to locate just the first line and remove the following lines whatever they contain

It works by reading the input file and copying it to STDOUT. If it encounters a line that contains the first line of the replacement block, then it reads and it discards lines until the number of lines read is equal to the size of the replacement block. Then the text in the replacement block is printed to STDOUT and the copying continues

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;
    }
}

This works fine with some sample data that I created, but I have no way of knowing whether the stipulations listed above apply to your actual data. I'm sure you will let me know if something needs adjusting

Answer 3

Here's what I did:

#!/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: $!";