From 51c7c40dba990905e76dc7751afb153dd431fd23 Mon Sep 17 00:00:00 2001 From: Dobrica Pavlinusic Date: Mon, 15 Aug 2011 16:37:53 +0200 Subject: [PATCH] implement FERWeb's users.getinfobycode --- lib/FERWeb.pm | 43 +++++++++++++++++++++++++++++++++++++++++++ t/FERWeb.t | 19 +++++++++++++++++++ 2 files changed, 62 insertions(+) create mode 100755 lib/FERWeb.pm create mode 100755 t/FERWeb.t diff --git a/lib/FERWeb.pm b/lib/FERWeb.pm new file mode 100755 index 0000000..bed57dc --- /dev/null +++ b/lib/FERWeb.pm @@ -0,0 +1,43 @@ +package FERWeb; +use warnings; +use strict; + +# sudo apt-get install librpc-xml-perl libio-socket-ssl-perl + +#use IO::Socket::SSL qw(debug4); +#use LWP::Debug qw(+); + +require RPC::XML; +require RPC::XML::Client; + +use Data::Dump qw(dump); + +sub new { + my ($class) = @_; + + my $auth = RPC::XML::Client->new('https://www.fer.hr/xmlrpc/xr_auth.php'); + + my $login_id = $auth->send_request('auth.rlogin', '_koha', $ENV{PASSWD} )->value; + die dump $login_id if ref $login_id eq 'HASH'; + + warn "# login_id $login_id\n"; + + my $self = { login_id => $login_id }; + bless $self, $class; + return $self; +} + +our $users = RPC::XML::Client->new('https://www.fer.hr/xmlrpc/xr_users.php'); +sub getinfobycode { + my ($self,$code) = @_; + + my $res = $users->send_request( + 'users.getinfobycode', $self->{login_id}, RPC::XML::string->new($code) + )->value; + + print "[$code] = ", dump($res), $/; + + return $res; +} + +1; diff --git a/t/FERWeb.t b/t/FERWeb.t new file mode 100755 index 0000000..c5447ce --- /dev/null +++ b/t/FERWeb.t @@ -0,0 +1,19 @@ +#!/usr/bin/perl +use strict; +use warnings; + +use Test::More tests => 4; +use Data::Dump qw(dump); + +use lib 'lib'; + +use_ok 'FERWeb'; + +my $o = new_ok 'FERWeb'; + +my $code = $ARGV[0] || 'dpavlin'; # JMBAG + +ok my $r = $o->getinfobycode( $code ), "JMBAG $code"; +diag dump $r; + +cmp_ok $r->{code}, 'eq', $code, "code $code"; -- 2.20.1