View | Details | Raw Unified | Return to bug 6536
Collapse All | Expand All

(-)a/C4/Breeding.pm (-33 / +95 lines)
Lines 234-239 sub Z3950Search { Link Here
234
    my @encoding;
234
    my @encoding;
235
    my @serverhost;
235
    my @serverhost;
236
    my @servername;
236
    my @servername;
237
    my @sru;
237
    my @breeding_loop = ();
238
    my @breeding_loop = ();
238
    my $numberpending;
239
    my $numberpending;
239
240
Lines 244-323 sub Z3950Search { Link Here
244
    my @errconn;
245
    my @errconn;
245
    my $s = 0;
246
    my $s = 0;
246
    my $query = '';
247
    my $query = '';
248
    my $squery= '';
247
    my $nterms;
249
    my $nterms;
248
    my $term;
250
    my $term;
249
    if ($pars->{isbn}) {
251
    if ($pars->{isbn}) {
250
        $term=$pars->{isbn};
252
        $term=$pars->{isbn};
251
        $query .= " \@or \@attr 1=8 \"$term\" \@attr 1=7 \"$term\" ";
253
        $query .= " \@or \@attr 1=8 \"$term\" \@attr 1=7 \"$term\" ";
254
        $squery = "[isbn]=\"$term\" and ";
252
        $nterms++;
255
        $nterms++;
253
    }
256
    }
254
    if ($pars->{title}) {
257
    if ($pars->{title}) {
255
        $term=$pars->{title};
258
        $term=$pars->{title};
256
        utf8::decode($term);
259
        utf8::decode($term);
257
        $query .= " \@attr 1=4 \"$term\" ";
260
        $query .= " \@attr 1=4 \"$term\" ";
261
        $squery .= "[title]=\"$term\" and ";
258
        $nterms++;
262
        $nterms++;
259
    }
263
    }
260
    if ($pars->{author}) {
264
    if ($pars->{author}) {
261
        $term=$pars->{author};
265
        $term=$pars->{author};
262
        utf8::decode($term);
266
        utf8::decode($term);
263
        $query .= " \@attr 1=1003 \"$term\" ";
267
        $query .= " \@attr 1=1003 \"$term\" ";
268
        $squery .= "[author]=\"$term\" and ";
264
        $nterms++;
269
        $nterms++;
265
    }
270
    }
266
    if ($pars->{dewey}) {
271
    if ($pars->{dewey}) {
267
        $term=$pars->{dewey};
272
        $term=$pars->{dewey};
268
        $query .= " \@attr 1=16 \"$term\" ";
273
        $query .= " \@attr 1=16 \"$term\" ";
274
        $squery .= "[dewey]=\"$term\" and ";
269
        $nterms++;
275
        $nterms++;
270
    }
276
    }
271
    if ($pars->{subject}) {
277
    if ($pars->{subject}) {
272
        $term=$pars->{subject};
278
        $term=$pars->{subject};
273
        utf8::decode($term);
279
        utf8::decode($term);
274
        $query .= " \@attr 1=21 \"$term\" ";
280
        $query .= " \@attr 1=21 \"$term\" ";
281
        $squery .= "[subject]=\"$term\" and ";
275
        $nterms++;
282
        $nterms++;
276
    }
283
    }
277
    if ($pars->{lccall}) {
284
    if ($pars->{lccall}) {
278
        $term=$pars->{lccall};
285
        $term=$pars->{lccall};
279
        $query .= " \@attr 1=16 \@attr 2=3 \@attr 3=1 \@attr 4=1 \@attr 5=1 \@attr 6=1 \"$term\" ";
286
        $query .= " \@attr 1=16 \@attr 2=3 \@attr 3=1 \@attr 4=1 \@attr 5=1 \@attr 6=1 \"$term\" ";
287
        $squery .= "[lccall]=\"$term\" and ";
280
        $nterms++;
288
        $nterms++;
281
    }
289
    }
282
    if ($pars->{controlnumber}) {
290
    if ($pars->{controlnumber}) {
283
        $term=$pars->{controlnumber};
291
        $term=$pars->{controlnumber};
284
        $query .= " \@attr 1=12 \"$term\" ";
292
        $query .= " \@attr 1=12 \"$term\" ";
293
        $squery .= "[controlnumber]=\"$term\" and ";
285
        $nterms++;
294
        $nterms++;
286
    }
295
    }
287
    if ($pars->{stdid}) {
296
    if ($pars->{stdid}) {
288
        $term=$pars->{stdid};
297
        $term=$pars->{stdid};
289
        $query .= " \@attr 1=1007 \"$term\" ";
298
        $query .= " \@attr 1=1007 \"$term\" ";
299
        $squery .= "[stdid]=\"$term\" and ";
290
        $nterms++;
300
        $nterms++;
291
    }
301
    }
292
    if ($pars->{srchany}) {
302
    if ($pars->{srchany}) {
293
        $term=$pars->{srchany};
303
        $term=$pars->{srchany};
294
        $query .= " \@attr 1=1016 \"$term\" ";
304
        $query .= " \@attr 1=1016 \"$term\" ";
305
        $squery .= "[any]=\"$term\" and ";
295
        $nterms++;
306
        $nterms++;
296
    }
307
    }
297
308
298
    for my $i (1..$nterms-1) {
309
    for my $i (1..$nterms-1) {
299
        $query = "\@and " . $query;
310
        $query = "\@and " . $query;
300
    }
311
    }
312
    $squery=~s/\sand\s$//; #remove last AND in sru query
301
313
302
    foreach my $servid (@id) {
314
    foreach my $servid (@id) {
303
        my $sth = $dbh->prepare("SELECT * FROM z3950servers WHERE id=? ORDER BY rank, name");
315
        my $sth = $dbh->prepare("SELECT * FROM z3950servers WHERE id=? ORDER BY rank, name");
304
        $sth->execute($servid);
316
        $sth->execute($servid);
305
        while ( $server = $sth->fetchrow_hashref ) {
317
        while ( $server = $sth->fetchrow_hashref ) {
318
            if($server->{host}=~/^sru=/) {
319
                $sru[$s]= {
320
                    srufields=>$server->{srufields},
321
                    syntax=>$server->{syntax},
322
                };
323
                change_sru_host($server);
324
            }
306
            my $option1      = new ZOOM::Options();
325
            my $option1      = new ZOOM::Options();
307
            $option1->option('async' => 1);
326
            $option1->option('async' => 1);
308
            $option1->option('elementSetName', 'F');
327
            $option1->option('elementSetName', 'F');
309
            $option1->option('databaseName', $server->{db});
328
            $option1->option('databaseName', $server->{db}) if !$sru[$s];
310
            $option1->option('user',         $server->{userid}  ) if $server->{userid};
329
            $option1->option('user',         $server->{userid}  ) if $server->{userid};
311
            $option1->option('password',     $server->{password}) if $server->{password};
330
            $option1->option('password',     $server->{password}) if $server->{password};
312
            $option1->option('preferredRecordSyntax', $server->{syntax});
331
            $option1->option('preferredRecordSyntax', $server->{syntax});
313
            $option1->option( 'timeout', $server->{timeout} ) if ($server->{timeout});
332
            $option1->option( 'timeout', $server->{timeout} ) if ($server->{timeout});
314
            $oConnection[$s] = create ZOOM::Connection($option1)
333
            pass_sru_options($server,$option1) if $sru[$s];
315
              || $DEBUG
334
            $oConnection[$s] = create ZOOM::Connection($option1);
316
              && warn( "" . $oConnection[$s]->errmsg() );
335
            #now connect
317
            warn( "server data", $server->{name}, $server->{port} ) if $DEBUG;
336
            if($sru[$s]) {
318
            $oConnection[$s]->connect( $server->{host}, $server->{port} )
337
                $oConnection[$s]->connect( 'http://'.$server->{host});
319
              || $DEBUG
338
            }
320
              && warn( "" . $oConnection[$s]->errmsg() );
339
            else {
340
                $oConnection[$s]->connect( $server->{host}, $server->{port} );
341
            }
321
            $serverhost[$s] = $server->{host};
342
            $serverhost[$s] = $server->{host};
322
            $servername[$s] = $server->{name};
343
            $servername[$s] = $server->{name};
323
            $encoding[$s]   = ($server->{encoding}?$server->{encoding}:"iso-5426");
344
            $encoding[$s]   = ($server->{encoding}?$server->{encoding}:"iso-5426");
Lines 328-338 sub Z3950Search { Link Here
328
    my $firstresult = 1;
349
    my $firstresult = 1;
329
350
330
    for ( my $z = 0 ; $z < $s ; $z++ ) {
351
    for ( my $z = 0 ; $z < $s ; $z++ ) {
331
        warn "doing the search" if $DEBUG;
352
        if($sru[$z]) {
332
        $oResult[$z] = $oConnection[$z]->search_pqf($query)
353
            $oResult[$z] = $oConnection[$z]->search(new ZOOM::Query::CQL(tran_query($squery, $sru[$z]->{srufields})));
333
          || $DEBUG
354
        }
334
          && warn( "somthing went wrong: " . $oConnection[$s]->errmsg() );
355
        else {
335
356
            $oResult[$z] = $oConnection[$z]->search_pqf($query);
357
        }
336
    }
358
    }
337
359
338
  AGAIN:
360
  AGAIN:
Lines 340-361 sub Z3950Search { Link Here
340
    my $event;
362
    my $event;
341
    while ( ( $k = ZOOM::event( \@oConnection ) ) != 0 ) {
363
    while ( ( $k = ZOOM::event( \@oConnection ) ) != 0 ) {
342
        $event = $oConnection[ $k - 1 ]->last_event();
364
        $event = $oConnection[ $k - 1 ]->last_event();
343
        warn( "connection ", $k - 1, ": event $event (",
344
            ZOOM::event_str($event), ")\n" )
345
          if $DEBUG;
346
        last if $event == ZOOM::Event::ZEND;
365
        last if $event == ZOOM::Event::ZEND;
347
    }
366
    }
348
367
349
    if ( $k != 0 ) {
368
    if ( $k != 0 ) {
350
        $k--;
369
        $k--;
351
        warn $serverhost[$k] if $DEBUG;
352
        my ( $error, $errmsg, $addinfo, $diagset ) =
370
        my ( $error, $errmsg, $addinfo, $diagset ) =
353
          $oConnection[$k]->error_x();
371
          $oConnection[$k]->error_x();
354
        if ($error) {
372
        if ($error) {
355
            if ($error =~ m/^(10000|10007)$/ ) {
373
            if ($error =~ m/^(10000|10007)$/ ) {
356
                push(@errconn, {'server' => $serverhost[$k], 'error' => $error});
374
                push(@errconn, {'server' => $serverhost[$k], 'error' => $error});
357
            }
375
            }
358
            $DEBUG and warn "$k $serverhost[$k] error $query: $errmsg ($error) $addinfo\n";
359
        }
376
        }
360
        else {
377
        else {
361
            my $numresults = $oResult[$k]->size();
378
            my $numresults = $oResult[$k]->size();
Lines 368-381 sub Z3950Search { Link Here
368
                        my $marcrecord;
385
                        my $marcrecord;
369
                        $marcdata   = $rec->raw();
386
                        $marcdata   = $rec->raw();
370
387
371
                        my ($charset_result, $charset_errors);
388
                        if($sru[$k]) { #SRU
372
                        ($marcrecord, $charset_result, $charset_errors) =
389
                            $marcrecord= MARC::Record->new_from_xml($marcdata,'UTF-8',$sru[$k]->{syntax});
373
                          MarcToUTF8Record($marcdata, C4::Context->preference('marcflavour'), $encoding[$k]);
390
                        }
391
                        else { #z3950
392
                            ($marcrecord)= MarcToUTF8Record($marcdata, C4::Context->preference('marcflavour'), $encoding[$k]);
393
                        }
374
                        SetUTF8Flag($marcrecord);
394
                        SetUTF8Flag($marcrecord);
375
####WARNING records coming from Z3950 clients are in various character sets MARC8,UTF8,UNIMARC etc
395
376
## In HEAD i change everything to UTF-8
377
# In rel2_2 i am not sure what encoding is so no character conversion is done here
378
##Add necessary encoding changes to here -TG
379
                        my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, "" );
396
                        my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, "" );
380
                        $oldbiblio->{isbn}   =~ s/ |-|\.//g if $oldbiblio->{isbn};
397
                        $oldbiblio->{isbn}   =~ s/ |-|\.//g if $oldbiblio->{isbn};
381
                        # pad | and ( with spaces to allow line breaks in the HTML
398
                        # pad | and ( with spaces to allow line breaks in the HTML
Lines 386-396 sub Z3950Search { Link Here
386
                        # pad | and ( with spaces to allow line breaks in the HTML
403
                        # pad | and ( with spaces to allow line breaks in the HTML
387
                        $oldbiblio->{issn} =~ s/\|/ \| /g if $oldbiblio->{issn};
404
                        $oldbiblio->{issn} =~ s/\|/ \| /g if $oldbiblio->{issn};
388
                        $oldbiblio->{issn} =~ s/\(/ \(/g if $oldbiblio->{issn};
405
                        $oldbiblio->{issn} =~ s/\(/ \(/g if $oldbiblio->{issn};
389
                          my (
406
390
                            $notmarcrecord, $alreadyindb, $alreadyinfarm,
407
                        #call to ImportBreeding replaced by next two calls for optimization
391
                            $imported,      $breedingid
408
                        my $batch_id = GetZ3950BatchId($servername[$k]);
392
                          )
409
                        my $breedingid = AddBiblioToBatch($batch_id, 0, $marcrecord, 'UTF-8', $pars->{random});
393
                          = ImportBreeding( $marcdata, 2, $serverhost[$k], $encoding[$k], $pars->{random}, 'z3950' );
410
394
                        my %row_data;
411
                        my %row_data;
395
                        $row_data{server}       = $servername[$k];
412
                        $row_data{server}       = $servername[$k];
396
                        $row_data{isbn}         = $oldbiblio->{isbn};
413
                        $row_data{isbn}         = $oldbiblio->{isbn};
Lines 416-422 sub Z3950Search { Link Here
416
        server        => $servername[$k],
433
        server        => $servername[$k],
417
        numberpending => $numberpending,
434
        numberpending => $numberpending,
418
        biblionumber  => $pars->{biblionumber},
435
        biblionumber  => $pars->{biblionumber},
419
        errconn       => \@errconn
436
        errconn       => \@errconn,
420
    );
437
    );
421
438
422
    return if $numberpending==0;
439
    return if $numberpending==0;
Lines 429-434 sub Z3950Search { Link Here
429
    }
446
    }
430
}
447
}
431
448
449
sub change_sru_host { #merge port and database into hostname
450
  my $server= shift;
451
  if($server->{port} ne '80') {
452
    if($server->{host}=~/^([^\/]+)\/(.*)$/ ) {
453
      $server->{host}= $1.':'.$server->{port}.'/'.$2;
454
    }
455
    else {
456
      $server->{host}.= ':'.$server->{port};
457
    }
458
  }
459
  #prevent double slash between host and db when concatenating
460
  $server->{host}=~ s/\/$//g;
461
  $server->{db}=~ s/^\///g;
462
  $server->{host}.= '/'.$server->{db};
463
}
464
465
sub pass_sru_options {
466
  my ($server, $option1)=@_;
467
  my @parts= split /,/,$server->{host};
468
  foreach(my $i=0; $i<@parts; $i++) {
469
    if($i==@parts-1) {
470
      $server->{host}=$parts[$i];
471
    }
472
    else {
473
      if($parts[$i]=~/^([^=]+)=(.*)/) {
474
        $option1->option( $1 => $2);
475
      }
476
    }
477
  }
478
}
479
480
sub tran_query { #translate to specific sru fields per server
481
  my ($q, $srufields)= @_;
482
  #srufields is in format title=field,isbn=field,...
483
  #if a field doesn't exist, try anywhere or remove [field]=
484
  my @parts= split(',', $srufields);
485
  my %trans= map { if(/=/){($`,$')}else{()} } @parts;
486
487
  my $any= $trans{any}?$trans{any}.'=':'';
488
  foreach my $key (keys %trans) {
489
    my $f=$trans{$key};
490
    if($f) {$q=~s/\[$key\]/$f/g; } else {$q=~s/\[$key\]=/$any/g; }
491
  }
492
  $q=~s/\[\w+\]=/$any/g; # remove remaining fields (not found in field list)
493
  return $q;
494
}
495
432
1;
496
1;
433
__END__
497
__END__
434
435
- 

Return to bug 6536