From 7ed90fc4abe2dcd62e90f59a0fd1c73d33d7284a Mon Sep 17 00:00:00 2001
From: Dobrica Pavlinusic <dpavlin@rot13.org>
Date: Thu, 10 Nov 2011 21:39:55 +0100
Subject: [PATCH] Bug 7213 - simple /svc/ HTTP example

Simple command-line client which can authorize itself to Koha,
get MARC XML record based on biblio number and update record

This script can also be used as module using require "koha-svc.pl"
from other scripts which can implement MARC XML creation or parsing.

This is follow up version which now uses Content-type: text/xml
header when using POST method to be in sync with documentation at
http://wiki.koha-community.org/wiki/Koha_/svc/_HTTP_API

Signed-off-by: Chris Cormack <chrisc@catalyst.net.nz>
Signed-off-by: Paul Poulain <paul.poulain@biblibre.com>
Signed-off-by: Chris Cormack <chrisc@catalyst.net.nz>
---
 misc/migration_tools/koha-svc.pl | 132 +++++++++++++++++++++++++++++++
 1 file changed, 132 insertions(+)
 create mode 100755 misc/migration_tools/koha-svc.pl

diff --git a/misc/migration_tools/koha-svc.pl b/misc/migration_tools/koha-svc.pl
new file mode 100755
index 0000000000..726e6b5a68
--- /dev/null
+++ b/misc/migration_tools/koha-svc.pl
@@ -0,0 +1,132 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+use LWP::UserAgent;
+use File::Slurp;
+
+if ( $#ARGV >= 3 && ! caller ) { # process command-line params only if not called as module!
+    my ( $url, $user, $password, $biblionumber, $file ) = @ARGV;
+
+    my $svc = Koha::SVC->new(
+        url      => $url,
+        user     => $user,
+        password => $password,
+        debug    => $ENV{DEBUG},
+    );
+
+    if ( ! $file ) {
+        my $marcxml = $svc->get( $biblionumber );
+        my $file = "bib-$biblionumber.xml";
+        write_file $file , $marcxml;
+        print "saved $file ", -s $file, " bytes\n";
+        print $marcxml;
+    } else {
+        print "update $biblionumber from $file\n";
+        $svc->post( $biblionumber, scalar read_file($file) );
+    }
+
+    exit 0;
+}
+
+package Koha::SVC;
+use warnings;
+use strict;
+
+=head1 NAME
+
+Koha::SVC
+
+=head1 DESCRIPTION
+
+Call Koha's C</svc/> API to fetch/update records
+
+This script can be used from other scripts as C<Koha::SVC> module or run
+directly using syntax:
+
+  koha-svc.pl http://koha-dev:8080/cgi-bin/koha/svc svc-user svc-password $biblionumber [bib-42.xml]
+
+If called without last argument (MARCXML filename) it will fetch C<$biblionumber> from Koha and create
+C<bib-$biblionumber.xml> file from it. When called with xml filename, it will update record in Koha.
+
+This script is intentionally separate from Koha itself and dependencies which Koha has under
+assumption that you might want to run it on another machine (or create custom script which mungles
+Koha's records from other machine without bringing all Koha dependencies with it).
+
+=head1 USAGE
+
+This same script can be used as module (as it defines T<Koha::SVC> package) using
+
+  require "koha-svc.pl"
+
+at begining of script. Rest of API is described below. Example of it's usage is at beginning of this script.
+
+=head2 new
+
+  my $svc = Koha::SVC->new(
+    url      => 'http://koha-dev:8080/cgi-bin/koha/svc',
+    user     => 'svc-user',
+    password => 'svc-password',
+    debug    => 0,
+  );
+
+URL must point to Koha's B<intranet> address and port.
+
+Specified user must have C<editcatalogue> permission.
+
+=cut
+
+sub new {
+    my $class = shift;
+    my $self = {@_};
+    bless $self, $class;
+
+    my $url = $self->{url} || die "no url found";
+    my $user = $self->{user} || die "no user specified";
+    my $password = $self->{password} || die "no password";
+
+    my $ua = LWP::UserAgent->new();
+    $ua->cookie_jar({});
+    my $resp = $ua->post( "$url/authentication", {userid =>$user, password => $password} );
+    die $resp->status_line unless $resp->is_success;
+
+    warn "# $user $url = ", $resp->decoded_content, "\n" if $self->{debug};
+
+    $self->{ua} = $ua;
+
+    return $self;
+}
+
+=head2 get
+
+  my $marcxml = $svc->get( $biblionumber );
+
+=cut
+
+sub get {
+    my ($self,$biblionumber) = @_;
+
+    my $url = $self->{url};
+    warn "# get $url/bib/$biblionumber\n" if $self->{debug};
+    my $resp = $self->{ua}->get( "$url/bib/$biblionumber" );
+    die $resp->status_line unless $resp->is_success;
+    return $resp->decoded_content;
+}
+
+=head2 post
+
+  my $marcxml = $svc->post( $biblionumber, $marcxml );
+
+=cut
+
+sub post {
+    my ($self,$biblionumber,$marcxml) = @_;
+    my $url = $self->{url};
+    warn "# post $url/bib/$biblionumber\n" if $self->{debug};
+    my $resp = $self->{ua}->post( "$url/bib/$biblionumber", 'Content_type' => 'text/xml', Content => $marcxml );
+    die $resp->status_line unless $resp->is_success;
+    return $resp->decoded_content;
+}
+
+1;
-- 
2.39.5