あらかじめ用意しておいたドメインリストに乗った URL かどうか判定する修行
ブラックリストを用意しておいて、指定した URL がそのブラックリストにマッチするかどうか調べるスクリプト。%excluding_domain がブラックリスト。まあホワイトリストとして使うこともできるわけだが。
use strict; use warnings; use Test::More qw(no_plan); use utf8; use Encode; my %excluding_domain = map {$_=>1} ( 'black.domain', ); sub is_excluding_url { my $url = shift; my $host; { my $i = index($url, '://'); return 0 if $i < 0; my $rest = substr($url, $i + 3); $i = index($rest, '/'); $host = $i > -1 ? substr($rest, 0, $i) : $rest; } my @domain = split(q{\.}, $host); my $i = scalar @domain; $i--; my $domain = $domain[$i]; $i--; while ($i >= 0) { $domain = $domain[$i].q{.}.$domain; return 1 if $excluding_domain{$domain}; } continue { $i--; } return 0; } while (my $line = <DATA>) { chomp $line; my ($url, $expected, $note) = split(q{,}, $line); my $actual = is_excluding_url($url); is($actual, $expected, encode_utf8("$url -> $expected")); } __DATA__ http://www.black.domain/index.html,1, http://www.white.black.domain/clean/clean.php?q=11,1, http://www.black.white.domain/clean/clean.php?q=11,0,