loop through global substitution and execute code in loop - regex

Question

use WWW::Mechanize;
mkdir "images";
$url = "https://www.somedomain.com/";
$mech = new WWW::Mechanize;
$mech->get($url);
$num = 1;
$year = 2019;
$number = 23;
$content = q{<P><div class="row" style="text-align:center"><a target="_blank" href="/image/SG0092a.gif"><img src="/image/SG0092a.gif" alt="graphic image" class="img-responsive graphic"/></a></div><div class="row" style="text-align:center"><a target="_blank" href="/image/SG0092b.gif"><img src="/image/SG0092b.gif" alt="graphic image" class="img-responsive graphic"/></a></div><div class="row" style="text-align:center"><a target="_blank" href="/image/SG0092c.gif"><img src="/image/SG0092c.gif" alt="graphic image" class="img-responsive graphic"/></a></div><div class="row" style="text-align:center"><a target="_blank" href="/image/SG0092d.gif"><img src="/image/SG0092d.gif" alt="graphic image" class="img-responsive graphic"/></a></div><div class="row" style="text-align:center"><a target="_blank" href="/image/SG0092e.gif"><img src="/image/SG0092e.gif" alt="graphic image" class="img-responsive graphic"/></a></div>};
while ($content =~ s/(<img.+?src=)"([^>]+?)\.([A-Za-z]+)"/$1"images\/${year}_${number}_$num.$3"/g)
{
$imageuri = "$2.$3";
print $imageuri, "\n";
$mech->get($imageuri);
$mech->save_content("images/${year}_${number}_$num.$3");
$num++;
}
print $content, "\n";
Is it possible to do the above in perl? I would like the src attributes of the img elements replaced with a new path and filename and for the image files to be downloaded and saved with that path and filename.

Answer 1

You could do the following (but you should really consider using a real HTML parser):
$content =~ s{(<img.+?src=)"([^>]+?)\.([A-Za-z]+)"}{
my $imageuri = "$2.$3";
print $imageuri, "\n";
$mech->get($imageuri);
my $file = "images/${year}_${number}_$num.$3";
$num++;
$mech->save_content($file);
qq($1"$file")
}eg;
The e modifier on the substitution operator makes perl parse the replacement part as a block of code, not a string.
Other notes:
Always start your Perl files with use strict; use warnings; or equivalent (e.g. use strict can be replaced by use v5.12.0 or higher).
Avoid indirect object syntax (new WWW::Mechanize). Use normal method calls instead (WWW::Mechanize->new).
Use local variables (e.g. my $num = 1;) unless you really need package variables.

Answer 2

Here is one way to do it with an HTML parser, HTML::TreeBuilder.
This changes the src attribute to the new value in the processed node and replaces that node in the tree with the changed copy, for all img tags.
use warnings;
use strict;
use feature 'say';
use HTML::TreeBuilder;
my $content = join '', <DATA>; # join in general (not needed with one line)
my ($num, $year, $number) = (1, 2019, 23);
my $new_src_base = "images/${year}_${number}_$num";
my $tree = HTML::TreeBuilder->new_from_content($content);
my #nodes = $tree->look_down(_tag => 'img');
for my $node (#nodes) {
my ($ext) = $node->attr('src') =~ m{.*/.*\.(.*)\z}; #/
my $orig_src = $node->attr('src', $new_src_base . ".$ext"); # change 'src'
$node->replace_with($node);
# my $imageurl = $orig_src; # fetch the image etc...
# $mech->get($imageurl);
}
say $tree->as_HTML; # to inspect; otherwise print to file
__DATA__
<P><div class="row" style="text-align:center"><a target="_blank" href="/image/SG0092a.gif"> <img src="/image/SG0092a.gif" alt="graphic image" class="img-responsive graphic"/></a></div> <div class="row" style="text-align:center"><a target="_blank" href="/image/SG0092b.gif"> <img src="/image/SG0092b.gif" alt="graphic image" class="img-responsive graphic"/></a></div> <div class="row" style="text-align:center"><a target="_blank" href="/image/SG0092c.gif"> <img src="/image/SG0092c.gif" alt="graphic image" class="img-responsive graphic"/></a></div> <div class="row" style="text-align:center"><a target="_blank" href="/image/SG0092d.gif"> <img src="/image/SG0092d.gif" alt="graphic image" class="img-responsive graphic"/></a></div> <div class="row" style="text-align:center"><a target="_blank" href="/image/SG0092e.gif"> <img src="/image/SG0092e.gif" alt="graphic image" class="img-responsive graphic"/></a></div>
For the new name of src attribute I copy what I can infer from the OP. The code in the question leaves href attribute of the link unchanged (path to the same gif) so this code leaves that, too.
There are other tools to do this with, see this post for more, for example.
The above could perhaps run into problems related to weak references in older versions, see documentation. Then this should be safer
for my $node (#nodes) {
my ($ext) = ( $node->attr('src') ) =~ m{.*/.*\.(.*)\z}; #/
my $copy = $node->clone;
my $orig_src = $copy->attr('src', $new_src_base . ".$ext");
$node->replace_with($copy)->delete;
...
}

Answer 3

Using Mojo::DOM:
use strict;
use warnings;
use Mojo::DOM;
use Mojo::UserAgent;
my $ua = Mojo::UserAgent->new;
my $dom = Mojo::DOM->new($content);
my $num = 1;
foreach my $img ($dom->find('img[src]')->each) {
next unless $img->{src} =~ m/\.([a-zA-Z]+)\z/;
my $ext = $1;
my $path = "images/${year}_${number}_$num.$ext";
$ua->get($img->{src})->result->save_to($path);
$img->attr(src => $path);
$num++;
}
print $dom->to_string;