Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

Calling sub-routine in regex

by tonydunn (Novice)
on Jul 19, 2020 at 15:26 UTC ( #11119522=perlquestion: print w/replies, xml ) Need Help??

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>

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>

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

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

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;

    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>

    Please let me know if you have any questions.

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>

    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;

    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>

    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.

Re: Calling sub-routine in regex
by LanX (Cardinal) 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 ;-)

Re: Calling sub-routine in regex
by kcott (Bishop) 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;

    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>

    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

    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 (Prior) 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; }

    This suggest that you need:

    #Untried $_ =~ s/$regex_2/$+{group_x} . $+{group_y} . changer("$+{text}")/e;
    Bill
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.

      Glad to hear it, if you have any further problems/questions just post what you've tried and someone will reply.

Re: Calling sub-routine in regex
by BillKSmith (Prior) 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"/; }

    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> #
    Bill

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://11119522]
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 perusing the Monastery: (1)
As of 2020-10-25 08:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My favourite web site is:












    Results (249 votes). Check out past polls.

    Notices?