r61735 - in /trunk/libnet-opensrs-perl: Changes META.yml debian/changelog lib/Net/OpenSRS.pm

[ivan at users.alioth.debian.org]

Author: ivan
Date: Thu Aug 19 13:20:55 2010
New Revision: 61735

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=61735
Log:
new upstream release 0.05

Modified:
    trunk/libnet-opensrs-perl/Changes
    trunk/libnet-opensrs-perl/META.yml
    trunk/libnet-opensrs-perl/debian/changelog
    trunk/libnet-opensrs-perl/lib/Net/OpenSRS.pm

Modified: trunk/libnet-opensrs-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-opensrs-perl/Changes?rev=61735&op=diff
==============================================================================
--- trunk/libnet-opensrs-perl/Changes (original)
+++ trunk/libnet-opensrs-perl/Changes Thu Aug 19 13:20:55 2010
@@ -8,3 +8,10 @@
 0.03 Tue Sep 1 2009
     - Ugly fix for Expat parser error due to spaces in an element name
       in the OpenSRS renew domain response.
+
+0.04
+   -  Correct de-nastification to handle lists
+
+0.05 Sun Jun 27 16:54:23 EDT 2010
+   -  Correct de-nastification to handle single item dt_assoc
+      (eg belongs_to_rsp response)

Modified: trunk/libnet-opensrs-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-opensrs-perl/META.yml?rev=61735&op=diff
==============================================================================
--- trunk/libnet-opensrs-perl/META.yml (original)
+++ trunk/libnet-opensrs-perl/META.yml Thu Aug 19 13:20:55 2010
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:               Net-OpenSRS
-version:            0.03
+version:            0.05
 abstract:           Domain registration via the Tucows OpenSRS HTTPS XML API
 author:
     - Richard L. Siddall <opensrs at elirion.net>
@@ -20,7 +20,7 @@
     directory:
         - t
         - inc
-generated_by:       ExtUtils::MakeMaker version 6.54
+generated_by:       ExtUtils::MakeMaker version 6.56
 meta-spec:
     url:      http://module-build.sourceforge.net/META-spec-v1.4.html
     version:  1.4

Modified: trunk/libnet-opensrs-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-opensrs-perl/debian/changelog?rev=61735&op=diff
==============================================================================
--- trunk/libnet-opensrs-perl/debian/changelog (original)
+++ trunk/libnet-opensrs-perl/debian/changelog Thu Aug 19 13:20:55 2010
@@ -1,4 +1,4 @@
-libnet-opensrs-perl (0.03-2) UNRELEASED; urgency=low
+libnet-opensrs-perl (0.05-1) UNRELEASED; urgency=low
 
   * Take over for the Debian Perl Group
   * debian/control: Added: Vcs-Svn field (source stanza); Vcs-Browser
@@ -8,8 +8,9 @@
     debian at 420.am>); Ivan Kohler <ivan-debian at 420.am> moved to
     Uploaders.
   * Add debian/watch.
+  * New upstream release
 
- -- Ivan Kohler <ivan-debian at 420.am>  Thu, 19 Aug 2010 06:10:40 -0700
+ -- Ivan Kohler <ivan-debian at 420.am>  Thu, 19 Aug 2010 06:19:23 -0700
 
 libnet-opensrs-perl (0.03-1) unstable; urgency=low
 

Modified: trunk/libnet-opensrs-perl/lib/Net/OpenSRS.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-opensrs-perl/lib/Net/OpenSRS.pm?rev=61735&op=diff
==============================================================================
--- trunk/libnet-opensrs-perl/lib/Net/OpenSRS.pm (original)
+++ trunk/libnet-opensrs-perl/lib/Net/OpenSRS.pm Thu Aug 19 13:20:55 2010
@@ -150,7 +150,7 @@
 use Digest::MD5;
 use Date::Calc qw/ Add_Delta_Days Today This_Year /;
 
-our $VERSION = '0.03';
+our $VERSION = '0.05';
 my $rv;
 *hash = \&Digest::MD5::md5_hex;
 
@@ -1166,7 +1166,13 @@
         my $rslt = $res->content;
         # OpenSRS renew response triggers Expat parser error due to spaces in element name
         $rslt =~ s/registration expiration date/registration_expiration_date/g;
-        eval { $struct = XML::Simple::XMLin( $rslt ); };
+
+        eval { $struct = XML::Simple::XMLin(
+                 $rslt,
+                 'KeyAttr' => [ 'dt_assoc' ],
+                 'GroupTags' => { 'dt_assoc' => 'item',  'dt_array' => 'item' },
+               );
+        };
 
         if ($self->debug_level > 1) {
             $self->debug("\nOpenSRS Response XML:\n" . '-' x 30);
@@ -1176,10 +1182,7 @@
 
         # get the struct looking just how we want it.
         # (de-nastify it.)
-        $xml = XML::Simple::XMLout( $struct->{body}->{data_block}->{dt_assoc}->{item} );
-        $struct = XML::Simple::XMLin( $xml );
-        $xml = XML::Simple::XMLout( $struct->{attributes}->{item} );
-        $struct->{attributes} = XML::Simple::XMLin( $xml );
+        (undef, $struct) = _denastify( $struct->{body}->{data_block} );
     }
     else {
         $self->debug("HTTP error: " . $res->status_line);
@@ -1229,6 +1232,37 @@
     return $xml;
 }
 
+sub _denastify {
+    my ($arg) = ( shift );
+
+    if ( 0 ) {
+      eval { use Data::Dumper };
+      warn $@ if $@;
+      warn "_denastify\n". Dumper($arg) unless $@;
+    }
+
+    if ( ref($arg) eq 'HASH' ) {
+        my $value;
+        if ( exists( $arg->{content} ) ) {
+            $value = $arg->{content};
+        } elsif ( exists( $arg->{dt_array} ) ) {
+            my $array = $arg->{dt_array};
+            $array = [ $array ] unless ref($array) eq 'ARRAY';
+            $value = [ map {
+                               { map { _denastify($_) } @{ $_->{dt_assoc} } }
+                           }
+                       @$array
+                     ];
+        } elsif ( exists( $arg->{dt_assoc} ) ) {
+            my $array = $arg->{dt_assoc};
+            $array = [ $array ] unless ref($array) eq 'ARRAY';
+            $value = { map { _denastify($_) } @$array };
+        }
+        return ( $arg->{key} => $value );
+    }
+    ();
+}
+
 =back
 
 =head1 Author