can u suggest a regex for this ?

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

I often have requests to comment out BLOCKS of text, such as "comment out everything between and including each cat/^cat block. Example:

mouse
cat
1
2
3
^cat 
deer
eel
cat
furbaby
elk
^cat
dog
fish
[download]

the result I want is

mouse
#cat
#1
#2
#3
#^cat 
deer
eel
#cat
#furbaby
#elk
#^cat
dog
fish
[download]

This can be in an array (one element per line) or a scalar. Usually I just loop thru the list and set a flag when hit cat, and unset it after leaving ^cat, and add the # if flagged. Which is like how I would do this in C. Every time I solve a problem in my brain in C, I always think to myself surely Perl has a better approach!.. Fugly code:

 my $comment=0;
 for (@a) {
  $comment++ if /^cat\b/;
  $_ = '#'.$_ if $comment;
  $comment-- if /^\#\^cat\b/;
 }
[download]

Can you suggest a brief solution with a single no-looping regex, OR a map for an array? Or maybe a clever mapped split?

Much thanks and happy Day of the Earth-Rodent-Forecaster!

Comment on can u suggest a regex for this ? Select or Download Code

Replies are listed 'Best First'.
Re: can u suggest a regex for this ? by jo37 (Deacon) on Feb 03, 2023 at 14:59 UTC
If you want to do it with `map`: `map {/^cat\b/ .. /^\^cat\b/ ? s/^/#/r : $_} @a;` [download] Greetings, -jo `$gryYup$d0ylprbpriprrYpkJl2xyl~rzg??P~5lp2hyl0p$`	[reply] [d/l] [select]
Re^2: can u suggest a regex for this ? by misterperl (Pilgrim) on Feb 03, 2023 at 15:26 UTC
THAT is very ELEGANT and Perlish TYVM! I get an error with the "r" modifier but it seems to work without it? I'm on Perl 5.8.8 maybe /r isn't supported?	[reply]
Re^3: can u suggest a regex for this ? by jo37 (Deacon) on Feb 03, 2023 at 15:43 UTC
Without `/r`, `map` would modify the original array, but this is not available in very old versions. Greetings, -jo `$gryYup$d0ylprbpriprrYpkJl2xyl~rzg??P~5lp2hyl0p$`	[reply] [d/l] [select]
Re^3: can u suggest a regex for this ? by kcott (Archbishop) on Feb 03, 2023 at 17:04 UTC
"I'm on Perl 5.8.8 maybe /r isn't supported?" The `/r` modifier was introduced in Perl `v5.14.0` (see "perl5140delta: Non-destructive substitution"). Perl `v5.14.0` was released 12 years ago (see perlhist). — Ken	[reply] [d/l] [select]
Re^3: can u suggest a regex for this ? by hippo (Bishop) on Feb 03, 2023 at 15:54 UTC
I'm on Perl 5.8.8 There have been recent discussions here about using old Perls. If it's not too impertinent to ask, would you mind divulging which O/S (and which version) you are running which has this Perl version installed? I'm unaware of any O/S still supported which has it. TYVM. 🦛	[reply]
Re^4: can u suggest a regex for this ? by misterperl (Pilgrim) on Feb 03, 2023 at 16:24 UTC
Re^5: can u suggest a regex for this ? by hippo (Bishop) on Feb 03, 2023 at 17:10 UTC
Some notes below your chosen depth have not been shown here
Re^5: can u suggest a regex for this ? by Fletch (Bishop) on Feb 03, 2023 at 16:31 UTC
Re^5: can u suggest a regex for this ? by marto (Cardinal) on Feb 04, 2023 at 14:47 UTC
Re^2: can u suggest a regex for this ? by misterperl (Pilgrim) on Feb 03, 2023 at 16:20 UTC
I just went back and ++'ed your reply JO , this is a game-changer. This construct has myriad applications in general. I'm always looking for ways to shorten code- its generally more maintainable, easier to read, and more reliable. This is a huge win to modify certain BLOCKS of text, in one statement. Like to change all "dog"s to "canine" only in XML pet blocks I might use: `map {/^<pets>/ .. /^<\/pets>/ ? s/dog/canine/gir : $_ } @a;` TY you made my month. I never knew how to do this ; I've tried all sorts of approaches over the years like regex assertions, etc. ++ to you for sure ; Id do ++^^10 if I could!	[reply] [d/l]
Re^3: can u suggest a regex for this ? by jo37 (Deacon) on Feb 03, 2023 at 16:31 UTC
Please don't even think about using this for XML. It is not the question if you get hit, only when and how hard you gonna hurt yourself. Really, honestly: Don't do that. Update: See Why a regex really isn't good enough for HTML and XML, even for "simple" tasks Greetings, -jo `$gryYup$d0ylprbpriprrYpkJl2xyl~rzg??P~5lp2hyl0p$`	[reply]
Re: can u suggest a regex for this ? by hv (Prior) on Feb 03, 2023 at 15:26 UTC
Your "fugly code" example suggests that you want to allow nesting of (cat ... ^cat) blocks, and that everything in the outer block should then get a single '#' inserted; and further, that if the final block is missing its closing "^cat" tag it should comment to the end of file. If both of those behaviours are required, then I'd probably prefer to stick with your example code - it makes it pretty clear what is going on, and could easily be extended to insert extra '#' characters for nested blocks if desired. jo37's solution is nice, but does not handle nested blocks: it will stop commenting as soon as it sees the first "^cat". If the "comment to end of file" behaviour is not desired, you may be better off with a recursive regexp that would only match balanced blocks.	[reply]
Re: can u suggest a regex for this ? by Discipulus (Canon) on Feb 03, 2023 at 15:49 UTC
Hello misterperl also flip-flop can be used (look for the scalar context usage): `use strict; use warnings; while (<DATA>){ print /^cat/ .. /^\^cat/ ? "#$_" : $_; } __DATA__ mouse cat 1 2 3 ^cat deer eel cat furbaby elk ^cat dog fish` [download] L* PS `^\^` is actually a cat :) PPS overlooked previous answer was already using flip-flop.. let rephrase: you can also use flip-flop directly :) There are no rules, there are no thumbs.. Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.	[reply] [d/l] [select]
Re: can u suggest a regex for this ? by tybalt89 (Monsignor) on Feb 03, 2023 at 17:32 UTC
Scalar without /r `#!/usr/bin/perl use strict; # https://perlmonks.org/?node_id=11150123 use warnings; my $blockoftext = <<END; mouse cat 1 2 3 ^cat deer eel cat furbaby elk ^cat dog fish END $blockoftext =~ s/^cat.*?^\^cat/ my $catsection = $&; $catsection =~ s!^!#!gm; $catsection /gems; print $blockoftext;` [download]	[reply] [d/l]


Just another Perl shrine
	PerlMonks