implement FERWeb's users.getinfobycode
authorDobrica Pavlinusic <dpavlin@rot13.org>
Mon, 15 Aug 2011 14:37:53 +0000 (16:37 +0200)
committerDobrica Pavlinusic <dpavlin@rot13.org>
Mon, 15 Aug 2011 14:37:53 +0000 (16:37 +0200)
lib/FERWeb.pm [new file with mode: 0755]
t/FERWeb.t [new file with mode: 0755]

diff --git a/lib/FERWeb.pm b/lib/FERWeb.pm
new file mode 100755 (executable)
index 0000000..bed57dc
--- /dev/null
@@ -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 (executable)
index 0000000..c5447ce
--- /dev/null
@@ -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";