From 86770156239f6c103b695bce1185da3556413db9 Mon Sep 17 00:00:00 2001
From: Bill Erickson <berick@esilibrary.com>
Date: Mon, 27 Oct 2014 17:18:46 -0400
Subject: [PATCH] Simple RPC/XML user retrieval example

Signed-off-by: Bill Erickson <berick@esilibrary.com>
---
 .../src/support-scripts/test-scripts/rpc_xml.pl    | 90 ++++++++++++++++++++++
 1 file changed, 90 insertions(+)
 create mode 100755 Open-ILS/src/support-scripts/test-scripts/rpc_xml.pl

diff --git a/Open-ILS/src/support-scripts/test-scripts/rpc_xml.pl b/Open-ILS/src/support-scripts/test-scripts/rpc_xml.pl
new file mode 100755
index 0000000000..81687ee80f
--- /dev/null
+++ b/Open-ILS/src/support-scripts/test-scripts/rpc_xml.pl
@@ -0,0 +1,90 @@
+#!/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
+
+die "usage: $0 <host> <barcode> <password>\n" unless $ARGV[2];
+
+# some example query params
+my $host     = shift;
+my $barcode  = shift;
+my $password = shift;
+
+$host = "http://$host/xml-rpc/";
+
+# --------------------------------------------------------------------
+# 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");
+    my $resp = $connection->send_request($method, smart_encode(@args));
+    return $resp;
+}
+
+
+# --------------------------------------------------------------------
+# Login 
+# --------------------------------------------------------------------
+sub login {
+    my( $barcode, $password ) = @_;
+
+    my $seed = request( 
+        'open-ils.auth',
+        'open__ils.auth.authenticate.init', $barcode )->value;
+
+    die "No auth seed returned\n" unless $seed;
+
+    my $response = request(
+        'open-ils.auth', 
+        'open__ils.auth.authenticate.complete', 
+        {    
+            barcode  => $barcode, 
+            password => md5_hex($seed . md5_hex($password)), 
+            type     => 'temp',
+        }
+    )->value;
+
+    die "No login response returned\n" unless $response;
+
+    my $key = $response->{payload}->{authtoken};
+
+    die "Login failed\n" unless $key;
+
+    return $key;
+}
+
+
+
+# --------------------------------------------------------------------
+# Login to the system so we can get an authentication token
+# --------------------------------------------------------------------
+my $authkey = login($barcode, $password);
+
+# --------------------------------------------------------------------
+# Retrieve the login session to get the user id
+# --------------------------------------------------------------------
+my $user = request(
+    'open-ils.auth',
+    'open__ils.auth.session.retrieve', $authkey);
+
+$user = $user->value->{__data__};
+
+# --------------------------------------------------------------------
+# Fetch the user again, this time "fleshed" with the addresses
+# --------------------------------------------------------------------
+my $fleshed_user = request(
+    'open-ils.actor',
+    'open__ils.actor.user.fleshed.retrieve',
+    $authkey, $user->{id}, ['billing_address','mailing_address']);
+
+$fleshed_user = $fleshed_user->value->{__data__};
+print Dumper($fleshed_user);
+
+
-- 
2.11.0