|
Lines 20-25
package Koha::Biblio;
Link Here
|
| 20 |
use Modern::Perl; |
20 |
use Modern::Perl; |
| 21 |
|
21 |
|
| 22 |
use Carp; |
22 |
use Carp; |
|
|
23 |
use URI; |
| 24 |
use URI::Escape; |
| 23 |
|
25 |
|
| 24 |
use C4::Biblio qw(); |
26 |
use C4::Biblio qw(); |
| 25 |
|
27 |
|
|
Lines 442-460
sub has_items_waiting_or_intransit {
Link Here
|
| 442 |
return 0; |
444 |
return 0; |
| 443 |
} |
445 |
} |
| 444 |
|
446 |
|
|
|
447 |
=head2 get_coins |
| 448 |
|
| 449 |
my $coins = $biblio->get_coins; |
| 450 |
|
| 451 |
Returns the COinS (a span) which can be included in a biblio record |
| 452 |
|
| 453 |
=cut |
| 454 |
|
| 455 |
sub get_coins { |
| 456 |
my ( $self ) = @_; |
| 457 |
|
| 458 |
my $record = $self->metadata->record; |
| 459 |
|
| 460 |
my $pos7 = substr $record->leader(), 7, 1; |
| 461 |
my $pos6 = substr $record->leader(), 6, 1; |
| 462 |
my $mtx; |
| 463 |
my $genre; |
| 464 |
my ( $aulast, $aufirst ) = ( '', '' ); |
| 465 |
my @authors; |
| 466 |
my $title; |
| 467 |
my $hosttitle; |
| 468 |
my $pubyear = ''; |
| 469 |
my $isbn = ''; |
| 470 |
my $issn = ''; |
| 471 |
my $publisher = ''; |
| 472 |
my $pages = ''; |
| 473 |
my $titletype = ''; |
| 474 |
|
| 475 |
# For the purposes of generating COinS metadata, LDR/06-07 can be |
| 476 |
# considered the same for UNIMARC and MARC21 |
| 477 |
my $fmts6 = { |
| 478 |
'a' => 'book', |
| 479 |
'b' => 'manuscript', |
| 480 |
'c' => 'book', |
| 481 |
'd' => 'manuscript', |
| 482 |
'e' => 'map', |
| 483 |
'f' => 'map', |
| 484 |
'g' => 'film', |
| 485 |
'i' => 'audioRecording', |
| 486 |
'j' => 'audioRecording', |
| 487 |
'k' => 'artwork', |
| 488 |
'l' => 'document', |
| 489 |
'm' => 'computerProgram', |
| 490 |
'o' => 'document', |
| 491 |
'r' => 'document', |
| 492 |
}; |
| 493 |
my $fmts7 = { |
| 494 |
'a' => 'journalArticle', |
| 495 |
's' => 'journal', |
| 496 |
}; |
| 497 |
|
| 498 |
$genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book'; |
| 499 |
|
| 500 |
if ( $genre eq 'book' ) { |
| 501 |
$genre = $fmts7->{$pos7} if $fmts7->{$pos7}; |
| 502 |
} |
| 503 |
|
| 504 |
##### We must transform mtx to a valable mtx and document type #### |
| 505 |
if ( $genre eq 'book' ) { |
| 506 |
$mtx = 'book'; |
| 507 |
$titletype = 'b'; |
| 508 |
} elsif ( $genre eq 'journal' ) { |
| 509 |
$mtx = 'journal'; |
| 510 |
$titletype = 'j'; |
| 511 |
} elsif ( $genre eq 'journalArticle' ) { |
| 512 |
$mtx = 'journal'; |
| 513 |
$genre = 'article'; |
| 514 |
$titletype = 'a'; |
| 515 |
} else { |
| 516 |
$mtx = 'dc'; |
| 517 |
} |
| 518 |
|
| 519 |
if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) { |
| 520 |
|
| 521 |
# Setting datas |
| 522 |
$aulast = $record->subfield( '700', 'a' ) || ''; |
| 523 |
$aufirst = $record->subfield( '700', 'b' ) || ''; |
| 524 |
push @authors, "$aufirst $aulast" if ($aufirst or $aulast); |
| 525 |
|
| 526 |
# others authors |
| 527 |
if ( $record->field('200') ) { |
| 528 |
for my $au ( $record->field('200')->subfield('g') ) { |
| 529 |
push @authors, $au; |
| 530 |
} |
| 531 |
} |
| 532 |
|
| 533 |
$title = $record->subfield( '200', 'a' ); |
| 534 |
my $subfield_210d = $record->subfield('210', 'd'); |
| 535 |
if ($subfield_210d and $subfield_210d =~ /(\d{4})/) { |
| 536 |
$pubyear = $1; |
| 537 |
} |
| 538 |
$publisher = $record->subfield( '210', 'c' ) || ''; |
| 539 |
$isbn = $record->subfield( '010', 'a' ) || ''; |
| 540 |
$issn = $record->subfield( '011', 'a' ) || ''; |
| 541 |
} else { |
| 542 |
|
| 543 |
# MARC21 need some improve |
| 544 |
|
| 545 |
# Setting datas |
| 546 |
if ( $record->field('100') ) { |
| 547 |
push @authors, $record->subfield( '100', 'a' ); |
| 548 |
} |
| 549 |
|
| 550 |
# others authors |
| 551 |
if ( $record->field('700') ) { |
| 552 |
for my $au ( $record->field('700')->subfield('a') ) { |
| 553 |
push @authors, $au; |
| 554 |
} |
| 555 |
} |
| 556 |
$title = $record->subfield( '245', 'a' ) . $record->subfield( '245', 'b' ); |
| 557 |
if ($titletype eq 'a') { |
| 558 |
$pubyear = $record->field('008') || ''; |
| 559 |
$pubyear = substr($pubyear->data(), 7, 4) if $pubyear; |
| 560 |
$isbn = $record->subfield( '773', 'z' ) || ''; |
| 561 |
$issn = $record->subfield( '773', 'x' ) || ''; |
| 562 |
$hosttitle = $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{}; |
| 563 |
my @rels = $record->subfield( '773', 'g' ); |
| 564 |
$pages = join(', ', @rels); |
| 565 |
} else { |
| 566 |
$pubyear = $record->subfield( '260', 'c' ) || ''; |
| 567 |
$publisher = $record->subfield( '260', 'b' ) || ''; |
| 568 |
$isbn = $record->subfield( '020', 'a' ) || ''; |
| 569 |
$issn = $record->subfield( '022', 'a' ) || ''; |
| 570 |
} |
| 571 |
|
| 572 |
} |
| 573 |
|
| 574 |
my @params = ( |
| 575 |
[ 'ctx_ver', 'Z39.88-2004' ], |
| 576 |
[ 'rft_val_fmt', "info:ofi/fmt:kev:mtx:$mtx" ], |
| 577 |
[ ($mtx eq 'dc' ? 'rft.type' : 'rft.genre'), $genre ], |
| 578 |
[ "rft.${titletype}title", $title ], |
| 579 |
); |
| 580 |
|
| 581 |
# rft.title is authorized only once, so by checking $titletype |
| 582 |
# we ensure that rft.title is not already in the list. |
| 583 |
if ($hosttitle and $titletype) { |
| 584 |
push @params, [ 'rft.title', $hosttitle ]; |
| 585 |
} |
| 586 |
|
| 587 |
push @params, ( |
| 588 |
[ 'rft.isbn', $isbn ], |
| 589 |
[ 'rft.issn', $issn ], |
| 590 |
); |
| 591 |
|
| 592 |
# If it's a subscription, these informations have no meaning. |
| 593 |
if ($genre ne 'journal') { |
| 594 |
push @params, ( |
| 595 |
[ 'rft.aulast', $aulast ], |
| 596 |
[ 'rft.aufirst', $aufirst ], |
| 597 |
(map { [ 'rft.au', $_ ] } @authors), |
| 598 |
[ 'rft.pub', $publisher ], |
| 599 |
[ 'rft.date', $pubyear ], |
| 600 |
[ 'rft.pages', $pages ], |
| 601 |
); |
| 602 |
} |
| 603 |
|
| 604 |
my $coins_value = join( '&', |
| 605 |
map { $$_[1] ? $$_[0] . '=' . uri_escape_utf8( $$_[1] ) : () } @params ); |
| 606 |
|
| 607 |
return $coins_value; |
| 608 |
} |
| 609 |
|
| 445 |
=head2 get_openurl |
610 |
=head2 get_openurl |
| 446 |
|
611 |
|
| 447 |
my $biblio = Koha::Biblios->find( $biblionumber ); |
612 |
my $url = $biblio->get_openurl; |
| 448 |
my $url = $biblio->get_openurl; |
|
|
| 449 |
|
613 |
|
| 450 |
Takes MARC::Record and return url for OpenURL resolver set in OpenURLResolverURL |
614 |
Returns url for OpenURL resolver set in OpenURLResolverURL system preference |
| 451 |
|
615 |
|
| 452 |
=cut |
616 |
=cut |
| 453 |
|
617 |
|
| 454 |
sub get_openurl { |
618 |
sub get_openurl { |
| 455 |
my ( $self ) = @_; |
619 |
my ( $self ) = @_; |
| 456 |
|
620 |
|
| 457 |
my $coins = C4::Biblio::GetCOinSBiblio( $self->metadata->record); |
|
|
| 458 |
my $OpenURLResolverURL = C4::Context->preference('OpenURLResolverURL'); |
621 |
my $OpenURLResolverURL = C4::Context->preference('OpenURLResolverURL'); |
| 459 |
|
622 |
|
| 460 |
if ($OpenURLResolverURL) { |
623 |
if ($OpenURLResolverURL) { |
|
Lines 465-471
sub get_openurl {
Link Here
|
| 465 |
} else { |
628 |
} else { |
| 466 |
$OpenURLResolverURL .= '&'; |
629 |
$OpenURLResolverURL .= '&'; |
| 467 |
} |
630 |
} |
| 468 |
$OpenURLResolverURL .= $coins; |
631 |
$OpenURLResolverURL .= $self->get_coins; |
| 469 |
} |
632 |
} |
| 470 |
|
633 |
|
| 471 |
return $OpenURLResolverURL; |
634 |
return $OpenURLResolverURL; |