Perl で、HTML 文書中にあるリンクを置換する

以下は、HTML 文書中にあるリンクを任意の文字列に置換するスクリプトであるが、他のタグでもいろいろと応用が利くと思われる。


#!/usr/bin/perl

use LWP::UserAgent;
use HTTP::Status;
use HTTP::Response;

our $URL = 'https://perltips.twinkle.cc/'; # アクセスする URL

my $proxy = new LWP::UserAgent;
$proxy->agent('your own created browser name here');
$proxy->timeout(60);

my $response = $proxy->request(HTTP::Request->new('GET' => $URL));
my $content = $response->content;

my %tags = (

'img'  => 'src',
'a'    => 'href',
'link' => 'href',
'td'   => 'background',
'form' => 'action'
);

my $data = $content;

skip_others: while($data =~ s/<([^>]*)>// && $i++ < 10000) { # 無限ループに陥るのを防ぐ

<pre>my $in_brackets = $1;

foreach $key (keys %tags) {

    if($in_brackets =~ /^\s*$key\s+/i) {

        if($in_brackets =~ /\s+$tags{$key}\s*=\s*["']([^"']*)["']/i
        || $in_brackets =~ /\s+$tags{$key}\s*=\s*([^\s]+)/i        ) {

            my $link =  $1;

            $link =~ s/[\n\r]//g;
            $link =~ s/\./\\./g;
            $link =~ s/\?/\\?/g;

            $content    =~
                s/\s*=\s*["']*$link["']*/=<<<ここに置換文字列を書く>>>/
                if $link !~ m/mailto:/i
                && $link !~ m/javascript/i;

            next skip_others;
        }
    }
}
}

1;