@@ -, +, @@ --- 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 --- a/C4/Breeding.pm +++ a/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 --- a/C4/ImportBatch.pm +++ a/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 = <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 = <dbh; + return $dbh->selectcol_arrayref($PENDING_WEBSERVICE_BATCHES_QRY); +} + =head2 GetImportBatchRangeDesc my $results = GetImportBatchRangeDesc($offset, $results_per_group); --- a/C4/Matcher.pm +++ a/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 --- a/installer/data/mysql/kohastructure.sql +++ a/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`), --- a/installer/data/mysql/updatedatabase.pl +++ a/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) --- a/misc/bin/connexion_import_daemon.pl +++ a/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 <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 () { + $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 + + --- a/misc/cronjobs/import_webservice_batch.pl +++ a/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 < '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; +} --- a/t/db_dependent/lib/KohaTest/ImportBatch.pm +++ a/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; } --- a/t/db_dependent/lib/KohaTest/ImportBatch/AddImportBatch.pm +++ a/t/db_dependent/lib/KohaTest/ImportBatch/AddImportBatch.pm @@ -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; --- a/t/db_dependent/lib/KohaTest/ImportBatch/GetImportBatch.pm +++ a/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 ); --