r49794 - in /branches/upstream/libnet-epp-perl/current: ./ lib/Net/ lib/Net/EPP/ lib/Net/EPP/Frame/ lib/Net/EPP/Frame/Command/ lib/Net/EPP/Frame/Command/Create/ t/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Fri Jan 1 20:57:08 UTC 2010
Author: jawnsy-guest
Date: Fri Jan 1 20:57:02 2010
New Revision: 49794
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=49794
Log:
[svn-upgrade] Integrating new upstream version, libnet-epp-perl (0.13)
Added:
branches/upstream/libnet-epp-perl/current/lib/Net/EPP.pm
branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Command/Create/Domain.pm
branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Command/Create/Host.pm
Modified:
branches/upstream/libnet-epp-perl/current/Makefile.PL
branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Client.pm
branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame.pm
branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Command/Create.pm
branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Command/Login.pm
branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Response.pm
branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Protocol.pm
branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Simple.pm
branches/upstream/libnet-epp-perl/current/t/use.t
Modified: branches/upstream/libnet-epp-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-epp-perl/current/Makefile.PL?rev=49794&op=diff
==============================================================================
--- branches/upstream/libnet-epp-perl/current/Makefile.PL (original)
+++ branches/upstream/libnet-epp-perl/current/Makefile.PL Fri Jan 1 20:57:02 2010
@@ -5,7 +5,7 @@
WriteMakefile(
'NAME' => 'Net::EPP',
- 'VERSION' => '0.12',
+ 'VERSION_FROM' => 'lib/Net/EPP.pm',
'PREREQ_PM' => {
'IO::Socket::SSL' => 0,
'XML::LibXML' => 0,
Added: branches/upstream/libnet-epp-perl/current/lib/Net/EPP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-epp-perl/current/lib/Net/EPP.pm?rev=49794&op=file
==============================================================================
--- branches/upstream/libnet-epp-perl/current/lib/Net/EPP.pm (added)
+++ branches/upstream/libnet-epp-perl/current/lib/Net/EPP.pm Fri Jan 1 20:57:02 2010
@@ -1,0 +1,17 @@
+# Copyright (c) 2009 CentralNic Ltd. All rights reserved. This program is
+# free software; you can redistribute it and/or modify it under the same
+# terms as Perl itself.
+#
+# $Id$
+package Net::EPP;
+use vars qw($VERSION);
+use Net::EPP::Client;
+use Net::EPP::Frame;
+use Net::EPP::Protocol;
+use Net::EPP::ResponseCodes;
+use Net::EPP::Simple;
+use strict;
+
+our $VERSION = '0.13';
+
+1;
Modified: branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Client.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Client.pm?rev=49794&op=diff
==============================================================================
--- branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Client.pm (original)
+++ branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Client.pm Fri Jan 1 20:57:02 2010
@@ -12,6 +12,7 @@
use vars qw($XMLDOM $EPPFRAME);
use UNIVERSAL qw(isa);
use strict;
+use warnings;
=pod
@@ -65,11 +66,11 @@
our $XMLDOM = 0;
our $EPPFRAME = 0;
eval {
- use XML::LibXML;
+ require XML::LibXML;
$XMLDOM = 1;
};
eval {
- use Net::EPP::Frame;
+ require Net::EPP::Frame;
$EPPFRAME = 1;
};
}
@@ -230,7 +231,7 @@
sub _connect_unix {
my ($self, %params) = @_;
- $self->{'connection'} = 'IO::Socket::UNIX'->new(
+ $self->{'connection'} = IO::Socket::UNIX->new(
Peer => $self->{'sock'},
Type => SOCK_STREAM,
%params
@@ -296,9 +297,8 @@
sub get_frame {
my $self = shift;
-
return $self->get_return_value(Net::EPP::Protocol->get_frame($self->{'connection'}));
-};
+}
sub get_return_value {
my ($self, $xml) = @_;
@@ -308,12 +308,11 @@
} else {
my $document;
- eval {
- $document = $self->{'parser'}->parse_string($xml);
- };
+ eval { $document = $self->{'parser'}->parse_string($xml) };
if (!defined($document) || $@ ne '') {
chomp($@);
- croak("Frame from server wasn't well formed: \"$@\"\n\nThe XML looks like this:\n\n$xml\n\n");
+ croak(sprintf("Frame from server wasn't well formed: %s\n\nThe XML looks like this:\n\n%s\n\n", $@, $xml));
+ return undef;
} else {
my $class = $self->{'class'};
@@ -356,7 +355,7 @@
$xml = $frame->toString;
$wfcheck = 0;
- } elsif (-e $frame) {
+ } elsif ($frame !~ /</ && -e $frame) {
if (!open(FRAME, $frame)) {
croak("Couldn't open file '$frame' for reading: $!");
@@ -374,21 +373,14 @@
}
if ($wfcheck == 1) {
- eval {
- $self->{'parser'}->parse_string($xml);
- };
-
+ eval { $self->{'parser'}->parse_string($xml) };
if ($@ ne '') {
chomp($@);
- croak("Frame wasn't well formed: \"$@\"\n\nThe XML looks like this:\n\n$xml\n\n");
-
- }
-
- }
-
- Net::EPP::Protocol->send_frame($self->{'connection'}, $xml);
-
- return 1;
+ croak(sprintf("Frame from server wasn't well formed: %s\n\nThe XML looks like this:\n\n%s\n\n", $@, $xml));
+ }
+ }
+
+ return Net::EPP::Protocol->send_frame($self->{'connection'}, $xml);
}
=pod
@@ -397,7 +389,7 @@
$epp->disconnect;
-This closes the connection. An EPP server will always close a connection after
+This closes the connection. An EPP server should always close a connection after
a C<E<lt>logoutE<gt>> frame has been received and acknowledged; this method
is provided to allow you to clean up on the client side, or close the
connection out of sync with the server.
Modified: branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame.pm?rev=49794&op=diff
==============================================================================
--- branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame.pm (original)
+++ branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame.pm Fri Jan 1 20:57:02 2010
@@ -181,7 +181,7 @@
$epp->setAttributeNS($SCHEMA_URI, 'schemaLocation', "$EPP_URN epp-1.0.xsd");
$self->addChild($epp);
- my $el = $self->createElement(lc($type));
+ my $el = $self->createElement($type);
$epp->addChild($el);
$self->_addExtraElements;
Modified: branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Command/Create.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Command/Create.pm?rev=49794&op=diff
==============================================================================
--- branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Command/Create.pm (original)
+++ branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Command/Create.pm Fri Jan 1 20:57:02 2010
@@ -5,6 +5,8 @@
# $Id: Create.pm,v 1.4 2007/12/03 11:44:52 gavin Exp $
package Net::EPP::Frame::Command::Create;
use base qw(Net::EPP::Frame::Command);
+use Net::EPP::Frame::Command::Create::Domain;
+use Net::EPP::Frame::Command::Create::Host;
use Net::EPP::Frame::Command::Create::Contact;
use strict;
Added: branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Command/Create/Domain.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Command/Create/Domain.pm?rev=49794&op=file
==============================================================================
--- branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Command/Create/Domain.pm (added)
+++ branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Command/Create/Domain.pm Fri Jan 1 20:57:02 2010
@@ -1,0 +1,191 @@
+# Copyright (c) 2009 CentralNic Ltd. All rights reserved. This program is
+# free software; you can redistribute it and/or modify it under the same
+# terms as Perl itself.
+#
+# $Id$
+package Net::EPP::Frame::Command::Create::Domain;
+use base qw(Net::EPP::Frame::Command::Create);
+use Net::EPP::Frame::ObjectSpec;
+use strict;
+
+=pod
+
+=head1 NAME
+
+Net::EPP::Frame::Command::Create::Domain - an instance of L<Net::EPP::Frame::Command::Create>
+for domain objects.
+
+=head1 SYNOPSIS
+
+ use Net::EPP::Frame::Command::Create::Domain;
+ use strict;
+
+ my $check = Net::EPP::Frame::Command::Create::Domain->new;
+ $create->setDomain('example.uk.com);
+
+ print $create->toString(1);
+
+This results in an XML document like this:
+
+ <?xml version="1.0" encoding="UTF-8"?>
+ <epp xmlns="urn:ietf:params:xml:ns:epp-1.0"
+ xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+ xsi:schemaLocation="urn:ietf:params:xml:ns:epp-1.0
+ epp-1.0.xsd">
+ <command>
+ <check>
+ <domain:create
+ xmlns:contact="urn:ietf:params:xml:ns:contact-1.0"
+ xsi:schemaLocation="urn:ietf:params:xml:ns:contact-1.0
+ contact-1.0.xsd">
+ <domain:name>example-1.tldE<lt>/domain:name>
+ </domain:create>
+ </check>
+ <clTRID>0cf1b8f7e14547d26f03b7641660c641d9e79f45</clTRIDE<gt>
+ </command>
+ </epp>
+
+=head1 OBJECT HIERARCHY
+
+ L<XML::LibXML::Node>
+ +----L<XML::LibXML::Document>
+ +----L<Net::EPP::Frame>
+ +----L<Net::EPP::Frame::Command>
+ +----L<Net::EPP::Frame::Command::Create>
+ +----L<Net::EPP::Frame::Command::Create::Domain>
+
+=cut
+
+sub new {
+ my $package = shift;
+ my $self = bless($package->SUPER::new('create'), $package);
+
+ $self->addObject(Net::EPP::Frame::ObjectSpec->spec('domain'));
+
+ return $self;
+}
+
+=pod
+
+=head1 METHODS
+
+ my $element = $frame->setDomain($domain_name);
+
+This sets the name of the object to be created. Returns the
+C<E<lt>domain:nameE<gt>> element.
+
+=cut
+
+sub setDomain {
+ my ($self, $domain) = @_;
+
+ my $name = $self->createElement('domain:name');
+ $name->appendText($domain);
+
+ $self->getNode('create')->getChildNodes->shift->appendChild($name);
+
+ return 1;
+}
+
+sub setPeriod {
+ my ($self, $period, $unit) = @_;
+
+ $unit = 'y' if (!defined($unit) || $unit eq '');
+
+ my $el = $self->createElement('domain:period');
+ $el->setAttribute('unit', $unit);
+ $el->appendText(int($period));
+
+ $self->getNode('create')->getChildNodes->shift->appendChild($el);
+
+ return 1;
+}
+
+sub setRegistrant {
+ my ($self, $contact) = @_;
+
+ my $registrant = $self->createElement('domain:registrant');
+ $registrant->appendText($contact);
+
+ $self->getNode('create')->getChildNodes->shift->appendChild($registrant);
+
+ return 1;
+}
+
+sub setContacts {
+ my ($self, $contacts) = @_;
+
+ foreach my $type (keys(%{$contacts})) {
+ my $contact = $self->createElement('domain:contact');
+ $contact->setAttribute('type', $type);
+ $contact->appendText($contacts->{$type});
+
+ $self->getNode('create')->getChildNodes->shift->appendChild($contact);
+ }
+
+ return 1;
+}
+
+sub setNS {
+ my ($self, @ns) = @_;
+
+ my $ns = $self->createElement('domain:ns');
+
+ foreach my $host (@ns) {
+ my $el = $self->createElement('domain:hostObj');
+ $el->appendText($host);
+ $ns->appendChild($el);
+ }
+ $self->getNode('create')->getChildNodes->shift->appendChild($ns);
+
+ return 1;
+}
+
+sub setAuthInfo {
+ my ($self, $authInfo) = @_;
+ my $el = $self->addEl('authInfo');
+ my $pw = $self->createElement('pw');
+ $pw->appendText($authInfo);
+ $el->appendChild($pw);
+ return $el;
+}
+
+sub appendStatus {
+ my ($self, $status) = @_;
+ return $self->addEl('status', $status);
+}
+
+sub addEl {
+ my ($self, $name, $value) = @_;
+
+ my $el = $self->createElement('domain:'.$name);
+ $el->appendText($value) if defined($value);
+
+ $self->getNode('create')->getChildNodes->shift->appendChild($el);
+
+ return $el;
+
+}
+
+=pod
+
+=head1 AUTHOR
+
+CentralNic Ltd (http://www.centralnic.com/).
+
+=head1 COPYRIGHT
+
+This module is (c) 2007 CentralNic Ltd. This module is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+=over
+
+=item * L<Net::EPP::Frame>
+
+=back
+
+=cut
+
+1;
Added: branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Command/Create/Host.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Command/Create/Host.pm?rev=49794&op=file
==============================================================================
--- branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Command/Create/Host.pm (added)
+++ branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Command/Create/Host.pm Fri Jan 1 20:57:02 2010
@@ -1,0 +1,11 @@
+# Copyright (c) 2009 CentralNic Ltd. All rights reserved. This program is
+# free software; you can redistribute it and/or modify it under the same
+# terms as Perl itself.
+#
+# $Id$
+package Net::EPP::Frame::Command::Create::Host;
+use base qw(Net::EPP::Frame::Command::Create);
+use Net::EPP::Frame::ObjectSpec;
+use strict;
+
+1;
Modified: branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Command/Login.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Command/Login.pm?rev=49794&op=diff
==============================================================================
--- branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Command/Login.pm (original)
+++ branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Command/Login.pm Fri Jan 1 20:57:02 2010
@@ -29,6 +29,10 @@
$self->getNode('login')->addChild($self->createElement('clID'));
$self->getNode('login')->addChild($self->createElement('pw'));
$self->getNode('login')->addChild($self->createElement('options'));
+
+ $self->getNode('options')->addChild($self->createElement('version'));
+ $self->getNode('options')->addChild($self->createElement('lang'));
+
$self->getNode('login')->addChild($self->createElement('svcs'));
}
@@ -56,12 +60,24 @@
This method returns the L<XML::LibXML::Element> object corresponding to the
C<E<lt>optionsE<gt>> element.
+ my $node = $frame->version;
+
+This method returns the L<XML::LibXML::Element> object corresponding to the
+C<E<lt>versionE<gt>> element.
+
+ my $node = $frame->lang;
+
+This method returns the L<XML::LibXML::Element> object corresponding to the
+C<E<lt>langE<gt>> element.
+
=cut
sub clID { $_[0]->getNode('clID') }
sub pw { $_[0]->getNode('pw') }
sub svcs { $_[0]->getNode('svcs') }
sub options { $_[0]->getNode('options') }
+sub version { $_[0]->getNode('version') }
+sub lang { $_[0]->getNode('lang') }
=pod
Modified: branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Response.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Response.pm?rev=49794&op=diff
==============================================================================
--- branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Response.pm (original)
+++ branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Response.pm Fri Jan 1 20:57:02 2010
@@ -30,15 +30,28 @@
=cut
+sub new {
+ my $package = shift;
+ my $self = $package->SUPER::new('response');
+ return bless($self, $package);
+}
+
sub _addExtraElements {
my $self = shift;
- $self->response->addChild($self->createElement('result'));
+
+ my $result = $self->createElement('result');
+ $result->appendChild($self->createElement('msg'));
+ $self->response->addChild($result);
+
+ $self->result->setAttribute('code' => COMMAND_FAILED);
+
$self->response->addChild($self->createElement('resData'));
- $self->result->setAttribute('code' => COMMAND_FAILED);
+
my $trID = $self->createElement('trID');
$trID->addChild($self->createElement('clTRID'));
$trID->addChild($self->createElement('svTRID'));
$self->response->addChild($trID);
+
return 1;
}
@@ -55,6 +68,11 @@
This method returns the L<XML::LibXML::Element> object corresponding to the
C<E<lt>resultE<gt>> element.
+
+ my $node = $frame->msg;
+
+This method returns the L<XML::LibXML::Element> object corresponding to the
+C<E<lt>msgE<gt>> element.
my $node = $frame->trID;
@@ -73,30 +91,11 @@
=cut
-sub response {
- my $self = shift;
- return $self->getNode($Net::EPP::Frame::EPP_URN, 'response');
-}
-
-sub result {
- my $self = shift;
- return $self->getNode($Net::EPP::Frame::EPP_URN, 'result');
-}
-
-sub trID {
- my $self = shift;
- return $self->getNode($Net::EPP::Frame::EPP_URN, 'trID');
-}
-
-sub clTRID {
- my $self = shift;
- return $self->getNode($Net::EPP::Frame::EPP_URN, 'clTRID');
-}
-
-sub svTRID {
- my $self = shift;
- return $self->getNode($Net::EPP::Frame::EPP_URN, 'svTRID');
-}
+sub response {$_[0]->getNode('response') }
+sub result {$_[0]->getNode('result') }
+sub trID {$_[0]->getNode('trID') }
+sub clTRID {$_[0]->getNode('clTRID') }
+sub svTRID {$_[0]->getNode('svTRID') }
=pod
Modified: branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Protocol.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Protocol.pm?rev=49794&op=diff
==============================================================================
--- branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Protocol.pm (original)
+++ branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Protocol.pm Fri Jan 1 20:57:02 2010
@@ -100,8 +100,9 @@
sub send_frame {
my ($class, $fh, $xml) = @_;
- croak("Connection closed") if (ref($fh) ne 'IO::Socket::SSL' && $fh->eof); # eof() dies for me
+# croak("Connection closed") if (ref($fh) ne 'IO::Socket::SSL' && $fh->eof); # eof() dies for me
$fh->print($class->prep_frame($xml));
+ $fh->flush;
return 1;
}
Modified: branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Simple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Simple.pm?rev=49794&op=diff
==============================================================================
--- branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Simple.pm (original)
+++ branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Simple.pm Fri Jan 1 20:57:02 2010
@@ -7,16 +7,17 @@
use Carp;
use Digest::SHA1 qw(sha1_hex);
use Net::EPP::Frame;
+use Net::EPP::ResponseCodes;
use Time::HiRes qw(time);
use UNIVERSAL qw(isa);
use base qw(Net::EPP::Client);
use constant EPP_XMLNS => 'urn:ietf:params:xml:ns:epp-1.0';
use vars qw($Error $Code $Message);
+use strict;
use warnings;
-use strict;
our $Error = '';
-our $Code = 1000;
+our $Code = OK;
our $Message = '';
=pod
@@ -99,12 +100,21 @@
my $self = $package->SUPER::new(%params);
+ $self->{user} = $params{user};
+ $self->{pass} = $params{pass};
$self->{debug} = (defined($params{debug}) ? int($params{debug}) : undef);
$self->{timeout} = (defined($params{timeout}) && int($params{timeout}) > 0 ? $params{timeout} : 5);
+ $self->{reconnect} = (defined($params{reconnect}) ? int($params{reconnect}) : 3);
$self->{connected} = undef;
$self->{authenticated} = undef;
bless($self, $package);
+
+ return ($self->_connect ? $self : undef);
+}
+
+sub _connect {
+ my $self = shift;
$self->debug(sprintf('Attempting to connect to %s:%d', $self->{host}, $self->{port}));
eval {
@@ -113,8 +123,9 @@
if ($@ ne '' || ref($self->{greeting}) ne 'Net::EPP::Frame::Response') {
chomp($@);
$@ =~ s/ at .+ line .+$//;
- $Code = 2400;
- $Message = $@;
+ $self->debug($@);
+ $Code = COMMAND_FAILED;
+ $Error = $Message = $@;
return undef;
}
@@ -126,8 +137,10 @@
my $login = Net::EPP::Frame::Command::Login->new;
- $login->clID->appendText($params{user});
- $login->pw->appendText($params{pass});
+ $login->clID->appendText($self->{user});
+ $login->pw->appendText($self->{pass});
+ $login->version->appendText($self->{greeting}->getElementsByTagNameNS(EPP_XMLNS, 'version')->shift->firstChild->data);
+ $login->lang->appendText($self->{greeting}->getElementsByTagNameNS(EPP_XMLNS, 'lang')->shift->firstChild->data);
my $objects = $self->{greeting}->getElementsByTagNameNS(EPP_XMLNS, 'objURI');
while (my $object = $objects->shift) {
@@ -142,7 +155,7 @@
$login->svcs->appendChild($el);
}
- $self->debug(sprintf("Attempting to login as client ID '%s'", $params{user}));
+ $self->debug(sprintf("Attempting to login as client ID '%s'", $self->{user}));
my $response = $self->request($login);
$Code = $self->_get_response_code($response);
@@ -159,7 +172,7 @@
}
- return $self;
+ return 1;
}
=pod
@@ -222,27 +235,32 @@
return undef;
}
- my $response = $self->request($frame);
-
- $Code = $self->_get_response_code($response);
- $Message = $self->_get_message($response);
-
- if ($Code > 1999) {
- $Error = sprintf("Server returned a %d code", $Code);
+ my $response = $self->_request($frame);
+
+ if (!$response) {
return undef;
} else {
- my $xmlns = (Net::EPP::Frame::ObjectSpec->spec($type))[1];
- my $key;
- if ($type eq 'domain' || $type eq 'host') {
- $key = 'name';
-
- } elsif ($type eq 'contact') {
- $key = 'id';
-
- }
- return $response->getNode($xmlns, $key)->getAttribute('avail');
-
+ $Code = $self->_get_response_code($response);
+ $Message = $self->_get_message($response);
+
+ if ($Code > 1999) {
+ $Error = sprintf("Server returned a %d code", $Code);
+ return undef;
+
+ } else {
+ my $xmlns = (Net::EPP::Frame::ObjectSpec->spec($type))[1];
+ my $key;
+ if ($type eq 'domain' || $type eq 'host') {
+ $key = 'name';
+
+ } elsif ($type eq 'contact') {
+ $key = 'id';
+
+ }
+ return $response->getNode($xmlns, $key)->getAttribute('avail');
+
+ }
}
}
@@ -252,11 +270,11 @@
You can retrieve information about an object by using one of the following:
- my $info = $epp->domain_info($domain);
+ my $info = $epp->domain_info($domain, $authInfo, $follow);
my $info = $epp->host_info($host);
- my $info = $epp->contact_info($contact);
+ my $info = $epp->contact_info($contact, $authInfo);
C<Net::EPP::Simple> will construct an C<E<lt>infoE<gt>> frame and send
it to the server, then parse the response into a simple hash ref. The
@@ -264,11 +282,49 @@
error, these methods will return C<undef>, and you can then check
C<$Net::EPP::Simple::Error> and C<$Net::EPP::Simple::Code>.
+If C<$authInfo> is defined, it will be sent to the server as per RFC
+4931, Section 3.1.2 and RRC 4933, Section 3.1.2. If the supplied
+authInfo code is validated by the registry, additional information will
+appear in the response. If it is invalid, you should get an error.
+
+If the C<$follow> parameter is true, then C<Net::EPP::Simple> will also
+retrieve the relevant host and contact details for a domain: instead of
+returning an object name or ID for the domain's registrant, contact
+associations, DNS servers or subordinate hosts, the values will be
+replaced with the return value from the appropriate C<host_info()> or
+C<contact_info()> command (unless there was an error, in which case the
+original object ID will be used instead).
+
=cut
sub domain_info {
- my ($self, $domain) = @_;
- return $self->_info('domain', $domain);
+ my ($self, $domain, $authInfo, $follow) = @_;
+ my $result = $self->_info('domain', $domain, $authInfo);
+ return $result if (ref($result) ne 'HASH' || !$follow);
+
+ if (defined($result->{'ns'}) && ref($result->{'ns'}) eq 'ARRAY') {
+ for (my $i = 0 ; $i < scalar(@{$result->{'ns'}}) ; $i++) {
+ my $info = $self->host_info($result->{'ns'}->[$i]);
+ $result->{'ns'}->[$i] = $info if (ref($info) eq 'HASH');
+ }
+ }
+
+ if (defined($result->{'hosts'}) && ref($result->{'hosts'}) eq 'ARRAY') {
+ for (my $i = 0 ; $i < scalar(@{$result->{'hosts'}}) ; $i++) {
+ my $info = $self->host_info($result->{'hosts'}->[$i]);
+ $result->{'hosts'}->[$i] = $info if (ref($info) eq 'HASH');
+ }
+ }
+
+ my $info = $self->contact_info($result->{'registrant'});
+ $result->{'registrant'} = $info if (ref($info) eq 'HASH');
+
+ foreach my $type (keys(%{$result->{'contacts'}})) {
+ my $info = $self->contact_info($result->{'contacts'}->{$type});
+ $result->{'contacts'}->{$type} = $info if (ref($info) eq 'HASH');
+ }
+
+ return $result;
}
sub host_info {
@@ -277,12 +333,12 @@
}
sub contact_info {
- my ($self, $contact) = @_;
- return $self->_info('contact', $contact);
+ my ($self, $contact, $authInfo) = @_;
+ return $self->_info('contact', $contact, $authInfo);
}
sub _info {
- my ($self, $type, $identifier) = @_;
+ my ($self, $type, $identifier, $authInfo) = @_;
my $frame;
if ($type eq 'domain') {
$frame = Net::EPP::Frame::Command::Info::Domain->new;
@@ -299,29 +355,44 @@
} else {
$Error = "Unknown object type '$type'";
return undef;
- }
-
- my $response = $self->request($frame);
-
- $Code = $self->_get_response_code($response);
- $Message = $self->_get_message($response);
-
- if ($Code > 1999) {
- $Error = sprintf("Server returned a %d code", $Code);
+
+ }
+
+ if (defined($authInfo) && $authInfo ne '') {
+ $self->debug('adding authInfo element to request frame');
+ my $el = $frame->createElement((Net::EPP::Frame::ObjectSpec->spec($type))[0].':authInfo');
+ my $pw = $frame->createElement((Net::EPP::Frame::ObjectSpec->spec($type))[0].':pw');
+ $pw->appendChild($frame->createTextNode($authInfo));
+ $el->appendChild($pw);
+ $frame->getNode((Net::EPP::Frame::ObjectSpec->spec($type))[1], 'info')->appendChild($el);
+ }
+
+ my $response = $self->_request($frame);
+
+ if (!$response) {
return undef;
} else {
- my $infData = $response->getNode((Net::EPP::Frame::ObjectSpec->spec($type))[1], 'infData');
-
- if ($type eq 'domain') {
- return $self->_domain_infData_to_hash($infData);
-
- } elsif ($type eq 'contact') {
- return $self->_contact_infData_to_hash($infData);
-
- } elsif ($type eq 'host') {
- return $self->_host_infData_to_hash($infData);
-
+ $Code = $self->_get_response_code($response);
+ $Message = $self->_get_message($response);
+
+ if ($Code > 1999) {
+ $Error = sprintf("Server returned a %d code", $Code);
+ return undef;
+
+ } else {
+ my $infData = $response->getNode((Net::EPP::Frame::ObjectSpec->spec($type))[1], 'infData');
+
+ if ($type eq 'domain') {
+ return $self->_domain_infData_to_hash($infData);
+
+ } elsif ($type eq 'contact') {
+ return $self->_contact_infData_to_hash($infData);
+
+ } elsif ($type eq 'host') {
+ return $self->_host_infData_to_hash($infData);
+
+ }
}
}
}
@@ -568,10 +639,12 @@
foreach my $name ('voice', 'fax') {
my $els = $infData->getElementsByLocalName($name);
- if ($els->size == 1) {
+ if (defined($els) && $els->size == 1) {
my $el = $els->shift;
- $hash->{$name} = $el->textContent;
- $hash->{$name} .= 'x'.$el->getAttribute('x') if ($el->getAttribute('x') ne '');
+ if (defined($el)) {
+ $hash->{$name} = $el->textContent;
+ $hash->{$name} .= 'x'.$el->getAttribute('x') if (defined($el->getAttribute('x')) && $el->getAttribute('x') ne '');
+ }
}
}
@@ -660,7 +733,7 @@
eval("\$frame = $class->new");
if ($@ || ref($frame) ne $class) {
$Error = "Error building request frame: $@";
- $Code = 2400;
+ $Code = COMMAND_FAILED;
return undef;
} else {
@@ -680,27 +753,33 @@
$frame->setPeriod(int($period)) if ($op eq 'request');
}
- my $response = $self->request($frame);
-
- $Code = $self->_get_response_code($response);
- $Message = $self->_get_message($response);
-
- if ($Code > 1999) {
- $Error = $response->msg;
+ my $response = $self->_request($frame);
+
+
+ if (!$response) {
return undef;
- } elsif ($op eq 'query' || $op eq 'request') {
- my $trnData = $response->getElementsByLocalName('trnData')->shift;
- my $hash = {};
- foreach my $child ($trnData->childNodes) {
- $hash->{$child->localName} = $child->textContent;
- }
-
- return $hash;
-
- } else {
- return 1;
-
+ } else {
+ $Code = $self->_get_response_code($response);
+ $Message = $self->_get_message($response);
+
+ if ($Code > 1999) {
+ $Error = $response->msg;
+ return undef;
+
+ } elsif ($op eq 'query' || $op eq 'request') {
+ my $trnData = $response->getElementsByLocalName('trnData')->shift;
+ my $hash = {};
+ foreach my $child ($trnData->childNodes) {
+ $hash->{$child->localName} = $child->textContent;
+ }
+
+ return $hash;
+
+ } else {
+ return 1;
+
+ }
}
}
@@ -796,14 +875,44 @@
$epp->create_domain($domain);
-C<Net::EPP::Simple> assumes the registry uses the host object model rather
-than the host attribute model.
+The C<period> key is assumed to be in years rather than months. C<Net::EPP::Simple>
+assumes the registry uses the host object model rather than the host attribute model.
=cut
sub create_domain {
my ($self, $domain) = @_;
- croak("Unfinished method create_domain()");
+
+ print Data::Dumper::Dumper($domain);
+
+ my $frame = Net::EPP::Frame::Command::Create::Domain->new;
+ $frame->setDomain($domain->{'name'});
+ $frame->setPeriod($domain->{'period'});
+ $frame->setRegistrant($domain->{'registrant'});
+ $frame->setContacts($domain->{'contacts'});
+ $frame->setNS(@{$domain->{'ns'}});
+
+ $frame->setAuthInfo($domain->{authInfo}) if ($domain->{authInfo} ne '');
+
+ my $response = $self->_request($frame);
+
+
+ if (!$response) {
+ return undef;
+
+ } else {
+ $Code = $self->_get_response_code($response);
+ $Message = $self->_get_message($response);
+
+ if ($Code > 1999) {
+ $Error = $response->msg;
+ return undef;
+
+ } else {
+ return 1;
+
+ }
+ }
}
sub create_host {
@@ -838,20 +947,24 @@
}
}
- my $response = $self->request($frame);
-
- $Code = $self->_get_response_code($response);
- $Message = $self->_get_message($response);
-
- if ($Code > 1999) {
- $Error = $response->msg;
+ my $response = $self->_request($frame);
+
+ if (!$response) {
return undef;
} else {
- return 1;
-
- }
-
+ $Code = $self->_get_response_code($response);
+ $Message = $self->_get_message($response);
+
+ if ($Code > 1999) {
+ $Error = $response->msg;
+ return undef;
+
+ } else {
+ return 1;
+
+ }
+ }
}
sub update_domain {
@@ -929,18 +1042,24 @@
}
- my $response = $self->request($frame);
-
- $Code = $self->_get_response_code($response);
- $Message = $self->_get_message($response);
-
- if ($Code > 1999) {
- $Error = sprintf("Server returned a %d code", $Code);
+ my $response = $self->_request($frame);
+
+
+ if (!$response) {
return undef;
} else {
- return 1;
-
+ $Code = $self->_get_response_code($response);
+ $Message = $self->_get_message($response);
+
+ if ($Code > 1999) {
+ $Error = sprintf("Server returned a %d code", $Code);
+ return undef;
+
+ } else {
+ return 1;
+
+ }
}
}
@@ -965,6 +1084,46 @@
=cut
sub greeting { $_[0]->{greeting} }
+
+sub ping {
+ my $self = shift;
+ my $hello = Net::EPP::Frame::Hello->new;
+ my $response = $self->request($hello);
+
+ return (isa($response, 'XML::LibXML::Document') ? 1 : undef);
+}
+
+sub _request {
+ my ($self, $frame) = @_;
+
+ if ($self->{reconnect} > 0) {
+ if (!$self->ping) {
+ $self->debug('connection seems dead, trying to reconnect');
+ for (1..$self->{reconnect}) {
+ $self->debug("attempt #$_");
+ if ($self->_connect) {
+ $self->debug("attempt #$_ succeeded");
+ return $self->request($frame);
+
+ } else {
+ $self->debug("attempt #$_ failed, sleeping");
+ sleep($self->{timeout});
+
+ }
+ }
+ $self->debug('unable to reconnect!');
+ return undef;
+
+ } else {
+ return $self->request($frame);
+
+ }
+
+ } else {
+ return $self->request($frame);
+
+ }
+}
=pod
@@ -983,6 +1142,13 @@
sub request {
my ($self, $frame) = @_;
+ # Make sure we start with blank variables
+ $Code = undef;
+ $Error = '';
+ $Message = '';
+
+ $frame->clTRID->appendText(sha1_hex(ref($self).time().$$)) if (isa($frame, 'Net::EPP::Frame::Command'));
+
$self->debug(sprintf('sending a %s to the server', ref($frame)));
if (isa($frame, 'XML::LibXML::Document')) {
map { $self->debug('C: '.$_) } split(/\n/, $frame->toString(1));
@@ -991,11 +1157,11 @@
map { $self->debug('C: '.$_) } split(/\n/, $frame);
}
- $frame->clTRID->appendText(sha1_hex(ref($self).time().$$)) if (isa($frame, 'XML::LibXML::Node'));
+
my $response = $self->SUPER::request($frame);
- if (isa($response, 'XML::LibXML::Document')) {
- map { $self->debug('S: '.$_) } split(/\n/, $response->toString(1));
- }
+
+ map { $self->debug('S: '.$_) } split(/\n/, $response->toString(1)) if (isa($response, 'XML::LibXML::Document'));
+
return $response;
}
@@ -1011,19 +1177,20 @@
sub get_frame {
my $self = shift;
my $frame;
- $self->debug(sprintf('transmitting frame, waiting %d seconds before timeout', $self->{timeout}));
+ $self->debug(sprintf('reading frame, waiting %d seconds before timeout', $self->{timeout}));
eval {
local $SIG{ALRM} = sub { die "alarm\n" };
- $self->debug('setting alarm');
+ $self->debug('setting timeout alarm for receiving frame');
alarm($self->{timeout});
$frame = $self->SUPER::get_frame();
- $self->debug('unsetting alarm');
+ $self->debug('unsetting timeout alarm after successful receive');
alarm(0);
};
if ($@ ne '') {
- $self->debug('unsetting alarm');
+ $self->debug('unsetting timeout alarm after alarm was triggered');
alarm(0);
- $Error = "get_frame() timed out\n";
+ $Code = COMMAND_FAILED;
+ $Error = $Message = "get_frame() timed out\n";
return undef;
} else {
@@ -1065,6 +1232,7 @@
}
$self->debug('disconnecting from server');
$self->disconnect;
+ $self->{connected} = 0;
return 1;
}
@@ -1081,7 +1249,7 @@
=pod
-=head1 PACKAGE VARIABLES
+=head1 Package Variables
=head2 $Net::EPP::Simple::Error
Modified: branches/upstream/libnet-epp-perl/current/t/use.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-epp-perl/current/t/use.t?rev=49794&op=diff
==============================================================================
--- branches/upstream/libnet-epp-perl/current/t/use.t (original)
+++ branches/upstream/libnet-epp-perl/current/t/use.t Fri Jan 1 20:57:02 2010
@@ -4,6 +4,6 @@
use Test;
BEGIN { plan tests => 1 }
-use Net::EPP::Simple; ok(1);
+use Net::EPP; ok(1);
exit;
More information about the Pkg-perl-cvs-commits
mailing list