ABAKUS

Code: Alles auswählen

sub domain {
  my $res = shift;
  $res =~ s/^(http:\/\/)?(www\.)?([^\/]+)(\/.*|)$/$3/;
  my ($lastres, $ip);
  while ($res =~ /\.[^\.]+\./) {
    $lastres = $res;
    $res =~ s/^[^\.]+\.(.*)$/$1/;
    unless ($ip = &get_ip ($res)) {
      $res = $lastres;
      last;
    }
  }
  return $res;
}

sub get_ip {
  my ($name, $aliases, $addrtype, $length, @addrs) = gethostbyname (shift);
  my ($a, $b, $c, $d);
  my $result = '';
  foreach my $addr (@addrs) { 
    ($a, $b, $c, $d) = unpack ('C4', $addr);
    $result .= ', ' if ($result);
    $result .= "$a.$b.$c.$d";
  }
  return $result;
}

Code: Alles auswählen

@ttld = qw (.fed.us .dni.us .com.ac .edu.ac .gov.ac);

sub domain {
  my $res = shift;
  $res =~ s/^(http:\/\/)?(www\.)?([^\/]+)(\/.*|)$/$3/;
  
  if (($res =~ /\.[^\.]+\./) && ($res !~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/)) {
    my $ready = 0;
    foreach my $tld (@ttld) {
      if ($res =~ /^([^\.]+\.)*([^\.]+)\Q$tld\E$/) {
        $res = $2.$tld;
        $ready++;
        last;
      }
    }
    unless ($ready) {
      $res =~ s/([^\.]+\.)*([^\.]+\.[^\.]+)$/$2/;
    }
  }
  return $res;
}