Bug 7613: OCLC Connexion web service and desktop client, followup patch

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.

diff --git a/misc/bin/connexion_import_daemon.pl b/misc/bin/connexion_import_daemon.pl
index 9d32f8a..dd83afb 100755 (executable)
--- a/misc/bin/connexion_import_daemon.pl
+++ b/misc/bin/connexion_import_daemon.pl
@@ -87,12 +87,16 @@ use IO::Socket::INET;
 use IO::Select;
 use POSIX;
 use HTTP::Status qw(:constants);
+use strict;
+use warnings;
 
 use LWP::UserAgent;
 use XML::Simple;
+use MARC::Record;
+use MARC::File::XML;
 
 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";
 
@@ -222,7 +226,7 @@ sub _ua {
 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) ){
@@ -231,22 +235,27 @@ sub read_request {
 
             # XXX ignore after NULL
             if ( $in =~ m/^(.*)\000/so ) { # null received, EOT
-                push @in, $1;
+                push @in_arr, $1;
                 last;
             }
-            push @in, $in;
+            push @in_arr, $in;
         }
         else {
-            $timeout = 1;
             last;
         }
     }
 
-    $in = join '', @in;
+    $in = join '', @in_arr;
 
+    $in =~ m/(.)$/;
+    my $lastchar = $1;
     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;
@@ -256,26 +265,36 @@ sub read_request {
             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;
         };
-        $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;
         };
-
         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, "XML: $xml" if $xml;
+    push @details, "Remaining data: $data" if ($data && !$xml);
     unless ($xml) {
         $self->log("Invalid request", $in, @details);
         return;
@@ -287,9 +306,14 @@ sub read_request {
 }
 
 sub _trim_identifier {
-    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 ) );
 }
 
 sub handle_request {
@@ -309,13 +333,28 @@ sub handle_request {
     }
 
     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 } );
-        $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) {
@@ -323,11 +362,14 @@ sub handle_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};
+        $bib         = $r->{biblionumber};
+        $overlay     = $r->{match_status};
+        $url         = $r->{url};
     }
     else {
         $koha_status = "error";
@@ -336,7 +378,12 @@ sub handle_request {
     }
 
     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 ) );

diff --git a/svc/import_bib b/svc/import_bib
index 5e7e493..a029a58 100755 (executable)
--- a/svc/import_bib
+++ b/svc/import_bib
@@ -41,10 +41,10 @@ unless ($status eq "ok") {
 
 my $xml;
 if ($query->request_method eq "POST") {
-    $xml = $query->param('POSTDATA');
+    $xml = $query->param('xml');
 }
 if ($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);
@@ -62,7 +62,7 @@ sub import_bib {
     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);
     }
 
@@ -83,19 +83,27 @@ sub import_bib {
 
     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';
 
+    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->{'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;
     return $result;
 }