View | Details | Raw Unified | Return to bug 7213
Collapse All | Expand All

(-)a/misc/migration_tools/koha-svc.pl (-1 / +132 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
use warnings;
4
use strict;
5
6
use LWP::UserAgent;
7
use File::Slurp;
8
9
if ( $#ARGV >= 3 && ! caller ) { # process command-line params only if not called as module!
10
	my ( $url, $user, $password, $biblionumber, $file ) = @ARGV;
11
12
	my $svc = Koha::SVC->new(
13
		url => $url,
14
		user => $user,
15
		password => $password,
16
		debug => $ENV{DEBUG},
17
	);
18
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) );
28
	}
29
30
	exit 0;
31
}
32
33
package Koha::SVC;
34
use warnings;
35
use strict;
36
37
=head1 NAME
38
39
Koha::SVC
40
41
=head1 DESCRIPTION
42
43
Call Koha's C</svc/> API to fetch/update records
44
45
This script can be used from other scripts as C<Koha::SVC> module or run
46
directly using syntax:
47
48
  koha-svc.pl http://koha-dev:8080/cgi-bin/koha/svc svc-user svc-password $biblionumber [bib-42.xml]
49
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.
52
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).
56
57
=head1 USAGE
58
59
This same script can be used as module (as it defines T<Koha::SVC> package) using
60
61
  require "koha-svc.pl"
62
63
at begining of script. Rest of API is described below. Example of it's usage is at beginning of this script.
64
65
=head2 new
66
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,
72
  );
73
74
URL must point to Koha's B<intranet> address and port.
75
76
Specified user must have C<editcatalogue> permission.
77
78
=cut
79
80
sub new {
81
	my $class = shift;
82
	my $self = {@_};
83
	bless $self, $class;
84
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";
88
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;
93
94
	warn "# $user $url = ", $resp->decoded_content, "\n" if $self->{debug};
95
96
	$self->{ua} = $ua;
97
98
	return $self;
99
}
100
101
=head2 get
102
103
  my $marcxml = $svc->get( $biblionumber );
104
105
=cut
106
107
sub get {
108
	my ($self,$biblionumber) = @_;
109
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;
115
}
116
117
=head2 port
118
119
  my $marcxml = $svc->post( $biblionumber, $marcxml );
120
121
=cut
122
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", { POSTDATA => $marcxml } );
128
	die $resp->status_line unless $resp->is_success;
129
	return $resp->decoded_content;
130
}
131
132
1;

Return to bug 7213