使用言語：Perl
用途：アクセス制限などアクセスを許すか不可の判定など

Perlの構文中に以下の記述で使えます。
禁止したいホスト(ユーザーホスト名でも可能)・ドメイン・IPなどを
$hosts="yahoo1244.bbtec.net,2143rg-dg.moritomo.com,daj.ne.jp,mori.com,sound.jp,zero.ad.jp";

$hosts="" の中に記述して
($a_1,$a_2,$a_3,@a_4)=&HostOut($hosts);
とサブルーチンを呼ぶと
該当した禁止ドメイン：$a_1
該当件数：$a_2
アクセスしてきたユーザー：$a_3
禁止ドメイン一覧：@a_4

上の$hostsで指定した場合、アクセスユーザーが仮にtokyo-124321f.zero.ad.jpだった場合
次のようになります。

該当した禁止ドメイン：zero.ad.jp
該当件数：1
アクセスしてきたユーザー：tokyo-124321f.zero.ad.jp
禁止ドメイン一覧：bbtec.net moritomo.com daj.ne.jp mori.com sound.jp zero.ad.jp
バグ・使い方がわからない・改善点などメールください
使い方によっていろいろできると思います。

sub HostOut(){
  my($agent_1)=$ENV{'REMOTE_HOST'};
  my($agent_2)=$ENV{'REMOTE_ADDR'};
  my($host_add)=$agent_2 unless $agent_1;
  my($ipad)=pack('C4',split(/\./,$agent_2));
  $host_add=gethostbyaddr($ipad,2) || $agent_2;
#アクセスを禁止するなどのドメイン・ホスト名・ユーザー名・IPアドレス
#などを$hostsに入れる
  my(@domain)=split /,/, $hosts;
  my(@domain_key)=('edu','gov','mil','int','arpa','nato','jp','name','net','org','biz','nu','st','com','info','to','ac','pro','coop','aero','museum');
  my(@domain_tiiki_rabel)=('pref','metro','city','town','vill');
  my(@domain_kikan)=('ac','co','go','or','ad','ne','gr','ed');
  foreach $host_line(@domain){
  my(@host_one)=split(/[^-\w]/,$host_line);
  local $count=@host_one;
  if($count==2){$host_out="$host_one[0].$host_one[1]";}
  if($count>=3){
  my($key)=grep(/$host_one[$count-1]/g,@domain_key);
  my($tiiki_key)=grep(/$host_one[$count-3]/g,@domein_tiiki_rabel);
  my($kikan_key)=grep(/$host_one[$count-2]/g,@domain_kikan);
  if($key > 0 && $host_one[$count-1] ne 'jp'){$host_out="$host_one[$count-2].$host_one[$count-1]";}
  elsif($tiiki_key > 0 && $kikan_key == 0){$host_out="$host_one[$count-4].$host_one[$count-3].$host_one[$count-2].$host_one[$count-1]";}
  else{$host_out="$host_one[$count-3].$host_one[$count-2].$host_one[$count-1]";}
}
#ドメインに変換したものを配列に入れる
  push(@new_domain,$host_out);
   }
#アクセスユーザー
  my($new_hostx)="$host_add";
#アクセスユーザーをドメインに変換
  my(@new_host)=split(/[^-\w]/,$new_hostx);
  local $new_host_count=@new_host;
  if($new_host_count==2){$new_host_x="$new_host[0].$new_host[1]";}
  if($new_host_count>=3){
  my($key)=grep(/$new_host[$new_host_count-1]/g,@domain_key);
  my($tiiki_key)=grep(/$new_host[$new_host_count-3]/g,@domein_tiiki_rabel);
  my($kikan_key)=grep(/$new_host[$new_host_count-2]/g,@domain_kikan);
  if($key > 0 && $new_host[$new_host_count-1] ne 'jp'){$new_host_x="$new_host[$new_host_count-2].$new_host[$new_host_count-1]";}
elsif($tiiki_key > 0 && $kikan_key == 0){$new_host_x="$new_host[$new_host_count-4].$new_host[$new_host_count-3].$new_host[$new_host_count-2].$new_host[$new_host_count-1]";}
  else{$new_host_x="$new_host[$new_host_count-3].$new_host[$new_host_count-2].$new_host[$new_host_count-1]";}
}
  if($host_out ne ""){
#アクセスホストと禁止ホストが該当したらアクセスホストを配列に入れる
  @error=grep(/$new_host_x/g,@new_domain);
#該当件数を表示
  $error_count=@error;
  if($error_count==0){
  @error="該当なし";
   }
  return @error,$error_count,$new_hostx,@new_domain;
  }
  }