цикл через глобальное замещение и выполнение кода в цикле

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";

Возможно ли сделать вышеизложенное в perl?Я хотел бы, чтобы атрибуты src элементов img были заменены новым путем и именем файла, а файлы изображений были загружены и сохранены с этим путем и именем файла.

Answer 1

Несмотря на то, что на этот вопрос был получен ответ, здесь также есть способ сделать это с помощью анализатора HTML.

Это изменяет атрибут src на новое значение в обработанном узле и заменяет этот узел вдерево с измененной копией для всех тегов img.

use warnings;
use strict;
use feature 'say';

use HTML::TreeBuilder;

my $content = join '', <DATA>;  # join just in case (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>

Для нового имени атрибута src я копирую то, что могу вывести из OP.Код в вопросе оставляет атрибут href ссылки неизменным (путь к тому же gif), поэтому этот код тоже оставляет это.

Существуют и другие инструменты для этого, см. этот постНапример, .

---

Возможно, приведенное выше может столкнуться с проблемами, связанными с слабыми ссылками в более старых версиях, см. Документацию.Тогда это должно быть безопаснее

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 2

Вы могли бы сделать следующее (но вам действительно следует подумать об использовании настоящего парсера HTML):

$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;

Модификатор e в операторе подстановки заставляет perl анализировать заменяющую часть как блок кода., а не строка.

---

Другие примечания:

• Всегда начинайте свои Perl-файлы с use strict; use warnings; или эквивалентного (например, use strict можно заменить на use v5.12.0 иливыше).
• Избегайте косвенного синтаксиса объекта (new WWW::Mechanize).Вместо этого используйте обычные вызовы методов (WWW::Mechanize->new).
• Используйте локальные переменные (например, my $num = 1;), если вам действительно не нужны переменные пакета.

Answer 3

Использование 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;