[Koha-patches] [PATCH] bug_7613: OCLC Connexion gateway
Srdjan Jankovic
srdjan at catalyst.net.nz
Mon Mar 19 10:45:31 CET 2012
svc/import_bib:
* takes custom POST request with parameters and MARC XML
* pushes MARC XML to an impoort bach queue of type 'webservice'
* returns status and imported record XML
* is a drop-in replacement for svc/new_bib
misc/cronjobs/import_webservice_batch.pl:
* a cron job for processing impoort bach queues of type 'webservice'
* batches can also be processed through the UI
misc/bin/connexion_import_daemon.pl:
* a daemon that listens for OCLC Connexion requests and is compliant
with OCLC Gateway spec
* takes request with MARC XML
* takes import batch params from a config file and forwards the lot to
svc/import_bib
* returns status
Added new import batch type of 'webservice'
Changed interface to AddImportBatch() - now it takes a hashref
---
C4/Breeding.pm | 8 +-
C4/ImportBatch.pm | 116 ++++++-
C4/Matcher.pm | 16 +
installer/data/mysql/kohastructure.sql | 2 +-
installer/data/mysql/updatedatabase.pl | 6 +
misc/bin/connexion_import_daemon.pl | 364 ++++++++++++++++++++
misc/cronjobs/import_webservice_batch.pl | 57 +++
svc/import_bib | 120 +++++++
t/db_dependent/lib/KohaTest/ImportBatch.pm | 6 +-
.../lib/KohaTest/ImportBatch/AddImportBatch.pm | 31 --
.../lib/KohaTest/ImportBatch/GetImportBatch.pm | 8 +-
11 files changed, 670 insertions(+), 64 deletions(-)
create mode 100755 misc/bin/connexion_import_daemon.pl
create mode 100755 misc/cronjobs/import_webservice_batch.pl
create mode 100755 svc/import_bib
delete mode 100644 t/db_dependent/lib/KohaTest/ImportBatch/AddImportBatch.pm
diff --git a/C4/Breeding.pm b/C4/Breeding.pm
index 9003f9a..c588c64 100644
--- a/C4/Breeding.pm
+++ b/C4/Breeding.pm
@@ -76,13 +76,7 @@ sub ImportBreeding {
my $dbh = C4::Context->dbh;
- my $batch_id = 0;
- if ($batch_type eq 'z3950') {
- $batch_id = GetZ3950BatchId($filename);
- } else {
- # create a new one
- $batch_id = AddImportBatch('create_new', 'staging', 'batch', $filename, '');
- }
+ my $batch_id = GetZ3950BatchId($filename);
my $searchisbn = $dbh->prepare("select biblioitemnumber from biblioitems where isbn=?");
my $searchissn = $dbh->prepare("select biblioitemnumber from biblioitems where issn=?");
# FIXME -- not sure that this kind of checking is actually needed
diff --git a/C4/ImportBatch.pm b/C4/ImportBatch.pm
index 63cc60b..2568422 100644
--- a/C4/ImportBatch.pm
+++ b/C4/ImportBatch.pm
@@ -35,10 +35,13 @@ BEGIN {
@ISA = qw(Exporter);
@EXPORT = qw(
GetZ3950BatchId
+ GetWebserviceBatchId
GetImportRecordMarc
+ GetImportRecordMarcXML
AddImportBatch
GetImportBatch
AddBiblioToBatch
+ AddItemsToImportBiblio
ModBiblioInBatch
BatchStageMarcRecords
@@ -48,6 +51,7 @@ BEGIN {
CleanBatch
GetAllImportBatches
+ GetStagedWebserviceBatches
GetImportBatchRangeDesc
GetNumberOfNonZ3950ImportBatches
GetImportBibliosRange
@@ -105,12 +109,51 @@ sub GetZ3950BatchId {
if (defined $rowref) {
return $rowref->[0];
} else {
- my $batch_id = AddImportBatch('create_new', 'staged', 'z3950', $z3950server, '');
+ my $batch_id = AddImportBatch( {
+ overlay_action => 'create_new',
+ import_status => 'staged',
+ batch_type => 'z3950',
+ file_name => $z3950server,
+ } );
return $batch_id;
}
}
+=head2 GetWebserviceBatchId
+
+ my $batchid = GetWebserviceBatchId();
+
+Retrieves the ID of the import batch for webservice.
+If necessary, creates the import batch.
+
+=cut
+
+my $WEBSERVICE_BASE_QRY = <<EOQ;
+SELECT import_batch_id FROM import_batches
+WHERE batch_type = 'webservice'
+AND import_status = 'staged'
+EOQ
+sub GetWebserviceBatchId {
+ my ($params) = @_;
+
+ my $dbh = C4::Context->dbh;
+ my $sql = $WEBSERVICE_BASE_QRY;
+ my @args;
+ foreach my $field (qw(matcher_id overlay_action nomatch_action item_action)) {
+ if (my $val = $params->{$field}) {
+ $sql .= " AND $field = ?";
+ push @args, $val;
+ }
+ }
+ my $id = $dbh->selectrow_array($sql, undef, @args);
+ return $id if $id;
+
+ $params->{batch_type} = 'webservice';
+ $params->{import_status} = 'staged';
+ return AddImportBatch($params);
+}
+
=head2 GetImportRecordMarc
my ($marcblob, $encoding) = GetImportRecordMarc($import_record_id);
@@ -129,26 +172,48 @@ sub GetImportRecordMarc {
}
-=head2 AddImportBatch
+=head2 GetImportRecordMarcXML
- my $batch_id = AddImportBatch($overlay_action, $import_status, $type,
- $file_name, $comments);
+ my $marcxml = GetImportRecordMarcXML($import_record_id);
=cut
-sub AddImportBatch {
- my ($overlay_action, $import_status, $type, $file_name, $comments) = @_;
+sub GetImportRecordMarcXML {
+ my ($import_record_id) = @_;
my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("INSERT INTO import_batches (overlay_action, import_status, batch_type,
- file_name, comments)
- VALUES (?, ?, ?, ?, ?)");
- $sth->execute($overlay_action, $import_status, $type, $file_name, $comments);
- my $batch_id = $dbh->{'mysql_insertid'};
+ my $sth = $dbh->prepare("SELECT marcxml FROM import_records WHERE import_record_id = ?");
+ $sth->execute($import_record_id);
+ my ($marcxml) = $sth->fetchrow();
$sth->finish();
+ return $marcxml;
+
+}
+
+=head2 AddImportBatch
- return $batch_id;
+ my $batch_id = AddImportBatch($params_hash);
+
+=cut
+sub AddImportBatch {
+ my ($params) = @_;
+
+ my (@fields, @vals);
+ foreach (qw( matcher_id template_id branchcode
+ overlay_action nomatch_action item_action
+ import_status batch_type file_name comments )) {
+ if (exists $params->{$_}) {
+ push @fields, $_;
+ push @vals, $params->{$_};
+ }
+ }
+ my $dbh = C4::Context->dbh;
+ $dbh->do("INSERT INTO import_batches (".join( ',', @fields).")
+ VALUES (".join( ',', map '?', @fields).")",
+ undef,
+ @vals);
+ return $dbh->{'mysql_insertid'};
}
=head2 GetImportBatch
@@ -237,7 +302,13 @@ sub BatchStageMarcRecords {
$progress_interval = 0 unless 'CODE' eq ref $progress_callback;
}
- my $batch_id = AddImportBatch('create_new', 'staging', 'batch', $file_name, $comments);
+ my $batch_id = AddImportBatch( {
+ overlay_action => 'create_new',
+ import_status => 'staging',
+ batch_type => 'batch',
+ file_name => $file_name,
+ comments => $comments,
+ } );
if ($parse_items) {
SetImportBatchItemAction($batch_id, 'always_add');
} else {
@@ -700,6 +771,25 @@ sub GetAllImportBatches {
return $results;
}
+=head2 GetStagedWebserviceBatches
+
+ my $batch_ids = GetStagedWebserviceBatches();
+
+Returns a references to an array of batch id's
+of batch_type 'webservice' that are not imported
+
+=cut
+
+my $PENDING_WEBSERVICE_BATCHES_QRY = <<EOQ;
+SELECT import_batch_id FROM import_batches
+WHERE batch_type = 'webservice'
+AND import_status = 'staged'
+EOQ
+sub GetStagedWebserviceBatches {
+ my $dbh = C4::Context->dbh;
+ return $dbh->selectcol_arrayref($PENDING_WEBSERVICE_BATCHES_QRY);
+}
+
=head2 GetImportBatchRangeDesc
my $results = GetImportBatchRangeDesc($offset, $results_per_group);
diff --git a/C4/Matcher.pm b/C4/Matcher.pm
index 9d1df67..1721a9a 100644
--- a/C4/Matcher.pm
+++ b/C4/Matcher.pm
@@ -95,6 +95,22 @@ sub GetMatcherList {
return @results;
}
+=head2 GetMatcherId
+
+ my $matcher_id = C4::Matcher::GetMatcherId($code);
+
+Returns the matcher_id of a code.
+
+=cut
+
+sub GetMatcherId {
+ my ($code) = @_;
+ my $dbh = C4::Context->dbh;
+
+ my $matcher_id = $dbh->selectrow_array("SELECT matcher_id FROM marc_matchers WHERE code = ?", undef, $code);
+ return $matcher_id;
+}
+
=head1 METHODS
=head2 new
diff --git a/installer/data/mysql/kohastructure.sql b/installer/data/mysql/kohastructure.sql
index 153e17b..7e0dd8a 100644
--- a/installer/data/mysql/kohastructure.sql
+++ b/installer/data/mysql/kohastructure.sql
@@ -851,7 +851,7 @@ CREATE TABLE `import_batches` (
`nomatch_action` enum('create_new', 'ignore') NOT NULL default 'create_new',
`item_action` enum('always_add', 'add_only_for_matches', 'add_only_for_new', 'ignore') NOT NULL default 'always_add',
`import_status` enum('staging', 'staged', 'importing', 'imported', 'reverting', 'reverted', 'cleaned') NOT NULL default 'staging',
- `batch_type` enum('batch', 'z3950') NOT NULL default 'batch',
+ `batch_type` enum('batch', 'z3950', 'webservice') NOT NULL default 'batch',
`file_name` varchar(100),
`comments` mediumtext,
PRIMARY KEY (`import_batch_id`),
diff --git a/installer/data/mysql/updatedatabase.pl b/installer/data/mysql/updatedatabase.pl
index 082d5ca..0dc0e8a 100755
--- a/installer/data/mysql/updatedatabase.pl
+++ b/installer/data/mysql/updatedatabase.pl
@@ -4923,6 +4923,12 @@ if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) {
SetVersion($DBversion);
}
+$DBversion = "3.07.00.XXX";
+if (C4::Context->preference("Version") < TransformToNum($DBversion)) {
+ $dbh->do("ALTER TABLE import_batches MODIFY COLUMN batch_type ENUM('batch','z3950','webservice') NOT NULL default 'batch'");
+ print "Upgrade to $DBversion done (Add 'webservice' to batch_type enum)\n";
+ SetVersion ($DBversion);
+}
=head1 FUNCTIONS
diff --git a/misc/bin/connexion_import_daemon.pl b/misc/bin/connexion_import_daemon.pl
new file mode 100755
index 0000000..bdbdbf9
--- /dev/null
+++ b/misc/bin/connexion_import_daemon.pl
@@ -0,0 +1,364 @@
+#!/usr/bin/perl -w
+
+# Copyright 2012 CatalystIT
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with Koha; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+use strict;
+use warnings;
+
+use Getopt::Long;
+
+my ($help, $config, $daemon);
+
+GetOptions(
+ 'config|c=s' => \$config,
+ 'daemon|d' => \$daemon,
+ 'help|?' => \$help,
+);
+
+if($help || !$config){
+ print <<EOF
+$0 --config=my.conf
+Parameters :
+ --daemon | d - go to background; prints pid to stdout
+ --config | c - config file
+ --help | ? - this message
+
+Config file format:
+ Lines of the form:
+ name: value
+
+ # comments are supported
+ No quotes
+
+ Parameter Names:
+ host - ip address or hostname to bind to, defaults all available
+ port - port to bind to, mandatory
+ log - log file path, stderr if omitted
+ debug - dumps requests to the log file, passwords inclusive
+ koha - koha intranet base url, eg http://librarian.koha
+ user - koha user, authentication
+ password - koha user password, authentication
+ match - marc_matchers.code: ISBN or ISSN
+ overlay_action - import_batches.overlay_action: replace, create_new or ignore
+ nomatch_action - import_batches.nomatch_action: create_new or ignore
+ item_action - import_batches.item_action: always_add,
+ add_only_for_matches, add_only_for_new or ignore
+ import_mode - stage or direct
+ framework - to be used if import_mode is direct
+
+ All process related parameters (all but ip and port) have default values as
+ per Koha import process.
+EOF
+;
+ exit;
+}
+
+my $server = ImportProxyServer->new($config);
+
+if ($daemon) {
+ print $server->background;
+} else {
+ $server->run;
+}
+
+exit;
+
+{
+package ImportProxyServer;
+
+use Carp;
+use IO::Socket::INET;
+# use IO::Socket::IP;
+use IO::Select;
+use POSIX;
+use HTTP::Status qw(:constants);
+
+use LWP::UserAgent;
+use XML::Simple;
+
+use constant CLIENT_READ_TIMEOUT => 5;
+use constant CLIENT_READ_BUFFER_SIZE => 4 * 1024;
+use constant AUTH_URI => "/cgi-bin/koha/mainpage.pl";
+use constant IMPORT_SVC_URI => "/cgi-bin/koha/svc/import_bib";
+
+sub new {
+ my $class = shift;
+ my $config_file = shift or croak "No config file";
+
+ my $self = {time_to_die => 0, config_file => $config_file };
+ bless $self, $class;
+
+ $self->parse_config;
+ return $self;
+}
+
+sub parse_config {
+ my $self = shift;
+
+ my $config_file = $self->{config_file};
+
+ open CONF, $config_file or die "Cannot open config file $config: $!";
+
+ my %param;
+ my $line = 0;
+ while (<CONF>) {
+ $line++;
+ chomp;
+ s/\s*#.*//o; # remove comments
+ s/^\s+//o; # trim leading spaces
+ s/\s+$//o; # trim trailing spaces
+ next unless $_;
+
+ my ($p, $v) = m/(\S+?):\s*(.*)/o;
+ die "Invalid config line $line: $_" unless defined $v;
+ $param{$p} = $v;
+ }
+
+ $self->{koha} = delete( $param{koha} )
+ or die "No koha base url in config file";
+ $self->{user} = delete( $param{user} )
+ or die "No koha user in config file";
+ $self->{password} = delete( $param{password} )
+ or die "No koha user password in config file";
+
+ $self->{host} = delete( $param{host} );
+ $self->{port} = delete( $param{port} )
+ or die "Port not specified";
+
+ $self->{debug} = delete( $param{debug} );
+
+ my $log_fh;
+ close $self->{log_fh} if $self->{log_fh};
+ if (my $logfile = delete $param{log}) {
+ open $log_fh, ">>$logfile" or die "Cannot open $logfile for write: $!";
+ } else {
+ $log_fh = \*STDERR;
+ }
+ $self->{log_fh} = $log_fh;
+
+ my $prefix = "";
+ while ( my ($p, $v) = each %param ) {
+ $prefix .= "$p: $v\n";
+ }
+
+ $self->{prefix} = $prefix;
+}
+
+sub log {
+ my $self = shift;
+ my $log_fh = $self->{log_fh}
+ or warn "No log fh",
+ return;
+ my $t = localtime;
+ print $log_fh map "$t: $_\n", @_;
+}
+
+sub background {
+ my $self = shift;
+
+ my $pid = fork;
+ return ($pid) if $pid; # parent
+
+ die "Couldn't fork: $!" unless defined($pid);
+
+ POSIX::setsid() or die "Can't start a new session: $!";
+
+ $SIG{INT} = $SIG{TERM} = $SIG{HUP} = sub { $self->{time_to_die} = 1 };
+ # trap or ignore $SIG{PIPE}
+ $SIG{USR1} = sub { $self->parse_config };
+
+ $self->run;
+}
+
+sub run {
+ my $self = shift;
+
+ my $server_port = $self->{port};
+ my $server_host = $self->{host};
+
+ my $server = IO::Socket::INET->new(
+ LocalHost => $server_host,
+ LocalPort => $server_port,
+ Type => SOCK_STREAM,
+ Proto => "tcp",
+ Listen => 12,
+ Blocking => 1,
+ ReuseAddr => 1,
+ ) or die "Couldn't be a tcp server on port $server_port: $! $@";
+
+ $self->log("Started tcp listener on $server_host:$server_port");
+
+ $self->{ua} = _ua();
+
+ while ("FOREVER") {
+ my $client = $server->accept()
+ or die "Cannot accept: $!";
+ my $oldfh = select($client);
+ $self->handle_request($client);
+ select($oldfh);
+ last if $self->{time_to_die};
+ }
+
+ close($server);
+}
+
+sub _ua {
+ my $ua = LWP::UserAgent->new;
+ $ua->timeout(10);
+ $ua->cookie_jar({});
+ return $ua;
+}
+
+sub read_request {
+ my ( $self, $io ) = @_;
+
+ my ($in, @in, $timeout);
+ my $select = IO::Select->new($io) ;
+ while ( "FOREVER" ) {
+ if ( $select->can_read(CLIENT_READ_TIMEOUT) ){
+ $io->recv($in, CLIENT_READ_BUFFER_SIZE);
+ last unless $in;
+
+ # XXX ignore after NULL
+ if ( $in =~ m/^(.*)\000/so ) { # null received, EOT
+ push @in, $1;
+ last;
+ }
+ push @in, $in;
+ }
+ else {
+ $timeout = 1;
+ last;
+ }
+ }
+
+ $in = join '', @in;
+
+ my ($xml, $user, $password, $local_user);
+ my $data = $in; # copy for diagmostic purposes
+ while ( my $first = substr( $data, 0, 1 ) ) {
+ $first eq 'U' && do {
+ ($user, $data) = _trim_identifier($data);
+ next;
+ };
+ $first eq 'A' && do {
+ ($local_user, $data) = _trim_identifier($data);
+ next;
+ };
+ $first eq 'P' && do {
+ ($password,, $data) = _trim_identifier($data);
+ next;
+ };
+ $first eq ' ' && do {
+ $data = substr( $data, 1 );
+ next;
+ };
+ $first eq '<' && do {
+ $xml = $data;
+ last;
+ };
+
+ last; # unexpected input
+ }
+
+ my @details;
+ push @details, "Timeout" if $timeout;
+ push @details, "User: $user" if $user;
+ push @details, "Password: " . ( $self->{debug} ? $password : ("x" x length($password)) ) if $password;
+ push @details, "Local user: $local_user" if $local_user;
+ unless ($xml) {
+ $self->log("Invalid request", $in, @details);
+ return;
+ }
+
+ $self->log("Request", @details);
+ $self->log($in) if $self->{debug};
+ return ($xml, $user, $password);
+}
+
+sub _trim_identifier {
+ my ($a, $len) = unpack "cc", substr( $_[0], 0, 2 );
+
+ return ( substr( $_[0], 2, $len ), substr( $_[0], 2 + $len ) );
+}
+
+sub handle_request {
+ my ( $self, $io ) = @_;
+
+ my ($data, $user, $password) = $self->read_request($io)
+ or return $self->error_response("Bad request");
+
+ $data = $self->{prefix} . $data;
+
+ my $ua;
+ if ($self->{user}) {
+ $user = $self->{user};
+ $password = $self->{password};
+ $ua = $self->{ua};
+ }
+ else {
+ $ua = _ua(); # fresh one, needs to authenticate
+ }
+
+ my $base_url = $self->{koha};
+ my $resp = $ua->post( $base_url.IMPORT_SVC_URI, 'Content-Type' => 'text/plain', Content => $data );
+ my $status = $resp->code;
+ if ($status == HTTP_UNAUTHORIZED || $status == HTTP_FORBIDDEN) {
+ my $user = $self->{user};
+ my $password = $self->{password};
+ $resp = $ua->post( $base_url.AUTH_URI, { userid => $user, password => $password } );
+ $resp = $ua->post( $base_url.IMPORT_SVC_URI, 'Content-Type' => 'text/plain', Content => $data )
+ if $resp->is_success;
+ }
+ unless ($resp->is_success) {
+ $self->log("Unsuccessful request", $resp->request->as_string, $resp->as_string);
+ return $self->error_response("Unsuccessful request");
+ }
+
+ my ($koha_status, $bib, $batch_id, $error);
+ if ( my $r = eval { XMLin($resp->content) } ) {
+ $koha_status = $r->{status};
+ $batch_id = $r->{import_batch_id};
+ $error = $r->{error};
+ }
+ else {
+ $koha_status = "error";
+ $self->log("Response format error:\n$resp->content");
+ return $self->error_response("Invalid response");
+ }
+
+ if ($koha_status eq "ok") {
+ return $self->response( sprintf( "Success. Import batch id: %s", $batch_id ) );
+ }
+
+ return $self->error_response( sprintf( "%s. Please contact administrator.", $error ) );
+}
+
+sub error_response {
+ my $self = shift;
+ $self->response(@_);
+}
+
+sub response {
+ my $self = shift;
+ printf $_[0] . "\0";
+}
+
+
+} # package
+
diff --git a/misc/cronjobs/import_webservice_batch.pl b/misc/cronjobs/import_webservice_batch.pl
new file mode 100755
index 0000000..d1b30ef
--- /dev/null
+++ b/misc/cronjobs/import_webservice_batch.pl
@@ -0,0 +1,57 @@
+#!/usr/bin/perl -w
+
+# Copyright 2012 CatalystIT
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with Koha; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+use strict;
+use warnings;
+use utf8;
+
+BEGIN {
+
+ # find Koha's Perl modules
+ # test carefully before changing this
+ use FindBin;
+ eval { require "$FindBin::Bin/../kohalib.pl" };
+}
+
+use Getopt::Long;
+use Pod::Usage;
+use C4::ImportBatch;
+
+my ($help, $framework);
+
+GetOptions(
+ 'help|?' => \$help,
+ 'framework=s' => \$framework,
+);
+
+if($help){
+ print <<EOF
+$0 --framework=myframework
+Parameters :
+--help|? This message
+--framework default ""
+EOF
+;
+ exit;
+}
+
+my $batch_ids = GetStagedWebserviceBatches() or exit;
+
+$framework ||= '';
+BatchCommitBibRecords($_, $framework) foreach @$batch_ids;
diff --git a/svc/import_bib b/svc/import_bib
new file mode 100755
index 0000000..f6f77c9
--- /dev/null
+++ b/svc/import_bib
@@ -0,0 +1,120 @@
+#!/usr/bin/perl
+
+# Copyright 2012 CatalystIT Ltd
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with Koha; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+#
+
+use strict;
+use warnings;
+
+use CGI;
+use C4::Auth qw/check_api_auth/;
+use C4::Context;
+use C4::ImportBatch;
+use C4::Matcher;
+use XML::Simple;
+use Carp::Always;
+
+my $query = new CGI;
+binmode STDOUT, ':encoding(UTF-8)';
+
+my ($status, $cookie, $sessionID) = check_api_auth($query, { editcatalogue => 'edit_catalogue'} );
+unless ($status eq "ok") {
+ print $query->header(-type => 'text/xml', -status => '403 Forbidden');
+ print XMLout({ auth_status => $status }, NoAttr => 1, RootName => 'response', XMLDecl => 1);
+ exit 0;
+}
+
+my $in;
+if ($query->request_method eq "POST") {
+ $in = $query->param('POSTDATA');
+}
+if ($in) {
+ my $result = import_bib($in);
+ print $query->header(-type => 'text/xml');
+ print XMLout($result, NoAttr => 1, RootName => 'response', XMLDecl => 1);
+} else {
+ print $query->header(-type => 'text/xml', -status => '400 Bad Request');
+}
+
+exit 0;
+
+sub import_bib {
+ my ($in) = shift;
+
+ my $result = {};
+
+ unless ($in) {
+ $result->{'status'} = "failed";
+ $result->{'error'} = "Empty request";
+ return $result;
+ }
+
+ my ($inparams, $inxml) = ($in =~ m/^(.*)?(\<\?xml .*)$/s);
+ unless ($inxml) {
+ $result->{'status'} = "failed";
+ $result->{'error'} = "No xml in the request\n$in";
+ return $result;
+ }
+
+ my %params;
+ if ($inparams) {
+ # params are "p1: v1\np2: v2\np3: v3..."
+ chomp $inparams;
+ %params = map { split /:\s*/ } split "\n", $inparams;
+ }
+
+ my $import_mode = delete $params{import_mode} || '';
+ my $framework = delete $params{framework} || '';
+
+ if (my $matcher_code = delete $params{matcher}) {
+ $params{matcher_id} = C4::Matcher::GetMatcherId($matcher_code);
+ }
+
+ my $batch_id = GetWebserviceBatchId(\%params);
+ unless ($batch_id) {
+ $result->{'status'} = "failed";
+ $result->{'error'} = "Batch create error";
+ return $result;
+ }
+
+ my $marcflavour = C4::Context->preference('marcflavour') || 'MARC21';
+ my $marc_record = eval {MARC::Record::new_from_xml( $inxml, "utf8", $marcflavour)};
+ if ($@) {
+ $result->{'status'} = "failed";
+ $result->{'error'} = $@;
+ return $result;
+ }
+
+ my $import_record_id = AddBiblioToBatch($batch_id, 0, $marc_record, "utf8", int(rand(99999)));
+ my @import_items_ids = AddItemsToImportBiblio($batch_id, $import_record_id, $marc_record, 0);
+ my $marcxml = GetImportRecordMarcXML($import_record_id);
+ unless ($marcxml) {
+ $result->{'status'} = "failed";
+ $result->{'error'} = "database write error";
+ return $result;
+ }
+ $marcxml =~ s/<\?xml.*?\?>//i;
+
+ # XXX we are ignoring the result of this;
+ BatchCommitBibRecords($batch_id, $framework) if lc($import_mode) eq 'direct';
+
+ $result->{'status'} = "ok";
+ $result->{'import_batch_id'} = $batch_id;
+ $result->{'marcxml'} = $marcxml;
+ return $result;
+}
diff --git a/t/db_dependent/lib/KohaTest/ImportBatch.pm b/t/db_dependent/lib/KohaTest/ImportBatch.pm
index a8fefaa..743b1aa 100644
--- a/t/db_dependent/lib/KohaTest/ImportBatch.pm
+++ b/t/db_dependent/lib/KohaTest/ImportBatch.pm
@@ -118,11 +118,7 @@ sub add_import_batch {
file_name => 'foo',
comments => 'inserted during automated testing',
};
- my $batch_id = AddImportBatch( $test_batch->{'overlay_action'},
- $test_batch->{'import_status'},
- $test_batch->{'batch_type'},
- $test_batch->{'file_name'},
- $test_batch->{'comments'}, );
+ my $batch_id = AddImportBatch( $test_batch );
return $batch_id;
}
diff --git a/t/db_dependent/lib/KohaTest/ImportBatch/AddImportBatch.pm b/t/db_dependent/lib/KohaTest/ImportBatch/AddImportBatch.pm
deleted file mode 100644
index 7b97e72..0000000
--- a/t/db_dependent/lib/KohaTest/ImportBatch/AddImportBatch.pm
+++ /dev/null
@@ -1,31 +0,0 @@
-package KohaTest::ImportBatch::AddImportBatch;
-use base qw( KohaTest::ImportBatch );
-
-use strict;
-use warnings;
-
-use Test::More;
-
-use C4::ImportBatch;
-use C4::Matcher;
-use C4::Biblio;
-
-
-=head3 add_one
-
-=cut
-
-sub add_one : Test( 1 ) {
- my $self = shift;
-
- my $batch_id = AddImportBatch(
- 'create_new', #overlay_action
- 'staging', # import_status
- 'batch', # batc_type
- 'foo', # file_name
- 'inserted during automated testing', # comments
- );
- ok( $batch_id, "successfully inserted batch: $batch_id" );
-}
-
-1;
diff --git a/t/db_dependent/lib/KohaTest/ImportBatch/GetImportBatch.pm b/t/db_dependent/lib/KohaTest/ImportBatch/GetImportBatch.pm
index 0b01707..6f436c5 100644
--- a/t/db_dependent/lib/KohaTest/ImportBatch/GetImportBatch.pm
+++ b/t/db_dependent/lib/KohaTest/ImportBatch/GetImportBatch.pm
@@ -25,13 +25,7 @@ sub add_one_and_find_it : Test( 7 ) {
file_name => 'foo',
comments => 'inserted during automated testing',
};
- my $batch_id = AddImportBatch(
- $batch->{'overlay_action'},
- $batch->{'import_status'},
- $batch->{'batch_type'},
- $batch->{'file_name'},
- $batch->{'comments'},
- );
+ my $batch_id = AddImportBatch($batch);
ok( $batch_id, "successfully inserted batch: $batch_id" );
my $retrieved = GetImportBatch( $batch_id );
--
1.6.5
More information about the Koha-patches
mailing list