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

(-)a/misc/migration_tools/koha-svc.pl (-1 / +126 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
=head2 new
60
61
  my $svc = Koha::SVC->new(
62
	url => 'http://koha-dev:8080/cgi-bin/koha/svc',
63
	user => 'svc-user',
64
	password => 'svc-password',
65
	debug => 0,
66
  );
67
68
URL must point to Koha's B<intranet> address and port.
69
70
Specified user must have C<editcatalogue> permission.
71
72
=cut
73
74
sub new {
75
	my $class = shift;
76
	my $self = {@_};
77
	bless $self, $class;
78
79
	my $url = $self->{url} || die "no url found";
80
	my $user = $self->{user} || die "no user specified";
81
	my $password = $self->{password} || die "no password";
82
83
	my $ua = LWP::UserAgent->new();
84
	$ua->cookie_jar({});
85
	my $resp = $ua->post( "$url/authentication", {userid =>$user, password => $password} );
86
	die $resp->status_line unless $resp->is_success;
87
88
	warn "# $user $url = ", $resp->decoded_content, "\n" if $self->{debug};
89
90
	$self->{ua} = $ua;
91
92
	return $self;
93
}
94
95
=head2 get
96
97
  my $marcxml = $svc->get( $biblionumber );
98
99
=cut
100
101
sub get {
102
	my ($self,$biblionumber) = @_;
103
104
	my $url = $self->{url};
105
	warn "# get $url/bib/$biblionumber\n" if $self->{debug};
106
	my $resp = $self->{ua}->get( "$url/bib/$biblionumber" );
107
	die $resp->status_line unless $resp->is_success;
108
	return $resp->decoded_content;
109
}
110
111
=head2 port
112
113
  my $marcxml = $svc->post( $biblionumber, $marcxml );
114
115
=cut
116
117
sub post {
118
	my ($self,$biblionumber,$marcxml) = @_;
119
	my $url = $self->{url};
120
	warn "# post $url/bib/$biblionumber\n" if $self->{debug};
121
	my $resp = $self->{ua}->post( "$url/bib/$biblionumber", { POSTDATA => $marcxml } );
122
	die $resp->status_line unless $resp->is_success;
123
	return $resp->decoded_content;
124
}
125
126
1;

Return to bug 7213