root/apps/perl/trunk/lookup/recurse.pl

# sample script that recurses through Non-Terminal NAPTR records
# Author: Henri Asseily < henri.tel >

use lib 'lib';  # uses a locally modified version of Net::Lookup::DotTel 0.1
use Net::Lookup::DotTel;

our $maxdepth = 5; # don't go deeper than this in subdomains
our $currdepth = 0;

sub lookmeup {
  $currdepth++;
  return if ($currdepth >= $maxdepth);
  my $domain = shift || return;
  warn "Entering domain: $domain\n";
  my $lookup = Net::Lookup::DotTel->new;

  if ( $lookup->lookup ( $domain )) {
   my @s = $lookup->get_services;
   foreach my $s (@s) {
     if ($s->{flags} eq '') { # non-terminal, recurse down
      &lookmeup($s->{replacement});
     } else {
      # Here we've got terminal records
     if ( $s->{uri} =~ /^mailto:(.+)/ ) {
        my $email = $1;
        warn "Found email: $email\n";
       }
     }
    }
  }
  $currdepth--;
} # sub lookmeup

my $d = shift || die "Usage: $0 domain.tel\n";
&lookmeup($d);