r49796 - in /trunk/libnet-epp-perl: ./ debian/ debian/patches/ 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 21:04:00 UTC 2010
Author: jawnsy-guest
Date: Fri Jan 1 21:03:13 2010
New Revision: 49796
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=49796
Log:
prepare for release
Added:
trunk/libnet-epp-perl/lib/Net/EPP.pm
- copied unchanged from r49795, branches/upstream/libnet-epp-perl/current/lib/Net/EPP.pm
trunk/libnet-epp-perl/lib/Net/EPP/Frame/Command/Create/Domain.pm
- copied unchanged from r49795, branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Command/Create/Domain.pm
trunk/libnet-epp-perl/lib/Net/EPP/Frame/Command/Create/Host.pm
- copied unchanged from r49795, branches/upstream/libnet-epp-perl/current/lib/Net/EPP/Frame/Command/Create/Host.pm
Modified:
trunk/libnet-epp-perl/Makefile.PL
trunk/libnet-epp-perl/debian/README.source
trunk/libnet-epp-perl/debian/changelog
trunk/libnet-epp-perl/debian/control
trunk/libnet-epp-perl/debian/copyright
trunk/libnet-epp-perl/debian/patches/01-manpages.patch
trunk/libnet-epp-perl/debian/rules
trunk/libnet-epp-perl/lib/Net/EPP/Client.pm
trunk/libnet-epp-perl/lib/Net/EPP/Frame.pm
trunk/libnet-epp-perl/lib/Net/EPP/Frame/Command/Create.pm
trunk/libnet-epp-perl/lib/Net/EPP/Frame/Command/Login.pm
trunk/libnet-epp-perl/lib/Net/EPP/Frame/Response.pm
trunk/libnet-epp-perl/lib/Net/EPP/Protocol.pm
trunk/libnet-epp-perl/lib/Net/EPP/Simple.pm
trunk/libnet-epp-perl/t/use.t
Modified: trunk/libnet-epp-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-epp-perl/Makefile.PL?rev=49796&op=diff
==============================================================================
--- trunk/libnet-epp-perl/Makefile.PL (original)
+++ trunk/libnet-epp-perl/Makefile.PL Fri Jan 1 21:03:13 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,
Modified: trunk/libnet-epp-perl/debian/README.source
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-epp-perl/debian/README.source?rev=49796&op=diff
==============================================================================
--- trunk/libnet-epp-perl/debian/README.source (original)
+++ trunk/libnet-epp-perl/debian/README.source Fri Jan 1 21:03:13 2010
@@ -1,17 +1,5 @@
-The libnet-epp-perl package uses quilt to maintain local changes to
-the libnet-epp-perl distribution. The Debian-specific patches are
-maintained in the debian/patches/ directory.
-
-To apply all the patches, preparing the source for building, use:
- debian/rules patch
-
-To revert the patches, preparing to build a source package, use:
- debian/rules unpatch
-
-You do not need to manually execute these targets when building
-the package; they are part of the debian/rules target chain.
-
-For more information on the quilt integration with Debian packages,
-as well as editing, adding or removing patches, please see
-the quilt documentation; in recent versions of the Debian package of
-quilt, start at the /usr/share/doc/quilt/README.source file.
+This package uses quilt to manage all modifications to the upstream
+source. Changes are stored in the source package as diffs in
+debian/patches and applied during the build.
+
+See /usr/share/doc/quilt/README.source for a detailed explanation.
Modified: trunk/libnet-epp-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-epp-perl/debian/changelog?rev=49796&op=diff
==============================================================================
--- trunk/libnet-epp-perl/debian/changelog (original)
+++ trunk/libnet-epp-perl/debian/changelog Fri Jan 1 21:03:13 2010
@@ -1,27 +1,5 @@
-libnet-epp-perl (0.12-1) UNRELEASED; urgency=low
+libnet-epp-perl (0.13-1) UNRELEASED; urgency=low
- [ Peter Pentchev ]
- TODO:
- - debian/rules:
- I think the "patch unpatch" target is not needed, "dh --with quilt" with
- the correct versions of debhelper and quilt does this automagically
- (and looking at the build log, they don't seem to be used)
- hm, or are they there because they are mentioned in README.source? that
- could also be changed by mentioning quilt push/pop or just using our
- default README.source template :)
- - debian/control:
- + we need debhelper >= 7.0.8 for the "--with" feature
- + remove the unversioned perl-modules from B-D-I and depends (yes, someone
- should fix dh-make-perl)
- - debian/copyright:
- + adding (a) year(s) to upstream copyright is recommended
- if possible (looks like "2009" in this case)
- + "Upstream-Maintainer" in the header would be nice, if possible
+ * Initial Release (Closes: #545480)
- * Initial Release. Closes: #545480
-
- [ gregor herrmann ]
- * debian/control: Changed: (build-)depend on perl instead of perl-
- modules.
-
- -- Peter Pentchev <roam at ringlet.net> Wed, 16 Sep 2009 13:21:28 +0300
+ -- Jonathan Yu <jawnsy at cpan.org> Fri, 01 Jan 2010 16:00:12 -0500
Modified: trunk/libnet-epp-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-epp-perl/debian/control?rev=49796&op=diff
==============================================================================
--- trunk/libnet-epp-perl/debian/control (original)
+++ trunk/libnet-epp-perl/debian/control Fri Jan 1 21:03:13 2010
@@ -1,11 +1,11 @@
Source: libnet-epp-perl
Section: perl
Priority: optional
-Build-Depends: debhelper (>= 7), quilt (>= 0.46-7)
-Build-Depends-Indep: perl, libio-socket-ssl-perl,
- libdigest-sha1-perl, libxml-libxml-perl
+Build-Depends: debhelper (>= 7.0.8), quilt (>= 0.46-7)
+Build-Depends-Indep: perl, libio-socket-ssl-perl, libdigest-sha1-perl,
+ libxml-libxml-perl
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
-Uploaders: Peter Pentchev <roam at ringlet.net>
+Uploaders: Jonathan Yu <jawnsy at cpan.org>
Standards-Version: 3.8.3
Homepage: http://search.cpan.org/dist/Net-EPP/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libnet-epp-perl/
@@ -13,9 +13,9 @@
Package: libnet-epp-perl
Architecture: all
-Depends: ${perl:Depends}, ${misc:Depends},
- libio-socket-ssl-perl, libdigest-sha1-perl, libxml-libxml-perl
-Description: EPP XML frame system built on top of XML::LibXML
+Depends: ${perl:Depends}, ${misc:Depends}, libio-socket-ssl-perl,
+ libdigest-sha1-perl, libxml-libxml-perl
+Description: EPP XML frame system built on XML::LibXML
EPP is the Extensible Provisioning Protocol. EPP (defined in RFC 4930) is an
application layer client-server protocol for the provisioning and management
of objects stored in a shared central repository. Specified in XML, the
Modified: trunk/libnet-epp-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-epp-perl/debian/copyright?rev=49796&op=diff
==============================================================================
--- trunk/libnet-epp-perl/debian/copyright (original)
+++ trunk/libnet-epp-perl/debian/copyright Fri Jan 1 21:03:13 2010
@@ -3,7 +3,7 @@
Name: Net-EPP
Files: *
-Copyright: CentralNic Ltd (http://www.centralnic.com/).
+Copyright: 2009, CentralNic Ltd <http://www.centralnic.com/>
License-Alias: Perl
License: Artistic | GPL-1+
Modified: trunk/libnet-epp-perl/debian/patches/01-manpages.patch
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-epp-perl/debian/patches/01-manpages.patch?rev=49796&op=diff
==============================================================================
--- trunk/libnet-epp-perl/debian/patches/01-manpages.patch (original)
+++ trunk/libnet-epp-perl/debian/patches/01-manpages.patch Fri Jan 1 21:03:13 2010
@@ -96,7 +96,7 @@
=item AUTH_FAILED_BYE (2501)
--- a/lib/Net/EPP/Simple.pm
+++ b/lib/Net/EPP/Simple.pm
-@@ -248,6 +248,8 @@
+@@ -266,6 +266,8 @@
=pod
Modified: trunk/libnet-epp-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-epp-perl/debian/rules?rev=49796&op=diff
==============================================================================
--- trunk/libnet-epp-perl/debian/rules (original)
+++ trunk/libnet-epp-perl/debian/rules Fri Jan 1 21:03:13 2010
@@ -1,7 +1,4 @@
#!/usr/bin/make -f
-
-patch unpatch:
- $(MAKE) -f /usr/share/quilt/quilt.make $@
%:
dh --with quilt $@
Modified: trunk/libnet-epp-perl/lib/Net/EPP/Client.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-epp-perl/lib/Net/EPP/Client.pm?rev=49796&op=diff
==============================================================================
--- trunk/libnet-epp-perl/lib/Net/EPP/Client.pm (original)
+++ trunk/libnet-epp-perl/lib/Net/EPP/Client.pm Fri Jan 1 21:03:13 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: trunk/libnet-epp-perl/lib/Net/EPP/Frame.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-epp-perl/lib/Net/EPP/Frame.pm?rev=49796&op=diff
==============================================================================
--- trunk/libnet-epp-perl/lib/Net/EPP/Frame.pm (original)
+++ trunk/libnet-epp-perl/lib/Net/EPP/Frame.pm Fri Jan 1 21:03:13 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: trunk/libnet-epp-perl/lib/Net/EPP/Frame/Command/Create.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-epp-perl/lib/Net/EPP/Frame/Command/Create.pm?rev=49796&op=diff
==============================================================================
--- trunk/libnet-epp-perl/lib/Net/EPP/Frame/Command/Create.pm (original)
+++ trunk/libnet-epp-perl/lib/Net/EPP/Frame/Command/Create.pm Fri Jan 1 21:03:13 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;
Modified: trunk/libnet-epp-perl/lib/Net/EPP/Frame/Command/Login.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-epp-perl/lib/Net/EPP/Frame/Command/Login.pm?rev=49796&op=diff
==============================================================================
--- trunk/libnet-epp-perl/lib/Net/EPP/Frame/Command/Login.pm (original)
+++ trunk/libnet-epp-perl/lib/Net/EPP/Frame/Command/Login.pm Fri Jan 1 21:03:13 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: trunk/libnet-epp-perl/lib/Net/EPP/Frame/Response.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-epp-perl/lib/Net/EPP/Frame/Response.pm?rev=49796&op=diff
==============================================================================
--- trunk/libnet-epp-perl/lib/Net/EPP/Frame/Response.pm (original)
+++ trunk/libnet-epp-perl/lib/Net/EPP/Frame/Response.pm Fri Jan 1 21:03:13 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: trunk/libnet-epp-perl/lib/Net/EPP/Protocol.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-epp-perl/lib/Net/EPP/Protocol.pm?rev=49796&op=diff
==============================================================================
--- trunk/libnet-epp-perl/lib/Net/EPP/Protocol.pm (original)
+++ trunk/libnet-epp-perl/lib/Net/EPP/Protocol.pm Fri Jan 1 21:03:13 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: trunk/libnet-epp-perl/lib/Net/EPP/Simple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-epp-perl/lib/Net/EPP/Simple.pm?rev=49796&op=diff
==============================================================================
--- trunk/libnet-epp-perl/lib/Net/EPP/Simple.pm (original)
+++ trunk/libnet-epp-perl/lib/Net/EPP/Simple.pm Fri Jan 1 21:03:13 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: trunk/libnet-epp-perl/t/use.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-epp-perl/t/use.t?rev=49796&op=diff
==============================================================================
--- trunk/libnet-epp-perl/t/use.t (original)
+++ trunk/libnet-epp-perl/t/use.t Fri Jan 1 21:03:13 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