From 8a2d02dd9a6fff7afed6d9f46043b5e8da07dc1d Mon Sep 17 00:00:00 2001 From: pines Date: Thu, 11 Aug 2005 19:09:25 +0000 Subject: [PATCH] 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 --- src/perlmods/OpenSRF/AppSession.pm | 8 ++-- src/perlmods/OpenSRF/DomainObject/oilsMessage.pm | 40 +++++++++++-------- src/perlmods/OpenSRF/DomainObject/oilsMethod.pm | 46 +++++++++------------- src/perlmods/OpenSRF/DomainObject/oilsResponse.pm | 38 +++++++++--------- src/perlmods/OpenSRF/Transport.pm | 16 ++++---- .../OpenSRF/Transport/SlimJabber/MessageWrapper.pm | 6 +-- 6 files changed, 77 insertions(+), 77 deletions(-) diff --git a/src/perlmods/OpenSRF/AppSession.pm b/src/perlmods/OpenSRF/AppSession.pm index 80e62c2..25f028a 100644 --- 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 --- 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. 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 --- 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 --- 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 --- 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 --- 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 ); } -- 2.11.0