Bug 7213 - simple /svc/ HTTP example
[koha.git] / misc / migration_tools / koha-svc.pl
blob726e6b5a683734e35446138cfeadd663a3d26d20
1 #!/usr/bin/perl
3 use warnings;
4 use strict;
6 use LWP::UserAgent;
7 use File::Slurp;
9 if ( $#ARGV >= 3 && ! caller ) { # process command-line params only if not called as module!
10 my ( $url, $user, $password, $biblionumber, $file ) = @ARGV;
12 my $svc = Koha::SVC->new(
13 url => $url,
14 user => $user,
15 password => $password,
16 debug => $ENV{DEBUG},
19 if ( ! $file ) {
20 my $marcxml = $svc->get( $biblionumber );
21 my $file = "bib-$biblionumber.xml";
22 write_file $file , $marcxml;
23 print "saved $file ", -s $file, " bytes\n";
24 print $marcxml;
25 } else {
26 print "update $biblionumber from $file\n";
27 $svc->post( $biblionumber, scalar read_file($file) );
30 exit 0;
33 package Koha::SVC;
34 use warnings;
35 use strict;
37 =head1 NAME
39 Koha::SVC
41 =head1 DESCRIPTION
43 Call Koha's C</svc/> API to fetch/update records
45 This script can be used from other scripts as C<Koha::SVC> module or run
46 directly using syntax:
48 koha-svc.pl http://koha-dev:8080/cgi-bin/koha/svc svc-user svc-password $biblionumber [bib-42.xml]
50 If called without last argument (MARCXML filename) it will fetch C<$biblionumber> from Koha and create
51 C<bib-$biblionumber.xml> file from it. When called with xml filename, it will update record in Koha.
53 This script is intentionally separate from Koha itself and dependencies which Koha has under
54 assumption that you might want to run it on another machine (or create custom script which mungles
55 Koha's records from other machine without bringing all Koha dependencies with it).
57 =head1 USAGE
59 This same script can be used as module (as it defines T<Koha::SVC> package) using
61 require "koha-svc.pl"
63 at begining of script. Rest of API is described below. Example of it's usage is at beginning of this script.
65 =head2 new
67 my $svc = Koha::SVC->new(
68 url => 'http://koha-dev:8080/cgi-bin/koha/svc',
69 user => 'svc-user',
70 password => 'svc-password',
71 debug => 0,
74 URL must point to Koha's B<intranet> address and port.
76 Specified user must have C<editcatalogue> permission.
78 =cut
80 sub new {
81 my $class = shift;
82 my $self = {@_};
83 bless $self, $class;
85 my $url = $self->{url} || die "no url found";
86 my $user = $self->{user} || die "no user specified";
87 my $password = $self->{password} || die "no password";
89 my $ua = LWP::UserAgent->new();
90 $ua->cookie_jar({});
91 my $resp = $ua->post( "$url/authentication", {userid =>$user, password => $password} );
92 die $resp->status_line unless $resp->is_success;
94 warn "# $user $url = ", $resp->decoded_content, "\n" if $self->{debug};
96 $self->{ua} = $ua;
98 return $self;
101 =head2 get
103 my $marcxml = $svc->get( $biblionumber );
105 =cut
107 sub get {
108 my ($self,$biblionumber) = @_;
110 my $url = $self->{url};
111 warn "# get $url/bib/$biblionumber\n" if $self->{debug};
112 my $resp = $self->{ua}->get( "$url/bib/$biblionumber" );
113 die $resp->status_line unless $resp->is_success;
114 return $resp->decoded_content;
117 =head2 post
119 my $marcxml = $svc->post( $biblionumber, $marcxml );
121 =cut
123 sub post {
124 my ($self,$biblionumber,$marcxml) = @_;
125 my $url = $self->{url};
126 warn "# post $url/bib/$biblionumber\n" if $self->{debug};
127 my $resp = $self->{ua}->post( "$url/bib/$biblionumber", 'Content_type' => 'text/xml', Content => $marcxml );
128 die $resp->status_line unless $resp->is_success;
129 return $resp->decoded_content;