Calling sub-routine in regex

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

I have a fairly large HTML file that I want to process to make useful with linking. As it stands, it's just 7.k of ordered lists with a sort of ToC, but none of which links together. My idea was to grep out lines by <h2-6> headers, to get something like:

<h2>2.1. Match Literal Text</h2>
<h2>2.2. Match Nonprintable Characters</h2>
<h2>2.3. Match One of Many Characters</h2>
[download]

Next step would be to search and substitute with regex, and harvest the existing text (after the ordered list tag) and make that into an ID, so I would end up with something like:

<h2 id="Match Literal Text">2.1. Match Literal Text</h2>
<h2 id="Match Nonprintable Characters">2.2. Match Nonprintable Charact
+ers</h2>
<h2 id="Match One of Many Characters">2.3. Match One of Many Character
+s</h2>
[download]

I did this like this:


use Tie::File;

my $ol_file = '/Users/tony/Dropbox/perl_data/h2_numbered_list.txt';
my @ol_file_array;
tie @ol_file_array, 'Tie::File', $ol_file or die "Something is wrong h
+ere";

my $regex = qr/
    (?<tag>(<\w\d))
    (?<closing_bracket>>)
    (?<ol_numbers>(\d\.(\d+?)\.))\s
    (?<text>(.+))
    (?<closing_tag>(\b<\/\w\d>))
    /xms;

foreach (@ol_file_array) {
    if ($_ =~ m/$regex/g) {
        $_ =~ s/$regex/$+{tag} id="$+{text}"$+{closing_bracket}$+{ol_n
+umbers} $+{text}$+{closing_tag}/;
    }
    else { # blah blah blah
[download]

The problem I have now is that the text I harvested for the ID has spaces, and is (mostly) Title Case. What I want to do, and for which I seek your wisdom, is convert the text in the id to:

<h2 id="match_nonprintable_characters">2.2. Match Nonprintable Characters</h2>

My initial thought was to write a sub-routine to take the ID text after the first pass alteration, and run it through something akin to lc() and s/ /_/, when running a regex sub. This is where I am stymied. I thoght I could write a sub called (say) 'changer' and insert it into the substitute regex, working on the capture group, like:

$_ =~ s/$regex_2/$+{group_x}$+{group_y} changer($+{text})/e;

Mixed results with this, none right. The '/e' flag gets me a non-descript 'syntax error'. The call to the sub (if I remove the 'e' flag) does not (but not an error seemingly) but the result is typically like:

some_data some_data changer($+{text})

In other words, the sub-routine does not work, and the text is returned in the regex sub literally.

I've had a look online and in my Perl books library, and I think I've understood that the right-side of the s/// needs to be code only, because it is compiled first, but I am failing on how I can get this done, for my scenario.

Is this clear? I'd welcome any suggestions from more knowledgeable programmers. The idea once this works in principle is to run the whole HTML file through it, and auto-generate a ToC and links, using the text that is already in place.

Many thanks.

Tony

Comment on Calling sub-routine in regex Select or Download Code

Replies are listed 'Best First'.
Re: Calling sub-routine in regex by marto (Cardinal) on Jul 19, 2020 at 16:21 UTC
Mojo::DOM makes such things fairly trivial. Consider the following: `#!/usr/bin/perl use strict; use warnings; use feature 'say'; use Mojo::DOM; my $html = '<h2>2.1. Match Literal Text</h2> <h2>2.2. Match Nonprintable Characters</h2> <h2>2.3. Match One of Many Characters</h2>'; my $dom = Mojo::DOM->new( $html ); #for each hr foreach my $hr ( $dom->find('h2')->each ){ # grab the text my $class = $hr->text; # remove x.x. $class =~ s/\-?\d+\.\d+\. //g; # update the DOM $hr->attr('class' => $class ); } # display updated DOM say $dom;` [download] Prints: `<h2 class="Match Literal Text">2.1. Match Literal Text</h2> <h2 class="Match Nonprintable Characters">2.2. Match Nonprintable Char +acters</h2> <h2 class="Match One of Many Characters">2.3. Match One of Many Charac +ters</h2>` [download] Please let me know if you have any questions.	[reply] [d/l] [select]
Re: Calling sub-routine in regex by marto (Cardinal) on Jul 19, 2020 at 18:09 UTC
Taking the time to re-read your requirements (sorry, I was making dinner for the kids when I last posted) I notice you want to do this for various header tags, so consider this: td.html `<!DOCTYPE html> <html> <head> <style> div.hammer { height: 100px; } </style> </head> <body> <h2>Derp</h2> <p>Derp content here</p> <div class='hammer'>Sponsored by artisan hammers</div> <h3>Gerp</h3> <p>Gerp content here</p> <div class='hammer'>Sponsored by artisan hammers</div> <h4>Blerp</h4> <p>Blerp content here</p> </body> </html>` [download] Why the divs? to break up the content a little so when you construct your TOC that it'll be easy to visibly test. td.pl `#!/usr/bin/perl use strict; use warnings; use feature 'say'; use Mojo::DOM; use Mojo::File; my $path = Mojo::File->new('td.html'); my $html = $path->slurp; my $dom = Mojo::DOM->new( $html ); #for each hr foreach my $hr ( $dom->find('h2,h3,h4,h5,h6')->each ){ # grab the text my $text = $hr->text; my $class = $hr->text; # remove x.x. $class =~ s/\-?\d+\.\d+\. //g; # update the DOM $hr->replace("<h2 class='$class'>$text</h2>"); } # display updated DOM say $dom;` [download] Output. `<!DOCTYPE html> <html> <head> <style> div.hammer { height: 100px; } </style> </head> <body> <h2 class="Derp">Derp</h2> <p>Derp content here</p> <div class="hammer">Sponsored by artisan hammers</div> <h2 class="Gerp">Gerp</h2> <p>Gerp content here</p> <div class="hammer">Sponsored by artisan hammers</div> <h2 class="Blerp">Blerp</h2> <p>Blerp content here</p> </body> </html>` [download] Now all you need to do is read and understand the Mojo docs, adding a little bit of code to create a TOC, appending it after the body, or wherever is appropriate in your actual HTML.	[reply] [d/l] [select]
Re: Calling sub-routine in regex by LanX (Saint) on Jul 19, 2020 at 15:50 UTC
> `$_ =~ s/$regex_2/$+{group_x}$+{group_y} changer($+{text})/e;` as you said ... > I think I've understood that the right-side of the s/// needs to be code only ... the RHS must be parsed as code. Hence please try `"$+{group_x}$+{group_y}" . changer($+{text})` or `$+{group_x} . $+{group_y} . changer($+{text})` If that's not your issue, please try to shorten your description, (TL;DR ;-) Cheers Rolf _{(addicted to the Perl Programming Language :) Wikisyntax for the Monastery} PS: people will tell you to use a HTML parser module. ( yep ;-)	[reply] [d/l] [select]
Re: Calling sub-routine in regex by kcott (Archbishop) on Jul 20, 2020 at 06:37 UTC
G'day Tony, Welcome to the Monastery. Using a regex to parse markup like HTML and XML is a poor idea (see "Why a regex really isn't good enough for HTML and XML, even for "simple" tasks"). Having said that, here's how you might have gone about this, using your three posted `h2` lines (plus a couple more I added to test additional header levels): `#!/usr/bin/env perl use 5.014; use warnings; my @html = ( '<h2>2.1. Match Literal Text</h2>', '<h3>2.1.1 H3 Heading</h3>', '<h4>2.1.1.1 H4 Heading</h4>', '<h2>2.2. Match Nonprintable Characters</h2>', '<h2>2.3. Match One of Many Characters</h2>', ); my $re = qr{^(<h[1-6])(>[1-6. ]+)([^<]+)(</h[1-6]>)$}; for my $i (0 .. $#html) { $html[$i] =~ s{$re}{$1 . ' id="' . lc($3) =~ y/ /_/r . "\"$2$3$4"} +e; } say for @html;` [download] Output: `<h2 id="match_literal_text">2.1. Match Literal Text</h2> <h3 id="h3_heading">2.1.1 H3 Heading</h3> <h4 id="h4_heading">2.1.1.1 H4 Heading</h4> <h2 id="match_nonprintable_characters">2.2. Match Nonprintable Charact +ers</h2> <h2 id="match_one_of_many_characters">2.3. Match One of Many Character +s</h2>` [download] Note that requires Perl 5.14 or later for the '`/r`' modifier (see "perl5140delta: Non-destructive substitution"). You can do something similar with older versions but it requires a bit more work. And, just for completeness, say was introduced in Perl 5.10. Also note that modifying elements of an array while you're looping through that array can have unforeseen problems. See how I loop through the indices of the array instead. — Ken	[reply] [d/l] [select]
A reply falls below the community's threshold of quality. You may see it by logging in.
Re: Calling sub-routine in regex by BillKSmith (Monsignor) on Jul 19, 2020 at 17:47 UTC
The sample code below shows how to 'change' one field in a string. `use strict; use warnings; use Test::More tests=>1; my $string = 'feeFii foo'; my $regex = qr/(...)(Fii )(...)/; $string =~ s/$regex/$1 . changer("$2") . $3/e; ok($string eq 'feefiifoo', 'change field 2'); sub changer { my $str = $_[0]; $str =~ s/\s//g; return lc $str; }` [download] This suggest that you need: `#Untried $_ =~ s/$regex_2/$+{group_x} . $+{group_y} . changer("$+{text}")/e;` [download] Bill	[reply] [d/l] [select]
Re: Calling sub-routine in regex by tonydunn (Novice) on Jul 21, 2020 at 13:26 UTC
Thanks to all who offered thoughts and code to help with the issues I posted about. If I needed any confirmation of the TMTOWTDI maxim :) Plenty to keep me busy trying out ideas, and I have since discovered Mojolicious off the back of the Mojo::DOM module, so fun there too.	[reply]
Re^2: Calling sub-routine in regex by marto (Cardinal) on Jul 21, 2020 at 13:28 UTC
Glad to hear it, if you have any further problems/questions just post what you've tried and someone will reply.	[reply]
Re: Calling sub-routine in regex by BillKSmith (Monsignor) on Jul 26, 2020 at 18:32 UTC
I know that I am a week late, but I found a one-line change to your original code that think is worth sharing. Use the function substr rather than s/// to insert the id. Note that you already have $+{text} from your first match. use strict; use warnings; use Test::More tests=>3; my @required = ( qq(<h2 id="match_literal_text">) .qq(2.1. Match Literal Text</h2>\n), qq(<h2 id="match_nonprintable_characters">) .qq(2.2. Match Nonprintable Characters</h2>\n), qq(<h2 id="match_one_of_many_characters">) .qq(2.3. Match One of Many Characters</h2>\n), ); my @ol_file_array = ( "<h2>2.1. Match Literal Text</h2>\n", "<h2>2.2. Match Nonprintable Characters</h2>\n", "<h2>2.3. Match One of Many Characters</h2>\n", ); my $regex = qr/ (?<tag>(<\w\d)) (?<closing_bracket>>) (?<ol_numbers>(\d\.(\d+?)\.))\s (?<text>(.+)) (?<closing_tag>(\b<\/\w\d>)) /xms; foreach (@ol_file_array) { if ($_ =~ m/$regex/g) { substr($_, 3, 0) = changer( $+{text} ); ok( $_ eq shift(@required), $_ ); } else { ... # blah blah blah } } sub changer{ (my $id = $_[0]) =~ tr /A-Z /a-z_/; return qq/ id="$id"/; } [download] OUTPUT: `C:\Users\Bill\forums\monks> tony3.pl 1..3 ok 1 - <h2 id="match_literal_text">2.1. Match Literal Text</h2> # ok 2 - <h2 id="match_nonprintable_characters">2.2. Match Nonprintable +Characters</h2> # ok 3 - <h2 id="match_one_of_many_characters">2.3. Match One of Many Ch +aracters</h2> #` [download] Bill	[reply] [d/l] [select]

Back to Seekers of Perl Wisdom