Attachment 8194 Details for Bug 7613 – patch

[patch] patch

0001-bug_7613-OCLC-Connexion-gateway.patch (text/plain), 25.34 KB, created by Srdjan Jankovic on 2012-03-13 04:04:44 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Srdjan Jankovic

Created: 2012-03-13 04:04:44 UTC

Size: 25.34 KB

patch

obsolete

>From 84abff8c09b09b25e7f189a984aeac8f2e3fb883 Mon Sep 17 00:00:00 2001
>From: Srdjan Jankovic <srdjan@catalyst.net.nz>
>Date: Tue, 13 Mar 2012 16:38:49 +1300
>Subject: [PATCH] bug_7613: OCLC Connexion gateway
>
>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
>

Actions: View | Diff | Splinter Review

Attachments on bug 7613: 8194 | 8256 | 8268 | 8269 | 8270 | 8328 | 8523 | 8527 | 8550 | 8678 | 8691 | 8896 | 10240