3 # Copyright 2000-2002 Katipo Communications
4 # Copyright 2010 BibLibre
5 # Copyright 2011 Equinox Software, Inc.
7 # This file is part of Koha.
9 # Koha is free software; you can redistribute it and/or modify it
10 # under the terms of the GNU General Public License as published by
11 # the Free Software Foundation; either version 3 of the License, or
12 # (at your option) any later version.
14 # Koha is distributed in the hope that it will be useful, but
15 # WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 # GNU General Public License for more details.
19 # You should have received a copy of the GNU General Public License
20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
24 use vars qw(@ISA @EXPORT_OK);
44 GetAuthorisedValueDesc
46 GetMarcSubfieldStructure
47 IsMarcStructureInternal
49 GetMarcSubfieldStructureFromKohaField
60 LinkBibHeadingsToAuthorities
69 # those functions are exported but should not be used
70 # they are useful in a few circumstances, so they are exported,
71 # but don't use them unless you are a core developer ;-)
78 use Try::Tiny qw( catch try );
81 use List::MoreUtils qw( uniq );
83 use MARC::File::USMARC;
85 use POSIX qw( strftime );
86 use Module::Load::Conditional qw( can_load );
89 use C4::Log qw( logaction ); # logaction
91 use C4::ClassSource qw( GetClassSort GetClassSource );
99 use C4::Items qw( GetMarcItem );
103 use Koha::Authority::Types;
104 use Koha::Acquisition::Currencies;
105 use Koha::BackgroundJob::BatchUpdateBiblioHoldsQueue;
106 use Koha::Biblio::Metadatas;
109 use Koha::MarcOverlayRules;
111 use Koha::SearchEngine;
112 use Koha::SearchEngine::Indexer;
114 use Koha::Util::MARC;
118 C4::Biblio - cataloging management functions
122 Biblio.pm contains functions for managing storage and editing of bibliographic data within Koha. Most of the functions in this module are used for cataloging records: adding, editing, or removing biblios, biblioitems, or items. Koha's stores bibliographic information in three places:
126 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
128 =item 2. as raw MARC in the Zebra index and storage engine
130 =item 3. as MARC XML in biblio_metadata.metadata
134 In the 3.0 version of Koha, the authoritative record-level information is in biblio_metadata.metadata
136 Because the data isn't completely normalized there's a chance for information to get out of sync. The design choice to go with a un-normalized schema was driven by performance and stability concerns. However, if this occur, it can be considered as a bug : The API is (or should be) complete & the only entry point for all biblio/items managements.
140 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
142 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
146 Because of this design choice, the process of managing storage and editing is a bit convoluted. Historically, Biblio.pm's grown to an unmanagable size and as a result we have several types of functions currently:
150 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
152 =item 2. _koha_* - low-level internal functions for managing the koha tables
154 =item 3. Marc management function : as the MARC record is stored in biblio_metadata.metadata, some subs dedicated to it's management are in this package. They should be used only internally by Biblio.pm, the only official entry points being AddBiblio, AddItem, ModBiblio, ModItem.
156 =item 4. Zebra functions used to update the Zebra index
158 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
162 The MARC record (in biblio_metadata.metadata) contains the complete marc record, including items. It also contains the biblionumber. That is the reason why it is not stored directly by AddBiblio, with all other fields . To save a biblio, we need to :
166 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
168 =item 2. add the biblionumber and biblioitemnumber into the MARC records
170 =item 3. save the marc record
174 =head1 EXPORTED FUNCTIONS
178 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
180 Exported function (core API) for adding a new biblio to koha.
182 The first argument is a C<MARC::Record> object containing the
183 bib to add, while the second argument is the desired MARC
186 The C<$options> argument is a hashref with additional parameters:
190 =item B<defer_marc_save>: used when ModBiblioMarc is handled by the caller
192 =item B<skip_record_index>: used when the indexing schedulling will be handled by the caller
199 my ( $record, $frameworkcode, $options ) = @_;
202 my $skip_record_index = $options->{skip_record_index} || 0;
203 my $defer_marc_save = $options->{defer_marc_save} || 0;
206 carp('AddBiblio called with undefined record');
210 my $schema = Koha::Database->schema;
211 my ( $biblionumber, $biblioitemnumber );
213 $schema->txn_do(sub {
215 # transform the data into koha-table style data
216 SetUTF8Flag($record);
217 my $olddata = TransformMarcToKoha({ record => $record, limit_table => 'no_items' });
219 my $biblio = Koha::Biblio->new(
221 frameworkcode => $frameworkcode,
222 author => $olddata->{author},
223 title => $olddata->{title},
224 subtitle => $olddata->{subtitle},
225 medium => $olddata->{medium},
226 part_number => $olddata->{part_number},
227 part_name => $olddata->{part_name},
228 unititle => $olddata->{unititle},
229 notes => $olddata->{notes},
231 ( $olddata->{serial} || $olddata->{seriestitle} ? 1 : 0 ),
232 seriestitle => $olddata->{seriestitle},
233 copyrightdate => $olddata->{copyrightdate},
234 datecreated => \'NOW()',
235 abstract => $olddata->{abstract},
238 $biblionumber = $biblio->biblionumber;
239 Koha::Exceptions::ObjectNotCreated->throw unless $biblio;
241 my ($cn_sort) = GetClassSort( $olddata->{'biblioitems.cn_source'}, $olddata->{'cn_class'}, $olddata->{'cn_item'} );
242 my $biblioitem = Koha::Biblioitem->new(
244 biblionumber => $biblionumber,
245 volume => $olddata->{volume},
246 number => $olddata->{number},
247 itemtype => $olddata->{itemtype},
248 isbn => $olddata->{isbn},
249 issn => $olddata->{issn},
250 publicationyear => $olddata->{publicationyear},
251 publishercode => $olddata->{publishercode},
252 volumedate => $olddata->{volumedate},
253 volumedesc => $olddata->{volumedesc},
254 collectiontitle => $olddata->{collectiontitle},
255 collectionissn => $olddata->{collectionissn},
256 collectionvolume => $olddata->{collectionvolume},
257 editionstatement => $olddata->{editionstatement},
258 editionresponsibility => $olddata->{editionresponsibility},
259 illus => $olddata->{illus},
260 pages => $olddata->{pages},
261 notes => $olddata->{bnotes},
262 size => $olddata->{size},
263 place => $olddata->{place},
264 lccn => $olddata->{lccn},
265 url => $olddata->{url},
266 cn_source => $olddata->{'biblioitems.cn_source'},
267 cn_class => $olddata->{cn_class},
268 cn_item => $olddata->{cn_item},
269 cn_suffix => $olddata->{cn_suff},
271 totalissues => $olddata->{totalissues},
272 ean => $olddata->{ean},
273 agerestriction => $olddata->{agerestriction},
276 Koha::Exceptions::ObjectNotCreated->throw unless $biblioitem;
277 $biblioitemnumber = $biblioitem->biblioitemnumber;
279 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
281 # update MARC subfield that stores biblioitems.cn_sort
282 _koha_marc_update_biblioitem_cn_sort( $record, $olddata, $frameworkcode );
284 if (C4::Context->preference('AutoLinkBiblios')) {
285 BiblioAutoLink( $record, $frameworkcode );
289 ModBiblioMarc( $record, $biblionumber, { skip_record_index => $skip_record_index } ) unless $defer_marc_save;
291 # update OAI-PMH sets
292 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
293 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
296 _after_biblio_action_hooks({ action => 'create', biblio_id => $biblionumber });
298 logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
302 ( $biblionumber, $biblioitemnumber ) = ( undef, undef );
304 return ( $biblionumber, $biblioitemnumber );
309 ModBiblio($record, $biblionumber, $frameworkcode, $options);
311 Replace an existing bib record identified by C<$biblionumber>
312 with one supplied by the MARC::Record object C<$record>. The embedded
313 item, biblioitem, and biblionumber fields from the previous
314 version of the bib record replace any such fields of those tags that
315 are present in C<$record>. Consequently, ModBiblio() is not
316 to be used to try to modify item records.
318 C<$frameworkcode> specifies the MARC framework to use
319 when storing the modified bib record; among other things,
320 this controls how MARC fields get mapped to display columns
321 in the C<biblio> and C<biblioitems> tables, as well as
322 which fields are used to store embedded item, biblioitem,
323 and biblionumber data for indexing.
325 The C<$options> argument is a hashref with additional parameters:
329 =item C<overlay_context>
331 This parameter is forwarded to L</ApplyMarcOverlayRules> where it is used for
332 selecting the current rule set if MARCOverlayRules is enabled.
333 See L</ApplyMarcOverlayRules> for more details.
335 =item C<disable_autolink>
337 Unless C<disable_autolink> is passed ModBiblio will relink record headings
338 to authorities based on settings in the system preferences. This flag allows
339 us to not relink records when the authority linker is saving modifications.
341 =item C<skip_holds_queue>
343 Unless C<skip_holds_queue> is passed, ModBiblio will trigger the BatchUpdateBiblioHoldsQueue
344 task to rebuild the holds queue for the biblio if I<RealTimeHoldsQueue> is enabled.
348 Returns 1 on success 0 on failure
353 my ( $record, $biblionumber, $frameworkcode, $options ) = @_;
356 my $skip_record_index = $options->{skip_record_index} || 0;
359 carp 'No record passed to ModBiblio';
363 if ( C4::Context->preference("CataloguingLog") ) {
364 my $biblio = Koha::Biblios->find($biblionumber);
365 logaction( "CATALOGUING", "MODIFY", $biblionumber, "biblio BEFORE=>" . $biblio->metadata->record->as_formatted );
368 if ( !$options->{disable_autolink} && C4::Context->preference('AutoLinkBiblios') ) {
369 BiblioAutoLink( $record, $frameworkcode );
372 # Cleaning up invalid fields must be done early or SetUTF8Flag is liable to
373 # throw an exception which probably won't be handled.
374 foreach my $field ($record->fields()) {
375 if (! $field->is_control_field()) {
376 if (scalar($field->subfields()) == 0 || (scalar($field->subfields()) == 1 && $field->subfield('9'))) {
377 $record->delete_field($field);
382 SetUTF8Flag($record);
383 my $dbh = C4::Context->dbh;
385 $frameworkcode = "" if !$frameworkcode || $frameworkcode eq "Default"; # XXX
387 _strip_item_fields($record, $frameworkcode);
389 # apply overlay rules
390 if ( C4::Context->preference('MARCOverlayRules')
393 && exists $options->{overlay_context} )
395 $record = ApplyMarcOverlayRules(
397 biblionumber => $biblionumber,
399 overlay_context => $options->{overlay_context},
404 # update biblionumber and biblioitemnumber in MARC
405 # FIXME - this is assuming a 1 to 1 relationship between
406 # biblios and biblioitems
407 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
408 $sth->execute($biblionumber);
409 my ($biblioitemnumber) = $sth->fetchrow;
411 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
413 # load the koha-table data object
414 my $oldbiblio = TransformMarcToKoha({ record => $record });
416 # update MARC subfield that stores biblioitems.cn_sort
417 _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode );
419 # update the MARC record (that now contains biblio and items) with the new record data
420 ModBiblioMarc( $record, $biblionumber, { skip_record_index => $skip_record_index } );
422 # modify the other koha tables
423 _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
424 _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
426 _after_biblio_action_hooks({ action => 'modify', biblio_id => $biblionumber });
428 # update OAI-PMH sets
429 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
430 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
433 Koha::BackgroundJob::BatchUpdateBiblioHoldsQueue->new->enqueue(
435 biblio_ids => [ $biblionumber ]
437 ) unless $options->{skip_holds_queue} or !C4::Context->preference('RealTimeHoldsQueue');
442 =head2 _strip_item_fields
444 _strip_item_fields($record, $frameworkcode)
446 Utility routine to remove item tags from a
451 sub _strip_item_fields {
453 my $frameworkcode = shift;
454 # get the items before and append them to the biblio before updating the record, atm we just have the biblio
455 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber" );
457 # delete any item fields from incoming record to avoid
458 # duplication or incorrect data - use AddItem() or ModItem()
460 foreach my $field ( $record->field($itemtag) ) {
461 $record->delete_field($field);
467 my $error = &DelBiblio($biblionumber, $params);
469 Exported function (core API) for deleting a biblio in koha.
470 Deletes biblio record from Zebra and Koha tables (biblio & biblioitems)
471 Also backs it up to deleted* tables.
472 Checks to make sure that the biblio has no items attached.
474 C<$error> : undef unless an error occurs
476 I<$params> is a hashref containing extra parameters. Valid keys are:
480 =item B<skip_holds_queue>: used when the holds queue update will be handled by the caller
482 =item B<skip_record_index>: used when the indexing schedulling will be handled by the caller
488 my ($biblionumber, $params) = @_;
490 my $biblio = Koha::Biblios->find( $biblionumber );
491 return unless $biblio; # Should we throw an exception instead?
493 my $dbh = C4::Context->dbh;
494 my $error; # for error handling
496 # First make sure this biblio has no items attached
497 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
498 $sth->execute($biblionumber);
499 if ( my $itemnumber = $sth->fetchrow ) {
501 # Fix this to use a status the template can understand
502 $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
505 return $error if $error;
507 # We delete any existing holds
508 my $holds = $biblio->holds;
509 while ( my $hold = $holds->next ) {
510 # no need to update the holds queue on each step, we'll do it at the end
511 $hold->cancel({ skip_holds_queue => 1 });
514 unless ( $params->{skip_record_index} ){
515 my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
516 $indexer->index_records( $biblionumber, "recordDelete", "biblioserver" );
519 # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
520 $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
521 $sth->execute($biblionumber);
522 while ( my $biblioitemnumber = $sth->fetchrow ) {
524 # delete this biblioitem
525 $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
526 return $error if $error;
530 # delete biblio from Koha tables and save in deletedbiblio
531 # must do this *after* _koha_delete_biblioitems, otherwise
532 # delete cascade will prevent deletedbiblioitems rows
533 # from being generated by _koha_delete_biblioitems
534 $error = _koha_delete_biblio( $dbh, $biblionumber );
536 _after_biblio_action_hooks({ action => 'delete', biblio_id => $biblionumber });
538 logaction( "CATALOGUING", "DELETE", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
540 Koha::BackgroundJob::BatchUpdateBiblioHoldsQueue->new->enqueue(
542 biblio_ids => [ $biblionumber ]
544 ) unless $params->{skip_holds_queue} or !C4::Context->preference('RealTimeHoldsQueue');
550 =head2 BiblioAutoLink
552 my $headings_linked = BiblioAutoLink($record, $frameworkcode)
554 Automatically links headings in a bib record to authorities.
556 Returns the number of headings changed
562 my $frameworkcode = shift;
565 carp('Undefined record passed to BiblioAutoLink');
568 my ( $num_headings_changed, %results );
571 "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
572 unless ( can_load( modules => { $linker_module => undef } ) ) {
573 $linker_module = 'C4::Linker::Default';
574 unless ( can_load( modules => { $linker_module => undef } ) ) {
579 my $linker = $linker_module->new(
580 { 'options' => C4::Context->preference("LinkerOptions") } );
581 my ( $headings_changed, $results ) =
582 LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, C4::Context->preference("CatalogModuleRelink") || '', undef, $verbose );
583 # By default we probably don't want to relink things when cataloging
584 return $headings_changed, $results;
587 =head2 LinkBibHeadingsToAuthorities
589 my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink, $tagtolink, $verbose]);
591 Links bib headings to authority records by checking
592 each authority-controlled field in the C<MARC::Record>
593 object C<$marc>, looking for a matching authority record,
594 and setting the linking subfield $9 to the ID of that
597 If $allowrelink is false, existing authids will never be
598 replaced, regardless of the values of LinkerKeepStale and
601 Returns the number of heading links changed in the
606 sub LinkBibHeadingsToAuthorities {
609 my $frameworkcode = shift;
610 my $allowrelink = shift;
611 my $tagtolink = shift;
615 carp 'LinkBibHeadingsToAuthorities called on undefined bib record';
619 require C4::AuthoritiesMarc;
621 $allowrelink = 1 unless defined $allowrelink;
622 my $num_headings_changed = 0;
623 foreach my $field ( $bib->fields() ) {
624 if ( defined $tagtolink ) {
625 next unless $field->tag() == $tagtolink ;
627 my $heading = C4::Heading->new_from_field( $field, $frameworkcode );
628 next unless defined $heading;
631 my $current_link = $field->subfield('9');
633 if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) )
635 $results{'linked'}->{ $heading->display_form() }++;
636 push(@{$results{'details'}}, { tag => $field->tag(), authid => $current_link, status => 'UNCHANGED'}) if $verbose;
640 my ( $authid, $fuzzy, $match_count ) = $linker->get_link($heading);
642 $results{ $fuzzy ? 'fuzzy' : 'linked' }
643 ->{ $heading->display_form() }++;
644 if(defined $current_link and $current_link == $authid) {
645 push(@{$results{'details'}}, { tag => $field->tag(), authid => $current_link, status => 'UNCHANGED'}) if $verbose;
649 $field->delete_subfield( code => '9' ) if defined $current_link;
650 $field->add_subfields( '9', $authid );
651 $num_headings_changed++;
652 push(@{$results{'details'}}, { tag => $field->tag(), authid => $authid, status => 'LOCAL_FOUND'}) if $verbose;
655 my $authority_type = Koha::Authority::Types->find( $heading->auth_type() );
656 if ( defined $current_link
657 && (!$allowrelink || C4::Context->preference('LinkerKeepStale')) )
659 $results{'fuzzy'}->{ $heading->display_form() }++;
660 push(@{$results{'details'}}, { tag => $field->tag(), authid => $current_link, status => 'UNCHANGED'}) if $verbose;
662 elsif ( C4::Context->preference('AutoCreateAuthorities') ) {
663 if ( _check_valid_auth_link( $current_link, $field ) ) {
664 $results{'linked'}->{ $heading->display_form() }++;
666 elsif ( !$match_count ) {
667 my $authority_type = Koha::Authority::Types->find( $heading->auth_type() );
668 my $marcrecordauth = MARC::Record->new();
669 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
670 $marcrecordauth->leader(' nz a22 o 4500');
671 SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
673 $field->delete_subfield( code => '9' )
674 if defined $current_link;
676 foreach my $subfield ( $field->subfields() ){
677 if ( $subfield->[0] =~ /[A-z]/
678 && C4::Heading::valid_heading_subfield(
679 $field->tag, $subfield->[0] )
681 push @auth_subfields, $subfield->[0] => $subfield->[1];
684 # Bib headings contain some ending punctuation that should NOT
685 # be included in the authority record. Strip those before creation
686 next unless @auth_subfields; # Don't try to create a record if we have no fields;
687 my $last_sub = pop @auth_subfields;
688 $last_sub =~ s/[\s]*[,.:=;!%\/][\s]*$//;
689 push @auth_subfields, $last_sub;
690 my $authfield = MARC::Field->new( $authority_type->auth_tag_to_report, '', '', @auth_subfields );
691 $marcrecordauth->insert_fields_ordered($authfield);
693 # bug 2317: ensure new authority knows it's using UTF-8; currently
694 # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
695 # automatically for UNIMARC (by not transcoding)
696 # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
697 # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
698 # of change to a core API just before the 3.0 release.
700 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
701 my $userenv = C4::Context->userenv;
703 if ( $userenv && $userenv->{'branch'} ) {
704 $library = Koha::Libraries->find( $userenv->{'branch'} );
706 $marcrecordauth->insert_fields_ordered(
709 'a' => C4::Context->preference('GenerateAuthorityField667')
713 $bib->author() . ", "
714 . $bib->title_proper() . ", "
715 . $bib->publication_date() . " ";
716 $cite =~ s/^[\s\,]*//;
717 $cite =~ s/[\s\,]*$//;
719 C4::Context->preference('GenerateAuthorityField670') . ": ("
720 . ( $library ? $library->get_effective_marcorgcode : C4::Context->preference('MARCOrgCode') ) . ")"
721 . $bib->subfield( '999', 'c' ) . ": "
723 $marcrecordauth->insert_fields_ordered(
724 MARC::Field->new( '670', '', '', 'a' => $cite ) );
727 # warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
730 C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '',
731 $heading->auth_type() );
732 $field->add_subfields( '9', $authid );
733 $num_headings_changed++;
734 $linker->update_cache($heading, $authid);
735 $results{'added'}->{ $heading->display_form() }++;
736 push(@{$results{'details'}}, { tag => $field->tag(), authid => $authid, status => 'CREATED'}) if $verbose;
739 elsif ( defined $current_link ) {
740 if ( _check_valid_auth_link( $current_link, $field ) ) {
741 $results{'linked'}->{ $heading->display_form() }++;
742 push(@{$results{'details'}}, { tag => $field->tag(), authid => $authid, status => 'UNCHANGED'}) if $verbose;
745 $field->delete_subfield( code => '9' );
746 $num_headings_changed++;
747 $results{'unlinked'}->{ $heading->display_form() }++;
748 push(@{$results{'details'}}, { tag => $field->tag(), authid => undef, status => 'NONE_FOUND', auth_type => $heading->auth_type(), tag_to_report => $authority_type->auth_tag_to_report}) if $verbose;
752 $results{'unlinked'}->{ $heading->display_form() }++;
753 push(@{$results{'details'}}, { tag => $field->tag(), authid => undef, status => 'NONE_FOUND', auth_type => $heading->auth_type(), tag_to_report => $authority_type->auth_tag_to_report}) if $verbose;
758 push(@{$results{'details'}}, { tag => '', authid => undef, status => 'UNCHANGED'}) unless %results;
759 return $num_headings_changed, \%results;
762 =head2 _check_valid_auth_link
764 if ( _check_valid_auth_link($authid, $field) ) {
768 Check whether the specified heading-auth link is valid without reference
769 to Zebra. Ideally this code would be in C4::Heading, but that won't be
770 possible until we have de-cycled C4::AuthoritiesMarc, so this is the
775 sub _check_valid_auth_link {
776 my ( $authid, $field ) = @_;
777 require C4::AuthoritiesMarc;
779 return C4::AuthoritiesMarc::CompareFieldWithAuthority( { 'field' => $field, 'authid' => $authid } );
784 $data = &GetBiblioData($biblionumber);
786 Returns information about the book with the given biblionumber.
787 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
788 the C<biblio> and C<biblioitems> tables in the
791 In addition, C<$data-E<gt>{subject}> is the list of the book's
792 subjects, separated by C<" , "> (space, comma, space).
793 If there are multiple biblioitems with the given biblionumber, only
794 the first one is considered.
800 my $dbh = C4::Context->dbh;
802 my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
804 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
805 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
806 WHERE biblio.biblionumber = ?";
808 my $sth = $dbh->prepare($query);
809 $sth->execute($bibnum);
811 $data = $sth->fetchrow_hashref;
815 } # sub GetBiblioData
819 $isbd = &GetISBDView({
820 'record' => $marc_record,
821 'template' => $interface, # opac/intranet
822 'framework' => $framework,
825 Return the ISBD view which can be included in opac and intranet
832 # Expecting record WITH items.
833 my $record = $params->{record};
834 return unless defined $record;
836 my $template = $params->{template} // q{};
837 my $sysprefname = $template eq 'opac' ? 'opacisbd' : 'isbd';
838 my $framework = $params->{framework};
839 my $itemtype = $framework;
840 my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField( "items.holdingbranch" );
841 my $tagslib = GetMarcStructure( 1, $itemtype, { unsafe => 1 } );
843 my $ISBD = C4::Context->preference($sysprefname);
848 foreach my $isbdfield ( split( /#/, $bloc ) ) {
850 # $isbdfield= /(.?.?.?)/;
851 $isbdfield =~ /(\d\d\d)([^\|])?\|(.*)\|(.*)\|(.*)/;
852 my $fieldvalue = $1 || 0;
853 my $subfvalue = $2 || "";
855 my $analysestring = $4;
858 # warn "==> $1 / $2 / $3 / $4";
859 # my $fieldvalue=substr($isbdfield,0,3);
860 if ( $fieldvalue > 0 ) {
861 my $hasputtextbefore = 0;
862 my @fieldslist = $record->field($fieldvalue);
863 @fieldslist = sort { $a->subfield($holdingbrtagsubf) cmp $b->subfield($holdingbrtagsubf) } @fieldslist if ( $fieldvalue eq $holdingbrtagf );
865 # warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
866 # warn "FV : $fieldvalue";
867 if ( $subfvalue ne "" ) {
868 # OPAC hidden subfield
870 if ( ( $template eq 'opac' )
871 && ( $tagslib->{$fieldvalue}->{$subfvalue}->{'hidden'} || 0 ) > 0 );
872 foreach my $field (@fieldslist) {
873 foreach my $subfield ( $field->subfield($subfvalue) ) {
874 my $calculated = $analysestring;
875 my $tag = $field->tag();
878 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subfvalue, $subfield, '', $tagslib );
879 my $tagsubf = $tag . $subfvalue;
880 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
881 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
883 # field builded, store the result
884 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
885 $blocres .= $textbefore;
886 $hasputtextbefore = 1;
889 # remove punctuation at start
890 $calculated =~ s/^( |;|:|\.|-)*//g;
891 $blocres .= $calculated;
896 $blocres .= $textafter if $hasputtextbefore;
898 foreach my $field (@fieldslist) {
899 my $calculated = $analysestring;
900 my $tag = $field->tag();
903 my @subf = $field->subfields;
904 for my $i ( 0 .. $#subf ) {
905 my $valuecode = $subf[$i][1];
906 my $subfieldcode = $subf[$i][0];
907 # OPAC hidden subfield
909 if ( ( $template eq 'opac' )
910 && ( $tagslib->{$fieldvalue}->{$subfieldcode}->{'hidden'} || 0 ) > 0 );
911 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subf[$i][0], $subf[$i][1], '', $tagslib );
912 my $tagsubf = $tag . $subfieldcode;
914 $calculated =~ s/ # replace all {{}} codes by the value code.
915 \{\{$tagsubf\}\} # catch the {{actualcode}}
917 $valuecode # replace by the value code
920 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
921 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
924 # field builded, store the result
925 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
926 $blocres .= $textbefore;
927 $hasputtextbefore = 1;
930 # remove punctuation at start
931 $calculated =~ s/^( |;|:|\.|-)*//g;
932 $blocres .= $calculated;
935 $blocres .= $textafter if $hasputtextbefore;
938 $blocres .= $isbdfield;
943 $res =~ s/\{(.*?)\}//g;
945 $res =~ s/\n/<br\/>/g;
953 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
955 =head2 IsMarcStructureInternal
957 my $tagslib = C4::Biblio::GetMarcStructure();
958 for my $tag ( sort keys %$tagslib ) {
960 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
961 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
966 GetMarcStructure creates keys (lib, tab, mandatory, repeatable, important) for a display purpose.
967 These different values should not be processed as valid subfields.
971 sub IsMarcStructureInternal {
972 my ( $subfield ) = @_;
973 return ref $subfield ? 0 : 1;
976 =head2 GetMarcStructure
978 $res = GetMarcStructure($forlibrarian, $frameworkcode, [ $params ]);
980 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
981 $forlibrarian :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
982 $frameworkcode : the framework code to read
983 $params allows you to pass { unsafe => 1 } for better performance.
985 Note: If you call GetMarcStructure with unsafe => 1, do not modify or
986 even autovivify its contents. It is a cached/shared data structure. Your
987 changes c/would be passed around in subsequent calls.
991 sub GetMarcStructure {
992 my ( $forlibrarian, $frameworkcode, $params ) = @_;
993 $frameworkcode = "" unless $frameworkcode;
995 $forlibrarian = $forlibrarian ? 1 : 0;
996 my $unsafe = ($params && $params->{unsafe})? 1: 0;
997 my $cache = Koha::Caches->get_instance();
998 my $cache_key = "MarcStructure-$forlibrarian-$frameworkcode";
999 my $cached = $cache->get_from_cache($cache_key, { unsafe => $unsafe });
1000 return $cached if $cached;
1002 my $dbh = C4::Context->dbh;
1003 my $sth = $dbh->prepare(
1004 "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable,important,ind1_defaultvalue,ind2_defaultvalue
1005 FROM marc_tag_structure
1006 WHERE frameworkcode=?
1009 $sth->execute($frameworkcode);
1010 my ( $liblibrarian, $libopac, $tag, $res, $mandatory, $repeatable, $important, $ind1_defaultvalue, $ind2_defaultvalue );
1012 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable, $important, $ind1_defaultvalue, $ind2_defaultvalue ) = $sth->fetchrow ) {
1013 $res->{$tag}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1014 $res->{$tag}->{tab} = "";
1015 $res->{$tag}->{mandatory} = $mandatory;
1016 $res->{$tag}->{important} = $important;
1017 $res->{$tag}->{repeatable} = $repeatable;
1018 $res->{$tag}->{ind1_defaultvalue} = $ind1_defaultvalue;
1019 $res->{$tag}->{ind2_defaultvalue} = $ind2_defaultvalue;
1022 my $mss = Koha::MarcSubfieldStructures->search( { frameworkcode => $frameworkcode } )->unblessed;
1024 $res->{ $m->{tagfield} }->{ $m->{tagsubfield} } = {
1025 lib => ( $forlibrarian or !$m->{libopac} ) ? $m->{liblibrarian} : $m->{libopac},
1026 subfield => $m->{tagsubfield},
1031 $cache->set_in_cache($cache_key, $res);
1035 =head2 GetUsedMarcStructure
1037 The same function as GetMarcStructure except it just takes field
1038 in tab 0-9. (used field)
1040 my $results = GetUsedMarcStructure($frameworkcode);
1042 C<$results> is a ref to an array which each case contains a ref
1043 to a hash which each keys is the columns from marc_subfield_structure
1045 C<$frameworkcode> is the framework code.
1049 sub GetUsedMarcStructure {
1050 my $frameworkcode = shift || '';
1053 FROM marc_subfield_structure
1055 AND frameworkcode = ?
1056 ORDER BY tagfield, display_order, tagsubfield
1058 my $sth = C4::Context->dbh->prepare($query);
1059 $sth->execute($frameworkcode);
1060 return $sth->fetchall_arrayref( {} );
1065 =head2 GetMarcSubfieldStructure
1067 my $structure = GetMarcSubfieldStructure($frameworkcode, [$params]);
1069 Returns a reference to hash representing MARC subfield structure
1070 for framework with framework code C<$frameworkcode>, C<$params> is
1071 optional and may contain additional options.
1075 =item C<$frameworkcode>
1081 An optional hash reference with additional options.
1082 The following options are supported:
1088 Pass { unsafe => 1 } do disable cached object cloning,
1089 and instead get a shared reference, resulting in better
1090 performance (but care must be taken so that retured object
1093 Note: If you call GetMarcSubfieldStructure with unsafe => 1, do not modify or
1094 even autovivify its contents. It is a cached/shared data structure. Your
1095 changes would be passed around in subsequent calls.
1103 sub GetMarcSubfieldStructure {
1104 my ( $frameworkcode, $params ) = @_;
1106 $frameworkcode //= '';
1108 my $cache = Koha::Caches->get_instance();
1109 my $cache_key = "MarcSubfieldStructure-$frameworkcode";
1110 my $cached = $cache->get_from_cache($cache_key, { unsafe => ($params && $params->{unsafe}) });
1111 return $cached if $cached;
1113 my $dbh = C4::Context->dbh;
1114 # We moved to selectall_arrayref since selectall_hashref does not
1115 # keep duplicate mappings on kohafield (like place in 260 vs 264)
1116 my $subfield_aref = $dbh->selectall_arrayref( q|
1118 FROM marc_subfield_structure
1119 WHERE frameworkcode = ?
1121 ORDER BY frameworkcode, tagfield, display_order, tagsubfield
1122 |, { Slice => {} }, $frameworkcode );
1123 # Now map the output to a hash structure
1124 my $subfield_structure = {};
1125 foreach my $row ( @$subfield_aref ) {
1126 push @{ $subfield_structure->{ $row->{kohafield} }}, $row;
1128 $cache->set_in_cache( $cache_key, $subfield_structure );
1129 return $subfield_structure;
1132 =head2 GetMarcFromKohaField
1134 ( $field,$subfield ) = GetMarcFromKohaField( $kohafield );
1135 @fields = GetMarcFromKohaField( $kohafield );
1136 $field = GetMarcFromKohaField( $kohafield );
1138 Returns the MARC fields & subfields mapped to $kohafield.
1139 Since the Default framework is considered as authoritative for such
1140 mappings, the former frameworkcode parameter is obsoleted.
1142 In list context all mappings are returned; there can be multiple
1143 mappings. Note that in the above example you could miss a second
1144 mappings in the first call.
1145 In scalar context only the field tag of the first mapping is returned.
1149 sub GetMarcFromKohaField {
1150 my ( $kohafield ) = @_;
1151 return unless $kohafield;
1152 # The next call uses the Default framework since it is AUTHORITATIVE
1153 # for all Koha to MARC mappings.
1154 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
1156 foreach( @{ $mss->{$kohafield} } ) {
1157 push @retval, $_->{tagfield}, $_->{tagsubfield};
1159 return wantarray ? @retval : ( @retval ? $retval[0] : undef );
1162 =head2 GetMarcSubfieldStructureFromKohaField
1164 my $str = GetMarcSubfieldStructureFromKohaField( $kohafield );
1166 Returns marc subfield structure information for $kohafield.
1167 The Default framework is used, since it is authoritative for kohafield
1169 In list context returns a list of all hashrefs, since there may be
1170 multiple mappings. In scalar context the first hashref is returned.
1174 sub GetMarcSubfieldStructureFromKohaField {
1175 my ( $kohafield ) = @_;
1177 return unless $kohafield;
1179 # The next call uses the Default framework since it is AUTHORITATIVE
1180 # for all Koha to MARC mappings.
1181 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
1182 return unless $mss->{$kohafield};
1183 return wantarray ? @{$mss->{$kohafield}} : $mss->{$kohafield}->[0];
1188 my $marcxml = GetXmlBiblio($biblionumber);
1190 Returns biblio_metadata.metadata/marcxml of the biblionumber passed in parameter.
1191 The XML should only contain biblio information (item information is no longer stored in marcxml field)
1196 my ($biblionumber) = @_;
1197 my $dbh = C4::Context->dbh;
1198 return unless $biblionumber;
1199 my ($marcxml) = $dbh->selectrow_array(
1202 FROM biblio_metadata
1203 WHERE biblionumber=?
1204 AND format='marcxml'
1206 |, undef, $biblionumber, C4::Context->preference('marcflavour')
1213 return the prices in accordance with the Marc format.
1215 returns 0 if no price found
1216 returns undef if called without a marc record or with
1217 an unrecognized marc format
1222 my ( $record, $marcflavour ) = @_;
1224 carp 'GetMarcPrice called on undefined record';
1231 if ( $marcflavour eq "MARC21" ) {
1232 @listtags = ('345', '020');
1234 } elsif ( $marcflavour eq "UNIMARC" ) {
1235 @listtags = ('345', '010');
1241 for my $field ( $record->field(@listtags) ) {
1242 for my $subfield_value ($field->subfield($subfield)){
1244 $subfield_value = MungeMarcPrice( $subfield_value );
1245 return $subfield_value if ($subfield_value);
1248 return 0; # no price found
1251 =head2 MungeMarcPrice
1253 Return the best guess at what the actual price is from a price field.
1257 sub MungeMarcPrice {
1259 return unless ( $price =~ m/\d/ ); ## No digits means no price.
1260 # Look for the currency symbol and the normalized code of the active currency, if it's there,
1261 my $active_currency = Koha::Acquisition::Currencies->get_active;
1262 my $symbol = $active_currency->symbol;
1263 my $isocode = $active_currency->isocode;
1264 $isocode = $active_currency->currency unless defined $isocode;
1267 my @matches =($price=~ /
1269 ( # start of capturing parenthesis
1271 (?:[\p{Sc}\p{L}\/.]){1,4} # any character from Currency signs or Letter Unicode categories or slash or dot within 1 to 4 occurrences : call this whole block 'symbol block'
1272 |(?:\d+[\p{P}\s]?){1,4} # or else at least one digit followed or not by a punctuation sign or whitespace, all these within 1 to 4 occurrences : call this whole block 'digits block'
1274 \s?\p{Sc}?\s? # followed or not by a whitespace. \p{Sc}?\s? are for cases like '25$ USD'
1276 (?:[\p{Sc}\p{L}\/.]){1,4} # followed by same block as symbol block
1277 |(?:\d+[\p{P}\s]?){1,4} # or by same block as digits block
1279 \s?\p{L}{0,4}\s? # followed or not by a whitespace. \p{L}{0,4}\s? are for cases like '$9.50 USD'
1280 ) # end of capturing parenthesis
1281 (?:\p{P}|\z) # followed by a punctuation sign or by the end of the string
1285 foreach ( @matches ) {
1286 $localprice = $_ and last if index($_, $isocode)>=0;
1288 if ( !$localprice ) {
1289 foreach ( @matches ) {
1290 $localprice = $_ and last if $_=~ /(^|[^\p{Sc}\p{L}\/])\Q$symbol\E([^\p{Sc}\p{L}\/]+\z|\z)/;
1295 if ( $localprice ) {
1296 $price = $localprice;
1298 ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
1299 ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
1301 # eliminate symbol/isocode, space and any final dot from the string
1302 $price =~ s/[\p{Sc}\p{L}\/ ]|\.$//g;
1303 # remove comma,dot when used as separators from hundreds
1304 $price =~s/[\,\.](\d{3})/$1/g;
1305 # convert comma to dot to ensure correct display of decimals if existing
1311 =head2 GetMarcQuantity
1313 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
1314 Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
1316 returns 0 if no quantity found
1317 returns undef if called without a marc record or with
1318 an unrecognized marc format
1322 sub GetMarcQuantity {
1323 my ( $record, $marcflavour ) = @_;
1325 carp 'GetMarcQuantity called on undefined record';
1332 if ( $marcflavour eq "MARC21" ) {
1334 } elsif ( $marcflavour eq "UNIMARC" ) {
1335 @listtags = ('969');
1341 for my $field ( $record->field(@listtags) ) {
1342 for my $subfield_value ($field->subfield($subfield)){
1344 if ($subfield_value) {
1345 # in France, the cents separator is the , but sometimes, ppl use a .
1346 # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1347 $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
1348 return $subfield_value;
1352 return 0; # no price found
1356 =head2 GetAuthorisedValueDesc
1358 my $subfieldvalue =get_authorised_value_desc(
1359 $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1361 Retrieve the complete description for a given authorised value.
1363 Now takes $category and $value pair too.
1365 my $auth_value_desc =GetAuthorisedValueDesc(
1366 '','', 'DVD' ,'','','CCODE');
1368 If the optional $opac parameter is set to a true value, displays OPAC
1369 descriptions rather than normal ones when they exist.
1373 sub GetAuthorisedValueDesc {
1374 my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1378 return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1381 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1382 my $branch = Koha::Libraries->find($value);
1383 return $branch? $branch->branchname: q{};
1387 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1388 my $itemtype = Koha::ItemTypes->find( $value );
1389 return $itemtype ? $itemtype->translated_description : q||;
1392 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "cn_source" ) {
1393 my $source = GetClassSource($value);
1394 return $source ? $source->{description} : q||;
1397 #---- "true" authorized value
1398 $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1401 my $dbh = C4::Context->dbh;
1402 if ( $category ne "" ) {
1403 my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1404 $sth->execute( $category, $value );
1405 my $data = $sth->fetchrow_hashref;
1406 return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
1408 return $value; # if nothing is found return the original value
1412 =head2 GetMarcControlnumber
1414 $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1416 Get the control number / record Identifier from the MARC record and return it.
1420 sub GetMarcControlnumber {
1421 my ( $record, $marcflavour ) = @_;
1423 carp 'GetMarcControlnumber called on undefined record';
1426 my $controlnumber = "";
1427 # Control number or Record identifier are the same field in MARC21 and UNIMARC
1428 # Keep $marcflavour for possible later use
1429 if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" ) {
1430 my $controlnumberField = $record->field('001');
1431 if ($controlnumberField) {
1432 $controlnumber = $controlnumberField->data();
1435 return $controlnumber;
1440 $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1442 Get all ISBNs from the MARC record and returns them in an array.
1443 ISBNs stored in different fields depending on MARC flavour
1448 my ( $record, $marcflavour ) = @_;
1450 carp 'GetMarcISBN called on undefined record';
1454 if ( $marcflavour eq "UNIMARC" ) {
1456 } else { # assume marc21 if not unimarc
1461 foreach my $field ( $record->field($scope) ) {
1462 my $isbn = $field->subfield( 'a' );
1463 if ( $isbn && $isbn ne "" ) {
1464 push @marcisbns, $isbn;
1474 $marcissnsarray = GetMarcISSN( $record, $marcflavour );
1476 Get all valid ISSNs from the MARC record and returns them in an array.
1477 ISSNs are stored in different fields depending on MARC flavour
1482 my ( $record, $marcflavour ) = @_;
1484 carp 'GetMarcISSN called on undefined record';
1488 if ( $marcflavour eq "UNIMARC" ) {
1491 else { # assume MARC21
1495 foreach my $field ( $record->field($scope) ) {
1496 push @marcissns, $field->subfield( 'a' )
1497 if ( $field->subfield( 'a' ) ne "" );
1502 =head2 GetMarcSubjects
1504 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1506 Get all subjects from the MARC record and returns them in an array.
1507 The subjects are stored in different fields depending on MARC flavour
1511 sub GetMarcSubjects {
1512 my ( $record, $marcflavour ) = @_;
1514 carp 'GetMarcSubjects called on undefined record';
1517 my ( $mintag, $maxtag, $fields_filter );
1518 if ( $marcflavour eq "UNIMARC" ) {
1521 $fields_filter = '6..';
1525 $fields_filter = '6..';
1530 my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1531 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1533 foreach my $field ( $record->field($fields_filter) ) {
1534 next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
1536 my @subfields = $field->subfields();
1539 # if there is an authority link, build the links with an= subfield9
1540 my $subfield9 = $field->subfield('9');
1543 my $linkvalue = $subfield9;
1544 $linkvalue =~ s/(\(|\))//g;
1545 @link_loop = ( { limit => 'an', 'link' => $linkvalue } );
1546 $authoritylink = $linkvalue
1550 for my $subject_subfield (@subfields) {
1551 next if ( $subject_subfield->[0] eq '9' );
1553 # don't load unimarc subfields 3,4,5
1554 next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1555 # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1556 next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1558 my $code = $subject_subfield->[0];
1559 my $value = $subject_subfield->[1];
1560 my $linkvalue = $value;
1561 $linkvalue =~ s/(\(|\))//g;
1562 # if no authority link, build a search query
1563 unless ($subfield9) {
1565 limit => $subject_limit,
1566 'link' => $linkvalue,
1567 operator => (scalar @link_loop) ? ' AND ' : undef
1570 my @this_link_loop = @link_loop;
1572 unless ( $code eq '0' ) {
1573 push @subfields_loop, {
1576 link_loop => \@this_link_loop,
1577 separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1582 push @marcsubjects, {
1583 MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop,
1584 authoritylink => $authoritylink,
1585 } if $authoritylink || @subfields_loop;
1588 return \@marcsubjects;
1589 } #end getMARCsubjects
1593 $marcurls = GetMarcUrls($record,$marcflavour);
1595 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1596 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1601 my ( $record, $marcflavour ) = @_;
1603 carp 'GetMarcUrls called on undefined record';
1608 for my $field ( $record->field('856') ) {
1610 for my $note ( $field->subfield('z') ) {
1611 push @notes, { note => $note };
1613 my @urls = $field->subfield('u');
1614 foreach my $url (@urls) {
1615 $url =~ s/^\s+|\s+$//g; # trim
1617 if ( $marcflavour eq 'MARC21' ) {
1618 my $s3 = $field->subfield('3');
1619 my $link = $field->subfield('y');
1620 unless ( $url =~ /^\w+:/ ) {
1621 if ( $field->indicator(1) eq '7' ) {
1622 $url = $field->subfield('2') . "://" . $url;
1623 } elsif ( $field->indicator(1) eq '1' ) {
1624 $url = 'ftp://' . $url;
1627 # properly, this should be if ind1=4,
1628 # however we will assume http protocol since we're building a link.
1629 $url = 'http://' . $url;
1633 # TODO handle ind 2 (relationship)
1638 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
1639 $marcurl->{'part'} = $s3 if ($link);
1640 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1642 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
1643 $marcurl->{'MARCURL'} = $url;
1645 push @marcurls, $marcurl;
1651 =head2 GetMarcSeries
1653 $marcseriesarray = GetMarcSeries($record,$marcflavour);
1655 Get all series from the MARC record and returns them in an array.
1656 The series are stored in different fields depending on MARC flavour
1661 my ( $record, $marcflavour ) = @_;
1663 carp 'GetMarcSeries called on undefined record';
1667 my ( $mintag, $maxtag, $fields_filter );
1668 if ( $marcflavour eq "UNIMARC" ) {
1671 $fields_filter = '2..';
1675 $fields_filter = '4..';
1679 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1681 foreach my $field ( $record->field($fields_filter) ) {
1682 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1684 my @subfields = $field->subfields();
1687 for my $series_subfield (@subfields) {
1689 # ignore $9, used for authority link
1690 next if ( $series_subfield->[0] eq '9' );
1693 my $code = $series_subfield->[0];
1694 my $value = $series_subfield->[1];
1695 my $linkvalue = $value;
1696 $linkvalue =~ s/(\(|\))//g;
1698 # see if this is an instance of a volume
1699 if ( $code eq 'v' ) {
1704 'link' => $linkvalue,
1705 operator => (scalar @link_loop) ? ' AND ' : undef
1708 if ($volume_number) {
1709 push @subfields_loop, { volumenum => $value };
1711 push @subfields_loop, {
1714 link_loop => \@link_loop,
1715 separator => (scalar @subfields_loop) ? $AuthoritySeparator : '',
1716 volumenum => $volume_number,
1720 push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1723 return \@marcseries;
1724 } #end getMARCseriess
1726 =head2 UpsertMarcSubfield
1728 my $record = C4::Biblio::UpsertMarcSubfield($MARC::Record, $fieldTag, $subfieldCode, $subfieldContent);
1732 sub UpsertMarcSubfield {
1733 my ($record, $tag, $code, $content) = @_;
1734 my $f = $record->field($tag);
1737 $f->update( $code => $content );
1740 my $f = MARC::Field->new( $tag, '', '', $code => $content);
1741 $record->insert_fields_ordered( $f );
1745 =head2 UpsertMarcControlField
1747 my $record = C4::Biblio::UpsertMarcControlField($MARC::Record, $fieldTag, $content);
1751 sub UpsertMarcControlField {
1752 my ($record, $tag, $content) = @_;
1753 die "UpsertMarcControlField() \$tag '$tag' is not a control field\n" unless 0+$tag < 10;
1754 my $f = $record->field($tag);
1757 $f->update( $content );
1760 my $f = MARC::Field->new($tag, $content);
1761 $record->insert_fields_ordered( $f );
1765 =head2 GetFrameworkCode
1767 $frameworkcode = GetFrameworkCode( $biblionumber )
1771 sub GetFrameworkCode {
1772 my ($biblionumber) = @_;
1773 my $dbh = C4::Context->dbh;
1774 my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
1775 $sth->execute($biblionumber);
1776 my ($frameworkcode) = $sth->fetchrow;
1777 return $frameworkcode;
1780 =head2 TransformKohaToMarc
1782 $record = TransformKohaToMarc( $hash [, $params ] )
1784 This function builds a (partial) MARC::Record from a hash.
1785 Hash entries can be from biblio, biblioitems or items.
1786 The params hash includes the parameter no_split used in C4::Items.
1788 This function is called in acquisition module, to create a basic catalogue
1789 entry from user entry.
1794 sub TransformKohaToMarc {
1795 my ( $hash, $params ) = @_;
1796 my $record = MARC::Record->new();
1797 SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
1799 # In the next call we use the Default framework, since it is considered
1800 # authoritative for Koha to Marc mappings.
1801 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # do not change framework
1803 while ( my ($kohafield, $value) = each %$hash ) {
1804 foreach my $fld ( @{ $mss->{$kohafield} } ) {
1805 my $tagfield = $fld->{tagfield};
1806 my $tagsubfield = $fld->{tagsubfield};
1809 # BZ 21800: split value if field is repeatable.
1810 my @values = _check_split($params, $fld, $value)
1811 ? split(/\s?\|\s?/, $value, -1)
1813 foreach my $value ( @values ) {
1814 next if $value eq '';
1815 $tag_hr->{$tagfield} //= [];
1816 push @{$tag_hr->{$tagfield}}, [($tagsubfield, $value)];
1820 foreach my $tag (sort keys %$tag_hr) {
1821 my @sfl = @{$tag_hr->{$tag}};
1822 @sfl = sort { $a->[0] cmp $b->[0]; } @sfl;
1823 @sfl = map { @{$_}; } @sfl;
1824 # Special care for control fields: remove the subfield indication @
1825 # and do not insert indicators.
1826 my @ind = $tag < 10 ? () : ( " ", " " );
1827 @sfl = grep { $_ ne '@' } @sfl if $tag < 10;
1828 $record->insert_fields_ordered( MARC::Field->new($tag, @ind, @sfl) );
1834 # Checks if $value must be split; may consult passed framework
1835 my ($params, $fld, $value) = @_;
1836 return if index($value,'|') == -1; # nothing to worry about
1837 return if $params->{no_split};
1839 # if we did not get a specific framework, check default in $mss
1840 return $fld->{repeatable} if !$params->{framework};
1842 # here we need to check the specific framework
1843 my $mss = GetMarcSubfieldStructure($params->{framework}, { unsafe => 1 });
1844 foreach my $fld2 ( @{ $mss->{ $fld->{kohafield} } } ) {
1845 next if $fld2->{tagfield} ne $fld->{tagfield};
1846 next if $fld2->{tagsubfield} ne $fld->{tagsubfield};
1847 return 1 if $fld2->{repeatable};
1852 =head2 PrepHostMarcField
1854 $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
1856 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
1860 sub PrepHostMarcField {
1861 my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
1862 $marcflavour ||="MARC21";
1864 my $biblio = Koha::Biblios->find($hostbiblionumber);
1865 my $hostrecord = $biblio->metadata->record;
1866 my $item = Koha::Items->find($hostitemnumber);
1869 if ( $marcflavour eq "MARC21" ) {
1873 if ($hostrecord->subfield('100','a')){
1874 $mainentry = $hostrecord->subfield('100','a');
1875 } elsif ($hostrecord->subfield('110','a')){
1876 $mainentry = $hostrecord->subfield('110','a');
1878 $mainentry = $hostrecord->subfield('111','a');
1881 # qualification info
1883 if (my $field260 = $hostrecord->field('260')){
1884 $qualinfo = $field260->as_string( 'abc' );
1889 my $ed = $hostrecord->subfield('250','a');
1890 my $barcode = $item->barcode;
1891 my $title = $hostrecord->subfield('245','a');
1893 # record control number, 001 with 003 and prefix
1895 if ($hostrecord->field('001')){
1896 $recctrlno = $hostrecord->field('001')->data();
1897 if ($hostrecord->field('003')){
1898 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
1903 my $issn = $hostrecord->subfield('022','a');
1904 my $isbn = $hostrecord->subfield('020','a');
1907 $hostmarcfield = MARC::Field->new(
1909 '0' => $hostbiblionumber,
1910 '9' => $hostitemnumber,
1920 } elsif ($marcflavour eq "UNIMARC") {
1921 $hostmarcfield = MARC::Field->new(
1923 '0' => $hostbiblionumber,
1924 't' => $hostrecord->subfield('200','a'),
1925 '9' => $hostitemnumber
1929 return $hostmarcfield;
1932 =head2 TransformHtmlToXml
1934 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
1935 $ind_tag, $auth_type )
1937 $auth_type contains :
1941 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
1943 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
1945 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
1951 sub TransformHtmlToXml {
1952 my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
1953 # NOTE: The parameter $ind_tag is NOT USED -- BZ 11247
1955 my ( $perm_loc_tag, $perm_loc_subfield ) = C4::Biblio::GetMarcFromKohaField( "items.permanent_location" );
1957 my $xml = MARC::File::XML::header('UTF-8');
1958 $xml .= "<record>\n";
1959 $auth_type = C4::Context->preference('marcflavour') unless $auth_type; # FIXME auth_type must be removed
1960 MARC::File::XML->default_record_format($auth_type);
1962 # in UNIMARC, field 100 contains the encoding
1963 # check that there is one, otherwise the
1964 # MARC::Record->new_from_xml will fail (and Koha will die)
1965 my $unimarc_and_100_exist = 0;
1966 $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
1971 for ( my $i = 0 ; $i < @$tags ; $i++ ) {
1972 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
1974 # if we have a 100 field and it's values are not correct, skip them.
1975 # if we don't have any valid 100 field, we will create a default one at the end
1976 my $enc = substr( @$values[$i], 26, 2 );
1977 if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
1978 $unimarc_and_100_exist = 1;
1983 @$values[$i] =~ s/&/&/g;
1984 @$values[$i] =~ s/</</g;
1985 @$values[$i] =~ s/>/>/g;
1986 @$values[$i] =~ s/"/"/g;
1987 @$values[$i] =~ s/'/'/g;
1989 my $skip = @$values[$i] eq q{};
1992 && $perm_loc_subfield
1993 && @$tags[$i] eq $perm_loc_tag
1994 && @$subfields[$i] eq $perm_loc_subfield;
1996 if ( ( @$tags[$i] ne $prevtag ) ) {
1997 $close_last_tag = 0;
1998 $j++ unless ( @$tags[$i] eq "" );
1999 my $str = ( $indicator->[$j] // q{} ) . ' '; # extra space prevents substr outside of string warn
2000 my $ind1 = _default_ind_to_space( substr( $str, 0, 1 ) );
2001 my $ind2 = _default_ind_to_space( substr( $str, 1, 1 ) );
2003 $xml .= "</datafield>\n";
2004 if ( ( @$tags[$i] && @$tags[$i] > 10 )
2006 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2007 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2009 $close_last_tag = 1;
2017 if ( @$tags[$i] eq "000" ) {
2018 $xml .= "<leader>@$values[$i]</leader>\n";
2021 # rest of the fixed fields
2022 } elsif ( @$tags[$i] < 10 ) {
2023 $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2026 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2027 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2029 $close_last_tag = 1;
2033 } else { # @$tags[$i] eq $prevtag
2036 my $str = ( $indicator->[$j] // q{} ) . ' '; # extra space prevents substr outside of string warn
2037 my $ind1 = _default_ind_to_space( substr( $str, 0, 1 ) );
2038 my $ind2 = _default_ind_to_space( substr( $str, 1, 1 ) );
2039 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2041 $close_last_tag = 1;
2043 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2046 $prevtag = @$tags[$i];
2048 $xml .= "</datafield>\n" if $close_last_tag;
2049 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2051 # warn "SETTING 100 for $auth_type";
2052 my $string = strftime( "%Y%m%d", localtime(time) );
2054 # set 50 to position 26 is biblios, 13 if authorities
2056 $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2057 $string = sprintf( "%-*s", 35, $string );
2058 substr( $string, $pos, 6, "50" );
2059 $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2060 $xml .= "<subfield code=\"a\">$string</subfield>\n";
2061 $xml .= "</datafield>\n";
2063 $xml .= "</record>\n";
2064 $xml .= MARC::File::XML::footer();
2068 =head2 _default_ind_to_space
2070 Passed what should be an indicator returns a space
2071 if its undefined or zero length
2075 sub _default_ind_to_space {
2077 if ( !defined $s || $s eq q{} ) {
2083 =head2 TransformHtmlToMarc
2085 L<$record> = TransformHtmlToMarc(L<$cgi>)
2086 L<$cgi> is the CGI object which contains the values for subfields
2088 'tag_010_indicator1_531951' ,
2089 'tag_010_indicator2_531951' ,
2090 'tag_010_code_a_531951_145735' ,
2091 'tag_010_subfield_a_531951_145735' ,
2092 'tag_200_indicator1_873510' ,
2093 'tag_200_indicator2_873510' ,
2094 'tag_200_code_a_873510_673465' ,
2095 'tag_200_subfield_a_873510_673465' ,
2096 'tag_200_code_b_873510_704318' ,
2097 'tag_200_subfield_b_873510_704318' ,
2098 'tag_200_code_e_873510_280822' ,
2099 'tag_200_subfield_e_873510_280822' ,
2100 'tag_200_code_f_873510_110730' ,
2101 'tag_200_subfield_f_873510_110730' ,
2103 L<$record> is the MARC::Record object.
2107 sub TransformHtmlToMarc {
2108 my ($cgi, $isbiblio) = @_;
2110 my @params = $cgi->multi_param();
2112 # explicitly turn on the UTF-8 flag for all
2113 # 'tag_' parameters to avoid incorrect character
2114 # conversion later on
2115 my $cgi_params = $cgi->Vars;
2116 foreach my $param_name ( keys %$cgi_params ) {
2117 if ( $param_name =~ /^tag_/ ) {
2118 my $param_value = $cgi_params->{$param_name};
2119 unless ( Encode::is_utf8( $param_value ) ) {
2120 $cgi_params->{$param_name} = Encode::decode('UTF-8', $param_value );
2125 # creating a new record
2126 my $record = MARC::Record->new();
2128 my ($biblionumbertagfield, $biblionumbertagsubfield) = (-1, -1);
2129 ($biblionumbertagfield, $biblionumbertagsubfield) =
2130 &GetMarcFromKohaField( "biblio.biblionumber", '' ) if $isbiblio;
2131 #FIXME This code assumes that the CGI params will be in the same order as the fields in the template; this is no absolute guarantee!
2132 for (my $i = 0; $params[$i]; $i++ ) { # browse all CGI params
2133 my $param = $params[$i];
2136 # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2137 if ( $param eq 'biblionumber' ) {
2138 if ( $biblionumbertagfield < 10 ) {
2139 $newfield = MARC::Field->new( $biblionumbertagfield, scalar $cgi->param($param), );
2141 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => scalar $cgi->param($param), );
2143 push @fields, $newfield if ($newfield);
2144 } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) { # new field start when having 'input name="..._indicator1_..."
2147 my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2148 my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2152 if ( $tag < 10 ) { # no code for theses fields
2153 # in MARC editor, 000 contains the leader.
2154 next if $tag == $biblionumbertagfield;
2155 my $fval= $cgi->param($params[$j+1]);
2156 if ( $tag eq '000' ) {
2157 # Force a fake leader even if not provided to avoid crashing
2158 # during decoding MARC record containing UTF-8 characters
2160 length( $fval ) == 24
2165 # between 001 and 009 (included)
2166 } elsif ( $fval ne '' ) {
2167 $newfield = MARC::Field->new( $tag, $fval, );
2170 # > 009, deal with subfields
2172 # browse subfields for this tag (reason for _code_ match)
2173 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2174 last unless defined $params[$j+1];
2176 if $tag == $biblionumbertagfield and
2177 $cgi->param($params[$j]) eq $biblionumbertagsubfield;
2178 #if next param ne subfield, then it was probably empty
2179 #try next param by incrementing j
2180 if($params[$j+1]!~/_subfield_/) {$j++; next; }
2181 my $fkey= $cgi->param($params[$j]);
2182 my $fval= $cgi->param($params[$j+1]);
2183 #check if subfield value not empty and field exists
2184 if($fval ne '' && $newfield) {
2185 $newfield->add_subfields( $fkey => $fval);
2187 elsif($fval ne '') {
2188 $newfield = MARC::Field->new( $tag, $ind1, $ind2, $fkey => $fval );
2192 $i= $j-1; #update i for outer loop accordingly
2194 push @fields, $newfield if ($newfield);
2198 @fields = sort { $a->tag() cmp $b->tag() } @fields;
2199 $record->append_fields(@fields);
2203 =head2 TransformMarcToKoha
2205 $result = TransformMarcToKoha({ record => $record, limit_table => $limit })
2207 Extract data from a MARC bib record into a hashref representing
2208 Koha biblio, biblioitems, and items fields.
2210 If passed an undefined record will log the error and return an empty
2215 sub TransformMarcToKoha {
2216 my ( $params ) = @_;
2218 my $record = $params->{record};
2219 my $limit_table = $params->{limit_table} // q{};
2220 my $kohafields = $params->{kohafields};
2223 if (!defined $record) {
2224 carp('TransformMarcToKoha called with undefined record');
2228 my %tables = ( biblio => 1, biblioitems => 1, items => 1 );
2229 if( $limit_table eq 'items' ) {
2230 %tables = ( items => 1 );
2231 } elsif ( $limit_table eq 'no_items' ){
2232 %tables = ( biblio => 1, biblioitems => 1 );
2235 # The next call acknowledges Default as the authoritative framework
2236 # for Koha to MARC mappings.
2237 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
2238 @{$kohafields} = keys %{ $mss } unless $kohafields;
2239 foreach my $kohafield ( @{$kohafields} ) {
2240 my ( $table, $column ) = split /[.]/, $kohafield, 2;
2241 next unless $tables{$table};
2242 my ( $value, @values );
2243 foreach my $fldhash ( @{$mss->{$kohafield}} ) {
2244 my $tag = $fldhash->{tagfield};
2245 my $sub = $fldhash->{tagsubfield};
2246 foreach my $fld ( $record->field($tag) ) {
2247 if( $sub eq '@' || $fld->is_control_field ) {
2248 push @values, $fld->data if $fld->data;
2250 push @values, grep { $_ } $fld->subfield($sub);
2255 $value = join ' | ', uniq(@values);
2257 # Additional polishing for individual kohafields
2258 if( $kohafield =~ /copyrightdate|publicationyear/ ) {
2259 $value = _adjust_pubyear( $value );
2263 next if !defined $value;
2264 my $key = _disambiguate( $table, $column );
2265 $result->{$key} = $value;
2270 =head2 _disambiguate
2272 $newkey = _disambiguate($table, $field);
2274 This is a temporary hack to distinguish between the
2275 following sets of columns when using TransformMarcToKoha.
2277 items.cn_source & biblioitems.cn_source
2278 items.cn_sort & biblioitems.cn_sort
2280 Columns that are currently NOT distinguished (FIXME
2281 due to lack of time to fully test) are:
2283 biblio.notes and biblioitems.notes
2288 FIXME - this is necessary because prefixing each column
2289 name with the table name would require changing lots
2290 of code and templates, and exposing more of the DB
2291 structure than is good to the UI templates, particularly
2292 since biblio and bibloitems may well merge in a future
2293 version. In the future, it would also be good to
2294 separate DB access and UI presentation field names
2300 my ( $table, $column ) = @_;
2301 if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2302 return $table . '.' . $column;
2309 =head2 _adjust_pubyear
2311 Helper routine for TransformMarcToKoha
2315 sub _adjust_pubyear {
2317 # modify return value to keep only the 1st year found
2318 if( $retval =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2320 } elsif( $retval =~ m/(\d\d\d\d)/ && $1 > 0 ) {
2322 } elsif( $retval =~ m/(?<year>\d{1,3})[.Xx?-]/ ) {
2323 # See also bug 24674: enough to look at one unknown year char like .Xx-?
2324 # At this point in code 1234? or 1234- already passed the earlier regex
2325 # Things like 2-, 1xx, 1??? are now converted to a four positions-year.
2326 $retval = $+{year} * ( 10 ** (4-length($+{year})) );
2333 =head2 CountItemsIssued
2335 my $count = CountItemsIssued( $biblionumber );
2339 sub CountItemsIssued {
2340 my ($biblionumber) = @_;
2341 my $dbh = C4::Context->dbh;
2342 my $sth = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2343 $sth->execute($biblionumber);
2344 my $row = $sth->fetchrow_hashref();
2345 return $row->{'issuedCount'};
2350 ModZebra( $record_number, $op, $server );
2352 $record_number is the authid or biblionumber we want to index
2354 $op is the operation: specialUpdate or recordDelete
2356 $server is authorityserver or biblioserver
2361 my ( $record_number, $op, $server ) = @_;
2362 Koha::Logger->get->debug("ModZebra: updates requested for: $record_number $op $server");
2363 my $dbh = C4::Context->dbh;
2365 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2367 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2368 # the table is emptied by rebuild_zebra.pl script (using the -z switch)
2369 my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2371 AND biblio_auth_number = ?
2374 my $check_sth = $dbh->prepare_cached($check_sql);
2375 $check_sth->execute( $server, $record_number, $op );
2376 my ($count) = $check_sth->fetchrow_array;
2377 $check_sth->finish();
2378 if ( $count == 0 ) {
2379 my $sth = $dbh->prepare("INSERT INTO zebraqueue (biblio_auth_number,server,operation) VALUES(?,?,?)");
2380 $sth->execute( $record_number, $server, $op );
2385 =head1 INTERNAL FUNCTIONS
2387 =head2 _koha_marc_update_bib_ids
2390 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2392 Internal function to add or update biblionumber and biblioitemnumber to
2397 sub _koha_marc_update_bib_ids {
2398 my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
2400 my ( $biblio_tag, $biblio_subfield ) = GetMarcFromKohaField( "biblio.biblionumber" );
2401 die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
2402 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber" );
2403 die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
2405 if ( $biblio_tag < 10 ) {
2406 C4::Biblio::UpsertMarcControlField( $record, $biblio_tag, $biblionumber );
2408 C4::Biblio::UpsertMarcSubfield($record, $biblio_tag, $biblio_subfield, $biblionumber);
2410 if ( $biblioitem_tag < 10 ) {
2411 C4::Biblio::UpsertMarcControlField( $record, $biblioitem_tag, $biblioitemnumber );
2413 C4::Biblio::UpsertMarcSubfield($record, $biblioitem_tag, $biblioitem_subfield, $biblioitemnumber);
2416 # update the control number (001) in MARC
2417 if(C4::Context->preference('autoControlNumber') eq 'biblionumber'){
2418 unless($record->field('001')){
2419 $record->insert_fields_ordered(MARC::Field->new('001', $biblionumber));
2424 =head2 _koha_marc_update_biblioitem_cn_sort
2426 _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
2428 Given a MARC bib record and the biblioitem hash, update the
2429 subfield that contains a copy of the value of biblioitems.cn_sort.
2433 sub _koha_marc_update_biblioitem_cn_sort {
2435 my $biblioitem = shift;
2436 my $frameworkcode = shift;
2438 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort" );
2439 return unless $biblioitem_tag;
2441 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2443 if ( my $field = $marc->field($biblioitem_tag) ) {
2444 $field->delete_subfield( code => $biblioitem_subfield );
2445 if ( $cn_sort ne '' ) {
2446 $field->add_subfields( $biblioitem_subfield => $cn_sort );
2450 # if we get here, no biblioitem tag is present in the MARC record, so
2451 # we'll create it if $cn_sort is not empty -- this would be
2452 # an odd combination of events, however
2454 $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
2459 =head2 _koha_modify_biblio
2461 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
2463 Internal function for updating the biblio table
2467 sub _koha_modify_biblio {
2468 my ( $dbh, $biblio, $frameworkcode ) = @_;
2473 SET frameworkcode = ?,
2486 WHERE biblionumber = ?
2489 my $sth = $dbh->prepare($query);
2492 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'subtitle'},
2493 $biblio->{'medium'}, $biblio->{'part_number'}, $biblio->{'part_name'}, $biblio->{'unititle'},
2494 $biblio->{'notes'}, $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'} ? int($biblio->{'copyrightdate'}) : undef,
2495 $biblio->{'abstract'}, $biblio->{'biblionumber'}
2496 ) if $biblio->{'biblionumber'};
2498 if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
2499 $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
2502 return ( $biblio->{'biblionumber'}, $error );
2505 =head2 _koha_modify_biblioitem_nonmarc
2507 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
2511 sub _koha_modify_biblioitem_nonmarc {
2512 my ( $dbh, $biblioitem ) = @_;
2515 # re-calculate the cn_sort, it may have changed
2516 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2518 my $query = "UPDATE biblioitems
2519 SET biblionumber = ?,
2525 publicationyear = ?,
2529 collectiontitle = ?,
2531 collectionvolume= ?,
2532 editionstatement= ?,
2533 editionresponsibility = ?,
2549 where biblioitemnumber = ?
2551 my $sth = $dbh->prepare($query);
2553 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
2554 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
2555 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
2556 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
2557 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
2558 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
2559 $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort, $biblioitem->{'totalissues'},
2560 $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}, $biblioitem->{'biblioitemnumber'}
2562 if ( $dbh->errstr ) {
2563 $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
2566 return ( $biblioitem->{'biblioitemnumber'}, $error );
2569 =head2 _koha_delete_biblio
2571 $error = _koha_delete_biblio($dbh,$biblionumber);
2573 Internal sub for deleting from biblio table -- also saves to deletedbiblio
2575 C<$dbh> - the database handle
2577 C<$biblionumber> - the biblionumber of the biblio to be deleted
2581 # FIXME: add error handling
2583 sub _koha_delete_biblio {
2584 my ( $dbh, $biblionumber ) = @_;
2586 # get all the data for this biblio
2587 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
2588 $sth->execute($biblionumber);
2590 # FIXME There is a transaction in _koha_delete_biblio_metadata
2591 # But actually all the following should be done inside a single transaction
2592 if ( my $data = $sth->fetchrow_hashref ) {
2594 # save the record in deletedbiblio
2595 # find the fields to save
2596 my $query = "INSERT INTO deletedbiblio SET ";
2598 foreach my $temp ( keys %$data ) {
2599 $query .= "$temp = ?,";
2600 push( @bind, $data->{$temp} );
2603 # replace the last , by ",?)"
2605 my $bkup_sth = $dbh->prepare($query);
2606 $bkup_sth->execute(@bind);
2609 _koha_delete_biblio_metadata( $biblionumber );
2612 my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
2613 $sth2->execute($biblionumber);
2614 # update the timestamp (Bugzilla 7146)
2615 $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
2616 $sth2->execute($biblionumber);
2623 =head2 _koha_delete_biblioitems
2625 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
2627 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
2629 C<$dbh> - the database handle
2630 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
2634 # FIXME: add error handling
2636 sub _koha_delete_biblioitems {
2637 my ( $dbh, $biblioitemnumber ) = @_;
2639 # get all the data for this biblioitem
2640 my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
2641 $sth->execute($biblioitemnumber);
2643 if ( my $data = $sth->fetchrow_hashref ) {
2645 # save the record in deletedbiblioitems
2646 # find the fields to save
2647 my $query = "INSERT INTO deletedbiblioitems SET ";
2649 foreach my $temp ( keys %$data ) {
2650 $query .= "$temp = ?,";
2651 push( @bind, $data->{$temp} );
2654 # replace the last , by ",?)"
2656 my $bkup_sth = $dbh->prepare($query);
2657 $bkup_sth->execute(@bind);
2660 # delete the biblioitem
2661 my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
2662 $sth2->execute($biblioitemnumber);
2663 # update the timestamp (Bugzilla 7146)
2664 $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
2665 $sth2->execute($biblioitemnumber);
2672 =head2 _koha_delete_biblio_metadata
2674 $error = _koha_delete_biblio_metadata($biblionumber);
2676 C<$biblionumber> - the biblionumber of the biblio metadata to be deleted
2680 sub _koha_delete_biblio_metadata {
2681 my ($biblionumber) = @_;
2683 my $dbh = C4::Context->dbh;
2684 my $schema = Koha::Database->new->schema;
2688 INSERT INTO deletedbiblio_metadata (biblionumber, format, `schema`, metadata)
2689 SELECT biblionumber, format, `schema`, metadata FROM biblio_metadata WHERE biblionumber=?
2690 |, undef, $biblionumber );
2691 $dbh->do( q|DELETE FROM biblio_metadata WHERE biblionumber=?|,
2692 undef, $biblionumber );
2697 =head1 UNEXPORTED FUNCTIONS
2699 =head2 ModBiblioMarc
2701 ModBiblioMarc($newrec,$biblionumber);
2703 Add MARC XML data for a biblio to koha
2705 Function exported, but should NOT be used, unless you really know what you're doing
2710 # pass the MARC::Record to this function, and it will create the records in
2712 my ( $record, $biblionumber, $params ) = @_;
2714 carp 'ModBiblioMarc passed an undefined record';
2718 my $skip_record_index = $params->{skip_record_index} || 0;
2720 # Clone record as it gets modified
2721 $record = $record->clone();
2722 my $dbh = C4::Context->dbh;
2723 my @fields = $record->fields();
2724 my $encoding = C4::Context->preference("marcflavour");
2726 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
2727 if ( $encoding eq "UNIMARC" ) {
2728 my $defaultlanguage = C4::Context->preference("UNIMARCField100Language");
2729 $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
2730 my $string = $record->subfield( 100, "a" );
2731 if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
2732 my $f100 = $record->field(100);
2733 $record->delete_field($f100);
2735 $string = POSIX::strftime( "%Y%m%d", localtime );
2737 $string = sprintf( "%-*s", 35, $string );
2738 substr ( $string, 22, 3, $defaultlanguage);
2740 substr( $string, 25, 3, "y50" );
2741 unless ( $record->subfield( 100, "a" ) ) {
2742 $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
2746 #enhancement 5374: update transaction date (005) for marc21/unimarc
2747 if($encoding =~ /MARC21|UNIMARC/) {
2748 my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
2749 # YY MM DD HH MM SS (update year and month)
2750 my $f005= $record->field('005');
2751 $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
2755 biblionumber => $biblionumber,
2756 format => 'marcxml',
2757 schema => C4::Context->preference('marcflavour'),
2759 $record->as_usmarc; # Bug 20126/10455 This triggers field length calculation
2761 my $m_rs = Koha::Biblio::Metadatas->find($metadata) //
2762 Koha::Biblio::Metadata->new($metadata);
2764 my $userenv = C4::Context->userenv;
2766 my $borrowernumber = $userenv->{number};
2767 my $borrowername = join ' ', map { $_ // q{} } @$userenv{qw(firstname surname)};
2768 unless ($m_rs->in_storage) {
2769 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorId'), $borrowernumber);
2770 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorName'), $borrowername);
2772 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierId'), $borrowernumber);
2773 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierName'), $borrowername);
2776 $m_rs->metadata( $record->as_xml_record($encoding) );
2779 unless ( $skip_record_index ) {
2780 my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
2781 $indexer->index_records( $biblionumber, "specialUpdate", "biblioserver" );
2784 return $biblionumber;
2787 =head2 prepare_host_field
2789 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
2790 Generate the host item entry for an analytic child entry
2794 sub prepare_host_field {
2795 my ( $hostbiblio, $marcflavour ) = @_;
2796 $marcflavour ||= C4::Context->preference('marcflavour');
2798 my $biblio = Koha::Biblios->find($hostbiblio);
2799 my $host = $biblio->metadata->record;
2800 # unfortunately as_string does not 'do the right thing'
2801 # if field returns undef
2805 if ( $marcflavour eq 'MARC21' ) {
2806 if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
2807 my $s = $field->as_string('ab');
2812 if ( $field = $host->field('245') ) {
2813 my $s = $field->as_string('a');
2818 if ( $field = $host->field('260') ) {
2819 my $s = $field->as_string('abc');
2824 if ( $field = $host->field('240') ) {
2825 my $s = $field->as_string();
2830 if ( $field = $host->field('022') ) {
2831 my $s = $field->as_string('a');
2836 if ( $field = $host->field('020') ) {
2837 my $s = $field->as_string('a');
2842 if ( $field = $host->field('001') ) {
2843 $sfd{w} = $field->data(),;
2845 $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
2848 elsif ( $marcflavour eq 'UNIMARC' ) {
2850 if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
2851 my $s = $field->as_string('ab');
2857 if ( $field = $host->field('200') ) {
2858 my $s = $field->as_string('a');
2863 #place of publicaton
2864 if ( $field = $host->field('210') ) {
2865 my $s = $field->as_string('a');
2870 #date of publication
2871 if ( $field = $host->field('210') ) {
2872 my $s = $field->as_string('d');
2878 if ( $field = $host->field('205') ) {
2879 my $s = $field->as_string();
2885 if ( $field = $host->field('856') ) {
2886 my $s = $field->as_string('u');
2892 if ( $field = $host->field('011') ) {
2893 my $s = $field->as_string('a');
2899 if ( $field = $host->field('010') ) {
2900 my $s = $field->as_string('a');
2905 if ( $field = $host->field('001') ) {
2906 $sfd{0} = $field->data(),;
2908 $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
2915 =head2 UpdateTotalIssues
2917 UpdateTotalIssues($biblionumber, $increase, [$value])
2919 Update the total issue count for a particular bib record.
2923 =item C<$biblionumber> is the biblionumber of the bib to update
2925 =item C<$increase> is the amount to increase (or decrease) the total issues count by
2927 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
2933 sub UpdateTotalIssues {
2934 my ($biblionumber, $increase, $value, $skip_holds_queue) = @_;
2937 my $biblio = Koha::Biblios->find($biblionumber);
2939 carp "UpdateTotalIssues could not get biblio";
2943 my $record = $biblio->metadata->record;
2945 carp "UpdateTotalIssues could not get biblio record";
2948 my $biblioitem = $biblio->biblioitem;
2949 my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField( 'biblioitems.totalissues' );
2950 unless ($totalissuestag) {
2951 return 1; # There is nothing to do
2954 if (defined $value) {
2955 $totalissues = $value;
2957 $totalissues = $biblioitem->totalissues + $increase;
2960 my $field = $record->field($totalissuestag);
2961 if (defined $field) {
2962 $field->update( $totalissuessubfield => $totalissues );
2964 $field = MARC::Field->new($totalissuestag, '0', '0',
2965 $totalissuessubfield => $totalissues);
2966 $record->insert_grouped_field($field);
2969 return ModBiblio($record, $biblionumber, $biblio->frameworkcode, { skip_holds_queue => $skip_holds_queue });
2974 &RemoveAllNsb($record);
2976 Removes all nsb/nse chars from a record
2983 carp 'RemoveAllNsb called with undefined record';
2987 SetUTF8Flag($record);
2989 foreach my $field ($record->fields()) {
2990 if ($field->is_control_field()) {
2991 $field->update(nsb_clean($field->data()));
2993 my @subfields = $field->subfields();
2995 foreach my $subfield (@subfields) {
2996 push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
2998 if (scalar(@new_subfields) > 0) {
3001 $new_field = MARC::Field->new(
3003 $field->indicator(1),
3004 $field->indicator(2),
3009 warn "error in RemoveAllNsb : $@";
3011 $field->replace_with($new_field);
3020 =head2 ApplyMarcOverlayRules
3022 my $record = ApplyMarcOverlayRules($params)
3024 Applies marc merge rules to a record.
3026 C<$params> is expected to be a hashref with below keys defined.
3030 =item C<biblionumber>
3031 biblionumber of old record
3034 Incoming record that will be merged with old record
3036 =item C<overlay_context>
3037 hashref containing at least one context module and filter value on
3038 the form {module => filter, ...}.
3048 Merged MARC record based with merge rules for C<context> applied. If no old
3049 record for C<biblionumber> can be found, C<record> is returned unchanged.
3050 Default action when no matching context is found to return C<record> unchanged.
3051 If no rules are found for a certain field tag the default is to overwrite with
3052 fields with this field tag from C<record>.
3058 sub ApplyMarcOverlayRules {
3060 my $biblionumber = $params->{biblionumber};
3061 my $incoming_record = $params->{record};
3063 if (!$biblionumber) {
3064 carp 'ApplyMarcOverlayRules called on undefined biblionumber';
3067 if (!$incoming_record) {
3068 carp 'ApplyMarcOverlayRules called on undefined record';
3071 my $biblio = Koha::Biblios->find($biblionumber);
3072 my $old_record = $biblio->metadata->record;
3074 # Skip overlay rules if called with no context
3075 if ($old_record && defined $params->{overlay_context}) {
3076 return Koha::MarcOverlayRules->merge_records($old_record, $incoming_record, $params->{overlay_context});
3078 return $incoming_record;
3081 =head2 _after_biblio_action_hooks
3083 Helper method that takes care of calling all plugin hooks
3087 sub _after_biblio_action_hooks {
3090 my $biblio_id = $args->{biblio_id};
3091 my $action = $args->{action};
3093 my $biblio = Koha::Biblios->find( $biblio_id );
3094 Koha::Plugins->call(
3095 'after_biblio_action',
3099 biblio_id => $biblio_id,
3110 Koha Development Team <http://koha-community.org/>
3112 Paul POULAIN paul.poulain@free.fr
3114 Joshua Ferraro jmf@liblime.com