Prior patches to this bug had lots of comments like "I don't have a way to test this, so..."
In the OCLC Connexion web, when you choose the option to export to MARC, it'll *send* it, and
say, "Record Exported," but the web client does nothing whatever to confirm that the record
actually landed in Koha. That's a flaw in their software, but can be easily checked by
looking in Koha to see if an import batch got created. The desktop client is a little
smarter about this, but needed much more testing, also.
With this patch, both the client and web will actually work. With a config file and set up as
previously described, The record will be staged and/or imported, and the desktop client returns
a useful message about what happened, *and* the staff client URL to the record.
Oodles of gobs of bunches of thanks to Virginia Military Institute, for loaning me their OCLC
authorization credentials so this could be tested, as well as for great suggestions of cosmetic
improvements to the mechanism and output.
use IO::Select;
use POSIX;
use HTTP::Status qw(:constants);
use IO::Select;
use POSIX;
use HTTP::Status qw(:constants);
+use strict;
+use warnings;
use LWP::UserAgent;
use XML::Simple;
use LWP::UserAgent;
use XML::Simple;
+use MARC::Record;
+use MARC::File::XML;
use constant CLIENT_READ_TIMEOUT => 5;
use constant CLIENT_READ_TIMEOUT => 5;
-use constant CLIENT_READ_BUFFER_SIZE => 4 * 1024;
+use constant CLIENT_READ_BUFFER_SIZE => 100000;
use constant AUTH_URI => "/cgi-bin/koha/mainpage.pl";
use constant IMPORT_SVC_URI => "/cgi-bin/koha/svc/import_bib";
use constant AUTH_URI => "/cgi-bin/koha/mainpage.pl";
use constant IMPORT_SVC_URI => "/cgi-bin/koha/svc/import_bib";
sub read_request {
my ( $self, $io ) = @_;
sub read_request {
my ( $self, $io ) = @_;
- my ($in, @in, $timeout);
+ my ($in, @in_arr, $timeout, $bad_marc);
my $select = IO::Select->new($io) ;
while ( "FOREVER" ) {
if ( $select->can_read(CLIENT_READ_TIMEOUT) ){
my $select = IO::Select->new($io) ;
while ( "FOREVER" ) {
if ( $select->can_read(CLIENT_READ_TIMEOUT) ){
# XXX ignore after NULL
if ( $in =~ m/^(.*)\000/so ) { # null received, EOT
# XXX ignore after NULL
if ( $in =~ m/^(.*)\000/so ) { # null received, EOT
+ $in = join '', @in_arr;
+ $in =~ m/(.)$/;
+ my $lastchar = $1;
my ($xml, $user, $password, $local_user);
my $data = $in; # copy for diagmostic purposes
my ($xml, $user, $password, $local_user);
my $data = $in; # copy for diagmostic purposes
- while ( my $first = substr( $data, 0, 1 ) ) {
+ while () {
+ my $first = substr( $data, 0, 1 );
+ if (!defined $first) {
+ last;
+ }
$first eq 'U' && do {
($user, $data) = _trim_identifier($data);
next;
$first eq 'U' && do {
($user, $data) = _trim_identifier($data);
next;
next;
};
$first eq 'P' && do {
next;
};
$first eq 'P' && do {
- ($password,, $data) = _trim_identifier($data);
+ ($password, $data) = _trim_identifier($data);
next;
};
$first eq ' ' && do {
$data = substr( $data, 1 ); # trim
next;
};
next;
};
$first eq ' ' && do {
$data = substr( $data, 1 ); # trim
next;
};
- $first eq '<' && do {
- $xml = $data;
+ $data =~ m/^[0-9]/ && do {
+ # What we have here might be a MARC record...
+ my $marc_record;
+ eval { $marc_record = MARC::Record->new_from_usmarc($data); };
+ if ($@) {
+ $bad_marc = 1;
+ }
+ else {
+ $xml = $marc_record->as_xml();
+ }
last; # unexpected input
}
my @details;
push @details, "Timeout" if $timeout;
last; # unexpected input
}
my @details;
push @details, "Timeout" if $timeout;
+ push @details, "Bad MARC" if $bad_marc;
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;
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;
+ push @details, "XML: $xml" if $xml;
+ push @details, "Remaining data: $data" if ($data && !$xml);
unless ($xml) {
$self->log("Invalid request", $in, @details);
return;
unless ($xml) {
$self->log("Invalid request", $in, @details);
return;
- my ($a, $len) = unpack "cc", substr( $_[0], 0, 2 );
-
- return ( substr( $_[0], 2, $len ), substr( $_[0], 2 + $len ) );
+ #my ($a, $len) = unpack "cc", substr( $_[0], 0, 2 );
+ my $len=ord(substr ($_[0], 1, 1)) - 64;
+ if ($len <0) { #length is numeric, and thus comes from the web client, not the desktop client.
+ $_[0] =~ m/.(\d+)/;
+ $len = $1;
+ return ( substr( $_[0], length($len)+1 , $len ), substr( $_[0], length($len) + 1 + $len ) );
+ }
+ return ( substr( $_[0], 2 , $len ), substr( $_[0], 2 + $len ) );
}
my $base_url = $self->{koha};
}
my $base_url = $self->{koha};
- my $resp = $ua->post( $base_url.IMPORT_SVC_URI, $self->{params}, 'Content-Type' => 'text/plain', Content => $data );
+ my $resp = $ua->post( $base_url.IMPORT_SVC_URI,
+ {'nomatch_action' => $self->{params}->{nomatch_action},
+ 'overlay_action' => $self->{params}->{overlay_action},
+ 'match' => $self->{params}->{match},
+ 'import_mode' => $self->{params}->{import_mode},
+ 'framework' => $self->{params}->{framework},
+ 'item_action' => $self->{params}->{item_action},
+ 'xml' => $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 } );
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 )
+ $resp = $ua->post( $base_url.IMPORT_SVC_URI,
+ {'nomatch_action' => $self->{params}->{nomatch_action},
+ 'overlay_action' => $self->{params}->{overlay_action},
+ 'match' => $self->{params}->{match},
+ 'import_mode' => $self->{params}->{import_mode},
+ 'framework' => $self->{params}->{framework},
+ 'item_action' => $self->{params}->{item_action},
+ 'xml' => $data})
if $resp->is_success;
}
unless ($resp->is_success) {
if $resp->is_success;
}
unless ($resp->is_success) {
return $self->error_response("Unsuccessful request");
}
return $self->error_response("Unsuccessful request");
}
- my ($koha_status, $bib, $batch_id, $error);
+ my ($koha_status, $bib, $overlay, $batch_id, $error, $url);
if ( my $r = eval { XMLin($resp->content) } ) {
$koha_status = $r->{status};
$batch_id = $r->{import_batch_id};
$error = $r->{error};
if ( my $r = eval { XMLin($resp->content) } ) {
$koha_status = $r->{status};
$batch_id = $r->{import_batch_id};
$error = $r->{error};
+ $bib = $r->{biblionumber};
+ $overlay = $r->{match_status};
+ $url = $r->{url};
}
else {
$koha_status = "error";
}
else {
$koha_status = "error";
}
if ($koha_status eq "ok") {
}
if ($koha_status eq "ok") {
- return $self->response( sprintf( "Success. Import batch id: %s", $batch_id ) );
+ my $response_string = sprintf( "Success. Batch number %s - biblio record number %s",
+ $batch_id,$bib);
+ $response_string .= $overlay eq 'no_match' ? ' added to Koha.' : ' overlaid by import.';
+ $response_string .= "\n\n$url";
+
+ return $self->response( $response_string );
}
return $self->error_response( sprintf( "%s. Please contact administrator.", $error ) );
}
return $self->error_response( sprintf( "%s. Please contact administrator.", $error ) );
my $xml;
if ($query->request_method eq "POST") {
my $xml;
if ($query->request_method eq "POST") {
- $xml = $query->param('POSTDATA');
+ $xml = $query->param('xml');
- my %params = map { $_ => $query->url_param($_) } $query->url_param;
+ my %params = map { $_ => $query->param($_) } $query->param;
my $result = import_bib($xml, \%params );
print $query->header(-type => 'text/xml');
print XMLout($result, NoAttr => 1, RootName => 'response', XMLDecl => 1);
my $result = import_bib($xml, \%params );
print $query->header(-type => 'text/xml');
print XMLout($result, NoAttr => 1, RootName => 'response', XMLDecl => 1);
my $import_mode = delete $params->{import_mode} || '';
my $framework = delete $params->{framework} || '';
my $import_mode = delete $params->{import_mode} || '';
my $framework = delete $params->{framework} || '';
- if (my $matcher_code = delete $params->{matcher}) {
+ if (my $matcher_code = delete $params->{match}) {
$params->{matcher_id} = C4::Matcher::GetMatcherId($matcher_code);
}
$params->{matcher_id} = C4::Matcher::GetMatcherId($matcher_code);
}
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 $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;
+
+ my $matcher = C4::Matcher->new($params->{record_type} || 'biblio');
+ $matcher = C4::Matcher->fetch($params->{matcher_id});
+ my $number_of_matches = BatchFindBibDuplicates($batch_id, $matcher);
# XXX we are ignoring the result of this;
BatchCommitBibRecords($batch_id, $framework) if lc($import_mode) eq 'direct';
# XXX we are ignoring the result of this;
BatchCommitBibRecords($batch_id, $framework) if lc($import_mode) eq 'direct';
+ my $dbh = C4::Context->dbh();
+ my $sth = $dbh->prepare("SELECT matched_biblionumber FROM import_biblios WHERE import_record_id =?");
+ $sth->execute($import_record_id);
+ my $biblionumber=$sth->fetchrow_arrayref->[0] || '';
+ $sth = $dbh->prepare("SELECT overlay_status FROM import_records WHERE import_record_id =?");
+ $sth->execute($import_record_id);
+ my $match_status = $sth->fetchrow_arrayref->[0] || 'no_match';
+ my $url = 'http://'. C4::Context->preference('staffClientBaseURL') .'/cgi-bin/koha/catalogue/detail.pl?biblionumber='. $biblionumber;
+
$result->{'status'} = "ok";
$result->{'status'} = "ok";
- $result->{'import_batch_id'} = $batch_id;
- $result->{'marcxml'} = $marcxml;
+ $result->{'import_batch_id'} = $batch_id;
+ $result->{'match_status'} = $match_status;
+ $result->{'biblionumber'} = $biblionumber;
+ $result->{'url'} = $url;