Attachment 8550 Details for Bug 7613 – patch

[patch] patch

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

(hide)

Description:

Filename:

MIME Type:

Creator: Srdjan Jankovic

Created: 2012-03-23 04:04:04 UTC

Size: 29.36 KB

patch

obsolete

>From 6004207e62166a1d532ee6cf14d365dd9c53dacf Mon Sep 17 00:00:00 2001
>From: Srdjan <srdjan@catalyst.net.nz>
>Date: Fri, 23 Mar 2012 16:33:06 +1300
>Subject: [PATCH] bug_7613: OCLC Connexion gateway
>
>svc/import_bib:
>* takes POST request with parameters in url and MARC XML as DATA
>* 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
>
>ImportBatches:
>* Added new import batch type of 'webservice'
>* Changed interface to AddImportBatch() - now it takes a hashref
>* Replaced batch_type = 'batch' with
>  batch_type IN ( 'batch', 'webservice' ) in some SELECTs
>---
> C4/Breeding.pm                                     |    8 +-
> C4/ImportBatch.pm                                  |  122 ++++++-
> C4/Matcher.pm                                      |   16 +
> installer/data/mysql/kohastructure.sql             |    2 +-
> installer/data/mysql/updatedatabase.pl             |   10 +
> misc/bin/connexion_import_daemon.pl                |  358 ++++++++++++++++++++
> misc/cronjobs/import_webservice_batch.pl           |   57 +++
> svc/import_bib                                     |  101 ++++++
> t/db_dependent/lib/KohaTest/ImportBatch.pm         |    6 +-
> .../lib/KohaTest/ImportBatch/AddImportBatch.pm     |   31 --
> .../lib/KohaTest/ImportBatch/GetImportBatch.pm     |    8 +-
> tools/manage-marc-import.pl                        |    2 +-
> 12 files changed, 653 insertions(+), 68 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..f7648cd 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 {
>@@ -688,7 +759,7 @@ ascending order by import_batch_id.
> sub  GetAllImportBatches {
>     my $dbh = C4::Context->dbh;
>     my $sth = $dbh->prepare_cached("SELECT * FROM import_batches
>-                                    WHERE batch_type = 'batch'
>+                                    WHERE batch_type IN ('batch', 'webservice')
>                                     ORDER BY import_batch_id ASC");
> 
>     my $results = [];
>@@ -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);
>@@ -715,7 +805,7 @@ sub GetImportBatchRangeDesc {
> 
>     my $dbh = C4::Context->dbh;
>     my $query = "SELECT * FROM import_batches
>-                                    WHERE batch_type = 'batch'
>+                                    WHERE batch_type IN ('batch', 'webservice')
>                                     ORDER BY import_batch_id DESC";
>     my @params;
>     if ($results_per_group){
>@@ -759,7 +849,7 @@ sub GetItemNumbersFromImportBatch {
> 
> sub GetNumberOfNonZ3950ImportBatches {
>     my $dbh = C4::Context->dbh;
>-    my $sth = $dbh->prepare("SELECT COUNT(*) FROM import_batches WHERE batch_type='batch'");
>+    my $sth = $dbh->prepare("SELECT COUNT(*) FROM import_batches WHERE batch_type != 'z3950'");
>     $sth->execute();
>     my ($count) = $sth->fetchrow_array();
>     $sth->finish();
>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 77423d1..6e6aa52 100644
>--- a/installer/data/mysql/kohastructure.sql
>+++ b/installer/data/mysql/kohastructure.sql
>@@ -858,7 +858,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 8259bf2..cc4c142 100755
>--- a/installer/data/mysql/updatedatabase.pl
>+++ b/installer/data/mysql/updatedatabase.pl
>@@ -5036,6 +5036,16 @@ 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..0005b65
>--- /dev/null
>+++ b/misc/bin/connexion_import_daemon.pl
>@@ -0,0 +1,358 @@
>+#!/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;
>+
>+    $self->{params} = \%param;
>+}
>+
>+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 ); # trim
>+            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");
>+
>+    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, $self->{params}, '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, $self->{params}, '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;
>+    $self->log("Response: $_[0]");
>+    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..fefcea4
>--- /dev/null
>+++ b/svc/import_bib
>@@ -0,0 +1,101 @@
>+#!/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 $xml;
>+if ($query->request_method eq "POST") {
>+    $xml = $query->param('POSTDATA');
>+}
>+if ($xml) {
>+    my %params = map { $_ => $query->url_param($_) } $query->url_param;
>+    my $result = import_bib($xml, \%params );
>+    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 ($inxml, $params) = @_;
>+
>+    my $result = {};
>+
>+    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 );
>diff --git a/tools/manage-marc-import.pl b/tools/manage-marc-import.pl
>index 34d2639..af19f92 100755
>--- a/tools/manage-marc-import.pl
>+++ b/tools/manage-marc-import.pl
>@@ -218,7 +218,7 @@ sub import_batches_list {
>             num_items => $batch->{'num_items'},
>             upload_timestamp => $batch->{'upload_timestamp'},
>             import_status => $batch->{'import_status'},
>-            file_name => $batch->{'file_name'},
>+            file_name => $batch->{'file_name'} || "($batch->{'batch_type'})",
>             comments => $batch->{'comments'},
>             can_clean => ($batch->{'import_status'} ne 'cleaned') ? 1 : 0,
>         };
>-- 
>1.7.5.4
>

Actions: View | Diff | Splinter Review

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