Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

delete multiple string blocks

by grandagent (Initiate)
on Aug 08, 2019 at 10:48 UTC ( #11104155=perlquestion: print w/replies, xml ) Need Help??

grandagent has asked for the wisdom of the Perl Monks concerning the following question:

I have a file that looks like this:

strategies{ XLON_DBX0F2_GBP DynamicSpreadQuoter { tradingServiceAttributes { session LSE1 } fairPrice { securityID LU0490618542 securityIDSource 4 service IDNPS } } XLON_DBX1AE_GBP DynamicSpreadQuoter { tradingServiceAttributes { session LSE3 } fairPrice { securityID LU0322252127 securityIDSource 4 service NMP_ABPS } } XLON_DBX1AE_USD DynamicSpreadQuoter { tradingServiceAttributes { session LSE1 } fairPrice { securityID LU0322252171 securityIDSource 4 service NMP_ABPS } } ;; }

What I want is to pass multiple strings to my script (for example 'XLON_DBX1AE_USD','XLON_DBX1AE_GBP',..) The script should then delete everything starting from there until the last closed bracket "}" for this particular block. Currently my script works if I pass ONE string to it but I just don't know how to modify it if I want to pass more than one string. Can anyone please help me on this? Appreciate your help in advance.

My code:

#!/usr/bin/perl # use strict; use warnings; # my $match='XLON_DBX1AE_USD'; my $file = $ARGV[0]; # open (my $fh, '+<', $file) or die "Could not open \"$file\"$!\n"; # my $depth = 0; while(<$fh>) { if($_=~ /$match/){ $depth = /\}/ ? 0 : 1; while($depth) { $_=<$fh>; $depth-- if /}/; $depth++ if /{/; } } else { print; } }

Replies are listed 'Best First'.
Re: delete multiple string blocks
by hippo (Canon) on Aug 08, 2019 at 11:07 UTC

    TIMTOWTDI. It's pretty simple so long as you assign to a lexical in your while loop. eg:

    #!/usr/bin/env perl use strict; use warnings; my @substrings = qw/XLON_DBX1AE_USD XLON_DBX1AE_GBP/; while (my $line = <DATA>) { if (grep { index ($line, $_) > -1 } @substrings) { print "Found a match in line: $line"; } } __DATA__ strategies{ XLON_DBX0F2_GBP DynamicSpreadQuoter { tradingServiceAttributes { session LSE1 } fairPrice { securityID LU0490618542 securityIDSource 4 service IDNPS } } XLON_DBX1AE_GBP DynamicSpreadQuoter { tradingServiceAttributes { session LSE3 } fairPrice { securityID LU0322252127 securityIDSource 4 service NMP_ABPS } } XLON_DBX1AE_USD DynamicSpreadQuoter { tradingServiceAttributes { session LSE1 } fairPrice { securityID LU0322252171 securityIDSource 4 service NMP_ABPS } } ;; }

    I've assumed here that your patterns are all substrings rather than regular expressions.

      Thanks a lot that worked! Could you elaborate a bit on how this works in detail? Would appreciate that mate..

        Sure. Working from the inside out:

        1. index looks for the substring within the string. Any result greater than -1 indicates it has been found. (If you know your substrings are always at the beginning of the string you can check for zero here)
        2. grep attempts the block of code against every element of the supplied array and returns those which evaluate to a true value.
        3. if tests all this for truth, ie. if the list returned by grep has elements.

        Note that grep isn't the most efficient here because it will go on testing even after a match is found. For a short array/list it won't matter much. For a longer array/list you might want List::Util::any instead.

Re: delete multiple string blocks (updated)
by AnomalousMonk (Bishop) on Aug 08, 2019 at 18:13 UTC

    Here's another approach. You already seem to have a solution you like and this may be too regexy for your taste, but FWIW... Note this requires Perl version 5.10+ for certain regex extensions; see Extended Patterns. See Building Regex Alternations Dynamically for more info on building the  $rx_target part of the search regex. (OPed example data file used for testing.)

    Update 1: Because I don't know just what you want to do with it, I'm not actually outputting the processed file content (except for debug prints); you'll have to take care of that yourself.

    Update 2: If a balanced expression regex utility is used, the code gets simpler/clearer (see Regexp::Common and Regexp::Common::balanced):

    use Regexp::Common; ... $content =~ s{ $rx_target \s+ [[:alpha:]]+ \s* $RE{balanced}{-parens=>'{}'} \s* } {}xmsg; ...


    Give a man a fish:  <%-{-{-{-<

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://11104155]
Approved by marto
Front-paged by haukex
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (5)
As of 2019-08-23 13:06 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?