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);
46 GetAuthorisedValueDesc
48 GetMarcSubfieldStructure
49 IsMarcStructureInternal
51 GetMarcSubfieldStructureFromKohaField
58 EmbedItemsInMarcBiblio
63 LinkBibHeadingsToAuthorities
69 TransformMarcToKohaOneField
73 # those functions are exported but should not be used
74 # they are useful in a few circumstances, so they are exported,
75 # but don't use them unless you are a core developer ;-)
82 use Try::Tiny qw( catch try );
85 use List::MoreUtils qw( uniq );
87 use MARC::File::USMARC;
89 use POSIX qw( strftime );
90 use Module::Load::Conditional qw( can_load );
93 use C4::Log qw( logaction ); # logaction
95 use C4::ClassSource qw( GetClassSort GetClassSource );
104 use C4::Items qw( GetHiddenItemnumbers GetMarcItem );
108 use Koha::Authority::Types;
109 use Koha::Acquisition::Currencies;
110 use Koha::Biblio::Metadatas;
113 use Koha::MarcOverlayRules;
115 use Koha::SearchEngine;
116 use Koha::SearchEngine::Indexer;
118 use Koha::Util::MARC;
122 C4::Biblio - cataloging management functions
126 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:
130 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
132 =item 2. as raw MARC in the Zebra index and storage engine
134 =item 3. as MARC XML in biblio_metadata.metadata
138 In the 3.0 version of Koha, the authoritative record-level information is in biblio_metadata.metadata
140 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.
144 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
146 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
150 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:
154 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
156 =item 2. _koha_* - low-level internal functions for managing the koha tables
158 =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.
160 =item 4. Zebra functions used to update the Zebra index
162 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
166 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 :
170 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
172 =item 2. add the biblionumber and biblioitemnumber into the MARC records
174 =item 3. save the marc record
178 =head1 EXPORTED FUNCTIONS
182 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
184 Exported function (core API) for adding a new biblio to koha.
186 The first argument is a C<MARC::Record> object containing the
187 bib to add, while the second argument is the desired MARC
190 This function also accepts a third, optional argument: a hashref
191 to additional options. The only defined option is C<defer_marc_save>,
192 which if present and mapped to a true value, causes C<AddBiblio>
193 to omit the call to save the MARC in C<biblio_metadata.metadata>
194 This option is provided B<only>
195 for the use of scripts such as C<bulkmarcimport.pl> that may need
196 to do some manipulation of the MARC record for item parsing before
197 saving it and which cannot afford the performance hit of saving
198 the MARC record twice. Consequently, do not use that option
199 unless you can guarantee that C<ModBiblioMarc> will be called.
205 my $frameworkcode = shift;
206 my $options = @_ ? shift : undef;
207 my $defer_marc_save = 0;
209 carp('AddBiblio called with undefined record');
212 if ( defined $options and exists $options->{'defer_marc_save'} and $options->{'defer_marc_save'} ) {
213 $defer_marc_save = 1;
216 my $schema = Koha::Database->schema;
217 my ( $biblionumber, $biblioitemnumber );
219 $schema->txn_do(sub {
221 # transform the data into koha-table style data
222 SetUTF8Flag($record);
223 my $olddata = TransformMarcToKoha( $record, $frameworkcode );
225 my $biblio = Koha::Biblio->new(
227 frameworkcode => $frameworkcode,
228 author => $olddata->{author},
229 title => $olddata->{title},
230 subtitle => $olddata->{subtitle},
231 medium => $olddata->{medium},
232 part_number => $olddata->{part_number},
233 part_name => $olddata->{part_name},
234 unititle => $olddata->{unititle},
235 notes => $olddata->{notes},
237 ( $olddata->{serial} || $olddata->{seriestitle} ? 1 : 0 ),
238 seriestitle => $olddata->{seriestitle},
239 copyrightdate => $olddata->{copyrightdate},
240 datecreated => \'NOW()',
241 abstract => $olddata->{abstract},
244 $biblionumber = $biblio->biblionumber;
245 Koha::Exceptions::ObjectNotCreated->throw unless $biblio;
247 my ($cn_sort) = GetClassSort( $olddata->{'biblioitems.cn_source'}, $olddata->{'cn_class'}, $olddata->{'cn_item'} );
248 my $biblioitem = Koha::Biblioitem->new(
250 biblionumber => $biblionumber,
251 volume => $olddata->{volume},
252 number => $olddata->{number},
253 itemtype => $olddata->{itemtype},
254 isbn => $olddata->{isbn},
255 issn => $olddata->{issn},
256 publicationyear => $olddata->{publicationyear},
257 publishercode => $olddata->{publishercode},
258 volumedate => $olddata->{volumedate},
259 volumedesc => $olddata->{volumedesc},
260 collectiontitle => $olddata->{collectiontitle},
261 collectionissn => $olddata->{collectionissn},
262 collectionvolume => $olddata->{collectionvolume},
263 editionstatement => $olddata->{editionstatement},
264 editionresponsibility => $olddata->{editionresponsibility},
265 illus => $olddata->{illus},
266 pages => $olddata->{pages},
267 notes => $olddata->{bnotes},
268 size => $olddata->{size},
269 place => $olddata->{place},
270 lccn => $olddata->{lccn},
271 url => $olddata->{url},
272 cn_source => $olddata->{'biblioitems.cn_source'},
273 cn_class => $olddata->{cn_class},
274 cn_item => $olddata->{cn_item},
275 cn_suffix => $olddata->{cn_suff},
277 totalissues => $olddata->{totalissues},
278 ean => $olddata->{ean},
279 agerestriction => $olddata->{agerestriction},
282 Koha::Exceptions::ObjectNotCreated->throw unless $biblioitem;
283 $biblioitemnumber = $biblioitem->biblioitemnumber;
285 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
287 # update MARC subfield that stores biblioitems.cn_sort
288 _koha_marc_update_biblioitem_cn_sort( $record, $olddata, $frameworkcode );
290 if (C4::Context->preference('BiblioAddsAuthorities')) {
291 BiblioAutoLink( $record, $frameworkcode );
295 ModBiblioMarc( $record, $biblionumber ) unless $defer_marc_save;
297 # update OAI-PMH sets
298 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
299 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
302 _after_biblio_action_hooks({ action => 'create', biblio_id => $biblionumber });
304 logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
308 ( $biblionumber, $biblioitemnumber ) = ( undef, undef );
310 return ( $biblionumber, $biblioitemnumber );
315 ModBiblio($record, $biblionumber, $frameworkcode, $options);
317 Replace an existing bib record identified by C<$biblionumber>
318 with one supplied by the MARC::Record object C<$record>. The embedded
319 item, biblioitem, and biblionumber fields from the previous
320 version of the bib record replace any such fields of those tags that
321 are present in C<$record>. Consequently, ModBiblio() is not
322 to be used to try to modify item records.
324 C<$frameworkcode> specifies the MARC framework to use
325 when storing the modified bib record; among other things,
326 this controls how MARC fields get mapped to display columns
327 in the C<biblio> and C<biblioitems> tables, as well as
328 which fields are used to store embedded item, biblioitem,
329 and biblionumber data for indexing.
331 The C<$options> argument is a hashref with additional parameters:
335 =item C<overlay_context>
337 This parameter is forwarded to L</ApplyMarcOverlayRules> where it is used for
338 selecting the current rule set if MARCOverlayRules is enabled.
339 See L</ApplyMarcOverlayRules> for more details.
341 =item C<disable_autolink>
343 Unless C<disable_autolink> is passed ModBiblio will relink record headings
344 to authorities based on settings in the system preferences. This flag allows
345 us to not relink records when the authority linker is saving modifications.
349 Returns 1 on success 0 on failure
354 my ( $record, $biblionumber, $frameworkcode, $options ) = @_;
358 carp 'No record passed to ModBiblio';
362 if ( C4::Context->preference("CataloguingLog") ) {
363 my $newrecord = GetMarcBiblio({ biblionumber => $biblionumber });
364 logaction( "CATALOGUING", "MODIFY", $biblionumber, "biblio BEFORE=>" . $newrecord->as_formatted );
367 if ( !$options->{disable_autolink} && C4::Context->preference('BiblioAddsAuthorities') ) {
368 BiblioAutoLink( $record, $frameworkcode );
371 # Cleaning up invalid fields must be done early or SetUTF8Flag is liable to
372 # throw an exception which probably won't be handled.
373 foreach my $field ($record->fields()) {
374 if (! $field->is_control_field()) {
375 if (scalar($field->subfields()) == 0 || (scalar($field->subfields()) == 1 && $field->subfield('9'))) {
376 $record->delete_field($field);
381 SetUTF8Flag($record);
382 my $dbh = C4::Context->dbh;
384 $frameworkcode = "" if !$frameworkcode || $frameworkcode eq "Default"; # XXX
386 _strip_item_fields($record, $frameworkcode);
388 # apply overlay rules
389 if ( C4::Context->preference('MARCOverlayRules')
392 && exists $options->{overlay_context} )
394 $record = ApplyMarcOverlayRules(
396 biblionumber => $biblionumber,
398 overlay_context => $options->{overlay_context},
403 # update biblionumber and biblioitemnumber in MARC
404 # FIXME - this is assuming a 1 to 1 relationship between
405 # biblios and biblioitems
406 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
407 $sth->execute($biblionumber);
408 my ($biblioitemnumber) = $sth->fetchrow;
410 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
412 # load the koha-table data object
413 my $oldbiblio = TransformMarcToKoha( $record, $frameworkcode );
415 # update MARC subfield that stores biblioitems.cn_sort
416 _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode );
418 # update the MARC record (that now contains biblio and items) with the new record data
419 ModBiblioMarc( $record, $biblionumber );
421 # modify the other koha tables
422 _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
423 _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
425 _after_biblio_action_hooks({ action => 'modify', biblio_id => $biblionumber });
427 # update OAI-PMH sets
428 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
429 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
435 =head2 _strip_item_fields
437 _strip_item_fields($record, $frameworkcode)
439 Utility routine to remove item tags from a
444 sub _strip_item_fields {
446 my $frameworkcode = shift;
447 # get the items before and append them to the biblio before updating the record, atm we just have the biblio
448 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber" );
450 # delete any item fields from incoming record to avoid
451 # duplication or incorrect data - use AddItem() or ModItem()
453 foreach my $field ( $record->field($itemtag) ) {
454 $record->delete_field($field);
460 my $error = &DelBiblio($biblionumber);
462 Exported function (core API) for deleting a biblio in koha.
463 Deletes biblio record from Zebra and Koha tables (biblio & biblioitems)
464 Also backs it up to deleted* tables.
465 Checks to make sure that the biblio has no items attached.
467 C<$error> : undef unless an error occurs
472 my ($biblionumber, $params) = @_;
474 my $biblio = Koha::Biblios->find( $biblionumber );
475 return unless $biblio; # Should we throw an exception instead?
477 my $dbh = C4::Context->dbh;
478 my $error; # for error handling
480 # First make sure this biblio has no items attached
481 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
482 $sth->execute($biblionumber);
483 if ( my $itemnumber = $sth->fetchrow ) {
485 # Fix this to use a status the template can understand
486 $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
489 return $error if $error;
491 # We delete any existing holds
492 my $holds = $biblio->holds;
493 while ( my $hold = $holds->next ) {
497 unless ( $params->{skip_record_index} ){
498 my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
499 $indexer->index_records( $biblionumber, "recordDelete", "biblioserver" );
502 # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
503 $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
504 $sth->execute($biblionumber);
505 while ( my $biblioitemnumber = $sth->fetchrow ) {
507 # delete this biblioitem
508 $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
509 return $error if $error;
513 # delete biblio from Koha tables and save in deletedbiblio
514 # must do this *after* _koha_delete_biblioitems, otherwise
515 # delete cascade will prevent deletedbiblioitems rows
516 # from being generated by _koha_delete_biblioitems
517 $error = _koha_delete_biblio( $dbh, $biblionumber );
519 _after_biblio_action_hooks({ action => 'delete', biblio_id => $biblionumber });
521 logaction( "CATALOGUING", "DELETE", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
527 =head2 BiblioAutoLink
529 my $headings_linked = BiblioAutoLink($record, $frameworkcode)
531 Automatically links headings in a bib record to authorities.
533 Returns the number of headings changed
539 my $frameworkcode = shift;
542 carp('Undefined record passed to BiblioAutoLink');
545 my ( $num_headings_changed, %results );
548 "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
549 unless ( can_load( modules => { $linker_module => undef } ) ) {
550 $linker_module = 'C4::Linker::Default';
551 unless ( can_load( modules => { $linker_module => undef } ) ) {
556 my $linker = $linker_module->new(
557 { 'options' => C4::Context->preference("LinkerOptions") } );
558 my ( $headings_changed, $results ) =
559 LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, C4::Context->preference("CatalogModuleRelink") || '', undef, $verbose );
560 # By default we probably don't want to relink things when cataloging
561 return $headings_changed, $results;
564 =head2 LinkBibHeadingsToAuthorities
566 my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink, $tagtolink, $verbose]);
568 Links bib headings to authority records by checking
569 each authority-controlled field in the C<MARC::Record>
570 object C<$marc>, looking for a matching authority record,
571 and setting the linking subfield $9 to the ID of that
574 If $allowrelink is false, existing authids will never be
575 replaced, regardless of the values of LinkerKeepStale and
578 Returns the number of heading links changed in the
583 sub LinkBibHeadingsToAuthorities {
586 my $frameworkcode = shift;
587 my $allowrelink = shift;
588 my $tagtolink = shift;
592 carp 'LinkBibHeadingsToAuthorities called on undefined bib record';
596 require C4::AuthoritiesMarc;
598 $allowrelink = 1 unless defined $allowrelink;
599 my $num_headings_changed = 0;
600 foreach my $field ( $bib->fields() ) {
601 if ( defined $tagtolink ) {
602 next unless $field->tag() == $tagtolink ;
604 my $heading = C4::Heading->new_from_field( $field, $frameworkcode );
605 next unless defined $heading;
608 my $current_link = $field->subfield('9');
610 if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) )
612 $results{'linked'}->{ $heading->display_form() }++;
613 push(@{$results{'details'}}, { tag => $field->tag(), authid => $current_link, status => 'UNCHANGED'}) if $verbose;
617 my ( $authid, $fuzzy, $match_count ) = $linker->get_link($heading);
619 $results{ $fuzzy ? 'fuzzy' : 'linked' }
620 ->{ $heading->display_form() }++;
621 if(defined $current_link and $current_link == $authid) {
622 push(@{$results{'details'}}, { tag => $field->tag(), authid => $current_link, status => 'UNCHANGED'}) if $verbose;
626 $field->delete_subfield( code => '9' ) if defined $current_link;
627 $field->add_subfields( '9', $authid );
628 $num_headings_changed++;
629 push(@{$results{'details'}}, { tag => $field->tag(), authid => $authid, status => 'LOCAL_FOUND'}) if $verbose;
632 my $authority_type = Koha::Authority::Types->find( $heading->auth_type() );
633 if ( defined $current_link
634 && (!$allowrelink || C4::Context->preference('LinkerKeepStale')) )
636 $results{'fuzzy'}->{ $heading->display_form() }++;
637 push(@{$results{'details'}}, { tag => $field->tag(), authid => $current_link, status => 'UNCHANGED'}) if $verbose;
639 elsif ( C4::Context->preference('AutoCreateAuthorities') ) {
640 if ( _check_valid_auth_link( $current_link, $field ) ) {
641 $results{'linked'}->{ $heading->display_form() }++;
643 elsif ( !$match_count ) {
644 my $authority_type = Koha::Authority::Types->find( $heading->auth_type() );
645 my $marcrecordauth = MARC::Record->new();
646 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
647 $marcrecordauth->leader(' nz a22 o 4500');
648 SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
650 $field->delete_subfield( code => '9' )
651 if defined $current_link;
653 foreach my $subfield ( $field->subfields() ){
654 if ( $subfield->[0] =~ /[A-z]/
655 && C4::Heading::valid_heading_subfield(
656 $field->tag, $subfield->[0] )
658 push @auth_subfields, $subfield->[0] => $subfield->[1];
661 # Bib headings contain some ending punctuation that should NOT
662 # be included in the authority record. Strip those before creation
663 next unless @auth_subfields; # Don't try to create a record if we have no fields;
664 my $last_sub = pop @auth_subfields;
665 $last_sub =~ s/[\s]*[,.:=;!%\/][\s]*$//;
666 push @auth_subfields, $last_sub;
667 my $authfield = MARC::Field->new( $authority_type->auth_tag_to_report, '', '', @auth_subfields );
668 $marcrecordauth->insert_fields_ordered($authfield);
670 # bug 2317: ensure new authority knows it's using UTF-8; currently
671 # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
672 # automatically for UNIMARC (by not transcoding)
673 # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
674 # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
675 # of change to a core API just before the 3.0 release.
677 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
678 my $userenv = C4::Context->userenv;
680 if ( $userenv && $userenv->{'branch'} ) {
681 $library = Koha::Libraries->find( $userenv->{'branch'} );
683 $marcrecordauth->insert_fields_ordered(
686 'a' => "Machine generated authority record."
690 $bib->author() . ", "
691 . $bib->title_proper() . ", "
692 . $bib->publication_date() . " ";
693 $cite =~ s/^[\s\,]*//;
694 $cite =~ s/[\s\,]*$//;
697 . ( $library ? $library->get_effective_marcorgcode : C4::Context->preference('MARCOrgCode') ) . ")"
698 . $bib->subfield( '999', 'c' ) . ": "
700 $marcrecordauth->insert_fields_ordered(
701 MARC::Field->new( '670', '', '', 'a' => $cite ) );
704 # warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
707 C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '',
708 $heading->auth_type() );
709 $field->add_subfields( '9', $authid );
710 $num_headings_changed++;
711 $linker->update_cache($heading, $authid);
712 $results{'added'}->{ $heading->display_form() }++;
713 push(@{$results{'details'}}, { tag => $field->tag(), authid => $authid, status => 'CREATED'}) if $verbose;
716 elsif ( defined $current_link ) {
717 if ( _check_valid_auth_link( $current_link, $field ) ) {
718 $results{'linked'}->{ $heading->display_form() }++;
719 push(@{$results{'details'}}, { tag => $field->tag(), authid => $authid, status => 'UNCHANGED'}) if $verbose;
722 $field->delete_subfield( code => '9' );
723 $num_headings_changed++;
724 $results{'unlinked'}->{ $heading->display_form() }++;
725 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;
729 $results{'unlinked'}->{ $heading->display_form() }++;
730 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;
735 push(@{$results{'details'}}, { tag => '', authid => undef, status => 'UNCHANGED'}) unless %results;
736 return $num_headings_changed, \%results;
739 =head2 _check_valid_auth_link
741 if ( _check_valid_auth_link($authid, $field) ) {
745 Check whether the specified heading-auth link is valid without reference
746 to Zebra. Ideally this code would be in C4::Heading, but that won't be
747 possible until we have de-cycled C4::AuthoritiesMarc, so this is the
752 sub _check_valid_auth_link {
753 my ( $authid, $field ) = @_;
754 require C4::AuthoritiesMarc;
756 return C4::AuthoritiesMarc::CompareFieldWithAuthority( { 'field' => $field, 'authid' => $authid } );
761 $data = &GetBiblioData($biblionumber);
763 Returns information about the book with the given biblionumber.
764 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
765 the C<biblio> and C<biblioitems> tables in the
768 In addition, C<$data-E<gt>{subject}> is the list of the book's
769 subjects, separated by C<" , "> (space, comma, space).
770 If there are multiple biblioitems with the given biblionumber, only
771 the first one is considered.
777 my $dbh = C4::Context->dbh;
779 my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
781 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
782 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
783 WHERE biblio.biblionumber = ?";
785 my $sth = $dbh->prepare($query);
786 $sth->execute($bibnum);
788 $data = $sth->fetchrow_hashref;
792 } # sub GetBiblioData
796 $isbd = &GetISBDView({
797 'record' => $marc_record,
798 'template' => $interface, # opac/intranet
799 'framework' => $framework,
802 Return the ISBD view which can be included in opac and intranet
809 # Expecting record WITH items.
810 my $record = $params->{record};
811 return unless defined $record;
813 my $template = $params->{template} // q{};
814 my $sysprefname = $template eq 'opac' ? 'opacisbd' : 'isbd';
815 my $framework = $params->{framework};
816 my $itemtype = $framework;
817 my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField( "items.holdingbranch" );
818 my $tagslib = GetMarcStructure( 1, $itemtype, { unsafe => 1 } );
820 my $ISBD = C4::Context->preference($sysprefname);
825 foreach my $isbdfield ( split( /#/, $bloc ) ) {
827 # $isbdfield= /(.?.?.?)/;
828 $isbdfield =~ /(\d\d\d)([^\|])?\|(.*)\|(.*)\|(.*)/;
829 my $fieldvalue = $1 || 0;
830 my $subfvalue = $2 || "";
832 my $analysestring = $4;
835 # warn "==> $1 / $2 / $3 / $4";
836 # my $fieldvalue=substr($isbdfield,0,3);
837 if ( $fieldvalue > 0 ) {
838 my $hasputtextbefore = 0;
839 my @fieldslist = $record->field($fieldvalue);
840 @fieldslist = sort { $a->subfield($holdingbrtagsubf) cmp $b->subfield($holdingbrtagsubf) } @fieldslist if ( $fieldvalue eq $holdingbrtagf );
842 # warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
843 # warn "FV : $fieldvalue";
844 if ( $subfvalue ne "" ) {
845 # OPAC hidden subfield
847 if ( ( $template eq 'opac' )
848 && ( $tagslib->{$fieldvalue}->{$subfvalue}->{'hidden'} || 0 ) > 0 );
849 foreach my $field (@fieldslist) {
850 foreach my $subfield ( $field->subfield($subfvalue) ) {
851 my $calculated = $analysestring;
852 my $tag = $field->tag();
855 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subfvalue, $subfield, '', $tagslib );
856 my $tagsubf = $tag . $subfvalue;
857 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
858 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
860 # field builded, store the result
861 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
862 $blocres .= $textbefore;
863 $hasputtextbefore = 1;
866 # remove punctuation at start
867 $calculated =~ s/^( |;|:|\.|-)*//g;
868 $blocres .= $calculated;
873 $blocres .= $textafter if $hasputtextbefore;
875 foreach my $field (@fieldslist) {
876 my $calculated = $analysestring;
877 my $tag = $field->tag();
880 my @subf = $field->subfields;
881 for my $i ( 0 .. $#subf ) {
882 my $valuecode = $subf[$i][1];
883 my $subfieldcode = $subf[$i][0];
884 # OPAC hidden subfield
886 if ( ( $template eq 'opac' )
887 && ( $tagslib->{$fieldvalue}->{$subfieldcode}->{'hidden'} || 0 ) > 0 );
888 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subf[$i][0], $subf[$i][1], '', $tagslib );
889 my $tagsubf = $tag . $subfieldcode;
891 $calculated =~ s/ # replace all {{}} codes by the value code.
892 \{\{$tagsubf\}\} # catch the {{actualcode}}
894 $valuecode # replace by the value code
897 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
898 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
901 # field builded, store the result
902 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
903 $blocres .= $textbefore;
904 $hasputtextbefore = 1;
907 # remove punctuation at start
908 $calculated =~ s/^( |;|:|\.|-)*//g;
909 $blocres .= $calculated;
912 $blocres .= $textafter if $hasputtextbefore;
915 $blocres .= $isbdfield;
920 $res =~ s/\{(.*?)\}//g;
922 $res =~ s/\n/<br\/>/g;
930 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
932 =head2 IsMarcStructureInternal
934 my $tagslib = C4::Biblio::GetMarcStructure();
935 for my $tag ( sort keys %$tagslib ) {
937 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
938 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
943 GetMarcStructure creates keys (lib, tab, mandatory, repeatable, important) for a display purpose.
944 These different values should not be processed as valid subfields.
948 sub IsMarcStructureInternal {
949 my ( $subfield ) = @_;
950 return ref $subfield ? 0 : 1;
953 =head2 GetMarcStructure
955 $res = GetMarcStructure($forlibrarian, $frameworkcode, [ $params ]);
957 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
958 $forlibrarian :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
959 $frameworkcode : the framework code to read
960 $params allows you to pass { unsafe => 1 } for better performance.
962 Note: If you call GetMarcStructure with unsafe => 1, do not modify or
963 even autovivify its contents. It is a cached/shared data structure. Your
964 changes c/would be passed around in subsequent calls.
968 sub GetMarcStructure {
969 my ( $forlibrarian, $frameworkcode, $params ) = @_;
970 $frameworkcode = "" unless $frameworkcode;
972 $forlibrarian = $forlibrarian ? 1 : 0;
973 my $unsafe = ($params && $params->{unsafe})? 1: 0;
974 my $cache = Koha::Caches->get_instance();
975 my $cache_key = "MarcStructure-$forlibrarian-$frameworkcode";
976 my $cached = $cache->get_from_cache($cache_key, { unsafe => $unsafe });
977 return $cached if $cached;
979 my $dbh = C4::Context->dbh;
980 my $sth = $dbh->prepare(
981 "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable,important,ind1_defaultvalue,ind2_defaultvalue
982 FROM marc_tag_structure
983 WHERE frameworkcode=?
986 $sth->execute($frameworkcode);
987 my ( $liblibrarian, $libopac, $tag, $res, $mandatory, $repeatable, $important, $ind1_defaultvalue, $ind2_defaultvalue );
989 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable, $important, $ind1_defaultvalue, $ind2_defaultvalue ) = $sth->fetchrow ) {
990 $res->{$tag}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
991 $res->{$tag}->{tab} = "";
992 $res->{$tag}->{mandatory} = $mandatory;
993 $res->{$tag}->{important} = $important;
994 $res->{$tag}->{repeatable} = $repeatable;
995 $res->{$tag}->{ind1_defaultvalue} = $ind1_defaultvalue;
996 $res->{$tag}->{ind2_defaultvalue} = $ind2_defaultvalue;
999 my $mss = Koha::MarcSubfieldStructures->search( { frameworkcode => $frameworkcode } )->unblessed;
1001 $res->{ $m->{tagfield} }->{ $m->{tagsubfield} } = {
1002 lib => ( $forlibrarian or !$m->{libopac} ) ? $m->{liblibrarian} : $m->{libopac},
1003 subfield => $m->{tagsubfield},
1008 $cache->set_in_cache($cache_key, $res);
1012 =head2 GetUsedMarcStructure
1014 The same function as GetMarcStructure except it just takes field
1015 in tab 0-9. (used field)
1017 my $results = GetUsedMarcStructure($frameworkcode);
1019 C<$results> is a ref to an array which each case contains a ref
1020 to a hash which each keys is the columns from marc_subfield_structure
1022 C<$frameworkcode> is the framework code.
1026 sub GetUsedMarcStructure {
1027 my $frameworkcode = shift || '';
1030 FROM marc_subfield_structure
1032 AND frameworkcode = ?
1033 ORDER BY tagfield, display_order, tagsubfield
1035 my $sth = C4::Context->dbh->prepare($query);
1036 $sth->execute($frameworkcode);
1037 return $sth->fetchall_arrayref( {} );
1042 =head2 GetMarcSubfieldStructure
1044 my $structure = GetMarcSubfieldStructure($frameworkcode, [$params]);
1046 Returns a reference to hash representing MARC subfield structure
1047 for framework with framework code C<$frameworkcode>, C<$params> is
1048 optional and may contain additional options.
1052 =item C<$frameworkcode>
1058 An optional hash reference with additional options.
1059 The following options are supported:
1065 Pass { unsafe => 1 } do disable cached object cloning,
1066 and instead get a shared reference, resulting in better
1067 performance (but care must be taken so that retured object
1070 Note: If you call GetMarcSubfieldStructure with unsafe => 1, do not modify or
1071 even autovivify its contents. It is a cached/shared data structure. Your
1072 changes would be passed around in subsequent calls.
1080 sub GetMarcSubfieldStructure {
1081 my ( $frameworkcode, $params ) = @_;
1083 $frameworkcode //= '';
1085 my $cache = Koha::Caches->get_instance();
1086 my $cache_key = "MarcSubfieldStructure-$frameworkcode";
1087 my $cached = $cache->get_from_cache($cache_key, { unsafe => ($params && $params->{unsafe}) });
1088 return $cached if $cached;
1090 my $dbh = C4::Context->dbh;
1091 # We moved to selectall_arrayref since selectall_hashref does not
1092 # keep duplicate mappings on kohafield (like place in 260 vs 264)
1093 my $subfield_aref = $dbh->selectall_arrayref( q|
1095 FROM marc_subfield_structure
1096 WHERE frameworkcode = ?
1098 ORDER BY frameworkcode, tagfield, display_order, tagsubfield
1099 |, { Slice => {} }, $frameworkcode );
1100 # Now map the output to a hash structure
1101 my $subfield_structure = {};
1102 foreach my $row ( @$subfield_aref ) {
1103 push @{ $subfield_structure->{ $row->{kohafield} }}, $row;
1105 $cache->set_in_cache( $cache_key, $subfield_structure );
1106 return $subfield_structure;
1109 =head2 GetMarcFromKohaField
1111 ( $field,$subfield ) = GetMarcFromKohaField( $kohafield );
1112 @fields = GetMarcFromKohaField( $kohafield );
1113 $field = GetMarcFromKohaField( $kohafield );
1115 Returns the MARC fields & subfields mapped to $kohafield.
1116 Since the Default framework is considered as authoritative for such
1117 mappings, the former frameworkcode parameter is obsoleted.
1119 In list context all mappings are returned; there can be multiple
1120 mappings. Note that in the above example you could miss a second
1121 mappings in the first call.
1122 In scalar context only the field tag of the first mapping is returned.
1126 sub GetMarcFromKohaField {
1127 my ( $kohafield ) = @_;
1128 return unless $kohafield;
1129 # The next call uses the Default framework since it is AUTHORITATIVE
1130 # for all Koha to MARC mappings.
1131 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
1133 foreach( @{ $mss->{$kohafield} } ) {
1134 push @retval, $_->{tagfield}, $_->{tagsubfield};
1136 return wantarray ? @retval : ( @retval ? $retval[0] : undef );
1139 =head2 GetMarcSubfieldStructureFromKohaField
1141 my $str = GetMarcSubfieldStructureFromKohaField( $kohafield );
1143 Returns marc subfield structure information for $kohafield.
1144 The Default framework is used, since it is authoritative for kohafield
1146 In list context returns a list of all hashrefs, since there may be
1147 multiple mappings. In scalar context the first hashref is returned.
1151 sub GetMarcSubfieldStructureFromKohaField {
1152 my ( $kohafield ) = @_;
1154 return unless $kohafield;
1156 # The next call uses the Default framework since it is AUTHORITATIVE
1157 # for all Koha to MARC mappings.
1158 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
1159 return unless $mss->{$kohafield};
1160 return wantarray ? @{$mss->{$kohafield}} : $mss->{$kohafield}->[0];
1163 =head2 GetMarcBiblio
1165 my $record = GetMarcBiblio({
1166 biblionumber => $biblionumber,
1167 embed_items => $embeditems,
1169 borcat => $patron_category });
1171 Returns MARC::Record representing a biblio record, or C<undef> if the
1172 biblionumber doesn't exist.
1174 Both embed_items and opac are optional.
1175 If embed_items is passed and is 1, items are embedded.
1176 If opac is passed and is 1, the record is filtered as needed.
1180 =item C<$biblionumber>
1184 =item C<$embeditems>
1186 set to true to include item information.
1190 set to true to make the result suited for OPAC view. This causes things like
1191 OpacHiddenItems to be applied.
1195 If the OpacHiddenItemsExceptions system preference is set, this patron category
1196 can be used to make visible OPAC items which would be normally hidden.
1197 It only makes sense in combination both embed_items and opac values true.
1206 if (not defined $params) {
1207 carp 'GetMarcBiblio called without parameters';
1211 my $biblionumber = $params->{biblionumber};
1212 my $embeditems = $params->{embed_items} || 0;
1213 my $opac = $params->{opac} || 0;
1214 my $borcat = $params->{borcat} // q{};
1216 if (not defined $biblionumber) {
1217 carp 'GetMarcBiblio called with undefined biblionumber';
1221 my $dbh = C4::Context->dbh;
1222 my $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=? ");
1223 $sth->execute($biblionumber);
1224 my $row = $sth->fetchrow_hashref;
1225 my $biblioitemnumber = $row->{'biblioitemnumber'};
1226 my $marcxml = GetXmlBiblio( $biblionumber );
1227 $marcxml = StripNonXmlChars( $marcxml );
1228 my $frameworkcode = GetFrameworkCode($biblionumber);
1229 MARC::File::XML->default_record_format( C4::Context->preference('marcflavour') );
1230 my $record = MARC::Record->new();
1234 MARC::Record::new_from_xml( $marcxml, "UTF-8",
1235 C4::Context->preference('marcflavour') );
1237 if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; }
1238 return unless $record;
1240 C4::Biblio::_koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber,
1241 $biblioitemnumber );
1242 C4::Biblio::EmbedItemsInMarcBiblio({
1243 marc_record => $record,
1244 biblionumber => $biblionumber,
1246 borcat => $borcat })
1258 my $marcxml = GetXmlBiblio($biblionumber);
1260 Returns biblio_metadata.metadata/marcxml of the biblionumber passed in parameter.
1261 The XML should only contain biblio information (item information is no longer stored in marcxml field)
1266 my ($biblionumber) = @_;
1267 my $dbh = C4::Context->dbh;
1268 return unless $biblionumber;
1269 my ($marcxml) = $dbh->selectrow_array(
1272 FROM biblio_metadata
1273 WHERE biblionumber=?
1274 AND format='marcxml'
1276 |, undef, $biblionumber, C4::Context->preference('marcflavour')
1283 return the prices in accordance with the Marc format.
1285 returns 0 if no price found
1286 returns undef if called without a marc record or with
1287 an unrecognized marc format
1292 my ( $record, $marcflavour ) = @_;
1294 carp 'GetMarcPrice called on undefined record';
1301 if ( $marcflavour eq "MARC21" ) {
1302 @listtags = ('345', '020');
1304 } elsif ( $marcflavour eq "UNIMARC" ) {
1305 @listtags = ('345', '010');
1311 for my $field ( $record->field(@listtags) ) {
1312 for my $subfield_value ($field->subfield($subfield)){
1314 $subfield_value = MungeMarcPrice( $subfield_value );
1315 return $subfield_value if ($subfield_value);
1318 return 0; # no price found
1321 =head2 MungeMarcPrice
1323 Return the best guess at what the actual price is from a price field.
1327 sub MungeMarcPrice {
1329 return unless ( $price =~ m/\d/ ); ## No digits means no price.
1330 # Look for the currency symbol and the normalized code of the active currency, if it's there,
1331 my $active_currency = Koha::Acquisition::Currencies->get_active;
1332 my $symbol = $active_currency->symbol;
1333 my $isocode = $active_currency->isocode;
1334 $isocode = $active_currency->currency unless defined $isocode;
1337 my @matches =($price=~ /
1339 ( # start of capturing parenthesis
1341 (?:[\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'
1342 |(?:\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'
1344 \s?\p{Sc}?\s? # followed or not by a whitespace. \p{Sc}?\s? are for cases like '25$ USD'
1346 (?:[\p{Sc}\p{L}\/.]){1,4} # followed by same block as symbol block
1347 |(?:\d+[\p{P}\s]?){1,4} # or by same block as digits block
1349 \s?\p{L}{0,4}\s? # followed or not by a whitespace. \p{L}{0,4}\s? are for cases like '$9.50 USD'
1350 ) # end of capturing parenthesis
1351 (?:\p{P}|\z) # followed by a punctuation sign or by the end of the string
1355 foreach ( @matches ) {
1356 $localprice = $_ and last if index($_, $isocode)>=0;
1358 if ( !$localprice ) {
1359 foreach ( @matches ) {
1360 $localprice = $_ and last if $_=~ /(^|[^\p{Sc}\p{L}\/])\Q$symbol\E([^\p{Sc}\p{L}\/]+\z|\z)/;
1365 if ( $localprice ) {
1366 $price = $localprice;
1368 ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
1369 ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
1371 # eliminate symbol/isocode, space and any final dot from the string
1372 $price =~ s/[\p{Sc}\p{L}\/ ]|\.$//g;
1373 # remove comma,dot when used as separators from hundreds
1374 $price =~s/[\,\.](\d{3})/$1/g;
1375 # convert comma to dot to ensure correct display of decimals if existing
1381 =head2 GetMarcQuantity
1383 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
1384 Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
1386 returns 0 if no quantity found
1387 returns undef if called without a marc record or with
1388 an unrecognized marc format
1392 sub GetMarcQuantity {
1393 my ( $record, $marcflavour ) = @_;
1395 carp 'GetMarcQuantity called on undefined record';
1402 if ( $marcflavour eq "MARC21" ) {
1404 } elsif ( $marcflavour eq "UNIMARC" ) {
1405 @listtags = ('969');
1411 for my $field ( $record->field(@listtags) ) {
1412 for my $subfield_value ($field->subfield($subfield)){
1414 if ($subfield_value) {
1415 # in France, the cents separator is the , but sometimes, ppl use a .
1416 # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1417 $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
1418 return $subfield_value;
1422 return 0; # no price found
1426 =head2 GetAuthorisedValueDesc
1428 my $subfieldvalue =get_authorised_value_desc(
1429 $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1431 Retrieve the complete description for a given authorised value.
1433 Now takes $category and $value pair too.
1435 my $auth_value_desc =GetAuthorisedValueDesc(
1436 '','', 'DVD' ,'','','CCODE');
1438 If the optional $opac parameter is set to a true value, displays OPAC
1439 descriptions rather than normal ones when they exist.
1443 sub GetAuthorisedValueDesc {
1444 my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1448 return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1451 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1452 my $branch = Koha::Libraries->find($value);
1453 return $branch? $branch->branchname: q{};
1457 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1458 my $itemtype = Koha::ItemTypes->find( $value );
1459 return $itemtype ? $itemtype->translated_description : q||;
1462 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "cn_source" ) {
1463 my $source = GetClassSource($value);
1464 return $source ? $source->{description} : q||;
1467 #---- "true" authorized value
1468 $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1471 my $dbh = C4::Context->dbh;
1472 if ( $category ne "" ) {
1473 my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1474 $sth->execute( $category, $value );
1475 my $data = $sth->fetchrow_hashref;
1476 return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
1478 return $value; # if nothing is found return the original value
1482 =head2 GetMarcControlnumber
1484 $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1486 Get the control number / record Identifier from the MARC record and return it.
1490 sub GetMarcControlnumber {
1491 my ( $record, $marcflavour ) = @_;
1493 carp 'GetMarcControlnumber called on undefined record';
1496 my $controlnumber = "";
1497 # Control number or Record identifier are the same field in MARC21 and UNIMARC
1498 # Keep $marcflavour for possible later use
1499 if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" ) {
1500 my $controlnumberField = $record->field('001');
1501 if ($controlnumberField) {
1502 $controlnumber = $controlnumberField->data();
1505 return $controlnumber;
1510 $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1512 Get all ISBNs from the MARC record and returns them in an array.
1513 ISBNs stored in different fields depending on MARC flavour
1518 my ( $record, $marcflavour ) = @_;
1520 carp 'GetMarcISBN called on undefined record';
1524 if ( $marcflavour eq "UNIMARC" ) {
1526 } else { # assume marc21 if not unimarc
1531 foreach my $field ( $record->field($scope) ) {
1532 my $isbn = $field->subfield( 'a' );
1533 if ( $isbn && $isbn ne "" ) {
1534 push @marcisbns, $isbn;
1544 $marcissnsarray = GetMarcISSN( $record, $marcflavour );
1546 Get all valid ISSNs from the MARC record and returns them in an array.
1547 ISSNs are stored in different fields depending on MARC flavour
1552 my ( $record, $marcflavour ) = @_;
1554 carp 'GetMarcISSN called on undefined record';
1558 if ( $marcflavour eq "UNIMARC" ) {
1561 else { # assume MARC21
1565 foreach my $field ( $record->field($scope) ) {
1566 push @marcissns, $field->subfield( 'a' )
1567 if ( $field->subfield( 'a' ) ne "" );
1572 =head2 GetMarcSubjects
1574 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1576 Get all subjects from the MARC record and returns them in an array.
1577 The subjects are stored in different fields depending on MARC flavour
1581 sub GetMarcSubjects {
1582 my ( $record, $marcflavour ) = @_;
1584 carp 'GetMarcSubjects called on undefined record';
1587 my ( $mintag, $maxtag, $fields_filter );
1588 if ( $marcflavour eq "UNIMARC" ) {
1591 $fields_filter = '6..';
1595 $fields_filter = '6..';
1600 my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1601 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1603 foreach my $field ( $record->field($fields_filter) ) {
1604 next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
1606 my @subfields = $field->subfields();
1609 # if there is an authority link, build the links with an= subfield9
1610 my $subfield9 = $field->subfield('9');
1613 my $linkvalue = $subfield9;
1614 $linkvalue =~ s/(\(|\))//g;
1615 @link_loop = ( { limit => 'an', 'link' => $linkvalue } );
1616 $authoritylink = $linkvalue
1620 for my $subject_subfield (@subfields) {
1621 next if ( $subject_subfield->[0] eq '9' );
1623 # don't load unimarc subfields 3,4,5
1624 next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1625 # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1626 next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1628 my $code = $subject_subfield->[0];
1629 my $value = $subject_subfield->[1];
1630 my $linkvalue = $value;
1631 $linkvalue =~ s/(\(|\))//g;
1632 # if no authority link, build a search query
1633 unless ($subfield9) {
1635 limit => $subject_limit,
1636 'link' => $linkvalue,
1637 operator => (scalar @link_loop) ? ' AND ' : undef
1640 my @this_link_loop = @link_loop;
1642 unless ( $code eq '0' ) {
1643 push @subfields_loop, {
1646 link_loop => \@this_link_loop,
1647 separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1652 push @marcsubjects, {
1653 MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop,
1654 authoritylink => $authoritylink,
1655 } if $authoritylink || @subfields_loop;
1658 return \@marcsubjects;
1659 } #end getMARCsubjects
1661 =head2 GetMarcAuthors
1663 authors = GetMarcAuthors($record,$marcflavour);
1665 Get all authors from the MARC record and returns them in an array.
1666 The authors are stored in different fields depending on MARC flavour
1670 sub GetMarcAuthors {
1671 my ( $record, $marcflavour ) = @_;
1673 carp 'GetMarcAuthors called on undefined record';
1676 my ( $mintag, $maxtag, $fields_filter );
1678 # tagslib useful only for UNIMARC author responsibilities
1680 if ( $marcflavour eq "UNIMARC" ) {
1681 # FIXME : we don't have the framework available, we take the default framework. May be buggy on some setups, will be usually correct.
1682 $tagslib = GetMarcStructure( 1, '', { unsafe => 1 });
1685 $fields_filter = '7..';
1689 $fields_filter = '7..';
1693 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1695 foreach my $field ( $record->field($fields_filter) ) {
1696 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1699 my @subfields = $field->subfields();
1702 # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1703 my $subfield9 = $field->subfield('9');
1705 my $linkvalue = $subfield9;
1706 $linkvalue =~ s/(\(|\))//g;
1707 @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1712 for my $authors_subfield (@subfields) {
1713 next if ( $authors_subfield->[0] eq '9' );
1715 # unimarc3 contains the $3 of the author for UNIMARC.
1716 # For french academic libraries, it's the "ppn", and it's required for idref webservice
1717 $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1719 # don't load unimarc subfields 3, 5
1720 next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1722 my $code = $authors_subfield->[0];
1723 my $value = $authors_subfield->[1];
1724 my $linkvalue = $value;
1725 $linkvalue =~ s/(\(|\))//g;
1726 # UNIMARC author responsibility
1727 if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1728 $value = GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1729 $linkvalue = "($value)";
1731 # if no authority link, build a search query
1732 unless ($subfield9) {
1735 'link' => $linkvalue,
1736 operator => (scalar @link_loop) ? ' AND ' : undef
1739 my @this_link_loop = @link_loop;
1741 unless ( $code eq '0') {
1742 push @subfields_loop, {
1743 tag => $field->tag(),
1746 link_loop => \@this_link_loop,
1747 separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1751 push @marcauthors, {
1752 MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
1753 authoritylink => $subfield9,
1754 unimarc3 => $unimarc3
1757 return \@marcauthors;
1762 $marcurls = GetMarcUrls($record,$marcflavour);
1764 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1765 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1770 my ( $record, $marcflavour ) = @_;
1772 carp 'GetMarcUrls called on undefined record';
1777 for my $field ( $record->field('856') ) {
1779 for my $note ( $field->subfield('z') ) {
1780 push @notes, { note => $note };
1782 my @urls = $field->subfield('u');
1783 foreach my $url (@urls) {
1784 $url =~ s/^\s+|\s+$//g; # trim
1786 if ( $marcflavour eq 'MARC21' ) {
1787 my $s3 = $field->subfield('3');
1788 my $link = $field->subfield('y');
1789 unless ( $url =~ /^\w+:/ ) {
1790 if ( $field->indicator(1) eq '7' ) {
1791 $url = $field->subfield('2') . "://" . $url;
1792 } elsif ( $field->indicator(1) eq '1' ) {
1793 $url = 'ftp://' . $url;
1796 # properly, this should be if ind1=4,
1797 # however we will assume http protocol since we're building a link.
1798 $url = 'http://' . $url;
1802 # TODO handle ind 2 (relationship)
1807 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
1808 $marcurl->{'part'} = $s3 if ($link);
1809 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1811 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
1812 $marcurl->{'MARCURL'} = $url;
1814 push @marcurls, $marcurl;
1820 =head2 GetMarcSeries
1822 $marcseriesarray = GetMarcSeries($record,$marcflavour);
1824 Get all series from the MARC record and returns them in an array.
1825 The series are stored in different fields depending on MARC flavour
1830 my ( $record, $marcflavour ) = @_;
1832 carp 'GetMarcSeries called on undefined record';
1836 my ( $mintag, $maxtag, $fields_filter );
1837 if ( $marcflavour eq "UNIMARC" ) {
1840 $fields_filter = '2..';
1844 $fields_filter = '4..';
1848 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1850 foreach my $field ( $record->field($fields_filter) ) {
1851 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1853 my @subfields = $field->subfields();
1856 for my $series_subfield (@subfields) {
1858 # ignore $9, used for authority link
1859 next if ( $series_subfield->[0] eq '9' );
1862 my $code = $series_subfield->[0];
1863 my $value = $series_subfield->[1];
1864 my $linkvalue = $value;
1865 $linkvalue =~ s/(\(|\))//g;
1867 # see if this is an instance of a volume
1868 if ( $code eq 'v' ) {
1873 'link' => $linkvalue,
1874 operator => (scalar @link_loop) ? ' AND ' : undef
1877 if ($volume_number) {
1878 push @subfields_loop, { volumenum => $value };
1880 push @subfields_loop, {
1883 link_loop => \@link_loop,
1884 separator => (scalar @subfields_loop) ? $AuthoritySeparator : '',
1885 volumenum => $volume_number,
1889 push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1892 return \@marcseries;
1893 } #end getMARCseriess
1895 =head2 UpsertMarcSubfield
1897 my $record = C4::Biblio::UpsertMarcSubfield($MARC::Record, $fieldTag, $subfieldCode, $subfieldContent);
1901 sub UpsertMarcSubfield {
1902 my ($record, $tag, $code, $content) = @_;
1903 my $f = $record->field($tag);
1906 $f->update( $code => $content );
1909 my $f = MARC::Field->new( $tag, '', '', $code => $content);
1910 $record->insert_fields_ordered( $f );
1914 =head2 UpsertMarcControlField
1916 my $record = C4::Biblio::UpsertMarcControlField($MARC::Record, $fieldTag, $content);
1920 sub UpsertMarcControlField {
1921 my ($record, $tag, $content) = @_;
1922 die "UpsertMarcControlField() \$tag '$tag' is not a control field\n" unless 0+$tag < 10;
1923 my $f = $record->field($tag);
1926 $f->update( $content );
1929 my $f = MARC::Field->new($tag, $content);
1930 $record->insert_fields_ordered( $f );
1934 =head2 GetFrameworkCode
1936 $frameworkcode = GetFrameworkCode( $biblionumber )
1940 sub GetFrameworkCode {
1941 my ($biblionumber) = @_;
1942 my $dbh = C4::Context->dbh;
1943 my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
1944 $sth->execute($biblionumber);
1945 my ($frameworkcode) = $sth->fetchrow;
1946 return $frameworkcode;
1949 =head2 TransformKohaToMarc
1951 $record = TransformKohaToMarc( $hash [, $params ] )
1953 This function builds a (partial) MARC::Record from a hash.
1954 Hash entries can be from biblio, biblioitems or items.
1955 The params hash includes the parameter no_split used in C4::Items.
1957 This function is called in acquisition module, to create a basic catalogue
1958 entry from user entry.
1963 sub TransformKohaToMarc {
1964 my ( $hash, $params ) = @_;
1965 my $record = MARC::Record->new();
1966 SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
1968 # In the next call we use the Default framework, since it is considered
1969 # authoritative for Koha to Marc mappings.
1970 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # do not change framework
1972 while ( my ($kohafield, $value) = each %$hash ) {
1973 foreach my $fld ( @{ $mss->{$kohafield} } ) {
1974 my $tagfield = $fld->{tagfield};
1975 my $tagsubfield = $fld->{tagsubfield};
1978 # BZ 21800: split value if field is repeatable.
1979 my @values = _check_split($params, $fld, $value)
1980 ? split(/\s?\|\s?/, $value, -1)
1982 foreach my $value ( @values ) {
1983 next if $value eq '';
1984 $tag_hr->{$tagfield} //= [];
1985 push @{$tag_hr->{$tagfield}}, [($tagsubfield, $value)];
1989 foreach my $tag (sort keys %$tag_hr) {
1990 my @sfl = @{$tag_hr->{$tag}};
1991 @sfl = sort { $a->[0] cmp $b->[0]; } @sfl;
1992 @sfl = map { @{$_}; } @sfl;
1993 # Special care for control fields: remove the subfield indication @
1994 # and do not insert indicators.
1995 my @ind = $tag < 10 ? () : ( " ", " " );
1996 @sfl = grep { $_ ne '@' } @sfl if $tag < 10;
1997 $record->insert_fields_ordered( MARC::Field->new($tag, @ind, @sfl) );
2003 # Checks if $value must be split; may consult passed framework
2004 my ($params, $fld, $value) = @_;
2005 return if index($value,'|') == -1; # nothing to worry about
2006 return if $params->{no_split};
2008 # if we did not get a specific framework, check default in $mss
2009 return $fld->{repeatable} if !$params->{framework};
2011 # here we need to check the specific framework
2012 my $mss = GetMarcSubfieldStructure($params->{framework}, { unsafe => 1 });
2013 foreach my $fld2 ( @{ $mss->{ $fld->{kohafield} } } ) {
2014 next if $fld2->{tagfield} ne $fld->{tagfield};
2015 next if $fld2->{tagsubfield} ne $fld->{tagsubfield};
2016 return 1 if $fld2->{repeatable};
2021 =head2 PrepHostMarcField
2023 $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
2025 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
2029 sub PrepHostMarcField {
2030 my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
2031 $marcflavour ||="MARC21";
2033 my $hostrecord = GetMarcBiblio({ biblionumber => $hostbiblionumber });
2034 my $item = Koha::Items->find($hostitemnumber);
2037 if ( $marcflavour eq "MARC21" ) {
2041 if ($hostrecord->subfield('100','a')){
2042 $mainentry = $hostrecord->subfield('100','a');
2043 } elsif ($hostrecord->subfield('110','a')){
2044 $mainentry = $hostrecord->subfield('110','a');
2046 $mainentry = $hostrecord->subfield('111','a');
2049 # qualification info
2051 if (my $field260 = $hostrecord->field('260')){
2052 $qualinfo = $field260->as_string( 'abc' );
2057 my $ed = $hostrecord->subfield('250','a');
2058 my $barcode = $item->barcode;
2059 my $title = $hostrecord->subfield('245','a');
2061 # record control number, 001 with 003 and prefix
2063 if ($hostrecord->field('001')){
2064 $recctrlno = $hostrecord->field('001')->data();
2065 if ($hostrecord->field('003')){
2066 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
2071 my $issn = $hostrecord->subfield('022','a');
2072 my $isbn = $hostrecord->subfield('020','a');
2075 $hostmarcfield = MARC::Field->new(
2077 '0' => $hostbiblionumber,
2078 '9' => $hostitemnumber,
2088 } elsif ($marcflavour eq "UNIMARC") {
2089 $hostmarcfield = MARC::Field->new(
2091 '0' => $hostbiblionumber,
2092 't' => $hostrecord->subfield('200','a'),
2093 '9' => $hostitemnumber
2097 return $hostmarcfield;
2100 =head2 TransformHtmlToXml
2102 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
2103 $ind_tag, $auth_type )
2105 $auth_type contains :
2109 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
2111 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2113 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2119 sub TransformHtmlToXml {
2120 my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2121 # NOTE: The parameter $ind_tag is NOT USED -- BZ 11247
2123 my ( $perm_loc_tag, $perm_loc_subfield ) = C4::Biblio::GetMarcFromKohaField( "items.permanent_location" );
2125 my $xml = MARC::File::XML::header('UTF-8');
2126 $xml .= "<record>\n";
2127 $auth_type = C4::Context->preference('marcflavour') unless $auth_type; # FIXME auth_type must be removed
2128 MARC::File::XML->default_record_format($auth_type);
2130 # in UNIMARC, field 100 contains the encoding
2131 # check that there is one, otherwise the
2132 # MARC::Record->new_from_xml will fail (and Koha will die)
2133 my $unimarc_and_100_exist = 0;
2134 $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
2139 for ( my $i = 0 ; $i < @$tags ; $i++ ) {
2140 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
2142 # if we have a 100 field and it's values are not correct, skip them.
2143 # if we don't have any valid 100 field, we will create a default one at the end
2144 my $enc = substr( @$values[$i], 26, 2 );
2145 if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2146 $unimarc_and_100_exist = 1;
2151 @$values[$i] =~ s/&/&/g;
2152 @$values[$i] =~ s/</</g;
2153 @$values[$i] =~ s/>/>/g;
2154 @$values[$i] =~ s/"/"/g;
2155 @$values[$i] =~ s/'/'/g;
2157 my $skip = @$values[$i] eq q{};
2160 && $perm_loc_subfield
2161 && @$tags[$i] eq $perm_loc_tag
2162 && @$subfields[$i] eq $perm_loc_subfield;
2164 if ( ( @$tags[$i] ne $prevtag ) ) {
2165 $close_last_tag = 0;
2166 $j++ unless ( @$tags[$i] eq "" );
2167 my $str = ( $indicator->[$j] // q{} ) . ' '; # extra space prevents substr outside of string warn
2168 my $ind1 = _default_ind_to_space( substr( $str, 0, 1 ) );
2169 my $ind2 = _default_ind_to_space( substr( $str, 1, 1 ) );
2171 $xml .= "</datafield>\n";
2172 if ( ( @$tags[$i] && @$tags[$i] > 10 )
2174 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2175 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2177 $close_last_tag = 1;
2185 if ( @$tags[$i] eq "000" ) {
2186 $xml .= "<leader>@$values[$i]</leader>\n";
2189 # rest of the fixed fields
2190 } elsif ( @$tags[$i] < 10 ) {
2191 $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2194 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2195 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2197 $close_last_tag = 1;
2201 } else { # @$tags[$i] eq $prevtag
2204 my $str = ( $indicator->[$j] // q{} ) . ' '; # extra space prevents substr outside of string warn
2205 my $ind1 = _default_ind_to_space( substr( $str, 0, 1 ) );
2206 my $ind2 = _default_ind_to_space( substr( $str, 1, 1 ) );
2207 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2209 $close_last_tag = 1;
2211 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2214 $prevtag = @$tags[$i];
2216 $xml .= "</datafield>\n" if $close_last_tag;
2217 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2219 # warn "SETTING 100 for $auth_type";
2220 my $string = strftime( "%Y%m%d", localtime(time) );
2222 # set 50 to position 26 is biblios, 13 if authorities
2224 $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2225 $string = sprintf( "%-*s", 35, $string );
2226 substr( $string, $pos, 6, "50" );
2227 $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2228 $xml .= "<subfield code=\"a\">$string</subfield>\n";
2229 $xml .= "</datafield>\n";
2231 $xml .= "</record>\n";
2232 $xml .= MARC::File::XML::footer();
2236 =head2 _default_ind_to_space
2238 Passed what should be an indicator returns a space
2239 if its undefined or zero length
2243 sub _default_ind_to_space {
2245 if ( !defined $s || $s eq q{} ) {
2251 =head2 TransformHtmlToMarc
2253 L<$record> = TransformHtmlToMarc(L<$cgi>)
2254 L<$cgi> is the CGI object which contains the values for subfields
2256 'tag_010_indicator1_531951' ,
2257 'tag_010_indicator2_531951' ,
2258 'tag_010_code_a_531951_145735' ,
2259 'tag_010_subfield_a_531951_145735' ,
2260 'tag_200_indicator1_873510' ,
2261 'tag_200_indicator2_873510' ,
2262 'tag_200_code_a_873510_673465' ,
2263 'tag_200_subfield_a_873510_673465' ,
2264 'tag_200_code_b_873510_704318' ,
2265 'tag_200_subfield_b_873510_704318' ,
2266 'tag_200_code_e_873510_280822' ,
2267 'tag_200_subfield_e_873510_280822' ,
2268 'tag_200_code_f_873510_110730' ,
2269 'tag_200_subfield_f_873510_110730' ,
2271 L<$record> is the MARC::Record object.
2275 sub TransformHtmlToMarc {
2276 my ($cgi, $isbiblio) = @_;
2278 my @params = $cgi->multi_param();
2280 # explicitly turn on the UTF-8 flag for all
2281 # 'tag_' parameters to avoid incorrect character
2282 # conversion later on
2283 my $cgi_params = $cgi->Vars;
2284 foreach my $param_name ( keys %$cgi_params ) {
2285 if ( $param_name =~ /^tag_/ ) {
2286 my $param_value = $cgi_params->{$param_name};
2287 unless ( Encode::is_utf8( $param_value ) ) {
2288 $cgi_params->{$param_name} = Encode::decode('UTF-8', $param_value );
2293 # creating a new record
2294 my $record = MARC::Record->new();
2296 my ($biblionumbertagfield, $biblionumbertagsubfield) = (-1, -1);
2297 ($biblionumbertagfield, $biblionumbertagsubfield) =
2298 &GetMarcFromKohaField( "biblio.biblionumber", '' ) if $isbiblio;
2299 #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!
2300 for (my $i = 0; $params[$i]; $i++ ) { # browse all CGI params
2301 my $param = $params[$i];
2304 # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2305 if ( $param eq 'biblionumber' ) {
2306 if ( $biblionumbertagfield < 10 ) {
2307 $newfield = MARC::Field->new( $biblionumbertagfield, scalar $cgi->param($param), );
2309 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => scalar $cgi->param($param), );
2311 push @fields, $newfield if ($newfield);
2312 } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) { # new field start when having 'input name="..._indicator1_..."
2315 my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2316 my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2320 if ( $tag < 10 ) { # no code for theses fields
2321 # in MARC editor, 000 contains the leader.
2322 next if $tag == $biblionumbertagfield;
2323 my $fval= $cgi->param($params[$j+1]);
2324 if ( $tag eq '000' ) {
2325 # Force a fake leader even if not provided to avoid crashing
2326 # during decoding MARC record containing UTF-8 characters
2328 length( $fval ) == 24
2333 # between 001 and 009 (included)
2334 } elsif ( $fval ne '' ) {
2335 $newfield = MARC::Field->new( $tag, $fval, );
2338 # > 009, deal with subfields
2340 # browse subfields for this tag (reason for _code_ match)
2341 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2342 last unless defined $params[$j+1];
2344 if $tag == $biblionumbertagfield and
2345 $cgi->param($params[$j]) eq $biblionumbertagsubfield;
2346 #if next param ne subfield, then it was probably empty
2347 #try next param by incrementing j
2348 if($params[$j+1]!~/_subfield_/) {$j++; next; }
2349 my $fkey= $cgi->param($params[$j]);
2350 my $fval= $cgi->param($params[$j+1]);
2351 #check if subfield value not empty and field exists
2352 if($fval ne '' && $newfield) {
2353 $newfield->add_subfields( $fkey => $fval);
2355 elsif($fval ne '') {
2356 $newfield = MARC::Field->new( $tag, $ind1, $ind2, $fkey => $fval );
2360 $i= $j-1; #update i for outer loop accordingly
2362 push @fields, $newfield if ($newfield);
2366 @fields = sort { $a->tag() cmp $b->tag() } @fields;
2367 $record->append_fields(@fields);
2371 =head2 TransformMarcToKoha
2373 $result = TransformMarcToKoha( $record, undef, $limit )
2375 Extract data from a MARC bib record into a hashref representing
2376 Koha biblio, biblioitems, and items fields.
2378 If passed an undefined record will log the error and return an empty
2383 sub TransformMarcToKoha {
2384 my ( $record, $frameworkcode, $limit_table ) = @_;
2385 # FIXME Parameter $frameworkcode is obsolete and will be removed
2386 $limit_table //= q{};
2389 if (!defined $record) {
2390 carp('TransformMarcToKoha called with undefined record');
2394 my %tables = ( biblio => 1, biblioitems => 1, items => 1 );
2395 if( $limit_table eq 'items' ) {
2396 %tables = ( items => 1 );
2397 } elsif ( $limit_table eq 'no_items' ){
2398 %tables = ( biblio => 1, biblioitems => 1 );
2401 # The next call acknowledges Default as the authoritative framework
2402 # for Koha to MARC mappings.
2403 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
2404 foreach my $kohafield ( keys %{ $mss } ) {
2405 my ( $table, $column ) = split /[.]/, $kohafield, 2;
2406 next unless $tables{$table};
2407 my $val = TransformMarcToKohaOneField( $kohafield, $record );
2408 next if !defined $val;
2409 my $key = _disambiguate( $table, $column );
2410 $result->{$key} = $val;
2415 =head2 _disambiguate
2417 $newkey = _disambiguate($table, $field);
2419 This is a temporary hack to distinguish between the
2420 following sets of columns when using TransformMarcToKoha.
2422 items.cn_source & biblioitems.cn_source
2423 items.cn_sort & biblioitems.cn_sort
2425 Columns that are currently NOT distinguished (FIXME
2426 due to lack of time to fully test) are:
2428 biblio.notes and biblioitems.notes
2433 FIXME - this is necessary because prefixing each column
2434 name with the table name would require changing lots
2435 of code and templates, and exposing more of the DB
2436 structure than is good to the UI templates, particularly
2437 since biblio and bibloitems may well merge in a future
2438 version. In the future, it would also be good to
2439 separate DB access and UI presentation field names
2445 my ( $table, $column ) = @_;
2446 if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2447 return $table . '.' . $column;
2454 =head2 TransformMarcToKohaOneField
2456 $val = TransformMarcToKohaOneField( 'biblio.title', $marc );
2458 Note: The authoritative Default framework is used implicitly.
2462 sub TransformMarcToKohaOneField {
2463 my ( $kohafield, $marc ) = @_;
2465 my ( @rv, $retval );
2466 my @mss = GetMarcSubfieldStructureFromKohaField($kohafield);
2467 foreach my $fldhash ( @mss ) {
2468 my $tag = $fldhash->{tagfield};
2469 my $sub = $fldhash->{tagsubfield};
2470 foreach my $fld ( $marc->field($tag) ) {
2471 if( $sub eq '@' || $fld->is_control_field ) {
2472 push @rv, $fld->data if $fld->data;
2474 push @rv, grep { $_ } $fld->subfield($sub);
2479 $retval = join ' | ', uniq(@rv);
2481 # Additional polishing for individual kohafields
2482 if( $kohafield =~ /copyrightdate|publicationyear/ ) {
2483 $retval = _adjust_pubyear( $retval );
2489 =head2 _adjust_pubyear
2491 Helper routine for TransformMarcToKohaOneField
2495 sub _adjust_pubyear {
2497 # modify return value to keep only the 1st year found
2498 if( $retval =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2500 } elsif( $retval =~ m/(\d\d\d\d)/ && $1 > 0 ) {
2502 } elsif( $retval =~ m/(?<year>\d{1,3})[.Xx?-]/ ) {
2503 # See also bug 24674: enough to look at one unknown year char like .Xx-?
2504 # At this point in code 1234? or 1234- already passed the earlier regex
2505 # Things like 2-, 1xx, 1??? are now converted to a four positions-year.
2506 $retval = $+{year} * ( 10 ** (4-length($+{year})) );
2513 =head2 CountItemsIssued
2515 my $count = CountItemsIssued( $biblionumber );
2519 sub CountItemsIssued {
2520 my ($biblionumber) = @_;
2521 my $dbh = C4::Context->dbh;
2522 my $sth = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2523 $sth->execute($biblionumber);
2524 my $row = $sth->fetchrow_hashref();
2525 return $row->{'issuedCount'};
2530 ModZebra( $record_number, $op, $server );
2532 $record_number is the authid or biblionumber we want to index
2534 $op is the operation: specialUpdate or recordDelete
2536 $server is authorityserver or biblioserver
2541 my ( $record_number, $op, $server ) = @_;
2542 Koha::Logger->get->debug("ModZebra: updates requested for: $record_number $op $server");
2543 my $dbh = C4::Context->dbh;
2545 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2547 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2548 # the table is emptied by rebuild_zebra.pl script (using the -z switch)
2549 my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2551 AND biblio_auth_number = ?
2554 my $check_sth = $dbh->prepare_cached($check_sql);
2555 $check_sth->execute( $server, $record_number, $op );
2556 my ($count) = $check_sth->fetchrow_array;
2557 $check_sth->finish();
2558 if ( $count == 0 ) {
2559 my $sth = $dbh->prepare("INSERT INTO zebraqueue (biblio_auth_number,server,operation) VALUES(?,?,?)");
2560 $sth->execute( $record_number, $server, $op );
2565 =head2 EmbedItemsInMarcBiblio
2567 EmbedItemsInMarcBiblio({
2568 marc_record => $marc,
2569 biblionumber => $biblionumber,
2570 item_numbers => $itemnumbers,
2573 Given a MARC::Record object containing a bib record,
2574 modify it to include the items attached to it as 9XX
2575 per the bib's MARC framework.
2576 if $itemnumbers is defined, only specified itemnumbers are embedded.
2578 If $opac is true, then opac-relevant suppressions are included.
2580 If opac filtering will be done, borcat should be passed to properly
2581 override if necessary.
2585 sub EmbedItemsInMarcBiblio {
2587 my ($marc, $biblionumber, $itemnumbers, $opac, $borcat);
2588 $marc = $params->{marc_record};
2590 carp 'EmbedItemsInMarcBiblio: No MARC record passed';
2593 $biblionumber = $params->{biblionumber};
2594 $itemnumbers = $params->{item_numbers};
2595 $opac = $params->{opac};
2596 $borcat = $params->{borcat} // q{};
2598 $itemnumbers = [] unless defined $itemnumbers;
2600 my $frameworkcode = GetFrameworkCode($biblionumber);
2601 _strip_item_fields($marc, $frameworkcode);
2603 # ... and embed the current items
2604 my $dbh = C4::Context->dbh;
2605 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2606 $sth->execute($biblionumber);
2607 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber" );
2609 my @item_fields; # Array holding the actual MARC data for items to be included.
2610 my @items; # Array holding items which are both in the list (sitenumbers)
2611 # and on this biblionumber
2613 # Flag indicating if there is potential hiding.
2614 my $opachiddenitems = $opac
2615 && ( C4::Context->preference('OpacHiddenItems') !~ /^\s*$/ );
2617 while ( my ($itemnumber) = $sth->fetchrow_array ) {
2618 next if @$itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers;
2620 if ( $opachiddenitems ) {
2621 $item = Koha::Items->find($itemnumber);
2622 $item = $item ? $item->unblessed : undef;
2624 push @items, { itemnumber => $itemnumber, item => $item };
2626 my @items2pass = map { $_->{item} } @items;
2629 ? C4::Items::GetHiddenItemnumbers({
2630 items => \@items2pass,
2631 borcat => $borcat })
2633 # Convert to a hash for quick searching
2634 my %hiddenitems = map { $_ => 1 } @hiddenitems;
2635 foreach my $itemnumber ( map { $_->{itemnumber} } @items ) {
2636 next if $hiddenitems{$itemnumber};
2637 my $item_marc = C4::Items::GetMarcItem( $biblionumber, $itemnumber );
2638 push @item_fields, $item_marc->field($itemtag);
2640 $marc->append_fields(@item_fields);
2643 =head1 INTERNAL FUNCTIONS
2645 =head2 _koha_marc_update_bib_ids
2648 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2650 Internal function to add or update biblionumber and biblioitemnumber to
2655 sub _koha_marc_update_bib_ids {
2656 my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
2658 my ( $biblio_tag, $biblio_subfield ) = GetMarcFromKohaField( "biblio.biblionumber" );
2659 die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
2660 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber" );
2661 die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
2663 if ( $biblio_tag < 10 ) {
2664 C4::Biblio::UpsertMarcControlField( $record, $biblio_tag, $biblionumber );
2666 C4::Biblio::UpsertMarcSubfield($record, $biblio_tag, $biblio_subfield, $biblionumber);
2668 if ( $biblioitem_tag < 10 ) {
2669 C4::Biblio::UpsertMarcControlField( $record, $biblioitem_tag, $biblioitemnumber );
2671 C4::Biblio::UpsertMarcSubfield($record, $biblioitem_tag, $biblioitem_subfield, $biblioitemnumber);
2675 =head2 _koha_marc_update_biblioitem_cn_sort
2677 _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
2679 Given a MARC bib record and the biblioitem hash, update the
2680 subfield that contains a copy of the value of biblioitems.cn_sort.
2684 sub _koha_marc_update_biblioitem_cn_sort {
2686 my $biblioitem = shift;
2687 my $frameworkcode = shift;
2689 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort" );
2690 return unless $biblioitem_tag;
2692 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2694 if ( my $field = $marc->field($biblioitem_tag) ) {
2695 $field->delete_subfield( code => $biblioitem_subfield );
2696 if ( $cn_sort ne '' ) {
2697 $field->add_subfields( $biblioitem_subfield => $cn_sort );
2701 # if we get here, no biblioitem tag is present in the MARC record, so
2702 # we'll create it if $cn_sort is not empty -- this would be
2703 # an odd combination of events, however
2705 $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
2710 =head2 _koha_modify_biblio
2712 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
2714 Internal function for updating the biblio table
2718 sub _koha_modify_biblio {
2719 my ( $dbh, $biblio, $frameworkcode ) = @_;
2724 SET frameworkcode = ?,
2737 WHERE biblionumber = ?
2740 my $sth = $dbh->prepare($query);
2743 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'subtitle'},
2744 $biblio->{'medium'}, $biblio->{'part_number'}, $biblio->{'part_name'}, $biblio->{'unititle'},
2745 $biblio->{'notes'}, $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'} ? int($biblio->{'copyrightdate'}) : undef,
2746 $biblio->{'abstract'}, $biblio->{'biblionumber'}
2747 ) if $biblio->{'biblionumber'};
2749 if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
2750 $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
2753 return ( $biblio->{'biblionumber'}, $error );
2756 =head2 _koha_modify_biblioitem_nonmarc
2758 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
2762 sub _koha_modify_biblioitem_nonmarc {
2763 my ( $dbh, $biblioitem ) = @_;
2766 # re-calculate the cn_sort, it may have changed
2767 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2769 my $query = "UPDATE biblioitems
2770 SET biblionumber = ?,
2776 publicationyear = ?,
2780 collectiontitle = ?,
2782 collectionvolume= ?,
2783 editionstatement= ?,
2784 editionresponsibility = ?,
2800 where biblioitemnumber = ?
2802 my $sth = $dbh->prepare($query);
2804 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
2805 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
2806 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
2807 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
2808 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
2809 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
2810 $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort, $biblioitem->{'totalissues'},
2811 $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}, $biblioitem->{'biblioitemnumber'}
2813 if ( $dbh->errstr ) {
2814 $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
2817 return ( $biblioitem->{'biblioitemnumber'}, $error );
2820 =head2 _koha_delete_biblio
2822 $error = _koha_delete_biblio($dbh,$biblionumber);
2824 Internal sub for deleting from biblio table -- also saves to deletedbiblio
2826 C<$dbh> - the database handle
2828 C<$biblionumber> - the biblionumber of the biblio to be deleted
2832 # FIXME: add error handling
2834 sub _koha_delete_biblio {
2835 my ( $dbh, $biblionumber ) = @_;
2837 # get all the data for this biblio
2838 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
2839 $sth->execute($biblionumber);
2841 # FIXME There is a transaction in _koha_delete_biblio_metadata
2842 # But actually all the following should be done inside a single transaction
2843 if ( my $data = $sth->fetchrow_hashref ) {
2845 # save the record in deletedbiblio
2846 # find the fields to save
2847 my $query = "INSERT INTO deletedbiblio SET ";
2849 foreach my $temp ( keys %$data ) {
2850 $query .= "$temp = ?,";
2851 push( @bind, $data->{$temp} );
2854 # replace the last , by ",?)"
2856 my $bkup_sth = $dbh->prepare($query);
2857 $bkup_sth->execute(@bind);
2860 _koha_delete_biblio_metadata( $biblionumber );
2863 my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
2864 $sth2->execute($biblionumber);
2865 # update the timestamp (Bugzilla 7146)
2866 $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
2867 $sth2->execute($biblionumber);
2874 =head2 _koha_delete_biblioitems
2876 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
2878 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
2880 C<$dbh> - the database handle
2881 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
2885 # FIXME: add error handling
2887 sub _koha_delete_biblioitems {
2888 my ( $dbh, $biblioitemnumber ) = @_;
2890 # get all the data for this biblioitem
2891 my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
2892 $sth->execute($biblioitemnumber);
2894 if ( my $data = $sth->fetchrow_hashref ) {
2896 # save the record in deletedbiblioitems
2897 # find the fields to save
2898 my $query = "INSERT INTO deletedbiblioitems SET ";
2900 foreach my $temp ( keys %$data ) {
2901 $query .= "$temp = ?,";
2902 push( @bind, $data->{$temp} );
2905 # replace the last , by ",?)"
2907 my $bkup_sth = $dbh->prepare($query);
2908 $bkup_sth->execute(@bind);
2911 # delete the biblioitem
2912 my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
2913 $sth2->execute($biblioitemnumber);
2914 # update the timestamp (Bugzilla 7146)
2915 $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
2916 $sth2->execute($biblioitemnumber);
2923 =head2 _koha_delete_biblio_metadata
2925 $error = _koha_delete_biblio_metadata($biblionumber);
2927 C<$biblionumber> - the biblionumber of the biblio metadata to be deleted
2931 sub _koha_delete_biblio_metadata {
2932 my ($biblionumber) = @_;
2934 my $dbh = C4::Context->dbh;
2935 my $schema = Koha::Database->new->schema;
2939 INSERT INTO deletedbiblio_metadata (biblionumber, format, `schema`, metadata)
2940 SELECT biblionumber, format, `schema`, metadata FROM biblio_metadata WHERE biblionumber=?
2941 |, undef, $biblionumber );
2942 $dbh->do( q|DELETE FROM biblio_metadata WHERE biblionumber=?|,
2943 undef, $biblionumber );
2948 =head1 UNEXPORTED FUNCTIONS
2950 =head2 ModBiblioMarc
2952 ModBiblioMarc($newrec,$biblionumber);
2954 Add MARC XML data for a biblio to koha
2956 Function exported, but should NOT be used, unless you really know what you're doing
2961 # pass the MARC::Record to this function, and it will create the records in
2963 my ( $record, $biblionumber ) = @_;
2965 carp 'ModBiblioMarc passed an undefined record';
2969 # Clone record as it gets modified
2970 $record = $record->clone();
2971 my $dbh = C4::Context->dbh;
2972 my @fields = $record->fields();
2973 my $encoding = C4::Context->preference("marcflavour");
2975 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
2976 if ( $encoding eq "UNIMARC" ) {
2977 my $defaultlanguage = C4::Context->preference("UNIMARCField100Language");
2978 $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
2979 my $string = $record->subfield( 100, "a" );
2980 if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
2981 my $f100 = $record->field(100);
2982 $record->delete_field($f100);
2984 $string = POSIX::strftime( "%Y%m%d", localtime );
2986 $string = sprintf( "%-*s", 35, $string );
2987 substr ( $string, 22, 3, $defaultlanguage);
2989 substr( $string, 25, 3, "y50" );
2990 unless ( $record->subfield( 100, "a" ) ) {
2991 $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
2995 #enhancement 5374: update transaction date (005) for marc21/unimarc
2996 if($encoding =~ /MARC21|UNIMARC/) {
2997 my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
2998 # YY MM DD HH MM SS (update year and month)
2999 my $f005= $record->field('005');
3000 $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3004 biblionumber => $biblionumber,
3005 format => 'marcxml',
3006 schema => C4::Context->preference('marcflavour'),
3008 $record->as_usmarc; # Bug 20126/10455 This triggers field length calculation
3010 my $m_rs = Koha::Biblio::Metadatas->find($metadata) //
3011 Koha::Biblio::Metadata->new($metadata);
3013 my $userenv = C4::Context->userenv;
3015 my $borrowernumber = $userenv->{number};
3016 my $borrowername = join ' ', map { $_ // q{} } @$userenv{qw(firstname surname)};
3017 unless ($m_rs->in_storage) {
3018 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorId'), $borrowernumber);
3019 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorName'), $borrowername);
3021 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierId'), $borrowernumber);
3022 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierName'), $borrowername);
3025 $m_rs->metadata( $record->as_xml_record($encoding) );
3028 my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
3029 $indexer->index_records( $biblionumber, "specialUpdate", "biblioserver" );
3031 return $biblionumber;
3034 =head2 prepare_host_field
3036 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
3037 Generate the host item entry for an analytic child entry
3041 sub prepare_host_field {
3042 my ( $hostbiblio, $marcflavour ) = @_;
3043 $marcflavour ||= C4::Context->preference('marcflavour');
3044 my $host = GetMarcBiblio({ biblionumber => $hostbiblio });
3045 # unfortunately as_string does not 'do the right thing'
3046 # if field returns undef
3050 if ( $marcflavour eq 'MARC21' ) {
3051 if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
3052 my $s = $field->as_string('ab');
3057 if ( $field = $host->field('245') ) {
3058 my $s = $field->as_string('a');
3063 if ( $field = $host->field('260') ) {
3064 my $s = $field->as_string('abc');
3069 if ( $field = $host->field('240') ) {
3070 my $s = $field->as_string();
3075 if ( $field = $host->field('022') ) {
3076 my $s = $field->as_string('a');
3081 if ( $field = $host->field('020') ) {
3082 my $s = $field->as_string('a');
3087 if ( $field = $host->field('001') ) {
3088 $sfd{w} = $field->data(),;
3090 $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
3093 elsif ( $marcflavour eq 'UNIMARC' ) {
3095 if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3096 my $s = $field->as_string('ab');
3102 if ( $field = $host->field('200') ) {
3103 my $s = $field->as_string('a');
3108 #place of publicaton
3109 if ( $field = $host->field('210') ) {
3110 my $s = $field->as_string('a');
3115 #date of publication
3116 if ( $field = $host->field('210') ) {
3117 my $s = $field->as_string('d');
3123 if ( $field = $host->field('205') ) {
3124 my $s = $field->as_string();
3130 if ( $field = $host->field('856') ) {
3131 my $s = $field->as_string('u');
3137 if ( $field = $host->field('011') ) {
3138 my $s = $field->as_string('a');
3144 if ( $field = $host->field('010') ) {
3145 my $s = $field->as_string('a');
3150 if ( $field = $host->field('001') ) {
3151 $sfd{0} = $field->data(),;
3153 $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
3160 =head2 UpdateTotalIssues
3162 UpdateTotalIssues($biblionumber, $increase, [$value])
3164 Update the total issue count for a particular bib record.
3168 =item C<$biblionumber> is the biblionumber of the bib to update
3170 =item C<$increase> is the amount to increase (or decrease) the total issues count by
3172 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
3178 sub UpdateTotalIssues {
3179 my ($biblionumber, $increase, $value) = @_;
3182 my $record = GetMarcBiblio({ biblionumber => $biblionumber });
3184 carp "UpdateTotalIssues could not get biblio record";
3187 my $biblio = Koha::Biblios->find( $biblionumber );
3189 carp "UpdateTotalIssues could not get datas of biblio";
3192 my $biblioitem = $biblio->biblioitem;
3193 my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField( 'biblioitems.totalissues' );
3194 unless ($totalissuestag) {
3195 return 1; # There is nothing to do
3198 if (defined $value) {
3199 $totalissues = $value;
3201 $totalissues = $biblioitem->totalissues + $increase;
3204 my $field = $record->field($totalissuestag);
3205 if (defined $field) {
3206 $field->update( $totalissuessubfield => $totalissues );
3208 $field = MARC::Field->new($totalissuestag, '0', '0',
3209 $totalissuessubfield => $totalissues);
3210 $record->insert_grouped_field($field);
3213 return ModBiblio($record, $biblionumber, $biblio->frameworkcode);
3218 &RemoveAllNsb($record);
3220 Removes all nsb/nse chars from a record
3227 carp 'RemoveAllNsb called with undefined record';
3231 SetUTF8Flag($record);
3233 foreach my $field ($record->fields()) {
3234 if ($field->is_control_field()) {
3235 $field->update(nsb_clean($field->data()));
3237 my @subfields = $field->subfields();
3239 foreach my $subfield (@subfields) {
3240 push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
3242 if (scalar(@new_subfields) > 0) {
3245 $new_field = MARC::Field->new(
3247 $field->indicator(1),
3248 $field->indicator(2),
3253 warn "error in RemoveAllNsb : $@";
3255 $field->replace_with($new_field);
3264 =head2 ApplyMarcOverlayRules
3266 my $record = ApplyMarcOverlayRules($params)
3268 Applies marc merge rules to a record.
3270 C<$params> is expected to be a hashref with below keys defined.
3274 =item C<biblionumber>
3275 biblionumber of old record
3278 Incoming record that will be merged with old record
3280 =item C<overlay_context>
3281 hashref containing at least one context module and filter value on
3282 the form {module => filter, ...}.
3292 Merged MARC record based with merge rules for C<context> applied. If no old
3293 record for C<biblionumber> can be found, C<record> is returned unchanged.
3294 Default action when no matching context is found to return C<record> unchanged.
3295 If no rules are found for a certain field tag the default is to overwrite with
3296 fields with this field tag from C<record>.
3302 sub ApplyMarcOverlayRules {
3304 my $biblionumber = $params->{biblionumber};
3305 my $incoming_record = $params->{record};
3307 if (!$biblionumber) {
3308 carp 'ApplyMarcOverlayRules called on undefined biblionumber';
3311 if (!$incoming_record) {
3312 carp 'ApplyMarcOverlayRules called on undefined record';
3315 my $old_record = GetMarcBiblio({ biblionumber => $biblionumber });
3317 # Skip overlay rules if called with no context
3318 if ($old_record && defined $params->{overlay_context}) {
3319 return Koha::MarcOverlayRules->merge_records($old_record, $incoming_record, $params->{overlay_context});
3321 return $incoming_record;
3324 =head2 _after_biblio_action_hooks
3326 Helper method that takes care of calling all plugin hooks
3330 sub _after_biblio_action_hooks {
3333 my $biblio_id = $args->{biblio_id};
3334 my $action = $args->{action};
3336 my $biblio = Koha::Biblios->find( $biblio_id );
3337 Koha::Plugins->call(
3338 'after_biblio_action',
3342 biblio_id => $biblio_id,
3353 Koha Development Team <http://koha-community.org/>
3355 Paul POULAIN paul.poulain@free.fr
3357 Joshua Ferraro jmf@liblime.com