moving from XML to JSON in the core messaging

git-svn-id: svn://svn.open-ils.org/OpenSRF/trunk@469 9efc2488-bf62-4759-914b-345cdb29e865

diff --git a/src/perlmods/OpenSRF/AppSession.pm b/src/perlmods/OpenSRF/AppSession.pm
index 80e62c2..25f028a 100644 (file)
--- a/src/perlmods/OpenSRF/AppSession.pm
+++ b/src/perlmods/OpenSRF/AppSession.pm
@@ -482,7 +482,7 @@ sub send {
                return undef; 
        }
 
-       my $doc = OpenSRF::DOM->createDocument();
+       my @doc = ();
 
        $logger->debug( "In send2", INTERNAL );
 
@@ -533,7 +533,7 @@ sub send {
                $msg->api_level($self->api_level);
                $msg->payload($payload) if $payload;
        
-               $doc->documentElement->appendChild( $msg );
+               push @doc, $msg;
 
        
                $logger->debug( "AppSession sending ".$msg->type." to ".$self->remote_id.
@@ -568,13 +568,13 @@ sub send {
                }
 
        } 
-       $logger->debug( "AppSession sending doc: " . $doc->toString(), INTERNAL );
+       $logger->debug( "AppSession sending doc: " . JSON->perl2JSON(\@doc), INTERNAL );
 
 
        $self->{peer_handle}->send( 
                                        to     => $self->remote_id,
                                   thread => $self->session_id,
-                                  body   => $doc->toString );
+                                  body   => JSON->perl2JSON(\@doc) );
 
        if( $disconnect) {
                $self->state( DISCONNECTED );

diff --git a/src/perlmods/OpenSRF/DomainObject/oilsMessage.pm b/src/perlmods/OpenSRF/DomainObject/oilsMessage.pm
index e599f6e..f3f6daa 100644 (file)
--- a/src/perlmods/OpenSRF/DomainObject/oilsMessage.pm
+++ b/src/perlmods/OpenSRF/DomainObject/oilsMessage.pm
@@ -1,11 +1,21 @@
 package OpenSRF::DomainObject::oilsMessage;
-use base 'OpenSRF::DomainObject';
+use JSON;
 use OpenSRF::AppSession;
 use OpenSRF::DomainObject::oilsResponse qw/:status/;
 use OpenSRF::Utils::Logger qw/:level/;
 use warnings; use strict;
 use OpenSRF::EX qw/:try/;
 
+JSON->register_class_hint(hint => 'osrfMessage', class => 'OpenSRF::DomainObject::oilsMessage');
+
+sub toString {
+       my $self = shift;
+       my $pretty = shift;
+       return JSON->perl2prettyJSON($self) if ($pretty);
+       return JSON->perl2JSON($self);
+}
+
+
 =head1 NAME
 
 OpenSRF::DomainObject::oilsMessage
@@ -44,7 +54,9 @@ B<CONNECT, REQUEST, RESULT, STATUS, ERROR, or DISCONNECT>.
 
 sub type {
        my $self = shift;
-       return $self->_attr_get_set( type => shift );
+       my $val = shift;
+       $self->{type} = $val if (defined $val);
+       return $self->{type};
 }
 
 =head2 OpenSRF::DomainObject::oilsMessage->api_level( [$new_api_level] )
@@ -62,7 +74,9 @@ REQUEST message.
 
 sub api_level {
        my $self = shift;
-       return $self->_attr_get_set( api_level => shift );
+       my $val = shift;
+       $self->{api_level} = $val if (defined $val);
+       return $self->{api_level};
 }
 
 =head2 OpenSRF::DomainObject::oilsMessage->threadTrace( [$new_threadTrace] );
@@ -78,7 +92,9 @@ for a message.  Useful as a debugging aid, but that's about it.
 
 sub threadTrace {
        my $self = shift;
-       return $self->_attr_get_set( threadTrace => shift );
+       my $val = shift;
+       $self->{threadTrace} = $val if (defined $val);
+       return $self->{threadTrace};
 }
 
 =head2 OpenSRF::DomainObject::oilsMessage->update_threadTrace
@@ -119,17 +135,9 @@ of (sub)type domainObject or domainObjectCollection.
 
 sub payload {
        my $self = shift;
-       my $new_pl = shift;
-
-       my ($payload) = $self->getChildrenByTagName('oils:domainObjectCollection') ||
-                               $self->getChildrenByTagName('oils:domainObject');
-       if ($new_pl) {
-               $payload = $self->removeChild($payload) if ($payload);
-               $self->appendChild($new_pl);
-               return $new_pl unless ($payload);
-       }
-
-       return OpenSRF::DOM::upcast($payload)->upcast if ($payload);
+       my $val = shift;
+       $self->{payload} = $val if (defined $val);
+       return $self->{payload};
 }
 
 =head2 OpenSRF::DomainObject::oilsMessage->handler( $session_id )
@@ -292,7 +300,7 @@ sub do_client {
                # This should be changed to check the type of response (is it a connectException?, etc.)
        }
 
-       if( $self->payload and $self->payload->class->isa( "OpenSRF::EX" ) ) { 
+       if( $self->payload and $self->payload->isa( "OpenSRF::EX" ) ) { 
                $self->payload->throw();
        }
 

diff --git a/src/perlmods/OpenSRF/DomainObject/oilsMethod.pm b/src/perlmods/OpenSRF/DomainObject/oilsMethod.pm
index 2b3509d..16134a4 100644 (file)
--- a/src/perlmods/OpenSRF/DomainObject/oilsMethod.pm
+++ b/src/perlmods/OpenSRF/DomainObject/oilsMethod.pm
@@ -1,8 +1,15 @@
 package OpenSRF::DomainObject::oilsMethod;
-use OpenSRF::DOM::Element::params;
-#use OpenSRF::DOM::Element::param;
+
 use JSON;
-use base 'OpenSRF::DomainObject';
+JSON->register_class_hint(hint => 'osrfMethod', class => 'OpenSRF::DomainObject::oilsMethod');
+
+sub toString {
+       my $self = shift;
+       my $pretty = shift;
+       return JSON->perl2prettyJSON($self) if ($pretty);
+       return JSON->perl2JSON($self);
+}
+
 
 =head1 NAME
 
@@ -36,7 +43,9 @@ oilsMethod object.
 
 sub method {
        my $self = shift;
-       return $self->_attr_get_set( method => shift );
+       my $val = shift;
+       $self->{method} = $val if (defined $val);
+       return $self->{method};
 }
 
 =head2 OpenSRF::DomainObject::oilsMethod->return_type( [$new_return_type] )
@@ -56,10 +65,12 @@ used as a suggestion when more than one return type or format is possible.
 
 sub return_type {
        my $self = shift;
-       return $self->_attr_get_set( return_type => shift );
+       my $val = shift;
+       $self->{return_type} = $val if (defined $val);
+       return $self->{return_type};
 }
 
-=head2 OpenSRF::DomainObject::oilsMethod->params( [@new_params] )
+=head2 OpenSRF::DomainObject::oilsMethod->params( @new_params )
 
 =over 4
 
@@ -74,27 +85,8 @@ parameters, or DOM nodes of any type.
 sub params {
        my $self = shift;
        my @args = @_;
-
-       my ($old_params) = $self->getChildrenByTagName('oils:params');
-
-       my $params;
-       if (@args) {
-
-               $self->removeChild($old_params) if ($old_params);
-
-               my $params = OpenSRF::DOM::Element::params->new;
-               $self->appendChild($params);
-               $params->appendTextNode( JSON->perl2JSON( \@args ) );
-
-               $old_params = $params unless ($old_params);
-       }
-
-       if ($old_params) {
-               $params = JSON->JSON2perl( $old_params->textContent );
-               return @$params;
-       }
-
-       return @args;
+       $self->{params} = \@args if (@args);
+       return @{ $self->{params} };
 }
 
 1;

diff --git a/src/perlmods/OpenSRF/DomainObject/oilsResponse.pm b/src/perlmods/OpenSRF/DomainObject/oilsResponse.pm
index 3d95c6e..59f6138 100644 (file)
--- a/src/perlmods/OpenSRF/DomainObject/oilsResponse.pm
+++ b/src/perlmods/OpenSRF/DomainObject/oilsResponse.pm
@@ -2,9 +2,11 @@ package OpenSRF::DomainObject::oilsResponse;
 use vars qw/@EXPORT_OK %EXPORT_TAGS/;
 use Exporter;
 use JSON;
-use base qw/OpenSRF::DomainObject Exporter/;
+use base qw/Exporter/;
 use OpenSRF::Utils::Logger qw/:level/;
 
+JSON->register_class_hint( hint => 'osrfResponse', class => 'OpenSRF::DomainObject::oilsResponse' );
+
 BEGIN {
 @EXPORT_OK = qw/STATUS_CONTINUE STATUS_OK STATUS_ACCEPTED
                                        STATUS_BADREQUEST STATUS_UNAUTHORIZED STATUS_FORBIDDEN
@@ -69,6 +71,13 @@ sub STATUS_VERSIONNOTSUPPORTED       { return 505 }
 
 my $log = 'OpenSRF::Utils::Logger';
 
+sub toString {
+       my $self = shift;
+       my $pretty = shift;
+       return JSON->perl2prettyJSON($self) if ($pretty);
+       return JSON->perl2JSON($self);
+}
+
 sub new {
        my $class = shift;
        $class = ref($class) || $class;
@@ -80,17 +89,21 @@ sub new {
                        statusCode => $default_statusCode,
                        @_ );
        
-       return $class->SUPER::new( %args );
+       return bless( \%args => $class );
 }
 
 sub status {
        my $self = shift;
-       return $self->_attr_get_set( status => shift );
+       my $val = shift;
+       $self->{status} = $val if (defined $val);
+       return $self->{status};
 }
 
 sub statusCode {
        my $self = shift;
-       return $self->_attr_get_set( statusCode => shift );
+       my $val = shift;
+       $self->{statusCode} = $val if (defined $val);
+       return $self->{statusCode};
 }
 
 
@@ -253,21 +266,10 @@ of (sub)type domainObject or domainObjectCollection.
 
 sub content {
         my $self = shift;
-       my $new_content = shift;
-
-       my ($content) = $self->getChildrenByTagName('oils:domainObject');
-
-       if (defined $new_content) {
-               $new_content = OpenSRF::DomainObject::oilsScalar->new( JSON->perl2JSON( $new_content ) );
-
-               $self->removeChild($content) if ($content);
-               $self->appendChild($new_content);
-       }
-
-
-       $new_content = $content if ($content);
+       my $val = shift;
 
-       return JSON->JSON2perl($new_content->textContent) if $new_content;
+       $self->{content} = $val if (defined $val);
+       return $self->{content};
 }
 
 =head1 SEE ALSO

diff --git a/src/perlmods/OpenSRF/Transport.pm b/src/perlmods/OpenSRF/Transport.pm
index 09950fd..eda097d 100644 (file)
--- a/src/perlmods/OpenSRF/Transport.pm
+++ b/src/perlmods/OpenSRF/Transport.pm
@@ -2,7 +2,6 @@ package OpenSRF::Transport;
 use strict; use warnings;
 use base 'OpenSRF';
 use Time::HiRes qw/time/;
-use OpenSRF::DOM;
 use OpenSRF::AppSession;
 use OpenSRF::Utils::Logger qw(:level);
 use OpenSRF::DomainObject::oilsResponse qw/:status/;
@@ -119,14 +118,14 @@ sub handler {
                throw OpenSRF::EX::Session ("Transport::handler(): No AppSession object returned from server_build()");
        }
 
-       # Create a document from the XML contained within the message 
+       # Create a document from the JSON contained within the message 
        my $doc; 
-       eval { $doc = OpenSRF::DOM->new->parse_string($body); };
+       eval { $doc = JSON->JSON2perl($body); };
        if( $@ ) {
 
-               $logger->transport( "Received bogus XML", INFO );
-               $logger->transport( "Bogus XML data: \n $body \n", INTERNAL );
-               my $res = OpenSRF::DomainObject::oilsXMLParseError->new( status => "XML Parse Error --- $body" );
+               $logger->transport( "Received bogus JSON: $@", INFO );
+               $logger->transport( "Bogus JSON data: \n $body \n", INTERNAL );
+               my $res = OpenSRF::DomainObject::oilsXMLParseError->new( status => "JSON Parse Error --- $body\n\n$@" );
 
                $app_session->status($res);
                #$app_session->kill_me;
@@ -157,7 +156,7 @@ sub handler {
 
        # cycle through and pass each oilsMessage contained in the message
        # up to the message layer for processing.
-       for my $msg ($doc->documentElement->childNodes) {
+       for my $msg (@$doc) {
 
                $logger->transport( 
                                "Transport::handler()passing to message handler \n".$msg->toString(1), DEBUG );
@@ -166,8 +165,7 @@ sub handler {
                                "Transport passing up ".$msg->type." from ".
                                $app_session->remote_id . " with threadTrace [" . $msg->threadTrace."]", INFO );
 
-               next unless (   $msg->nodeName eq 'oils:domainObject' &&
-                               $msg->getAttribute('name') eq 'oilsMessage' );
+               next unless (   $msg && UNIVERSAL::isa($msg => 'OpenSRF::DomainObject::oilsMessage'));
 
                if( $app_session->endpoint == $app_session->SERVER() ) {
 

diff --git a/src/perlmods/OpenSRF/Transport/SlimJabber/MessageWrapper.pm b/src/perlmods/OpenSRF/Transport/SlimJabber/MessageWrapper.pm
index 1dd25fd..3711e6c 100644 (file)
--- a/src/perlmods/OpenSRF/Transport/SlimJabber/MessageWrapper.pm
+++ b/src/perlmods/OpenSRF/Transport/SlimJabber/MessageWrapper.pm
@@ -1,5 +1,5 @@
 package OpenSRF::Transport::SlimJabber::MessageWrapper;
-use OpenSRF::DOM;
+use XML::LibXML;
 
 sub new {
        my $class = shift;
@@ -9,10 +9,10 @@ sub new {
 
        my ($doc, $msg);
        if ($xml) {
-               $doc = OpenSRF::DOM->new->parse_string($xml);
+               $doc = XML::LibXML->new->parse_string($xml);
                $msg = $doc->documentElement;
        } else {
-               $doc = OpenSRF::DOM->createDocument;
+               $doc = XML::LibXML::Document->createDocument;
                $msg = $doc->createElement( 'message' );
                $doc->documentElement->appendChild( $msg );
        }