[Koha-patches] [PATCH] Bug 7213: simple /svc/ HTTP example

[Dobrica Pavlinusic]

Simple command-line client which can authorize itself to Koha,
get MARC XML record based on biblio number and update record
---
 misc/migration_tools/koha-svc.pl |  126 ++++++++++++++++++++++++++++++++++++++
 1 files changed, 126 insertions(+), 0 deletions(-)
 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 0000000..81adfb9
--- /dev/null
+++ b/misc/migration_tools/koha-svc.pl
@@ -0,0 +1,126 @@
+#!/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
+
+=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 port
+
+  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", { POSTDATA => $marcxml } );
+	die $resp->status_line unless $resp->is_success;
+	return $resp->decoded_content;
+}
+
+1;
-- 
1.7.2.5