|
Lines 23-33
use warnings;
Link Here
|
| 23 |
#use Encode; |
23 |
#use Encode; |
| 24 |
use MARC::File::USMARC; |
24 |
use MARC::File::USMARC; |
| 25 |
#use ZOOM; #has been loaded already in Context |
25 |
#use ZOOM; #has been loaded already in Context |
|
|
26 |
use XML::LibXML; |
| 27 |
use XML::LibXSLT; |
| 26 |
|
28 |
|
| 27 |
use C4::Biblio; |
29 |
use C4::Biblio; |
| 28 |
use C4::Koha; |
30 |
use C4::Koha; |
| 29 |
use C4::Charset; |
31 |
use C4::Charset; |
| 30 |
use C4::ImportBatch; |
32 |
use C4::ImportBatch; |
|
|
33 |
use C4::Templates; |
| 31 |
|
34 |
|
| 32 |
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
35 |
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
| 33 |
|
36 |
|
|
Lines 39-44
BEGIN {
Link Here
|
| 39 |
@EXPORT = qw(&ImportBreeding &BreedingSearch Z3950Search); |
42 |
@EXPORT = qw(&ImportBreeding &BreedingSearch Z3950Search); |
| 40 |
} |
43 |
} |
| 41 |
|
44 |
|
|
|
45 |
my %xslthash; |
| 46 |
|
| 42 |
=head1 NAME |
47 |
=head1 NAME |
| 43 |
|
48 |
|
| 44 |
C4::Breeding : module to add biblios to import_records via |
49 |
C4::Breeding : module to add biblios to import_records via |
|
Lines 230-239
sub Z3950Search {
Link Here
|
| 230 |
my ($pars, $template)= @_; |
235 |
my ($pars, $template)= @_; |
| 231 |
|
236 |
|
| 232 |
my $server; |
237 |
my $server; |
|
|
238 |
my @servers; |
| 233 |
my $marcdata; |
239 |
my $marcdata; |
| 234 |
my @encoding; |
|
|
| 235 |
my @serverhost; |
| 236 |
my @servername; |
| 237 |
my @sru; |
240 |
my @sru; |
| 238 |
my @breeding_loop = (); |
241 |
my @breeding_loop = (); |
| 239 |
my $numberpending; |
242 |
my $numberpending; |
|
Lines 315-320
sub Z3950Search {
Link Here
|
| 315 |
my $sth = $dbh->prepare("SELECT * FROM z3950servers WHERE id=? ORDER BY rank, name"); |
318 |
my $sth = $dbh->prepare("SELECT * FROM z3950servers WHERE id=? ORDER BY rank, name"); |
| 316 |
$sth->execute($servid); |
319 |
$sth->execute($servid); |
| 317 |
while ( $server = $sth->fetchrow_hashref ) { |
320 |
while ( $server = $sth->fetchrow_hashref ) { |
|
|
321 |
$servers[$s]= $server; |
| 322 |
$servers[$s]->{encoding}= "iso-5426" if !$servers[$s]->{encoding}; |
| 318 |
if($server->{host}=~/^sru=/) { |
323 |
if($server->{host}=~/^sru=/) { |
| 319 |
$sru[$s]= { |
324 |
$sru[$s]= { |
| 320 |
srufields=>$server->{srufields}, |
325 |
srufields=>$server->{srufields}, |
|
Lines 339-347
sub Z3950Search {
Link Here
|
| 339 |
else { |
344 |
else { |
| 340 |
$oConnection[$s]->connect( $server->{host}, $server->{port} ); |
345 |
$oConnection[$s]->connect( $server->{host}, $server->{port} ); |
| 341 |
} |
346 |
} |
| 342 |
$serverhost[$s] = $server->{host}; |
|
|
| 343 |
$servername[$s] = $server->{name}; |
| 344 |
$encoding[$s] = ($server->{encoding}?$server->{encoding}:"iso-5426"); |
| 345 |
$s++; |
347 |
$s++; |
| 346 |
} ## while fetch |
348 |
} ## while fetch |
| 347 |
} # foreach |
349 |
} # foreach |
|
Lines 371-377
sub Z3950Search {
Link Here
|
| 371 |
$oConnection[$k]->error_x(); |
373 |
$oConnection[$k]->error_x(); |
| 372 |
if ($error) { |
374 |
if ($error) { |
| 373 |
if ($error =~ m/^(10000|10007)$/ ) { |
375 |
if ($error =~ m/^(10000|10007)$/ ) { |
| 374 |
push(@errconn, {'server' => $serverhost[$k], 'error' => $error}); |
376 |
push(@errconn, {'server' => $servers[$k]->{host}, 'error' => $error}); |
| 375 |
} |
377 |
} |
| 376 |
} |
378 |
} |
| 377 |
else { |
379 |
else { |
|
Lines 389-397
sub Z3950Search {
Link Here
|
| 389 |
$marcrecord= MARC::Record->new_from_xml($marcdata,'UTF-8',$sru[$k]->{syntax}); |
391 |
$marcrecord= MARC::Record->new_from_xml($marcdata,'UTF-8',$sru[$k]->{syntax}); |
| 390 |
} |
392 |
} |
| 391 |
else { #z3950 |
393 |
else { #z3950 |
| 392 |
($marcrecord)= MarcToUTF8Record($marcdata, C4::Context->preference('marcflavour'), $encoding[$k]); |
394 |
($marcrecord)= MarcToUTF8Record($marcdata, C4::Context->preference('marcflavour'), $servers[$k]->{encoding}); |
| 393 |
} |
395 |
} |
| 394 |
SetUTF8Flag($marcrecord); |
396 |
SetUTF8Flag($marcrecord); |
|
|
397 |
$marcrecord= do_xslt_proc($marcrecord, $servers[$k]->{add_xslt}); |
| 398 |
if(!$marcrecord) { |
| 399 |
push @errconn, {'server' => $servers[$k]->{name}, 'error' => 'Additional XSLT failure on record '.$i}; #not a real connection error.. |
| 400 |
next; |
| 401 |
} |
| 395 |
|
402 |
|
| 396 |
my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, "" ); |
403 |
my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, "" ); |
| 397 |
$oldbiblio->{isbn} =~ s/ |-|\.//g if $oldbiblio->{isbn}; |
404 |
$oldbiblio->{isbn} =~ s/ |-|\.//g if $oldbiblio->{isbn}; |
|
Lines 405-415
sub Z3950Search {
Link Here
|
| 405 |
$oldbiblio->{issn} =~ s/\(/ \(/g if $oldbiblio->{issn}; |
412 |
$oldbiblio->{issn} =~ s/\(/ \(/g if $oldbiblio->{issn}; |
| 406 |
|
413 |
|
| 407 |
#call to ImportBreeding replaced by next two calls for optimization |
414 |
#call to ImportBreeding replaced by next two calls for optimization |
| 408 |
my $batch_id = GetZ3950BatchId($servername[$k]); |
415 |
my $batch_id = GetZ3950BatchId($servers[$k]->{name}); |
| 409 |
my $breedingid = AddBiblioToBatch($batch_id, 0, $marcrecord, 'UTF-8', $pars->{random}); |
416 |
my $breedingid = AddBiblioToBatch($batch_id, 0, $marcrecord, 'UTF-8', $pars->{random}); |
| 410 |
|
417 |
|
| 411 |
my %row_data; |
418 |
my %row_data; |
| 412 |
$row_data{server} = $servername[$k]; |
419 |
$row_data{server} = $servers[$k]->{name}; |
| 413 |
$row_data{isbn} = $oldbiblio->{isbn}; |
420 |
$row_data{isbn} = $oldbiblio->{isbn}; |
| 414 |
$row_data{lccn} = $oldbiblio->{lccn}; |
421 |
$row_data{lccn} = $oldbiblio->{lccn}; |
| 415 |
$row_data{title} = $oldbiblio->{title}; |
422 |
$row_data{title} = $oldbiblio->{title}; |
|
Lines 421-427
sub Z3950Search {
Link Here
|
| 421 |
push( @breeding_loop, \%row_data ); |
428 |
push( @breeding_loop, \%row_data ); |
| 422 |
|
429 |
|
| 423 |
} else { |
430 |
} else { |
| 424 |
push(@breeding_loop,{'server'=>$servername[$k],'title'=>join(': ',$oConnection[$k]->error_x()),'breedingid'=>-1,'biblionumber'=>-1}); |
431 |
push(@breeding_loop,{'server'=>$servers[$k]->{name},'title'=>join(': ',$oConnection[$k]->error_x()),'breedingid'=>-1,'biblionumber'=>-1}); |
| 425 |
} # $rec |
432 |
} # $rec |
| 426 |
} |
433 |
} |
| 427 |
} #$numresults |
434 |
} #$numresults |
|
Lines 430-436
sub Z3950Search {
Link Here
|
| 430 |
$numberpending = $nremaining - 1; |
437 |
$numberpending = $nremaining - 1; |
| 431 |
$template->param( |
438 |
$template->param( |
| 432 |
breeding_loop => \@breeding_loop, |
439 |
breeding_loop => \@breeding_loop, |
| 433 |
server => $servername[$k], |
440 |
server => $servers[$k]->{name}, |
| 434 |
numberpending => $numberpending, |
441 |
numberpending => $numberpending, |
| 435 |
biblionumber => $pars->{biblionumber}, |
442 |
biblionumber => $pars->{biblionumber}, |
| 436 |
errconn => \@errconn, |
443 |
errconn => \@errconn, |
|
Lines 493-497
sub tran_query { #translate to specific sru fields per server
Link Here
|
| 493 |
return $q; |
500 |
return $q; |
| 494 |
} |
501 |
} |
| 495 |
|
502 |
|
|
|
503 |
sub do_xslt_proc { |
| 504 |
my ($marcrec, $xsltfile)= @_; |
| 505 |
return $marcrec if !$xsltfile; |
| 506 |
|
| 507 |
my $stylesheet= _load_xslt_stylesheet($xsltfile); |
| 508 |
return $marcrec if !$stylesheet; |
| 509 |
|
| 510 |
my $parser = XML::LibXML->new(); |
| 511 |
my $doc= $parser->parse_string($marcrec->as_xml()); |
| 512 |
return if !$doc; #undef: trouble |
| 513 |
|
| 514 |
my $result= $stylesheet->transform($doc); |
| 515 |
my $xml= $stylesheet->output_as_chars($result); |
| 516 |
return $xml? MARC::Record->new_from_xml($xml, 'UTF-8'): undef; |
| 517 |
} |
| 518 |
|
| 519 |
sub _load_xslt_stylesheet { |
| 520 |
my ($name)= @_; |
| 521 |
if(exists $xslthash{$name}) { |
| 522 |
return $xslthash{$name}{stylesheet}; |
| 523 |
} |
| 524 |
my $f=_full_xslt_path($name); |
| 525 |
if($f && -e $f) { |
| 526 |
my $parser = XML::LibXML->new(); |
| 527 |
#my $style_doc = $parser->parse_file($f); |
| 528 |
my $style_doc = $parser->load_xml(location=>$f); |
| 529 |
my $xslt = XML::LibXSLT->new(); |
| 530 |
$xslthash{$name}{stylesheet}= $xslt->parse_stylesheet($style_doc); |
| 531 |
return $xslthash{$name}{stylesheet}; |
| 532 |
} |
| 533 |
} |
| 534 |
|
| 535 |
sub _full_xslt_path { |
| 536 |
my $name=shift; |
| 537 |
#absolute path? |
| 538 |
if(substr($name,0,1) eq '/') { |
| 539 |
return $name; |
| 540 |
} |
| 541 |
#a relative path: look in xslt subfolder of staff templates |
| 542 |
my $dir= C4::Context->config('intrahtdocs').'/'. |
| 543 |
C4::Context->preference('template'); |
| 544 |
#try language folder first, otherwise english |
| 545 |
my $lang=C4::Templates::_current_language() || 'en'; #null->english |
| 546 |
my $ff= $dir.'/'.$lang.'/xslt/'.$name; |
| 547 |
return $ff if -e $ff; |
| 548 |
$ff=$dir.'/en/xslt/'.$name; |
| 549 |
return $ff; |
| 550 |
} |
| 551 |
|
| 496 |
1; |
552 |
1; |
| 497 |
__END__ |
553 |
__END__ |