view release on metacpan or  search on metacpan

lib/Net/Whois/SIDN.pm  view on Meta::CPAN

to the HASH containing the result. Otherwise, C<$rc> is an error code,
defined as HTTP error codes and C<$data> an error text.

The C<%opts> are parameter pairs. Defined keys are: C<lang> (language
EN or NL, default EN), C<output_format> (PLAIN, HTML, and the default XML)
and C<usertext_format> (PLAIN or HTML).

Example:

   my ($rc, $data) = $whois->whois('sidn.nl');
   $rc==0 or die "Error: $data";

   print $data->{domain}{status}{code}, "\n";
  
The distribution package contains an extended realistic example of
the data structure as made available in Perl.

=item my ($rc, $data) = $obj->is('sidn.nl', %opts)

The C<is()> works exactly the same as the C<whois()>, but produces a
shorter answer.

=cut

sub _call($$)
{   my ($self, $action, $data_out) = @_;

    my $xmlout   = $self->create("whois:$action-query" => $data_out);

    my $request  = HTTP::Request->new
      ( POST => $self->service($action)
      , [ X_Net_Whois_SIDN => $VERSION
        , Content_Type     => 'text/xml; charset="utf-8"'
        , Connection       => 'open'
        ]
      , $xmlout->toString(1)
      );

    print "\n==> Request\n", $request->as_string
        if $self->{trace};

    my $response = $self->userAgent->request($request);
    print "\n--> Response\n", $response->as_string
        if $self->{trace};

    my $content  = $response->decoded_content || $response->content;

    my $rc = $response->code;
    $rc == RC_OK
        or return ($rc, "Error: $rc = "
           . ($response->header('Client-Warnings') || $content));

    my $ct = $response->content_type;
    $ct eq 'text/xml'
        or return (-1, "Error: expect xml, but got $ct");

    my ($type, $data_in) = $self->from($content);
    (0, $data_in);
}

sub is($@)
{   my ($self, $domain, @args) = @_;
    $self->_call(is => {domain => $domain, @args});
}

sub whois($@)
{   my ($self, $domain, @args) = @_;
    $self->_call(whois => {domain => $domain, @args});
}

=back

=head2 Helpers

=over 4

=item my $xml = $obj->create($type, $data);

Pass a correctly constructed Perl C<$data> nested HASH, which suites
to the C<$type>, which is C<whois:{whois,is}-{query,response}>. See
the examples provided by the distribution.

  my $xml = $whois->create($type, $data);
  print $xml->toString(1);

=cut

sub create($$)
{   my ($self, $type, $data) = @_;
    my $doc  = XML::LibXML::Document->new('1.0', 'UTF-8');
    my $wr   = $self->writer($type) or return;
    my $root = $wr->($doc, $data);
    $doc->setDocumentElement($root);
    $doc;
}

=item $class->from($data, [@opts]);

=item $obj->from($data, [@opts]);

Read an XML message from C<$data>, in any format supported by
L<XML::Compile> method C<dataToXML()>: string, file, filehandle, and more.
Returned is a list of two: the type of the top-level element plus the
data-structure.

When called as instance method, the data will automatically get converted
to the version of required by the object.  When called as class method,
the version of the top-level element will determine the returned version
automatically (which may give unpredictable versions as result).

When the method is called as class method, then a temporary instance is
created.  Creating an instance is (very) slow.

Examples:

  my $whois = Net::Whois::SIDN->new(drs_version => '3.14');
  my ($type, $data) = $whois->from('data.xml');

or

  my ($type, $data) = Net::Whois::SIDN->from('data.xml');