view release on metacpan or  search on metacpan

lib/Metabrik/Lookup/Countrycode.pm  view on Meta::CPAN

sub _load {
   my $self = shift;

   my $data = $self->_data;
   if (! defined($data)) {
      $data = $self->load or return;
      $self->_data($data);
   }

   return $data;
}

sub _load_by_tld {
   my $self = shift;

   my $data = $self->_data_by_tld;
   if (! defined($data)) {
      $data = $self->load_by_tld or return;
      $self->_data_by_tld($data);
   }

   return $data;
}

sub list_types {
   my $self = shift;

   my $data = $self->_load or return;

   my %list = ();
   for my $this (@$data) {
      $list{$this->{type}}++;
   }

   my @types = sort { $a cmp $b } keys %list;

   return \@types;
}

sub list_tlds {
   my $self = shift;

   my $data = $self->_load or return;

   my %list = ();
   for my $this (@$data) {
      $list{$this->{tld}}++;
   }

   my @tlds = sort { $a cmp $b } keys %list;

   return \@tlds;
}

#
# Port numbers:
# http://www.iana.org/protocols
# http://www.iana.org/assignments/service-names-port-numbers/service-names-port-numbers.xhtml
#
sub update {
   my $self = shift;

   my $input = $self->input;

   my $sf = Metabrik::System::File->new_from_brik_init($self) or return;
   $sf->remove($input);

   my $uri = 'http://www.iana.org/domains/root/db';

   my $get = $self->get($uri) or return;
   my $html = $get->{content};

   my @cc = ();
   while ($html =~ m{<span class="domain tld">(.*?)</tr>}gcs) {
      my $this = $1;

      $this =~ s/\n//g;

      $self->log->debug("update: this[$this]");

      # <tr>
      #  <td>
      #   <span class="domain tld"><a href="/domains/root/db/aaa.html">.aaa</a></span></td>
      #  <td>generic</td>
      #  <td>American Automobile Association, Inc.</td>
      # </tr>

      my ($tld, $type, $sponsor) =
         ($this =~ m{^.*?<a href.*?>(.*?)<.*?<td>(.*?)<.*?<td>(.*?)<.*$});

      # Remove leading . and put to lowercase
      $tld =~ s{^\.}{};
      $tld = lc($tld);

      push @cc, {
         tld => $tld,
         type => "\"$type\"",
         sponsor => "\"$sponsor\"",
      };
   }

   my $fc = Metabrik::File::Csv->new_from_brik_init($self) or return;
   $fc->append(0);
   $fc->overwrite(1);
   $fc->encoding('utf8');
   $fc->write_header(1);
   $fc->separator(',');
   $fc->header([qw(tld type sponsor)]);

   $fc->write(\@cc, $input) or return;

   return $input;
}

sub load {
   my $self = shift;
   my ($input) = @_;

   $input ||= $self->input;
   $self->brik_help_run_undef_arg('load', $input) or return;