perl remove string block from file and save to file

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.