あらかじめ用意しておいたドメインリストに乗った 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,