[Koha-patches] [PATCH] bug_7613: OCLC Connexion gateway

Srdjan Jankovic srdjan at catalyst.net.nz
Tue Mar 13 04:53:12 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
* 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             |    7 +
 misc/bin/connexion_import_daemon.pl                |  263 ++++++++++++++++++++
 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, 570 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 9dbd032..da91ef6 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 b844560..8ece898 100755
--- a/installer/data/mysql/updatedatabase.pl
+++ b/installer/data/mysql/updatedatabase.pl
@@ -4892,6 +4892,13 @@ 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
 
 =head2 DropAllForeignKeys($table)
diff --git a/misc/bin/connexion_import_daemon.pl b/misc/bin/connexion_import_daemon.pl
new file mode 100755
index 0000000..a4775bc
--- /dev/null
+++ b/misc/bin/connexion_import_daemon.pl
@@ -0,0 +1,263 @@
+#!/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, defaults 80
+  log      - log file path, stderr if omitted
+  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;
+$server->config_file($config);
+
+if ($daemon) {
+    print $server->background;
+} else {
+    $server->run;
+}
+
+
+{
+package ImportProxyServer;
+       
+use base qw(HTTP::Server::Simple::CGI);
+
+use LWP::UserAgent;
+use HTTP::Status qw(:constants status_message);
+use XML::Simple;
+
+use constant AUTH_URI       => "/cgi-bin/koha/mainpage.pl";
+use constant IMPORT_SVC_URI => "/cgi-bin/koha/svc/import_bib";
+
+sub config_file {
+    my $self = shift;
+    $self->{'config_file'} = shift if (@_);
+    return $self->{'config_file'};
+
+}
+
+sub parse_config {
+    my $self = shift;
+
+    my $config_file = $self->config_file or die "No 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->{LOCAL}->{koha} = delete( $param{koha} )
+      or die "No koha base url in config file";
+    $self->{LOCAL}->{user} = delete( $param{user} )
+      or die "No koha user in config file";
+    $self->{LOCAL}->{password} = delete( $param{password} )
+      or die "No koha user password in config file";
+
+    $self->host( delete $param{host} );
+    $self->port( delete( $param{port} ) || 80 );
+
+    my $log_fh;
+    if (my $logfile = delete $param{log}) {
+        open $log_fh, ">>$logfile" or die "Cannot open $logfile for write: $!";
+    } else {
+        $log_fh = \*STDERR;
+    }
+    $self->{LOCAL}->{log_fh} = $log_fh;
+
+    my $prefix = "";
+    while ( my ($p, $v) = each %param ) {
+        $prefix .= "$p: $v\n";
+    }
+
+    $self->{LOCAL}->{prefix} = $prefix;
+}
+
+sub log {
+    my $self = shift;
+    my $log_fh = $self->{LOCAL}->{log_fh}
+      or warn "No log fh",
+         return;
+    print $log_fh map "$_\n", @_;
+}
+
+sub print_banner {};
+
+sub run {
+    my $self = shift;
+
+    $self->parse_config;
+
+    my $ua = LWP::UserAgent->new;
+    $ua->timeout(10);
+    $ua->cookie_jar({});
+    $self->{LOCAL}->{ua} = $ua;
+
+    $self->SUPER::run(@_);
+}
+
+sub response_start {
+    my ( $self, $status ) = @_;
+    print "HTTP/1.0 $status ". status_message($status);
+    print "\r\n";
+#   print "Content-Type: text/html; charset='UTF-8'\r\n";
+
+}
+sub bad_req_error {
+    my ( $self, $cgi ) = @_;
+    $self->response_start(HTTP_BAD_REQUEST);
+    die $cgi->headers->as_string, $cgi->param;
+}
+sub handle_request {
+    my ( $self, $cgi ) = @_;
+
+    my $data = $cgi->param('POSTDATA')
+      or return $self->bad_req_error($cgi);
+
+    $data = $self->{LOCAL}->{prefix} . $data;
+
+    my $ua  = $self->{LOCAL}->{ua};
+    my $base_url = $self->{LOCAL}->{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->{LOCAL}->{user};
+        my $password = $self->{LOCAL}->{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;
+    }
+    $self->log("Unsuccessful request", $resp->request->as_string, $resp->as_string)
+      unless $resp->is_success;
+
+    $self->response_start($resp->code);
+    print $resp->headers->as_string;
+    print "\r\n";
+
+    if ($resp->is_success) {
+        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";
+            $error       = "Response iformat error:\n$resp->content"
+        }
+
+        if ($koha_status eq "ok") {
+            printf "Got it.  Thanks.\nImport batch id: %s\0", $batch_id;
+        } else {
+            printf "%s.  Please contact administrator.\0", $error;
+        }
+    }
+    else {
+        print $resp->content;
+    }
+}
+
+} # package
+=comment
+use HTTP::Proxy;
+use HTTP::Proxy::HeaderFilter::simple;
+use HTTP::Proxy::BodyFilter::complete;
+use HTTP::Proxy::BodyFilter::simple;
+
+my $header_filter = HTTP::Proxy::HeaderFilter::simple->new(
+    sub {
+        my ( $self, $headers, $message) = @_;
+        $headers->header('Content-Type' => 'text/plain');
+        $message->url($svc_url);
+    }
+);
+my $body_filter = HTTP::Proxy::BodyFilter::simple->new(
+    sub {
+        my ( $self, $dataref, $message, $protocol, $buffer) = @_;
+        $$dataref = $prefix.$$dataref unless $buffer;
+    }
+);
+my $proxy = HTTP::Proxy->new(
+    host => $host,
+    port => $port );
+$proxy->push_filter(
+    method => 'POST',
+    request => $header_filter,
+    request => HTTP::Proxy::BodyFilter::complete->new,
+    request => $body_filter,
+);
+$proxy->start;
+=cut
+
+
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