package fqdn2domain;
####################
# COPYRIGHT NOTICE (c)1999-2006 Yuuichirou Oka
#  fqdn2domain.pl
# Yuuichirou Oka (oka@a-f.jp)
# Created on August 2nd 1999
; $Last_Modified = "November 6th 2004";
; $Version = "Version 1.00.1g";
; $Pattern_Date = "March 25th 2006";
#
# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 2 of the License, or (at your
# option) any later version.
# For more detail, see http://www.gnu.org/licenses/licenses.html
#
# Latest version of this script is distributed at:
#   http://a-f.jp/oka/domains/fqdn2domain/.
#
####################
# Japanese in this document is written with Shift_JIS Character set.
# Timestamp in this document is JST(+0900).
####################
#
# Extract domain without sub domains from hostname.
#
# usage:
#  require 'fqdn2domain.pl';
#  $domain_of_host = &fqdn2domain::extract($fqdn_of_host);
#
#  NOTE:If return value has postfix "*", that value may be wrong.
#  Please report me with original host names and $Pattern_Date.
#  Thank you for your cooperation.
#
####################

sub extract {
    my $remote_host = shift;
    $remote_host =~ tr/A-Z/a-z/;

    return '' unless $remote_host =~ /[a-z]/; # Eliminate IPv4 addr
    return '' unless $remote_host =~ /\./; # Not FQDN
    return '' if $remote_host =~ /[^a-z0-9-\.]/; # Allow only [a-z0-9-\.]+
    return '' if $remote_host =~ /\.\./; # Label has at least 1 char.
    return '' if $remote_host =~ /\.[0-9-]+$/; # TLD is required at least 1 alphabet.

    my @domain = reverse( split(/\./,$remote_host));
    foreach (@domain) {
      return '' if length > 63;
    }
# for Debug
#    undef($remote_host);

    if ($domain[0] eq "localhost") {
      $remote_host = "localhost";

#=================================================
    } elsif ($domain[0] =~ /^(biz|cat|com|coop|edu|gov|jobs|info|int|mil|mobi|name|net|org)$/) {
#gTDL(InterNIC domain)
      $remote_host = "$domain[1].$domain[0]";

    } elsif ($domain[0] eq "pro") {
      if ($domain[1] =~ /^(cpa|eng|law|med)$/){
        return "$domain[2].$domain[1].$domain[0]";
      }
      return "$domain[1].$domain[0]";

    } elsif ($domain[0] eq "museum") {
      if ($domain[1] =~ /(index|musenic|nic|whois|www)/){
        return "$domain[1].$domain[0]";
      }
      return "$domain[2].$domain[1].$domain[0]";
    } elsif ($domain[0] eq "aero") {
#.aero, SITA / www.nic.aero
#http://www.information.aero/policy/aerodmp.htm / 4:17 2002/11/19
      if ($domain[1] =~ /^(accident-(investigation|prevention)|aero(batic|club|drome)|
        agents|air-(surveillance|traffic-control)|air(craft|line|port|traffic)|
        ambulance|amusement|association|author|ballooning|broker|caa|cargo|catering|
        certification|championship|charter|civilaviation|club|conference|consultant|
        consulting|control|council |crew|design|dgca|educator|emergency|engine|
        engineer|entertainment|equipment|exchange|express|federation|flight|freight|
        fuel |gliding|government|groundhandling|group|hanggliding|homebuilt|
        insurance|journal(ist)?| leasing| logistics|magazine|maintenance|marketplace|
        media|microlight|modelling|navigation|para(chuting|gliding)|
        passenger-association|pilot|press|production|recreation|repbody|res|research|
        rotorcraft|safety|scientist|services|show|skydiving|software|student|
        taxi|trader|trading|trainer|union|workinggroup|works)$/x) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }
    } elsif ($domain[0] eq "arpa") {
      return '';
#=================================================
#Japan, www.nic.ad.jp / jprs.jp
    } elsif ($domain[0] eq "jp") {
      if ($domain[1] =~ /^(ac|ad|co|ed|go|gr|lg|ne|or)$/) {
      # Property-oriented domain
        $remote_host = "$domain[2].$domain[1].$domain[0]";

      } elsif ($domain[1] =~ /^(kawasaki|kitakyushu|kobe|sapporo|sendai|yokohama|
          nagoya)$/x) {
      # Cabinet-order-Designated City, Part1
      # Sapporo, Sendai, Kawasaki, Yokohama, Nagoya, Kobe, Kitakyushu
        if ($domain[2] eq 'city') {
          $remote_host = "$domain[2].$domain[1].$domain[0]";
        } else {
      # Geometrical Domain in Cabinet-order-Designated City
          $remote_host = "$domain[3].$domain[2].$domain[1].$domain[0]";
        }

      } elsif ($domain[1] =~ /^(chiba|fukuoka|hiroshima|kyoto|osaka|saitama|shizuoka)$/) {
      # Cabinet-order-Designated City, Part2
      # Saitama, Chiba, Kyoto, Osaka, Hiroshima, Fukuoka
      # Note: Saitama will be Cabinet-order-Designated City from Apr. 1st 2003
        if ($domain[2] =~ /^(city|pref)$/) {
          $remote_host = "$domain[2].$domain[1].$domain[0]";
        } else {
        # Geometrical Domain in Cabinet-order-Designated City
          $remote_host = "$domain[3].$domain[2].$domain[1].$domain[0]";
        }

      } elsif ($domain[1] eq "tokyo") {
        if ($domain[2] eq "metro") {
          $remote_host = "$domain[2].$domain[1].$domain[0]";
        } else {
        # Local Gov. and Geometrical Domain
          $remote_host = "$domain[3].$domain[2].$domain[1].$domain[0]";
        }

      } elsif ($domain[1] =~ /^(aomori|akita|aichi|ehime|fukushima|fukui|gifu|gunma|
        hokkaido|hyogo|ibaraki|iwate|ishikawa|kagawa|kagoshima|kanagawa|kochi|
        kumamoto|mie|miyagi|miyazaki|nagano|nagasaki|nara|niigata|oita|okayama|
        okinawa|saga|shiga|shimane|tochigi|tokushima|tottori|toyama|
        wakayama|yamaguchi|yamagata|yamanashi)$/x) {
        if ($domain[2] eq "pref") {
          # Prefecture   ex) pref   . fukuoka  .  jp
          $remote_host = "$domain[2].$domain[1].$domain[0]";
        } else {
          # Regional Domains, include Local Goverment and Private Regional domain
          # Local Pub. ex)   city   .  ogori   . fukuoka  .  jp
          # Priv. Reg. ex) redangel .   nara   .   nara   .  jp
          $remote_host = "$domain[3].$domain[2].$domain[1].$domain[0]";
        }
      } else {
      # General Domain
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#Output 2LD.
#Belgium, www.dns.be 20:21 2002/11/22
#Cocos (Keeling) Islands, www.nic.cc / 19:51 2002/12/03
#Switzerland, www.nic.ch
#Chile, www.nic.cl
#Czech Rep., www.nic.cz
#Germany(Deutche), www.nic.de
#Denmark, www.dk-hostmaster.dk / 18:53 2003/01/05
#Spain(Espana), www.nic.es
#Finland, www.thk.fi/englanti/internet/
#Ireland, www.domainregistry.ie / 23:08 2003/06/22
#Iceland, www.isnic.is
#Italy, www.nic.it
#Liechtenstein, www.nic.li
#Lithuania, www.domreg.lt
#Netherlands, www.domain-registry.nl 17:48 2003/02/04
#Niue, www.nic.nu 17:36 2003/03/02
#Russia (.ru), www.ripn.net/nic/NICHomePage.html
#Slovenia, ftp://ftp.arnes.si/network/templates/domain-english.pdf, 17:55 2003/01/17
#Slovakia, https://www.sk-nic.sk/, 15:47 2003/11/16
#Sao Tome and Principe, www.nic.st
#Tonga, www.tonic.to, 15:09 2003/04/29
#Tuvalu, www.tv, 21:50 2002/11/05
    } elsif ($domain[0] =~ /^(be|c[chlz]|d[ek]|es|fi|i[est]|l[it]|n[lu]|ru|s[ikt]|t[ov])$/) {
      $remote_host = "$domain[1].$domain[0]";

#=================================================
#Andorra, www.nic.ad / 20:33 2006/03/25
    } elsif ($domain[0] eq "ad") {
      if($domain[1] =~ /^(nom)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#United Arab Emirates, www.uaenic.ae / Apr/03/2005
    } elsif ($domain[0] eq "ae") {
      if($domain[1] =~ /^(ac|co|gov|mil|name|net|org|pro|sch)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }

#=================================================
#Argentine, www.nic.ar / 21:40 2003/06/07
    } elsif ($domain[0] eq "ar") {
      if($domain[1] =~ /^(com|gov|int|mil|net|org)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]**";
      }

#=================================================
#Austria, www.nic.at / 18:23 2003/01/19
    } elsif ($domain[0] eq "at") {
      if($domain[1] =~ /^(ac|co|gv|or)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }

#=================================================
#Australia, www.auda.org.au / 19:43 2003/01/24
# Geometrical domains will be implement, later...
    } elsif ($domain[0] eq "au") {
      if($domain[1] =~ /^(act|asn|com|csiro|edu|gov|id|net|nsw|nt|org|qld|sa|tas|vic|wa)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else { # Not Installed
        $remote_host = "$domain[1].$domain[0]**";
      }
#=================================================
#Burundi, www.nic.bi 19:03 2003/01/21
    } elsif ($domain[0] eq "bi") {
      if($domain[1] =~ /^(co|gov|org)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }

#=================================================
#Brazil, registro.br / 22:45 2002/11/05
    } elsif ($domain[0] eq "br") {
      if($domain[1] =~ /^(adm|adv|agr|am|arq|art|ato|bio|bmd|cim|cng|cnt|com|coop|
        ecn|edu|eng|esp|etc|eti|far|fm|fnd|fot|fst|g12|ggf|gov|imb|ind|inf|jor|lel|
        mat|med|mil|mus|net|not|ntr|odo|org|ppg|pro|psc|psi|qsl|rec|slg|srv|tmp|trd|
        tur|tv|vet|zlg)$/x) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } elsif ($domain[1] =~ /^(nom)$/) {
        $remote_host = "$domain[3].$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#Canada, www.cira.ca / 17:13 2002/09/06
    } elsif ($domain[0] eq "ca") {
      if($domain[1] =~ /^(ab|bc|mb|nb|nl|ns|nt|nu|on|pe|qc|sk|yk)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } elsif ($domain[3] =~ /^(city|ville|town|village|hamlet|hameau)$/) {
        $remote_host = "$domain[3].$domain[2].$domain[1].$domain[0]";
#What is MUN1 (other municipal/district area - major agglomeration), 
#and MUN2 (other municipal/district area - miscellaneous) ?
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#China, People's Republic of, www.cnnic.net.cn / 19:31 2002/12/20
# http://www.cnnic.net.cn/doc/e-3.shtml
    } elsif ($domain[0] eq "cn") {
# Property Oriented Domains
      if($domain[1] =~ /^(ac|adm|com|edu|gov|net|org)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
# Locality Domains
      } elsif($domain[1] =~ /^(ah|bj|cq|fj|gd|gs|gx|gz|ha|hb|he|hi|hk|hl|hn|jl|js|jx|
                               ln|mo|nm|nx|qh|sc|sd|sh|sn|sx|tj|tw|xj|xz|yn|zj)$/x) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#Colombia, www.nic.co / 16:33 2004/09/05
    } elsif ($domain[0] eq "co") {
      if($domain[1] =~ /^(com|edu|gov|mil|net|nom|org)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } elsif ($domain[1] eq 'nic') {
        $remote_host = "$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]**";
      }
#=================================================
#Cyprus, www.nic.cy / 19:22 2003/09/21
    } elsif ($domain[0] eq "cy") {
      if($domain[1] =~ /^(ac|biz|com|ekloges|gov|ltd|name|net|org|parliament|pro|press|tm)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } elsif ($domain[1] eq 'nic') {
        $remote_host = "$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]**";
      }
#=================================================
#Estonia, http://www.eenet.ee/services/subdomains.html / 21:09 2003/02/05
    } elsif ($domain[0] eq "ee") {
      if($domain[1] =~ /^(com|edu|org|pri)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }

#=================================================
#Egypt, http://www.euc.eg / 20:20 2003/06/07
    } elsif ($domain[0] eq "eg") {
      if($domain[1] =~ /^(com|edu|gov|net|org|sci)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } elsif($domain[1] eq 'eun') {
        if ($domain[2] eq 'www') {
          $remote_host = "$domain[1].$domain[0]";
        } else {
          $remote_host = "$domain[2].$domain[1].$domain[0]";
        }
      } else {
        $remote_host = "$domain[1].$domain[0]**";
      }

#=================================================
#France, www.nic.fr
#http://www.nic.fr/english/register/charter-fr.html 20:08 2002/09/24
#My diary on Sep/24/2002
    } elsif ($domain[0] eq "fr") {
      if($domain[1] =~ /^(aeroport|assedic|asso|avocat|avoues|barreau|caf|
        caisse-epargne|canam|cci|ch-dentiste|chambagri|chirurgiens-dentistes|com|
        crpf|educagri|experts-comptables|fnclcc|geometre-expert|gouv|greta|
        huissier-justice|iufm|medecin|nom|notaires|pharmacien|port|prd|presse|tm|
        unaf|veterinaire|reunion)$/x) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#Ghana, www.ghana.com.gh 19:20 2003/02/04
    } elsif ($domain[0] eq "gh") {
      if($domain[1] =~ /^(com|edu|gov|mil|org)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]**";
      }
#=================================================
#Greece, www.gr 19:20 2003/02/04
    } elsif ($domain[0] eq "gr") {
      if($domain[1] =~ /^(com|edu|gov|net|org)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#Hong Kong, www.hknic.net.hk 18:56 2002/10/25
    } elsif ($domain[0] eq "hk") {
      if($domain[1] =~ /^(com|edu|gov|net|org)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#Croatia, www.dns.hr 14:53 2003/03/30
    } elsif ($domain[0] eq "hr") {
      if($domain[1] =~ /^(com|from|iz|name)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#Hungary, www.nic.hu 18:32 2003/03/02
    } elsif ($domain[0] eq "hu") {
      if($domain[1] =~ /^(2000|agrar|bolt|casino|city|co|eroti[ck]a|film|
         forum|games|gov|hotel|info|ingatlan|jogasz|konyvelo|lakes|media|
         news|org|priv|reklam|sex|shop|sport|suli|szex|tm|tozsde|utazas|
         video)$/x) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#Indonesia, www.idnic.net.id 18:00 2003/02/04
    } elsif ($domain[0] eq "id") {
      if($domain[1] =~ /^(ac|co|go|mil|or|sch|web)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } elsif($domain[1] eq 'net') {
        if ($domain[2] eq 'web') {
          $remote_host = "$domain[3].$domain[2].$domain[1].$domain[0]";
        } else {
          $remote_host = "$domain[2].$domain[1].$domain[0]";
        }
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }

#=================================================
#Israel, http://www.isoc.org.il, 15:49 2003/11/16
    } elsif ($domain[0] eq "il") {
      if($domain[1] =~ /^(ac|co|gov|idf|k12|muni|net|org)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]**";
      }

#=================================================
#India, http://domain.ncst.ernet.in, 21:18 2003/06/07
    } elsif ($domain[0] eq "in") {
      if($domain[1] =~ /^(ac|co|firm|gen|gov|ind|mil|net|org|res)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }

#=================================================
#Iran, http://www.nic.ir, 04:20 2004/01/01
    } elsif ($domain[0] eq "ir") {
      if($domain[1] =~ /^(ac|co|gov|id|net|org|sch)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }

#=================================================
#Jordan, http://www.nis.gov.jo/dns/, 15:52 2003/11/16
    } elsif ($domain[0] eq "jo") {
      if($domain[1] =~ /^(com|edu|gov|mil|net|org)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }

#=================================================
#Kenya, www.psg.com/dns/ke/ => www.kenic.or.ke
    } elsif ($domain[0] eq "ke") {
      if($domain[1] =~ /^(ac|co|go|ne|or)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]**";
      }

#=================================================
#Kingdom of Cambodia, www.camnet.com.kh
    } elsif ($domain[0] eq "kh") {
      if($domain[1] =~ /^(com|edu|gov|mil|net|org|per)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]**";
      }

#=================================================
#Korea, Republic of, www.nic.or.kr
    } elsif ($domain[0] eq "kr") {

      if($domain[1] =~ /^(ac|co|es|go|hs|kg|ms|ne|or|pe|re|sc)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } elsif($domain[1] =~ /^(busan|pusan|chungbuk|chungnam|daegu|taegu|
        daejeon|taejon|gangwon|kangwon|gyeongbuk|kyongbuk|gyeongnam|kyongnam|
        gyeonggi|kyonggi|gwangju|kwangju|incheon|jeju|chejujeonbuk|chonbuk|
        jeonnam|chonnam|seoul|ulsan|)$/x) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]**";
      }

#=================================================
#Kazakhstan, www.nic.kz, 20:29 2006/03/25
    } elsif ($domain[0] eq "kz") {
      if($domain[1] =~ /^(com|edu|gov|mil|net|org)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }

#=================================================
#Latvia, www.nic.lv, 21:40 2003/12/23
    } elsif ($domain[0] eq "lv") {
      if($domain[1] =~ /^(asn|com|conf|edu|gov|id|mil|net|org)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }

#=================================================
#Mauririus, www.nic.mu, 21:52 2003/12/07
    } elsif ($domain[0] eq "mu") {
      if($domain[1] =~ /^(ac|com?|net|org)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#Malawi, www.registrar.mw 18:42 2003/01/21
    } elsif ($domain[0] eq "mw") {
      if($domain[1] =~ /^(ac|com?|coop|edu|gov|int|museum|net|org)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#Mexico, www.nic.mx
    } elsif ($domain[0] eq "mx") {
      if($domain[1] =~ /^(com|edu|gob|net|org)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#Malaysia, www.mynic.net
    } elsif ($domain[0] eq "my") {
      if($domain[1] =~ /^[a-z][a-z][a-z]$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#Namibia, www.na-nic.com.na 18:49 2003/06/01
    } elsif ($domain[0] eq "na") {
      if($domain[1] =~ /^(alt|com|cul|edu|gov|org|telecom|un|unam)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }

#=================================================
#Nicaragua, www.nic.ni, 01:12 2004/01/26
    } elsif ($domain[0] eq "ni") {
      if($domain[1] =~ /^(biz|com?|edu|gob|in(fo)?|mil|net|nic|nom|org)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }

#=================================================
#Norway, www.norid.no
#http://www.norid.no/navnepolitikk.en.html 20:09 2002/09/18
    } elsif ($domain[0] eq "no") {
    # 2nd-level Administered by Norid 
      if($domain[1] =~ /^(fhs|vgs|fylkesbibl|folkebibl|museum|idrett)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
    # 2nd-level Administered by Organization except Norid
      } elsif($domain[1] =~ /^(mil|stat|kommune|priv)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
    # 3rd-level Administered by Norid 
      } elsif($domain[2] =~ /^gs$/) {
        $remote_host = "$domain[3].$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }

#=================================================
#Nepal, www.mos.com.np, 20:30 2006/03/25
    } elsif ($domain[0] eq "np") {
      if($domain[1] =~ /^(com|edu|gov|mil|net|org)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]**";
      }

#=================================================
#New Zealand, www.domainz.net.nz
#http://www.domainz.net.nz/Domainz.asp?Content=Get_NHInfo_Name 19:05 2002/10/01
    } elsif ($domain[0] eq "nz") {
      if($domain[1] =~ /^(ac|co|cri|gen|govt|iwi|mil|net|org|school)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]**";
      }
#=================================================
#Peru, www.nic.pe 19:24 2004/10/03
    } elsif ($domain[0] eq "pe") {
      if ($domain[1] =~ /^(com|edu|gob|mil|net|nom|org|sld)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } elsif ($domain[1] =~ /^(nic)$/) {
        $remote_host = "$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]**";
      }
#=================================================
#Philippines, www.domreg.org.ph 18:55 2002/10/15
    } elsif ($domain[0] eq "ph") {
      if($domain[1] =~ /^(com|edu|gov|mil|ngo|net|org)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#Pakistan, www.pknic.net.pk 1:20 2005/03/14
    } elsif ($domain[0] eq "pk") {
      if($domain[1] =~ /^(biz|com|edu|fam|go[bknpsv]|net|org|web)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]**";
      }
#=================================================
#Poland, www.dns.pl 19:01 2003/02/21
    } elsif ($domain[0] eq "pl") {
      if($domain[1] =~ /^(aid|agro|atm|auto|biz|com|edu|gmina|gsm|info|mail|miasta|
        media|mil|net|nieruchomosci|nom|org|pc|powiat|priv|realestate|rel|sex|shop|
        sklep|sos|szkola|targi|tm|tourism|travel|turystyka)$/x) {
        # Functional Domains
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } elsif ($domain[1] =~ /^(augustow|babia-gora|bedzin|beskidy|bialowieza|
        bialystok|bielawa|bieszczady|boleslawiec|bydgoszcz|bytom|chelm|cieszyn|
        czeladz|czest|deblin|dlugoleka|dzierzoniow|elblag|elk|glogow|gniezno|gorlice|
        grajewo|ilawa|jaworzno|jelenia-gora|jgora|kalisz|kazimierz-dolny|karpacz|
        kartuzy|kaszuby|katowice|kepno|ketrzyn|klodzko|kobierzyce|kolobrzeg|konin|
        konskowola|koronowo|kutno|lapy|lebork|legionowo|legnica|lezajsk|limanowa|
        lomza|lowicz|lubin|lukow|malbork|malopolska|mazowsze|mazury|mielec|mielno|
        mragowo|naklo|nidzica|nowaruda|nysa|olawa|olecko|olkusz|olsztyn|opoczno|
        opole|ostroda|ostroleka|ostrowiec|ostrowwlkp|pila|pisz|podhale|podlasie|
        polkowice|pomorze|pomorskie|prochowice|pruszkow|przeworsk|pulawy|radom|
        rawa-maz|rybnik|rzeszow|sanok|sejny|siedlce|slask|slupsk|sosnowiec|
        stalowa-wola|skoczow|starachowice|stargard|suwalki|swidnica|swiebodzin|
        swinoujscie|szczecin|szczytno|tarnobrzeg|tgory|turek|tychy|ustka|walbrzych|
        warmia|warszawa|waw|wegrow|wielun|wlocl|wloclawek|wodzislaw|wolomin|wroclaw|
        wlodawa|zachpomor|zagan|zarow|zgora|zgorzelec)$/x){
        # Regional Domains
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#Portugal, www.fccn.pt
#http://www.fccn.pt/DNS/?in_menu_option=80000
    } elsif ($domain[0] eq "pt") {
      if($domain[1] =~ /^(com|edu|gov|int|net|nome|org|publ)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#Reunion Island, www.nic.re redirect to AFNIC www.nic.fr
#http://www.nic.fr/english/register/charter-re.html 20:08 2002/09/24
#My diary on Sep/24/2002
    } elsif ($domain[0] eq "re") {
      if($domain[1] =~ /^(asso|com|nom|crt-reunion|crreunion|cr-reunion)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }

#=================================================
#Romania, http://www.rnc.ro/new/welcome.shtml 20:13 2003/03/14
    } elsif ($domain[0] eq "ro") {
      if($domain[1] =~ /^(arts|com|firm|info|nom|nt|org|rec|store|tm|www)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }

#=================================================
#Saudi Alabia, www.saudinic.net.sa
#http://www.saudinic.net.sa/terms/policies.htm 20:08 2002/11/05
    } elsif ($domain[0] eq "sa") {
      if($domain[1] =~ /^(com|edu|gov|med|net|pub|org|sch)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else { #between 2 to 63 bytes
        $remote_host = "$domain[1].$domain[0]**";
      }

#=================================================
#Sweden, www.nic-se.se, 21:28 2003/11/16
    } elsif ($domain[0] eq "se") {
      if($domain[1] =~ /^(brand|fh(sk|v)?|kom(forb|munalforbund|vux)|lan(arb|bib)|
        naturbruksgymn|sshn|parti|press|pp|org|tm)$/x) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else { #between 2 to 63 bytes
        $remote_host = "$domain[1].$domain[0]";
      }

#=================================================
#Syria, www.ste.net.sy 21:38 2003/07/12
    } elsif ($domain[0] eq "sy") {
      if($domain[1] =~ /^(com|gov|net|org)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]**";
      }

#=================================================
#Singapore, www.nic.net.sg
#http://www.nic.net.sg/f_sgdom.html 19:22 2002/10/15
    } elsif ($domain[0] eq "sg") {
      if($domain[1] =~ /^(com|edu|gov|net|org|per)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#Thailand, www.thnic.net 16:41 2003/02/12
    } elsif ($domain[0] eq "th") {
      # between 2 and 24 char.
      if($domain[1] =~ /^(ac|co|go|in|mi|net|or)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]**";
      }
#=================================================
#Timor-Leste (East Timor), www.nic.tp 01:52 2003/05/18
    } elsif ($domain[0] eq "tp") {
      if($domain[1] =~ /^(com|edu|gov|mil|net|org)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#Turkey, www.nic.tr 16:34 2004/09/05
    } elsif ($domain[0] eq "tr") {
      if($domain[1] =~ /^(av|bbs|bel|biz|com|edu|gen|gov|info|k12|
                          org|pol|mil|name|net|tel|web)$/x) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } elsif ($domain[1] eq "nic") {
        $remote_host = "$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]**";
      }
#=================================================
#Taiwan, www.twnic.net
#http://www.twnic.net.tw/English/DN_01.htm 19:33 2002/09/18
    } elsif ($domain[0] eq "tw") {
      if($domain[1] =~ /^(edu|gov|com|net|org|mil|idv)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else { #between 2 to 63 bytes
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#Ukraine, www.nic.net.ua, 1:23 2005/03/14
    } elsif ($domain[0] eq "ua") {

      if($domain[1] =~ /^(edu|gov|com|net|org)$/) {
        # Property-oriented domains
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } elsif($domain[1] =~ /^(cherkassy|chernigov|chernovtsy|c[knv]|
        crimea|dnepropetrovsk|d[np]|donetsk|if|ivano-frankivsk|k[hmrsv]|
        kharkov|kherson|khmelnitskiy|kiev|kirovograd|lg|lugansk|lutsk|
        lviv|mk|nikolaev|od(essa)?|pl|poltava|rovno|rv|sebastopol|
        sumy|te(rnopil)?|uz(hgorod)?|vinnica|vn|zaporizhzhe|zhitomir|
        zp|zt)$/x) {
        # Geographical domains
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } elsif($domain[1] =~ /^(cr|l[tv]|s[bm])$/) {
        # Geographical domains, defined but not used.
        $remote_host = "$domain[2].$domain[1].$domain[0]**";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#United Kingdom, www.nic.uk
#http://www.nic.uk/rules/new-rules-final2.html 19:20 2003/01/17
    } elsif ($domain[0] eq "uk") {
      if($domain[1] eq 'nic' && $domain[2] eq 'www') {
        $remote_host = "$domain[1].$domain[0]";
#     } elsif($domain[1] =~ /^(ac|co|gov|ltd|me|mod|net|nic|nhs|org|plc|police|sch)$/)
      } else {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      }
#=================================================
#United States of America, www.nic.us 18:36 2002/09/18
#http://ha1.seikyou.ne.jp/home/avex-freak/hypertxt/privinfo/diary/1999/1118.htm
#http://www.nic.us/policies/docs/rfc_1480.txt The US Domain
    } elsif ($domain[0] eq "us") {
      if($domain[1] =~ /^[a-z][a-z]$/) { # supposed State Code
        #<hostname>.(CI|CO).<locality>.<state>.US
        if ($domain[2] eq 'k12') {
          if ($domain[3] eq 'pvt') {
            # Private School
            $remote_host = "$domain[4].$domain[3].$domain[2].$domain[1].$domain[0]";
          } else {
            # Schools K12 District and K12 School.
            # Can't decided which is $remote_host, so minimum one returned.
            $remote_host = "$domain[3].$domain[2].$domain[1].$domain[0]";
          }
        } elsif ($domain[2] =~ /^(cc|cog|dst|gen|lib|mus|state|tec)$/) {
          $remote_host = "$domain[3].$domain[2].$domain[1].$domain[0]";
        } elsif ($domain[3] =~ /^(borough|ci|co|parish|town(ship)?|twp|vil(lage)?)$/) {
          # have $domain[4] as dept-name. Which is better, return $domain[0..3] ?
          $remote_host = "$domain[4].$domain[3].$domain[2].$domain[1].$domain[0]";
        } else {
          $remote_host = "$domain[3].$domain[2].$domain[1].$domain[0]";
        }
      } elsif($domain[1] =~ /^(fed|nsn|isa|dni)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } elsif($domain[1] eq 'kids') {
        if ($domain[2] eq 'www') {
          $remote_host = "$domain[1].$domain[0]";
        } else {
          $remote_host = "$domain[2].$domain[1].$domain[0]";
        }
      } else { # General US Domain
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#Uruguay, http://www.rau.edu.uy/rau/dom/ 01:48 2003/08/24
    } elsif ($domain[0] eq "uy") {
      if($domain[1] =~ /^(com|edu|gub|mil|net|org)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]**";
      }
#=================================================
#Venezuela, www.nic.ve 16:51 2003/03/29
    } elsif ($domain[0] eq "ve") {
      if($domain[1] =~ /^(arts|bib|com?|edu|firm|gov|info|int|mil|net|nom|org|
                          rec|store|tec|web)$/x) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#Serbia and Motenegro, www.nic.yu 03:07 2004/06/14
    } elsif ($domain[0] eq "yu") {
      if($domain[1] eq "ac") {
        if ($domain[2] eq "bg") {
          $remote_host = "$domain[3].$domain[2].$domain[1].$domain[0]";
        } else {
          $remote_host = "$domain[2].$domain[1].$domain[0]";
        }
      } elsif($domain[1] =~ /^(co|edu|gov|org)$/) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
#South Africa, www.namespace.org.za, 17:51 2003/07/06
    } elsif ($domain[0] eq "za") {
      if($domain[1] =~ /^(ac|alt|bourse|city|co|edu|gov|law|mil|net|ngo|nom|org|
                          school|tm|web)$/x) {
        $remote_host = "$domain[2].$domain[1].$domain[0]";
      } else {
        $remote_host = "$domain[1].$domain[0]";
      }
#=================================================
# Suppose general domain with ccTLD.
# Output with postfix, "*"
    }elsif ($domain[1] =~ /^[a-z0-9-]{4,}$/) {
      $remote_host = "$domain[1].$domain[0]*";
    }else{ # length of 2nd-level is less than 4 bytes.
# ccTLD and assume 3rd-lebel is indentical
      $remote_host = "$domain[2].$domain[1].$domain[0]*";
    }
    return $remote_host;
}

# To no warnings;
$Last_Modified = $Last_Modified;
$Version = $Version;
$Pattern_Date = $Pattern_Date;

# Return true when loading.
1;

__END__

=head1 NAME

fqdn2domain - Extract the domain from fully qualified domain name of a host.

=head1 SYNOPSIS

    require 'fqdn2domain.pl';
    $domain_of_host = &fqdn2domain::extract($fqdn_of_host);

=head1 NOTE

If a return value has postfix "*", that value may be wrong.
Please report me with original host names and $Pattern_Date.

Thank you for your cooperation.

=head1 AUTHOR

Yuuichirou Oka <oka@a-f.jp>

Latest version is distributed at http://a-f.jp/oka/domains/fqdn2domain/

=head1 COPYRIGHT

Copyright (c) 1999-2004 Yuuichirou Oka. All rights reserved.

This script is freeware.
You can use, modify and/or redistribute this script under the terms of
GNU General Public License(GPL).
For detail about GNU GPL, see http://www.gnu.org/licenses/licenses.html .

=cut