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
use C4::Debug;
use C4::Branch; # GetBranches
use C4::Log; # logaction
-
+use C4::Koha qw(GetAuthorisedValueByCode);
use Data::Dumper;
use Koha::DateUtils;
use Koha::Calendar;
{
$issuingimpossible{RESTRICTED} = 1;
}
+ if ( $item->{'itemlost'} ) {
+ $needsconfirmation{ITEM_LOST} = GetAuthorisedValueByCode( 'LOST', $item->{'itemlost'} );
+ }
if ( C4::Context->preference("IndependantBranches") ) {
my $userenv = C4::Context->userenv;
if ( ($userenv) && ( $userenv->{flags} % 2 != 1 ) ) {
@ISA = qw(Exporter);
@EXPORT = qw(
GetZ3950BatchId
+ GetWebserviceBatchId
GetImportRecordMarc
+ GetImportRecordMarcXML
AddImportBatch
GetImportBatch
AddBiblioToBatch
+ AddItemsToImportBiblio
ModBiblioInBatch
BatchStageMarcRecords
CleanBatch
GetAllImportBatches
+ GetStagedWebserviceBatches
GetImportBatchRangeDesc
GetNumberOfNonZ3950ImportBatches
GetImportBibliosRange
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);
}
-=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;
- return $batch_id;
+}
+
+=head2 AddImportBatch
+ 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
$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 {
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 = [];
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);
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){
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();
my ($batch_id) = @_;
my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare_cached("UPDATE import_batches SET num_biblios = (
- SELECT COUNT(*)
- FROM import_records
- WHERE import_batch_id = import_batches.import_batch_id
- AND record_type = 'biblio')
- WHERE import_batch_id = ?");
- $sth->bind_param(1, $batch_id);
- $sth->execute();
- $sth->finish();
- $sth = $dbh->prepare_cached("UPDATE import_batches SET num_items = (
- SELECT COUNT(*)
- FROM import_records
- JOIN import_items USING (import_record_id)
- WHERE import_batch_id = import_batches.import_batch_id
- AND record_type = 'biblio')
+ my $sth = $dbh->prepare_cached("UPDATE import_batches SET
+ num_biblios = (
+ SELECT COUNT(*)
+ FROM import_records
+ WHERE import_batch_id = import_batches.import_batch_id
+ AND record_type = 'biblio'),
+ num_items = (
+ SELECT COUNT(*)
+ FROM import_records
+ JOIN import_items USING (import_record_id)
+ WHERE import_batch_id = import_batches.import_batch_id
+ AND record_type = 'biblio')
WHERE import_batch_id = ?");
$sth->bind_param(1, $batch_id);
$sth->execute();
$sth->finish();
-
}
sub _get_commit_action {
use C4::Koha;
use C4::Biblio;
use C4::Dates qw/format_date format_date_in_iso/;
-use C4::Search qw/SimpleSearch/;
use MARC::Record;
use C4::ClassSource;
use C4::Log;
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
# FIXME: the locale should be set based on the user's language and/or search choice
#warn "$lang";
+ # Make sure we only use the first two letters from the language code
+ $lang = lc(substr($lang, 0, 2));
+ # The language codes for the two variants of Norwegian will now be "nb" and "nn",
+ # none of which Lingua::Stem::Snowball can use, so we need to "translate" them
+ if ($lang eq 'nb' || $lang eq 'nn') {
+ $lang = 'no';
+ }
my $stemmer = Lingua::Stem::Snowball->new( lang => $lang,
encoding => "UTF-8" );
$getreserv{biblionumber} = $getiteminfo->{'biblionumber'};
$getreserv{waitingat} = GetBranchName( $num_res->{'branchcode'} );
$getreserv{suspend} = $num_res->{'suspend'};
- $getreserv{suspend_until} = C4::Dates->new( $num_res->{'suspend_until'}, "iso")->output("syspref");
+ $getreserv{suspend_until} = $num_res->{'suspend_until'};
# check if we have a waiting status for reservations
if ( $num_res->{'found'} eq 'W' ) {
$getreserv{color} = 'reserved';
`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`),
`chargename` varchar(100) default NULL,
`maxissueqty` int(4) default NULL,
`issuelength` int(4) default NULL,
+ `lengthunit` varchar(10) default 'days',
`hardduedate` date default NULL,
`hardduedatecompare` tinyint NOT NULL default "0",
`renewalsallowed` smallint(6) NOT NULL default "0",
$dbh->do("ALTER TABLE old_issues CHANGE returndate returndate datetime");
$dbh->do("ALTER TABLE old_issues CHANGE lastreneweddate lastreneweddate datetime");
$dbh->do("ALTER TABLE old_issues CHANGE issuedate issuedate datetime");
- $dbh->do("alter table issuingrules add column lengthunit varchar(10) default 'days' after issuelength");
print "Upgrade to $DBversion done (Setting up issues tables for hourly loans)\n";
SetVersion($DBversion);
}
SetVersion($DBversion);
}
+$DBversion = "3.07.00.045";
+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);
+}
+
+$DBversion = "3.07.00.046";
+if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) {
+ $dbh->do("ALTER TABLE issuingrules ADD COLUMN lengthunit varchar(10) DEFAULT 'days' AFTER issuelength");
+ print "Upgrade to $DBversion done (Setting up issues tables for hourly loans (lengthunit fix))\n";
+ SetVersion($DBversion);
+}
+
=head1 FUNCTIONS
=head2 DropAllForeignKeys($table)
- pref: numSearchRSSResults
class: long
- search results in the RSS feed.
+ -
+ - pref: SocialNetworks
+ default: 0
+ choices:
+ yes: Enable
+ no: Disable
+ - social network links in opac detail pages
Policy:
-
- pref: singleBranchMode
yes: Using
no: "Not using"
- 'ICU Zebra indexing. Please note: This setting will not affect Zebra indexing, it should only be used to tell Koha that you have activated ICU indexing if you have actually done so, since there is no way for Koha to figure this out on its own.'
- -
- - pref: SocialNetworks
- default: 0
- choices:
- yes: Enable
- no: Disable
- - Enable/Disable social network links in opac detail pages
Search Form:
-
- Show tabs in OPAC and staff-side advanced search for limiting searches on the
[% IF ( NOT_FOR_LOAN_FORCING ) %]
<li>Item is normally not for loan. Check out anyway?</li>
[% END %]
+
[% IF ( USERBLOCKEDOVERDUE ) %]
<li>Patron has [% USERBLOCKEDOVERDUE %] overdue item(s). Check out anyway?</li>
[% END %]
+
+[% IF ( ITEM_LOST ) %]
+ <li>This item has been lost with a status of "[% ITEM_LOST %]". Check out anyway?</li>
+[% END %]
</ul>
<form method="post" action="/cgi-bin/koha/circ/circulation.pl" autocomplete="off">
<input type="hidden" name="borrowernumber" value="[% borrowernumber %]" />
<input type="hidden" name="reservenumber" value="[% reservloo.reservenumber %]" />
</td>
- <td>[% IF ( reservloo.suspend ) %]Suspended [% IF ( reservloo.suspend_until ) %] until [% reservloo.suspend_until %][% END %][% END %]</td>
+ <td>[% IF ( reservloo.suspend ) %]Suspended [% IF ( reservloo.suspend_until ) %] until [% reservloo.suspend_until | $KohaDates %][% END %][% END %]</td>
</tr>
[% END %]</tbody>
</table>
- <fieldset class="action"><input type="submit" class="cancel" name="submit" value="Cancel Marked Requests" /></fieldset>
+ <fieldset class="action"><input type="submit" class="cancel" name="submit" value="Cancel marked holds" /></fieldset>
</form>
<fieldset class="action">
<form action="/cgi-bin/koha/reserve/modrequest_suspendall.pl" method="post">
<input type="hidden" name="from" value="circ" />
<input type="hidden" name="borrowernumber" value="[% borrowernumber %]" />
- <input type="submit" value="Suspend All Requests" />
+ <input type="submit" value="Suspend all holds" />
[% IF AutoResumeSuspendedHolds %]
<label for="suspend_until">until</label>
<input type="hidden" name="from" value="circ" />
<input type="hidden" name="borrowernumber" value="[% borrowernumber %]" />
<input type="hidden" name="suspend" value="0" />
- <input type="submit" value="Resume All Suspended All Requests" />
+ <input type="submit" value="Resume all suspended holds" />
</form>
</fieldset>
<input type="hidden" name="biblionumber" value="[% reservloo.biblionumber %]" />
<input type="hidden" name="borrowernumber" value="[% borrowernumber %]" />
</td>
- <td>[% IF ( reservloo.suspend ) %]Suspended [% IF ( reservloo.suspend_until ) %] until [% reservloo.suspend_until %][% END %][% END %]</td>
+ <td>[% IF ( reservloo.suspend ) %]Suspended [% IF ( reservloo.suspend_until ) %] until [% reservloo.suspend_until | $KohaDates %][% END %][% END %]</td>
</tr>
[% END %]</tbody>
</table>
- <fieldset class="action"><input type="submit" class="cancel" name="submit" value="Cancel Marked Requests" /></fieldset>
+ <fieldset class="action"><input type="submit" class="cancel" name="submit" value="Cancel marked holds" /></fieldset>
</form>
<fieldset class="action">
<form action="/cgi-bin/koha/reserve/modrequest_suspendall.pl" method="post">
<input type="hidden" name="from" value="borrower" />
<input type="hidden" name="borrowernumber" value="[% borrowernumber %]" />
- <input type="submit" value="Suspend All Requests" />
+ <input type="submit" value="Suspend all holds" />
[% IF AutoResumeSuspendedHolds %]
<label for="suspend_until">until</label>
<input type="hidden" name="from" value="borrower" />
<input type="hidden" name="borrowernumber" value="[% borrowernumber %]" />
<input type="hidden" name="suspend" value="0" />
- <input type="submit" value="Resume All Suspended All Requests" />
+ <input type="submit" value="Resume all suspended holds" />
</form>
</fieldset>
use strict;
sub kohaversion {
- our $VERSION = '3.07.00.044';
+ our $VERSION = '3.07.00.046';
# version needs to be set this way
# so that it can be picked up by Makefile.PL
# during install
}
$getreserv{waitingposition} = $num_res->{'priority'};
$getreserv{suspend} = $num_res->{'suspend'};
- $getreserv{suspend_until} = C4::Dates->new( $num_res->{'suspend_until'}, "iso")->output("syspref");;
+ $getreserv{suspend_until} = $num_res->{'suspend_until'};
push( @reservloop, \%getreserv );
}
--- /dev/null
+#!/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 (my $conf_fh, '<', $config_file) or die "Cannot open config file $config: $!";
+
+ my %param;
+ my $line = 0;
+ while (<$conf_fh>) {
+ $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
--- /dev/null
+#!/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;
for (my $i=0;$i<@servers;$i++) {
my $server = $servers[$i];
$hits = $results_hashref->{$server}->{"hits"};
- @newresults = searchResults('opac', '', $hits, $results_per_page, $offset, $arrParamsBusc->{'scan'}, @{$results_hashref->{$server}->{"RECORDS"}},, C4::Context->preference('hidelostitems'));
+ my @records = $results_hashref->{$server}->{"RECORDS"};
+ @newresults = searchResults('opac', '', $hits, $results_per_page, $offset, $arrParamsBusc->{'scan'}, \@records,, C4::Context->preference('hidelostitems'));
}
return \@newresults;
}#searchAgain
--- /dev/null
+#!/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, 'UPDATE COUNTS');
+ 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;
+}
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;
}
+++ /dev/null
-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;
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 );
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,
};