From 22b26a2d13ed0c559fa84c6d65e7a76997459902 Mon Sep 17 00:00:00 2001 From: Galen Charlton Date: Thu, 20 Oct 2022 18:17:13 -0400 Subject: [PATCH] LP#1993754: fix XML-RPC gateway's handling of Fieldmapper objects This patch improves the handling of Fieldmapper objects by the XML-RPC gateway by: - enabling support for the XML-RPC nil extension, thereby allowing null values to be correcty passed back and forth rather than converting them to empty strings - fixing the de-serialization of Fieldmapper objects; this allows a Fieldmapper object returned by one XML-RPC call to be modified and consumed by a second one To test ------- [1] Apply the patch but do not restart Apache. [2] Run the new test script test-xml-rpc-patron-update.pl to try update a patron record; note that the update fails. [3] Restart or reload Apache and repeat step 2; this time, the patron update should succeed. Note that the test script may need minor modification to work on your local testing environment. Signed-off-by: Galen Charlton --- .../src/perlmods/lib/OpenILS/WWW/XMLRPCGateway.pm | 4 +- .../test-scripts/test-xml-rpc-patron-update.pl | 116 +++++++++++++++++++++ 2 files changed, 118 insertions(+), 2 deletions(-) create mode 100755 Open-ILS/src/support-scripts/test-scripts/test-xml-rpc-patron-update.pl diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/XMLRPCGateway.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/XMLRPCGateway.pm index 43e99e4a61..3190869910 100644 --- a/Open-ILS/src/perlmods/lib/OpenILS/WWW/XMLRPCGateway.pm +++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/XMLRPCGateway.pm @@ -48,6 +48,7 @@ sub child_init { OpenILS::Utils::Fieldmapper->require; Fieldmapper->import(IDL => $idl); OpenSRF::AppSession->ingress('apache'); + $RPC::XML::ALLOW_NIL = 1; return Apache2::Const::OK; } @@ -152,8 +153,7 @@ sub unwrap_perl { if( defined($obj->{$CLASS_KEY})) { my $class = $obj->{$CLASS_KEY}; if( $obj = unwrap_perl($obj->{$PAYLOAD_KEY}) ) { - return bless(\$obj, $class) unless ref($obj); - return bless( $obj, $class ); + return Fieldmapper::class_for_hint($class)->from_bare_hash($obj); } return undef; } diff --git a/Open-ILS/src/support-scripts/test-scripts/test-xml-rpc-patron-update.pl b/Open-ILS/src/support-scripts/test-scripts/test-xml-rpc-patron-update.pl new file mode 100755 index 0000000000..a086f3c3a3 --- /dev/null +++ b/Open-ILS/src/support-scripts/test-scripts/test-xml-rpc-patron-update.pl @@ -0,0 +1,116 @@ +#!/usr/bin/perl +use strict; use warnings; + +use Digest::MD5 qw(md5_hex); +use RPC::XML qw/smart_encode/; +use RPC::XML::Client; +use Data::Dumper; # for debugging +$RPC::XML::ALLOW_NIL = 1; + +die "usage: $0 \n" unless $ARGV[4]; + + +# some example query params +my $host = shift; +my $location = shift; +my $username = shift; +my $password = shift; +my $barcode = shift; + + +$host = "http://$host/xml-rpc"; + +# -------------------------------------------------------------------- +# Login to the system so we can get an authentication token +# -------------------------------------------------------------------- +my $authkey = login( $username, $password ); + +# -------------------------------------------------------------------- +# Grab a patron by barcode +# -------------------------------------------------------------------- +my $resp = request( + 'open-ils.actor', + 'open__ils.actor.user.fleshed.retrieve_by_barcode', + $authkey, $barcode); + + + +# -------------------------------------------------------------------- +# Get the Perl-ized version of the data +# -------------------------------------------------------------------- +my $user_data = $resp->value; + +# bump up the expiration date by a year +my $expire_date = $user_data->{__data__}->{expire_date}; +print "Original expire date: $expire_date\n"; + +my $expire_year = substr($expire_date, 0, 4); +$expire_year = sprintf('%-04.4d', int($expire_year) + 1); +substr($expire_date, 0, 4) = $expire_year; +print "New expire date: $expire_date\n"; + +$user_data->{__data__}->{expire_date} = $expire_date; +$user_data->{__data__}->{ischanged} = 't'; + +# and manipulate any addresses... +foreach my $addr (@{ $user_data->{__data__}->{addresses} }) { + $addr->{__data__}->{street1} .= 'Z'; + $addr->{__data__}->{ischanged} = 't'; +} + +my $update_resp = request( + 'open-ils.actor', + 'open__ils.actor.patron.update', + $authkey, $user_data); + +# -------------------------------------------------------------------- +# This sends an XML-RPC request and returns the RPC::XML::response +# object. +# $resp->value gives the Perl, +# $resp->as_string gives the XML +# -------------------------------------------------------------------- +sub request { + my( $service, $method, @args ) = @_; + my $connection = RPC::XML::Client->new("$host/$service", useragent => [ssl_opts => {verify_hostname => 0}]); + my $resp = $connection->send_request($method, smart_encode(@args)); + return $resp; +} + + + + + +# -------------------------------------------------------------------- +# Login +# -------------------------------------------------------------------- +sub login { + my( $username, $password ) = @_; + + my $seed = request( + 'open-ils.auth', + 'open__ils.auth.authenticate.init', $username )->value; + + die "No auth seed returned\n" unless $seed; + + my $response = request( + 'open-ils.auth', + 'open__ils.auth.authenticate.complete', + { + username => $username, + password => md5_hex($seed . md5_hex($password)), + type => 'opac', + } + )->value; + + die "No login response returned\n" unless $response; + + my $key = $response->{payload}->{authtoken}; + + die "Login failed\n" unless $key; + + warn $key; + + return $key; +} + + -- 2.11.0