perl remove string block from file and save to file - string

Question

I have a file that looks like this:
string 1 {
abc { session 1 }
fairPrice {
ID LU0432618274456
Source 4
service xyz
}
}
string 2 {
abc { session 23 }
fairPrice {
ID LU036524565456171
Source 4
service tzu
}
}
My program should read in the file with a search-parameter given (for example "string 1") and search the complete block until "}" and remove that part from the file. Can someone assist on that...I have some code so far but how can I do the removal and saving to the same file again?
my $fh = IO::File->new( "$fname", "r" ) or die ( "ERROR: Strategy file \"$fname\" not found." );
while($line=<$fh>)
{
if ($line =~ /^\s*string 1\s*\w+\s*\{\s*$/) {
$inside_json_msg = 1;
$msg_json .= $line;
}
else {
if ($inside_json_msg)
{
if ($line =~ m/^\}\s*$/) {
$msg_json.= $line if defined($line);
$inside_json_msg = 0;
} else {
$msg_json .= $line;
}
}
}
}

Answer 1

You code mentions JSON, but your data isn't JSON. If it is JSON and you've just transcribed it badly, then please use a JSON library.
But if your data isn't JSON, then something like this will do the trick.
#!/usr/bin/perl
use strict;
use warnings;
my $match = shift or die "I need a string to match\n";
while (<DATA>) {
# If this is the start of a block we want to remove...
if (/^\s*$match\s+{/) {
# Set $braces to 1 (or 0 if the block closes on this line)
my $braces = /}/ ? 0 : 1;
# While $braces is non-zero
while ($braces) {
# Read the next line of the file
$_ = <DATA>;
# Increment or decrement $braces as appropriate
$braces-- if /}/;
$braces++ if /{/;
}
} else {
# Otherwise, just print the line
print;
}
}
__DATA__
string 1 {
abc { session 1 }
fairPrice {
ID LU0432618274456
Source 4
service xyz
}
}
string 2 {
abc { session 23 }
fairPrice {
ID LU036524565456171
Source 4
service tzu
}
}
Currently, this just prints the output to the console. And I use the DATA filehandle for easier testing. Switching to use real filehandles is left as an exercise for the reader :-)
Update: I decided that I didn't like all the incrementing and decrementing of $braces using regex matches. So here's another (improved?) version that uses y/.../.../ to count the occurrences of opening and closing braces in the line. It's possible that this version might be slightly less readable (the syntax highlighter certainly thinks so).
#!/usr/bin/perl
use strict;
use warnings;
my $match = shift or die "I need a string to match\n";
while (<DATA>) {
if (/^\s*$match\s+{/) {
my $braces = y/{// - y/}//;
while ($braces) {
$_ = <DATA>;
$braces -= y/}//;
$braces += y/{//;
}
} else {
print;
}
}
__DATA__
string 1 {
abc { session 1 }
fairPrice {
ID LU0432618274456
Source 4
service xyz
}
}
string 2 {
abc { session 23 }
fairPrice {
ID LU036524565456171
Source 4
service tzu
}
}
Update 2: Ok, I originally said that dealing with real filehandles would be left as an exercise for the reader. But here's a version that does that.
#!/usr/bin/perl
use strict;
use warnings;
my $match = shift or die "I need a string to match\n";
open my $fh, '+<', 'data' or die $!;
# Read all the data from the file
my #data = <$fh>;
# Empty the file
seek $fh, 0, 0;
truncate $fh, 0;
my $x = 0;
while ($x <= $#data) {
$_ = $data[$x++];
if (/^\s*$match\s+{/) {
my $braces = y/{// - y/}//;
while ($braces) {
$_ = $data[$x++];
$braces -= y/}//;
$braces += y/{//;
}
} else {
print $fh $_;
}
}
Currently, I've hard-coded the filename to be data. I hope it's obvious how to fix that.

Answer 2

Can use Text::Balanced to break the text into blocks delimited by {}, in a way that also keeps the text preceding and following the blocks.
In that list drop the element with the specific skip-pattern (string 1 here) and its following block and retain everything else. Then overwrite the source file with that.
use warnings;
use strict;
use Path::Tiny;
use Text::Balanced qw(extract_bracketed extract_multiple);
my $file = shift // die "Usage: $0 file\n"; #/
my $text = path($file)->slurp;
# returns: 'string 1', BLOCK, 'string 2', BLOCK (may have spaces/newlines)
my #elems = extract_multiple(
$text, [ sub { extract_bracketed($text, '{}') } ]
);
my $skip_phrase = 'string 1';
my (#text_keep, $skip);
for (#elems) {
if (/$skip_phrase/) {
$skip = 1;
next;
}
elsif ($skip) {
$skip = 0;
next
}
push #text_keep, $_;
}
print for #text_keep;
# Overwrite source; uncomment when tested
#open my $fh_out, '>', $file or die "Can't open $file: $!";
#print $fh_out $_ for #text_keep;
Tested with files with more text and blocks, both before and after the one to drop.
Another tool that can be used to extract delimited chunks is in Regexp::Common, see this post.

Answer 3

I would use proper json as format and jq as processor for that format. Rewriting a hack in perl does not make much sense.

Answer 4

Here is an example using Regexp::Grammars:
use feature qw(say);
use strict;
use warnings;
use Data::Printer;
use Regexp::Grammars;
{
my ($block_name, $block_num) = #ARGV;
my $parser = qr!
<nocontext:>
<blocks>
<rule: blocks> <[block]>+
<rule: block> <block_name> <block_num> <braced_item>
<token: block_name> \w+
<token: block_num> \d+
<rule: braced_item> \{ (?: <escape> | <braced_item> | [^{}] )* \}
<token: escape> \\ .
!xms;
my $data = read_file('cfg.txt');
if ($data =~ $parser) {
print_blocks( $/{blocks}{block}, $block_name, $block_num );
}
else {
warn "No match";
}
}
sub print_blocks {
my ( $blocks, $block_name, $block_num ) = #_;
for my $block (#$blocks) {
next if ($block->{block_name} eq $block_name)
&& ($block->{block_num} == $block_num);
say $block->{block_name}, " ", $block->{block_num},
" ", $block->{braced_item}{braced_item};
}
}
sub read_file {
my ( $fn ) = #_;
open ( my $fh, '<', $fn ) or die "Could not open file '$fn': $!";
my $str = do { local $/; <$fh> };
close $fh;
return $str;
}