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);
46 GetAuthorisedValueDesc
48 IsMarcStructureInternal
50 GetMarcSubfieldStructureFromKohaField
61 LinkBibHeadingsToAuthorities
69 # those functions are exported but should not be used
70 # they are useful in a few circumstances, so they are exported,
71 # but don't use them unless you are a core developer ;-)
80 use Encode qw( decode is_utf8 );
81 use List::MoreUtils qw( uniq );
83 use MARC::File::USMARC;
85 use POSIX qw(strftime);
86 use Module::Load::Conditional qw(can_load);
89 use C4::Log; # logaction
98 use Koha::Authority::Types;
99 use Koha::Acquisition::Currencies;
100 use Koha::Biblio::Metadatas;
104 use Koha::SearchEngine;
105 use Koha::SearchEngine::Indexer;
107 use Koha::Util::MARC;
109 use vars qw($debug $cgi_debug);
114 C4::Biblio - cataloging management functions
118 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:
122 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
124 =item 2. as raw MARC in the Zebra index and storage engine
126 =item 3. as MARC XML in biblio_metadata.metadata
130 In the 3.0 version of Koha, the authoritative record-level information is in biblio_metadata.metadata
132 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.
136 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
138 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
142 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:
146 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
148 =item 2. _koha_* - low-level internal functions for managing the koha tables
150 =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.
152 =item 4. Zebra functions used to update the Zebra index
154 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
158 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 :
162 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
164 =item 2. add the biblionumber and biblioitemnumber into the MARC records
166 =item 3. save the marc record
170 =head1 EXPORTED FUNCTIONS
174 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
176 Exported function (core API) for adding a new biblio to koha.
178 The first argument is a C<MARC::Record> object containing the
179 bib to add, while the second argument is the desired MARC
182 This function also accepts a third, optional argument: a hashref
183 to additional options. The only defined option is C<defer_marc_save>,
184 which if present and mapped to a true value, causes C<AddBiblio>
185 to omit the call to save the MARC in C<biblio_metadata.metadata>
186 This option is provided B<only>
187 for the use of scripts such as C<bulkmarcimport.pl> that may need
188 to do some manipulation of the MARC record for item parsing before
189 saving it and which cannot afford the performance hit of saving
190 the MARC record twice. Consequently, do not use that option
191 unless you can guarantee that C<ModBiblioMarc> will be called.
197 my $frameworkcode = shift;
198 my $options = @_ ? shift : undef;
199 my $defer_marc_save = 0;
201 carp('AddBiblio called with undefined record');
204 if ( defined $options and exists $options->{'defer_marc_save'} and $options->{'defer_marc_save'} ) {
205 $defer_marc_save = 1;
208 my $schema = Koha::Database->schema;
209 my ( $biblionumber, $biblioitemnumber );
211 $schema->txn_do(sub {
213 if (C4::Context->preference('BiblioAddsAuthorities')) {
214 BiblioAutoLink( $record, $frameworkcode );
217 # transform the data into koha-table style data
218 SetUTF8Flag($record);
219 my $olddata = TransformMarcToKoha( $record, $frameworkcode );
221 my $biblio = Koha::Biblio->new(
223 frameworkcode => $frameworkcode,
224 author => $olddata->{author},
225 title => $olddata->{title},
226 subtitle => $olddata->{subtitle},
227 medium => $olddata->{medium},
228 part_number => $olddata->{part_number},
229 part_name => $olddata->{part_name},
230 unititle => $olddata->{unititle},
231 notes => $olddata->{notes},
233 ( $olddata->{serial} || $olddata->{seriestitle} ? 1 : 0 ),
234 seriestitle => $olddata->{seriestitle},
235 copyrightdate => $olddata->{copyrightdate},
236 datecreated => \'NOW()',
237 abstract => $olddata->{abstract},
240 $biblionumber = $biblio->biblionumber;
241 Koha::Exceptions::ObjectNotCreated->throw unless $biblio;
243 my ($cn_sort) = GetClassSort( $olddata->{'biblioitems.cn_source'}, $olddata->{'cn_class'}, $olddata->{'cn_item'} );
244 my $biblioitem = Koha::Biblioitem->new(
246 biblionumber => $biblionumber,
247 volume => $olddata->{volume},
248 number => $olddata->{number},
249 itemtype => $olddata->{itemtype},
250 isbn => $olddata->{isbn},
251 issn => $olddata->{issn},
252 publicationyear => $olddata->{publicationyear},
253 publishercode => $olddata->{publishercode},
254 volumedate => $olddata->{volumedate},
255 volumedesc => $olddata->{volumedesc},
256 collectiontitle => $olddata->{collectiontitle},
257 collectionissn => $olddata->{collectionissn},
258 collectionvolume => $olddata->{collectionvolume},
259 editionstatement => $olddata->{editionstatement},
260 editionresponsibility => $olddata->{editionresponsibility},
261 illus => $olddata->{illus},
262 pages => $olddata->{pages},
263 notes => $olddata->{bnotes},
264 size => $olddata->{size},
265 place => $olddata->{place},
266 lccn => $olddata->{lccn},
267 url => $olddata->{url},
268 cn_source => $olddata->{'biblioitems.cn_source'},
269 cn_class => $olddata->{cn_class},
270 cn_item => $olddata->{cn_item},
271 cn_suffix => $olddata->{cn_suff},
273 totalissues => $olddata->{totalissues},
274 ean => $olddata->{ean},
275 agerestriction => $olddata->{agerestriction},
278 Koha::Exceptions::ObjectNotCreated->throw unless $biblioitem;
279 $biblioitemnumber = $biblioitem->biblioitemnumber;
281 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
283 # update MARC subfield that stores biblioitems.cn_sort
284 _koha_marc_update_biblioitem_cn_sort( $record, $olddata, $frameworkcode );
287 ModBiblioMarc( $record, $biblionumber ) unless $defer_marc_save;
289 # update OAI-PMH sets
290 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
291 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
294 _after_biblio_action_hooks({ action => 'create', biblio_id => $biblionumber });
296 logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
300 ( $biblionumber, $biblioitemnumber ) = ( undef, undef );
302 return ( $biblionumber, $biblioitemnumber );
307 ModBiblio( $record,$biblionumber,$frameworkcode, $disable_autolink);
309 Replace an existing bib record identified by C<$biblionumber>
310 with one supplied by the MARC::Record object C<$record>. The embedded
311 item, biblioitem, and biblionumber fields from the previous
312 version of the bib record replace any such fields of those tags that
313 are present in C<$record>. Consequently, ModBiblio() is not
314 to be used to try to modify item records.
316 C<$frameworkcode> specifies the MARC framework to use
317 when storing the modified bib record; among other things,
318 this controls how MARC fields get mapped to display columns
319 in the C<biblio> and C<biblioitems> tables, as well as
320 which fields are used to store embedded item, biblioitem,
321 and biblionumber data for indexing.
323 Unless C<$disable_autolink> is passed ModBiblio will relink record headings
324 to authorities based on settings in the system preferences. This flag allows
325 us to not relink records when the authority linker is saving modifications.
327 Returns 1 on success 0 on failure
332 my ( $record, $biblionumber, $frameworkcode, $disable_autolink ) = @_;
334 carp 'No record passed to ModBiblio';
338 if ( C4::Context->preference("CataloguingLog") ) {
339 my $newrecord = GetMarcBiblio({ biblionumber => $biblionumber });
340 logaction( "CATALOGUING", "MODIFY", $biblionumber, "biblio BEFORE=>" . $newrecord->as_formatted );
343 if ( !$disable_autolink && C4::Context->preference('BiblioAddsAuthorities') ) {
344 BiblioAutoLink( $record, $frameworkcode );
347 # Cleaning up invalid fields must be done early or SetUTF8Flag is liable to
348 # throw an exception which probably won't be handled.
349 foreach my $field ($record->fields()) {
350 if (! $field->is_control_field()) {
351 if (scalar($field->subfields()) == 0 || (scalar($field->subfields()) == 1 && $field->subfield('9'))) {
352 $record->delete_field($field);
357 SetUTF8Flag($record);
358 my $dbh = C4::Context->dbh;
360 $frameworkcode = "" if !$frameworkcode || $frameworkcode eq "Default"; # XXX
362 _strip_item_fields($record, $frameworkcode);
364 # update biblionumber and biblioitemnumber in MARC
365 # FIXME - this is assuming a 1 to 1 relationship between
366 # biblios and biblioitems
367 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
368 $sth->execute($biblionumber);
369 my ($biblioitemnumber) = $sth->fetchrow;
371 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
373 # load the koha-table data object
374 my $oldbiblio = TransformMarcToKoha( $record, $frameworkcode );
376 # update MARC subfield that stores biblioitems.cn_sort
377 _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode );
379 # update the MARC record (that now contains biblio and items) with the new record data
380 &ModBiblioMarc( $record, $biblionumber );
382 # modify the other koha tables
383 _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
384 _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
386 _after_biblio_action_hooks({ action => 'modify', biblio_id => $biblionumber });
388 # update OAI-PMH sets
389 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
390 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
396 =head2 _strip_item_fields
398 _strip_item_fields($record, $frameworkcode)
400 Utility routine to remove item tags from a
405 sub _strip_item_fields {
407 my $frameworkcode = shift;
408 # get the items before and append them to the biblio before updating the record, atm we just have the biblio
409 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber" );
411 # delete any item fields from incoming record to avoid
412 # duplication or incorrect data - use AddItem() or ModItem()
414 foreach my $field ( $record->field($itemtag) ) {
415 $record->delete_field($field);
421 my $error = &DelBiblio($biblionumber);
423 Exported function (core API) for deleting a biblio in koha.
424 Deletes biblio record from Zebra and Koha tables (biblio & biblioitems)
425 Also backs it up to deleted* tables.
426 Checks to make sure that the biblio has no items attached.
428 C<$error> : undef unless an error occurs
433 my ($biblionumber, $params) = @_;
435 my $biblio = Koha::Biblios->find( $biblionumber );
436 return unless $biblio; # Should we throw an exception instead?
438 my $dbh = C4::Context->dbh;
439 my $error; # for error handling
441 # First make sure this biblio has no items attached
442 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
443 $sth->execute($biblionumber);
444 if ( my $itemnumber = $sth->fetchrow ) {
446 # Fix this to use a status the template can understand
447 $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
450 return $error if $error;
452 # We delete any existing holds
453 my $holds = $biblio->holds;
454 while ( my $hold = $holds->next ) {
458 unless ( $params->{skip_record_index} ){
459 my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
460 $indexer->index_records( $biblionumber, "recordDelete", "biblioserver" );
463 # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
464 $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
465 $sth->execute($biblionumber);
466 while ( my $biblioitemnumber = $sth->fetchrow ) {
468 # delete this biblioitem
469 $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
470 return $error if $error;
474 # delete biblio from Koha tables and save in deletedbiblio
475 # must do this *after* _koha_delete_biblioitems, otherwise
476 # delete cascade will prevent deletedbiblioitems rows
477 # from being generated by _koha_delete_biblioitems
478 $error = _koha_delete_biblio( $dbh, $biblionumber );
480 _after_biblio_action_hooks({ action => 'delete', biblio_id => $biblionumber });
482 logaction( "CATALOGUING", "DELETE", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
488 =head2 BiblioAutoLink
490 my $headings_linked = BiblioAutoLink($record, $frameworkcode)
492 Automatically links headings in a bib record to authorities.
494 Returns the number of headings changed
500 my $frameworkcode = shift;
503 carp('Undefined record passed to BiblioAutoLink');
506 my ( $num_headings_changed, %results );
509 "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
510 unless ( can_load( modules => { $linker_module => undef } ) ) {
511 $linker_module = 'C4::Linker::Default';
512 unless ( can_load( modules => { $linker_module => undef } ) ) {
517 my $linker = $linker_module->new(
518 { 'options' => C4::Context->preference("LinkerOptions") } );
519 my ( $headings_changed, $results ) =
520 LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, C4::Context->preference("CatalogModuleRelink") || '', undef, $verbose );
521 # By default we probably don't want to relink things when cataloging
522 return $headings_changed, $results;
525 =head2 LinkBibHeadingsToAuthorities
527 my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink, $tagtolink, $verbose]);
529 Links bib headings to authority records by checking
530 each authority-controlled field in the C<MARC::Record>
531 object C<$marc>, looking for a matching authority record,
532 and setting the linking subfield $9 to the ID of that
535 If $allowrelink is false, existing authids will never be
536 replaced, regardless of the values of LinkerKeepStale and
539 Returns the number of heading links changed in the
544 sub LinkBibHeadingsToAuthorities {
547 my $frameworkcode = shift;
548 my $allowrelink = shift;
549 my $tagtolink = shift;
553 carp 'LinkBibHeadingsToAuthorities called on undefined bib record';
557 require C4::AuthoritiesMarc;
559 $allowrelink = 1 unless defined $allowrelink;
560 my $num_headings_changed = 0;
561 foreach my $field ( $bib->fields() ) {
562 if ( defined $tagtolink ) {
563 next unless $field->tag() == $tagtolink ;
565 my $heading = C4::Heading->new_from_field( $field, $frameworkcode );
566 next unless defined $heading;
569 my $current_link = $field->subfield('9');
571 if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) )
573 $results{'linked'}->{ $heading->display_form() }++;
574 push(@{$results{'details'}}, { tag => $field->tag(), authid => $current_link, status => 'UNCHANGED'}) if $verbose;
578 my ( $authid, $fuzzy, $match_count ) = $linker->get_link($heading);
580 $results{ $fuzzy ? 'fuzzy' : 'linked' }
581 ->{ $heading->display_form() }++;
582 if(defined $current_link and $current_link == $authid) {
583 push(@{$results{'details'}}, { tag => $field->tag(), authid => $current_link, status => 'UNCHANGED'}) if $verbose;
587 $field->delete_subfield( code => '9' ) if defined $current_link;
588 $field->add_subfields( '9', $authid );
589 $num_headings_changed++;
590 push(@{$results{'details'}}, { tag => $field->tag(), authid => $authid, status => 'LOCAL_FOUND'}) if $verbose;
593 my $authority_type = Koha::Authority::Types->find( $heading->auth_type() );
594 if ( defined $current_link
595 && (!$allowrelink || C4::Context->preference('LinkerKeepStale')) )
597 $results{'fuzzy'}->{ $heading->display_form() }++;
598 push(@{$results{'details'}}, { tag => $field->tag(), authid => $current_link, status => 'UNCHANGED'}) if $verbose;
600 elsif ( C4::Context->preference('AutoCreateAuthorities') ) {
601 if ( _check_valid_auth_link( $current_link, $field ) ) {
602 $results{'linked'}->{ $heading->display_form() }++;
604 elsif ( !$match_count ) {
605 my $authority_type = Koha::Authority::Types->find( $heading->auth_type() );
606 my $marcrecordauth = MARC::Record->new();
607 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
608 $marcrecordauth->leader(' nz a22 o 4500');
609 SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
611 $field->delete_subfield( code => '9' )
612 if defined $current_link;
614 foreach my $subfield ( $field->subfields() ){
615 if ( $subfield->[0] =~ /[A-z]/
616 && C4::Heading::valid_heading_subfield(
617 $field->tag, $subfield->[0] )
619 push @auth_subfields, $subfield->[0] => $subfield->[1];
622 # Bib headings contain some ending punctuation that should NOT
623 # be included in the authority record. Strip those before creation
624 next unless @auth_subfields; # Don't try to create a record if we have no fields;
625 my $last_sub = pop @auth_subfields;
626 $last_sub =~ s/[\s]*[,.:=;!%\/][\s]*$//;
627 push @auth_subfields, $last_sub;
628 my $authfield = MARC::Field->new( $authority_type->auth_tag_to_report, '', '', @auth_subfields );
629 $marcrecordauth->insert_fields_ordered($authfield);
631 # bug 2317: ensure new authority knows it's using UTF-8; currently
632 # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
633 # automatically for UNIMARC (by not transcoding)
634 # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
635 # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
636 # of change to a core API just before the 3.0 release.
638 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
639 my $userenv = C4::Context->userenv;
641 if ( $userenv && $userenv->{'branch'} ) {
642 $library = Koha::Libraries->find( $userenv->{'branch'} );
644 $marcrecordauth->insert_fields_ordered(
647 'a' => "Machine generated authority record."
651 $bib->author() . ", "
652 . $bib->title_proper() . ", "
653 . $bib->publication_date() . " ";
654 $cite =~ s/^[\s\,]*//;
655 $cite =~ s/[\s\,]*$//;
658 . ( $library ? $library->get_effective_marcorgcode : C4::Context->preference('MARCOrgCode') ) . ")"
659 . $bib->subfield( '999', 'c' ) . ": "
661 $marcrecordauth->insert_fields_ordered(
662 MARC::Field->new( '670', '', '', 'a' => $cite ) );
665 # warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
668 C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '',
669 $heading->auth_type() );
670 $field->add_subfields( '9', $authid );
671 $num_headings_changed++;
672 $linker->update_cache($heading, $authid);
673 $results{'added'}->{ $heading->display_form() }++;
674 push(@{$results{'details'}}, { tag => $field->tag(), authid => $authid, status => 'CREATED'}) if $verbose;
677 elsif ( defined $current_link ) {
678 if ( _check_valid_auth_link( $current_link, $field ) ) {
679 $results{'linked'}->{ $heading->display_form() }++;
680 push(@{$results{'details'}}, { tag => $field->tag(), authid => $authid, status => 'UNCHANGED'}) if $verbose;
683 $field->delete_subfield( code => '9' );
684 $num_headings_changed++;
685 $results{'unlinked'}->{ $heading->display_form() }++;
686 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;
690 $results{'unlinked'}->{ $heading->display_form() }++;
691 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;
696 push(@{$results{'details'}}, { tag => '', authid => undef, status => 'UNCHANGED'}) unless %results;
697 return $num_headings_changed, \%results;
700 =head2 _check_valid_auth_link
702 if ( _check_valid_auth_link($authid, $field) ) {
706 Check whether the specified heading-auth link is valid without reference
707 to Zebra. Ideally this code would be in C4::Heading, but that won't be
708 possible until we have de-cycled C4::AuthoritiesMarc, so this is the
713 sub _check_valid_auth_link {
714 my ( $authid, $field ) = @_;
715 require C4::AuthoritiesMarc;
717 my $authorized_heading =
718 C4::AuthoritiesMarc::GetAuthorizedHeading( { 'authid' => $authid } ) || '';
719 return ($field->as_string('abcdefghijklmnopqrstuvwxyz') eq $authorized_heading);
724 $data = &GetBiblioData($biblionumber);
726 Returns information about the book with the given biblionumber.
727 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
728 the C<biblio> and C<biblioitems> tables in the
731 In addition, C<$data-E<gt>{subject}> is the list of the book's
732 subjects, separated by C<" , "> (space, comma, space).
733 If there are multiple biblioitems with the given biblionumber, only
734 the first one is considered.
740 my $dbh = C4::Context->dbh;
742 my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
744 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
745 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
746 WHERE biblio.biblionumber = ?";
748 my $sth = $dbh->prepare($query);
749 $sth->execute($bibnum);
751 $data = $sth->fetchrow_hashref;
755 } # sub GetBiblioData
759 $isbd = &GetISBDView({
760 'record' => $marc_record,
761 'template' => $interface, # opac/intranet
762 'framework' => $framework,
765 Return the ISBD view which can be included in opac and intranet
772 # Expecting record WITH items.
773 my $record = $params->{record};
774 return unless defined $record;
776 my $template = $params->{template} // q{};
777 my $sysprefname = $template eq 'opac' ? 'opacisbd' : 'isbd';
778 my $framework = $params->{framework};
779 my $itemtype = $framework;
780 my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField( "items.holdingbranch" );
781 my $tagslib = GetMarcStructure( 1, $itemtype, { unsafe => 1 } );
783 my $ISBD = C4::Context->preference($sysprefname);
788 foreach my $isbdfield ( split( /#/, $bloc ) ) {
790 # $isbdfield= /(.?.?.?)/;
791 $isbdfield =~ /(\d\d\d)([^\|])?\|(.*)\|(.*)\|(.*)/;
792 my $fieldvalue = $1 || 0;
793 my $subfvalue = $2 || "";
795 my $analysestring = $4;
798 # warn "==> $1 / $2 / $3 / $4";
799 # my $fieldvalue=substr($isbdfield,0,3);
800 if ( $fieldvalue > 0 ) {
801 my $hasputtextbefore = 0;
802 my @fieldslist = $record->field($fieldvalue);
803 @fieldslist = sort { $a->subfield($holdingbrtagsubf) cmp $b->subfield($holdingbrtagsubf) } @fieldslist if ( $fieldvalue eq $holdingbrtagf );
805 # warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
806 # warn "FV : $fieldvalue";
807 if ( $subfvalue ne "" ) {
808 # OPAC hidden subfield
810 if ( ( $template eq 'opac' )
811 && ( $tagslib->{$fieldvalue}->{$subfvalue}->{'hidden'} || 0 ) > 0 );
812 foreach my $field (@fieldslist) {
813 foreach my $subfield ( $field->subfield($subfvalue) ) {
814 my $calculated = $analysestring;
815 my $tag = $field->tag();
818 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subfvalue, $subfield, '', $tagslib );
819 my $tagsubf = $tag . $subfvalue;
820 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
821 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
823 # field builded, store the result
824 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
825 $blocres .= $textbefore;
826 $hasputtextbefore = 1;
829 # remove punctuation at start
830 $calculated =~ s/^( |;|:|\.|-)*//g;
831 $blocres .= $calculated;
836 $blocres .= $textafter if $hasputtextbefore;
838 foreach my $field (@fieldslist) {
839 my $calculated = $analysestring;
840 my $tag = $field->tag();
843 my @subf = $field->subfields;
844 for my $i ( 0 .. $#subf ) {
845 my $valuecode = $subf[$i][1];
846 my $subfieldcode = $subf[$i][0];
847 # OPAC hidden subfield
849 if ( ( $template eq 'opac' )
850 && ( $tagslib->{$fieldvalue}->{$subfieldcode}->{'hidden'} || 0 ) > 0 );
851 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subf[$i][0], $subf[$i][1], '', $tagslib );
852 my $tagsubf = $tag . $subfieldcode;
854 $calculated =~ s/ # replace all {{}} codes by the value code.
855 \{\{$tagsubf\}\} # catch the {{actualcode}}
857 $valuecode # replace by the value code
860 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
861 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
864 # field builded, store the result
865 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
866 $blocres .= $textbefore;
867 $hasputtextbefore = 1;
870 # remove punctuation at start
871 $calculated =~ s/^( |;|:|\.|-)*//g;
872 $blocres .= $calculated;
875 $blocres .= $textafter if $hasputtextbefore;
878 $blocres .= $isbdfield;
883 $res =~ s/\{(.*?)\}//g;
885 $res =~ s/\n/<br\/>/g;
893 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
895 =head2 IsMarcStructureInternal
897 my $tagslib = C4::Biblio::GetMarcStructure();
898 for my $tag ( sort keys %$tagslib ) {
900 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
901 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
906 GetMarcStructure creates keys (lib, tab, mandatory, repeatable, important) for a display purpose.
907 These different values should not be processed as valid subfields.
911 sub IsMarcStructureInternal {
912 my ( $subfield ) = @_;
913 return ref $subfield ? 0 : 1;
916 =head2 GetMarcStructure
918 $res = GetMarcStructure($forlibrarian, $frameworkcode, [ $params ]);
920 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
921 $forlibrarian :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
922 $frameworkcode : the framework code to read
923 $params allows you to pass { unsafe => 1 } for better performance.
925 Note: If you call GetMarcStructure with unsafe => 1, do not modify or
926 even autovivify its contents. It is a cached/shared data structure. Your
927 changes c/would be passed around in subsequent calls.
931 sub GetMarcStructure {
932 my ( $forlibrarian, $frameworkcode, $params ) = @_;
933 $frameworkcode = "" unless $frameworkcode;
935 $forlibrarian = $forlibrarian ? 1 : 0;
936 my $unsafe = ($params && $params->{unsafe})? 1: 0;
937 my $cache = Koha::Caches->get_instance();
938 my $cache_key = "MarcStructure-$forlibrarian-$frameworkcode";
939 my $cached = $cache->get_from_cache($cache_key, { unsafe => $unsafe });
940 return $cached if $cached;
942 my $dbh = C4::Context->dbh;
943 my $sth = $dbh->prepare(
944 "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable,important,ind1_defaultvalue,ind2_defaultvalue
945 FROM marc_tag_structure
946 WHERE frameworkcode=?
949 $sth->execute($frameworkcode);
950 my ( $liblibrarian, $libopac, $tag, $res, $mandatory, $repeatable, $important, $ind1_defaultvalue, $ind2_defaultvalue );
952 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable, $important, $ind1_defaultvalue, $ind2_defaultvalue ) = $sth->fetchrow ) {
953 $res->{$tag}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
954 $res->{$tag}->{tab} = "";
955 $res->{$tag}->{mandatory} = $mandatory;
956 $res->{$tag}->{important} = $important;
957 $res->{$tag}->{repeatable} = $repeatable;
958 $res->{$tag}->{ind1_defaultvalue} = $ind1_defaultvalue;
959 $res->{$tag}->{ind2_defaultvalue} = $ind2_defaultvalue;
962 my $mss = Koha::MarcSubfieldStructures->search( { frameworkcode => $frameworkcode } )->unblessed;
964 $res->{ $m->{tagfield} }->{ $m->{tagsubfield} } = {
965 lib => ( $forlibrarian or !$m->{libopac} ) ? $m->{liblibrarian} : $m->{libopac},
966 subfield => $m->{tagsubfield},
971 $cache->set_in_cache($cache_key, $res);
975 =head2 GetUsedMarcStructure
977 The same function as GetMarcStructure except it just takes field
978 in tab 0-9. (used field)
980 my $results = GetUsedMarcStructure($frameworkcode);
982 C<$results> is a ref to an array which each case contains a ref
983 to a hash which each keys is the columns from marc_subfield_structure
985 C<$frameworkcode> is the framework code.
989 sub GetUsedMarcStructure {
990 my $frameworkcode = shift || '';
993 FROM marc_subfield_structure
995 AND frameworkcode = ?
996 ORDER BY tagfield, display_order, tagsubfield
998 my $sth = C4::Context->dbh->prepare($query);
999 $sth->execute($frameworkcode);
1000 return $sth->fetchall_arrayref( {} );
1005 =head2 GetMarcSubfieldStructure
1007 my $structure = GetMarcSubfieldStructure($frameworkcode, [$params]);
1009 Returns a reference to hash representing MARC subfield structure
1010 for framework with framework code C<$frameworkcode>, C<$params> is
1011 optional and may contain additional options.
1015 =item C<$frameworkcode>
1021 An optional hash reference with additional options.
1022 The following options are supported:
1028 Pass { unsafe => 1 } do disable cached object cloning,
1029 and instead get a shared reference, resulting in better
1030 performance (but care must be taken so that retured object
1033 Note: If you call GetMarcSubfieldStructure with unsafe => 1, do not modify or
1034 even autovivify its contents. It is a cached/shared data structure. Your
1035 changes would be passed around in subsequent calls.
1043 sub GetMarcSubfieldStructure {
1044 my ( $frameworkcode, $params ) = @_;
1046 $frameworkcode //= '';
1048 my $cache = Koha::Caches->get_instance();
1049 my $cache_key = "MarcSubfieldStructure-$frameworkcode";
1050 my $cached = $cache->get_from_cache($cache_key, { unsafe => ($params && $params->{unsafe}) });
1051 return $cached if $cached;
1053 my $dbh = C4::Context->dbh;
1054 # We moved to selectall_arrayref since selectall_hashref does not
1055 # keep duplicate mappings on kohafield (like place in 260 vs 264)
1056 my $subfield_aref = $dbh->selectall_arrayref( q|
1058 FROM marc_subfield_structure
1059 WHERE frameworkcode = ?
1061 ORDER BY frameworkcode, tagfield, display_order, tagsubfield
1062 |, { Slice => {} }, $frameworkcode );
1063 # Now map the output to a hash structure
1064 my $subfield_structure = {};
1065 foreach my $row ( @$subfield_aref ) {
1066 push @{ $subfield_structure->{ $row->{kohafield} }}, $row;
1068 $cache->set_in_cache( $cache_key, $subfield_structure );
1069 return $subfield_structure;
1072 =head2 GetMarcFromKohaField
1074 ( $field,$subfield ) = GetMarcFromKohaField( $kohafield );
1075 @fields = GetMarcFromKohaField( $kohafield );
1076 $field = GetMarcFromKohaField( $kohafield );
1078 Returns the MARC fields & subfields mapped to $kohafield.
1079 Since the Default framework is considered as authoritative for such
1080 mappings, the former frameworkcode parameter is obsoleted.
1082 In list context all mappings are returned; there can be multiple
1083 mappings. Note that in the above example you could miss a second
1084 mappings in the first call.
1085 In scalar context only the field tag of the first mapping is returned.
1089 sub GetMarcFromKohaField {
1090 my ( $kohafield ) = @_;
1091 return unless $kohafield;
1092 # The next call uses the Default framework since it is AUTHORITATIVE
1093 # for all Koha to MARC mappings.
1094 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
1096 foreach( @{ $mss->{$kohafield} } ) {
1097 push @retval, $_->{tagfield}, $_->{tagsubfield};
1099 return wantarray ? @retval : ( @retval ? $retval[0] : undef );
1102 =head2 GetMarcSubfieldStructureFromKohaField
1104 my $str = GetMarcSubfieldStructureFromKohaField( $kohafield );
1106 Returns marc subfield structure information for $kohafield.
1107 The Default framework is used, since it is authoritative for kohafield
1109 In list context returns a list of all hashrefs, since there may be
1110 multiple mappings. In scalar context the first hashref is returned.
1114 sub GetMarcSubfieldStructureFromKohaField {
1115 my ( $kohafield ) = @_;
1117 return unless $kohafield;
1119 # The next call uses the Default framework since it is AUTHORITATIVE
1120 # for all Koha to MARC mappings.
1121 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
1122 return unless $mss->{$kohafield};
1123 return wantarray ? @{$mss->{$kohafield}} : $mss->{$kohafield}->[0];
1126 =head2 GetMarcBiblio
1128 my $record = GetMarcBiblio({
1129 biblionumber => $biblionumber,
1130 embed_items => $embeditems,
1132 borcat => $patron_category });
1134 Returns MARC::Record representing a biblio record, or C<undef> if the
1135 biblionumber doesn't exist.
1137 Both embed_items and opac are optional.
1138 If embed_items is passed and is 1, items are embedded.
1139 If opac is passed and is 1, the record is filtered as needed.
1143 =item C<$biblionumber>
1147 =item C<$embeditems>
1149 set to true to include item information.
1153 set to true to make the result suited for OPAC view. This causes things like
1154 OpacHiddenItems to be applied.
1158 If the OpacHiddenItemsExceptions system preference is set, this patron category
1159 can be used to make visible OPAC items which would be normally hidden.
1160 It only makes sense in combination both embed_items and opac values true.
1169 if (not defined $params) {
1170 carp 'GetMarcBiblio called without parameters';
1174 my $biblionumber = $params->{biblionumber};
1175 my $embeditems = $params->{embed_items} || 0;
1176 my $opac = $params->{opac} || 0;
1177 my $borcat = $params->{borcat} // q{};
1179 if (not defined $biblionumber) {
1180 carp 'GetMarcBiblio called with undefined biblionumber';
1184 my $dbh = C4::Context->dbh;
1185 my $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=? ");
1186 $sth->execute($biblionumber);
1187 my $row = $sth->fetchrow_hashref;
1188 my $biblioitemnumber = $row->{'biblioitemnumber'};
1189 my $marcxml = GetXmlBiblio( $biblionumber );
1190 $marcxml = StripNonXmlChars( $marcxml );
1191 my $frameworkcode = GetFrameworkCode($biblionumber);
1192 MARC::File::XML->default_record_format( C4::Context->preference('marcflavour') );
1193 my $record = MARC::Record->new();
1197 MARC::Record::new_from_xml( $marcxml, "UTF-8",
1198 C4::Context->preference('marcflavour') );
1200 if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; }
1201 return unless $record;
1203 C4::Biblio::_koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber,
1204 $biblioitemnumber );
1205 C4::Biblio::EmbedItemsInMarcBiblio({
1206 marc_record => $record,
1207 biblionumber => $biblionumber,
1209 borcat => $borcat })
1221 my $marcxml = GetXmlBiblio($biblionumber);
1223 Returns biblio_metadata.metadata/marcxml of the biblionumber passed in parameter.
1224 The XML should only contain biblio information (item information is no longer stored in marcxml field)
1229 my ($biblionumber) = @_;
1230 my $dbh = C4::Context->dbh;
1231 return unless $biblionumber;
1232 my ($marcxml) = $dbh->selectrow_array(
1235 FROM biblio_metadata
1236 WHERE biblionumber=?
1237 AND format='marcxml'
1239 |, undef, $biblionumber, C4::Context->preference('marcflavour')
1246 return the prices in accordance with the Marc format.
1248 returns 0 if no price found
1249 returns undef if called without a marc record or with
1250 an unrecognized marc format
1255 my ( $record, $marcflavour ) = @_;
1257 carp 'GetMarcPrice called on undefined record';
1264 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1265 @listtags = ('345', '020');
1267 } elsif ( $marcflavour eq "UNIMARC" ) {
1268 @listtags = ('345', '010');
1274 for my $field ( $record->field(@listtags) ) {
1275 for my $subfield_value ($field->subfield($subfield)){
1277 $subfield_value = MungeMarcPrice( $subfield_value );
1278 return $subfield_value if ($subfield_value);
1281 return 0; # no price found
1284 =head2 MungeMarcPrice
1286 Return the best guess at what the actual price is from a price field.
1290 sub MungeMarcPrice {
1292 return unless ( $price =~ m/\d/ ); ## No digits means no price.
1293 # Look for the currency symbol and the normalized code of the active currency, if it's there,
1294 my $active_currency = Koha::Acquisition::Currencies->get_active;
1295 my $symbol = $active_currency->symbol;
1296 my $isocode = $active_currency->isocode;
1297 $isocode = $active_currency->currency unless defined $isocode;
1300 my @matches =($price=~ /
1302 ( # start of capturing parenthesis
1304 (?:[\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'
1305 |(?:\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'
1307 \s?\p{Sc}?\s? # followed or not by a whitespace. \p{Sc}?\s? are for cases like '25$ USD'
1309 (?:[\p{Sc}\p{L}\/.]){1,4} # followed by same block as symbol block
1310 |(?:\d+[\p{P}\s]?){1,4} # or by same block as digits block
1312 \s?\p{L}{0,4}\s? # followed or not by a whitespace. \p{L}{0,4}\s? are for cases like '$9.50 USD'
1313 ) # end of capturing parenthesis
1314 (?:\p{P}|\z) # followed by a punctuation sign or by the end of the string
1318 foreach ( @matches ) {
1319 $localprice = $_ and last if index($_, $isocode)>=0;
1321 if ( !$localprice ) {
1322 foreach ( @matches ) {
1323 $localprice = $_ and last if $_=~ /(^|[^\p{Sc}\p{L}\/])\Q$symbol\E([^\p{Sc}\p{L}\/]+\z|\z)/;
1328 if ( $localprice ) {
1329 $price = $localprice;
1331 ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
1332 ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
1334 # eliminate symbol/isocode, space and any final dot from the string
1335 $price =~ s/[\p{Sc}\p{L}\/ ]|\.$//g;
1336 # remove comma,dot when used as separators from hundreds
1337 $price =~s/[\,\.](\d{3})/$1/g;
1338 # convert comma to dot to ensure correct display of decimals if existing
1344 =head2 GetMarcQuantity
1346 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
1347 Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
1349 returns 0 if no quantity found
1350 returns undef if called without a marc record or with
1351 an unrecognized marc format
1355 sub GetMarcQuantity {
1356 my ( $record, $marcflavour ) = @_;
1358 carp 'GetMarcQuantity called on undefined record';
1365 if ( $marcflavour eq "MARC21" ) {
1367 } elsif ( $marcflavour eq "UNIMARC" ) {
1368 @listtags = ('969');
1374 for my $field ( $record->field(@listtags) ) {
1375 for my $subfield_value ($field->subfield($subfield)){
1377 if ($subfield_value) {
1378 # in France, the cents separator is the , but sometimes, ppl use a .
1379 # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1380 $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
1381 return $subfield_value;
1385 return 0; # no price found
1389 =head2 GetAuthorisedValueDesc
1391 my $subfieldvalue =get_authorised_value_desc(
1392 $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1394 Retrieve the complete description for a given authorised value.
1396 Now takes $category and $value pair too.
1398 my $auth_value_desc =GetAuthorisedValueDesc(
1399 '','', 'DVD' ,'','','CCODE');
1401 If the optional $opac parameter is set to a true value, displays OPAC
1402 descriptions rather than normal ones when they exist.
1406 sub GetAuthorisedValueDesc {
1407 my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1411 return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1414 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1415 my $branch = Koha::Libraries->find($value);
1416 return $branch? $branch->branchname: q{};
1420 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1421 my $itemtype = Koha::ItemTypes->find( $value );
1422 return $itemtype ? $itemtype->translated_description : q||;
1425 #---- "true" authorized value
1426 $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1429 my $dbh = C4::Context->dbh;
1430 if ( $category ne "" ) {
1431 my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1432 $sth->execute( $category, $value );
1433 my $data = $sth->fetchrow_hashref;
1434 return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
1436 return $value; # if nothing is found return the original value
1440 =head2 GetMarcControlnumber
1442 $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1444 Get the control number / record Identifier from the MARC record and return it.
1448 sub GetMarcControlnumber {
1449 my ( $record, $marcflavour ) = @_;
1451 carp 'GetMarcControlnumber called on undefined record';
1454 my $controlnumber = "";
1455 # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
1456 # Keep $marcflavour for possible later use
1457 if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" || $marcflavour eq "NORMARC") {
1458 my $controlnumberField = $record->field('001');
1459 if ($controlnumberField) {
1460 $controlnumber = $controlnumberField->data();
1463 return $controlnumber;
1468 $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1470 Get all ISBNs from the MARC record and returns them in an array.
1471 ISBNs stored in different fields depending on MARC flavour
1476 my ( $record, $marcflavour ) = @_;
1478 carp 'GetMarcISBN called on undefined record';
1482 if ( $marcflavour eq "UNIMARC" ) {
1484 } else { # assume marc21 if not unimarc
1489 foreach my $field ( $record->field($scope) ) {
1490 my $isbn = $field->subfield( 'a' );
1491 if ( $isbn && $isbn ne "" ) {
1492 push @marcisbns, $isbn;
1502 $marcissnsarray = GetMarcISSN( $record, $marcflavour );
1504 Get all valid ISSNs from the MARC record and returns them in an array.
1505 ISSNs are stored in different fields depending on MARC flavour
1510 my ( $record, $marcflavour ) = @_;
1512 carp 'GetMarcISSN called on undefined record';
1516 if ( $marcflavour eq "UNIMARC" ) {
1519 else { # assume MARC21 or NORMARC
1523 foreach my $field ( $record->field($scope) ) {
1524 push @marcissns, $field->subfield( 'a' )
1525 if ( $field->subfield( 'a' ) ne "" );
1530 =head2 GetMarcSubjects
1532 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1534 Get all subjects from the MARC record and returns them in an array.
1535 The subjects are stored in different fields depending on MARC flavour
1539 sub GetMarcSubjects {
1540 my ( $record, $marcflavour ) = @_;
1542 carp 'GetMarcSubjects called on undefined record';
1545 my ( $mintag, $maxtag, $fields_filter );
1546 if ( $marcflavour eq "UNIMARC" ) {
1549 $fields_filter = '6..';
1550 } else { # marc21/normarc
1553 $fields_filter = '6..';
1558 my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1559 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1561 foreach my $field ( $record->field($fields_filter) ) {
1562 next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
1564 my @subfields = $field->subfields();
1567 # if there is an authority link, build the links with an= subfield9
1568 my $subfield9 = $field->subfield('9');
1571 my $linkvalue = $subfield9;
1572 $linkvalue =~ s/(\(|\))//g;
1573 @link_loop = ( { limit => 'an', 'link' => $linkvalue } );
1574 $authoritylink = $linkvalue
1578 for my $subject_subfield (@subfields) {
1579 next if ( $subject_subfield->[0] eq '9' );
1581 # don't load unimarc subfields 3,4,5
1582 next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1583 # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1584 next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1586 my $code = $subject_subfield->[0];
1587 my $value = $subject_subfield->[1];
1588 my $linkvalue = $value;
1589 $linkvalue =~ s/(\(|\))//g;
1590 # if no authority link, build a search query
1591 unless ($subfield9) {
1593 limit => $subject_limit,
1594 'link' => $linkvalue,
1595 operator => (scalar @link_loop) ? ' and ' : undef
1598 my @this_link_loop = @link_loop;
1600 unless ( $code eq '0' ) {
1601 push @subfields_loop, {
1604 link_loop => \@this_link_loop,
1605 separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1610 push @marcsubjects, {
1611 MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop,
1612 authoritylink => $authoritylink,
1613 } if $authoritylink || @subfields_loop;
1616 return \@marcsubjects;
1617 } #end getMARCsubjects
1619 =head2 GetMarcAuthors
1621 authors = GetMarcAuthors($record,$marcflavour);
1623 Get all authors from the MARC record and returns them in an array.
1624 The authors are stored in different fields depending on MARC flavour
1628 sub GetMarcAuthors {
1629 my ( $record, $marcflavour ) = @_;
1631 carp 'GetMarcAuthors called on undefined record';
1634 my ( $mintag, $maxtag, $fields_filter );
1636 # tagslib useful only for UNIMARC author responsibilities
1638 if ( $marcflavour eq "UNIMARC" ) {
1639 # FIXME : we don't have the framework available, we take the default framework. May be buggy on some setups, will be usually correct.
1640 $tagslib = GetMarcStructure( 1, '', { unsafe => 1 });
1643 $fields_filter = '7..';
1644 } else { # marc21/normarc
1647 $fields_filter = '7..';
1651 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1653 foreach my $field ( $record->field($fields_filter) ) {
1654 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1657 my @subfields = $field->subfields();
1660 # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1661 my $subfield9 = $field->subfield('9');
1663 my $linkvalue = $subfield9;
1664 $linkvalue =~ s/(\(|\))//g;
1665 @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1670 for my $authors_subfield (@subfields) {
1671 next if ( $authors_subfield->[0] eq '9' );
1673 # unimarc3 contains the $3 of the author for UNIMARC.
1674 # For french academic libraries, it's the "ppn", and it's required for idref webservice
1675 $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1677 # don't load unimarc subfields 3, 5
1678 next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1680 my $code = $authors_subfield->[0];
1681 my $value = $authors_subfield->[1];
1682 my $linkvalue = $value;
1683 $linkvalue =~ s/(\(|\))//g;
1684 # UNIMARC author responsibility
1685 if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1686 $value = GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1687 $linkvalue = "($value)";
1689 # if no authority link, build a search query
1690 unless ($subfield9) {
1693 'link' => $linkvalue,
1694 operator => (scalar @link_loop) ? ' and ' : undef
1697 my @this_link_loop = @link_loop;
1699 unless ( $code eq '0') {
1700 push @subfields_loop, {
1701 tag => $field->tag(),
1704 link_loop => \@this_link_loop,
1705 separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1709 push @marcauthors, {
1710 MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
1711 authoritylink => $subfield9,
1712 unimarc3 => $unimarc3
1715 return \@marcauthors;
1720 $marcurls = GetMarcUrls($record,$marcflavour);
1722 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1723 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1728 my ( $record, $marcflavour ) = @_;
1730 carp 'GetMarcUrls called on undefined record';
1735 for my $field ( $record->field('856') ) {
1737 for my $note ( $field->subfield('z') ) {
1738 push @notes, { note => $note };
1740 my @urls = $field->subfield('u');
1741 foreach my $url (@urls) {
1742 $url =~ s/^\s+|\s+$//g; # trim
1744 if ( $marcflavour eq 'MARC21' ) {
1745 my $s3 = $field->subfield('3');
1746 my $link = $field->subfield('y');
1747 unless ( $url =~ /^\w+:/ ) {
1748 if ( $field->indicator(1) eq '7' ) {
1749 $url = $field->subfield('2') . "://" . $url;
1750 } elsif ( $field->indicator(1) eq '1' ) {
1751 $url = 'ftp://' . $url;
1754 # properly, this should be if ind1=4,
1755 # however we will assume http protocol since we're building a link.
1756 $url = 'http://' . $url;
1760 # TODO handle ind 2 (relationship)
1765 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
1766 $marcurl->{'part'} = $s3 if ($link);
1767 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1769 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
1770 $marcurl->{'MARCURL'} = $url;
1772 push @marcurls, $marcurl;
1778 =head2 GetMarcSeries
1780 $marcseriesarray = GetMarcSeries($record,$marcflavour);
1782 Get all series from the MARC record and returns them in an array.
1783 The series are stored in different fields depending on MARC flavour
1788 my ( $record, $marcflavour ) = @_;
1790 carp 'GetMarcSeries called on undefined record';
1794 my ( $mintag, $maxtag, $fields_filter );
1795 if ( $marcflavour eq "UNIMARC" ) {
1798 $fields_filter = '2..';
1799 } else { # marc21/normarc
1802 $fields_filter = '4..';
1806 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1808 foreach my $field ( $record->field($fields_filter) ) {
1809 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1811 my @subfields = $field->subfields();
1814 for my $series_subfield (@subfields) {
1816 # ignore $9, used for authority link
1817 next if ( $series_subfield->[0] eq '9' );
1820 my $code = $series_subfield->[0];
1821 my $value = $series_subfield->[1];
1822 my $linkvalue = $value;
1823 $linkvalue =~ s/(\(|\))//g;
1825 # see if this is an instance of a volume
1826 if ( $code eq 'v' ) {
1831 'link' => $linkvalue,
1832 operator => (scalar @link_loop) ? ' and ' : undef
1835 if ($volume_number) {
1836 push @subfields_loop, { volumenum => $value };
1838 push @subfields_loop, {
1841 link_loop => \@link_loop,
1842 separator => (scalar @subfields_loop) ? $AuthoritySeparator : '',
1843 volumenum => $volume_number,
1847 push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1850 return \@marcseries;
1851 } #end getMARCseriess
1853 =head2 UpsertMarcSubfield
1855 my $record = C4::Biblio::UpsertMarcSubfield($MARC::Record, $fieldTag, $subfieldCode, $subfieldContent);
1859 sub UpsertMarcSubfield {
1860 my ($record, $tag, $code, $content) = @_;
1861 my $f = $record->field($tag);
1864 $f->update( $code => $content );
1867 my $f = MARC::Field->new( $tag, '', '', $code => $content);
1868 $record->insert_fields_ordered( $f );
1872 =head2 UpsertMarcControlField
1874 my $record = C4::Biblio::UpsertMarcControlField($MARC::Record, $fieldTag, $content);
1878 sub UpsertMarcControlField {
1879 my ($record, $tag, $content) = @_;
1880 die "UpsertMarcControlField() \$tag '$tag' is not a control field\n" unless 0+$tag < 10;
1881 my $f = $record->field($tag);
1884 $f->update( $content );
1887 my $f = MARC::Field->new($tag, $content);
1888 $record->insert_fields_ordered( $f );
1892 =head2 GetFrameworkCode
1894 $frameworkcode = GetFrameworkCode( $biblionumber )
1898 sub GetFrameworkCode {
1899 my ($biblionumber) = @_;
1900 my $dbh = C4::Context->dbh;
1901 my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
1902 $sth->execute($biblionumber);
1903 my ($frameworkcode) = $sth->fetchrow;
1904 return $frameworkcode;
1907 =head2 TransformKohaToMarc
1909 $record = TransformKohaToMarc( $hash [, $params ] )
1911 This function builds a (partial) MARC::Record from a hash.
1912 Hash entries can be from biblio, biblioitems or items.
1913 The params hash includes the parameter no_split used in C4::Items.
1915 This function is called in acquisition module, to create a basic catalogue
1916 entry from user entry.
1921 sub TransformKohaToMarc {
1922 my ( $hash, $params ) = @_;
1923 my $record = MARC::Record->new();
1924 SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
1926 # In the next call we use the Default framework, since it is considered
1927 # authoritative for Koha to Marc mappings.
1928 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # do not change framework
1930 while ( my ($kohafield, $value) = each %$hash ) {
1931 foreach my $fld ( @{ $mss->{$kohafield} } ) {
1932 my $tagfield = $fld->{tagfield};
1933 my $tagsubfield = $fld->{tagsubfield};
1936 # BZ 21800: split value if field is repeatable.
1937 my @values = _check_split($params, $fld, $value)
1938 ? split(/\s?\|\s?/, $value, -1)
1940 foreach my $value ( @values ) {
1941 next if $value eq '';
1942 $tag_hr->{$tagfield} //= [];
1943 push @{$tag_hr->{$tagfield}}, [($tagsubfield, $value)];
1947 foreach my $tag (sort keys %$tag_hr) {
1948 my @sfl = @{$tag_hr->{$tag}};
1949 @sfl = sort { $a->[0] cmp $b->[0]; } @sfl;
1950 @sfl = map { @{$_}; } @sfl;
1951 # Special care for control fields: remove the subfield indication @
1952 # and do not insert indicators.
1953 my @ind = $tag < 10 ? () : ( " ", " " );
1954 @sfl = grep { $_ ne '@' } @sfl if $tag < 10;
1955 $record->insert_fields_ordered( MARC::Field->new($tag, @ind, @sfl) );
1961 # Checks if $value must be split; may consult passed framework
1962 my ($params, $fld, $value) = @_;
1963 return if index($value,'|') == -1; # nothing to worry about
1964 return if $params->{no_split};
1966 # if we did not get a specific framework, check default in $mss
1967 return $fld->{repeatable} if !$params->{framework};
1969 # here we need to check the specific framework
1970 my $mss = GetMarcSubfieldStructure($params->{framework}, { unsafe => 1 });
1971 foreach my $fld2 ( @{ $mss->{ $fld->{kohafield} } } ) {
1972 next if $fld2->{tagfield} ne $fld->{tagfield};
1973 next if $fld2->{tagsubfield} ne $fld->{tagsubfield};
1974 return 1 if $fld2->{repeatable};
1979 =head2 PrepHostMarcField
1981 $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
1983 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
1987 sub PrepHostMarcField {
1988 my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
1989 $marcflavour ||="MARC21";
1991 my $hostrecord = GetMarcBiblio({ biblionumber => $hostbiblionumber });
1992 my $item = Koha::Items->find($hostitemnumber);
1995 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1999 if ($hostrecord->subfield('100','a')){
2000 $mainentry = $hostrecord->subfield('100','a');
2001 } elsif ($hostrecord->subfield('110','a')){
2002 $mainentry = $hostrecord->subfield('110','a');
2004 $mainentry = $hostrecord->subfield('111','a');
2007 # qualification info
2009 if (my $field260 = $hostrecord->field('260')){
2010 $qualinfo = $field260->as_string( 'abc' );
2015 my $ed = $hostrecord->subfield('250','a');
2016 my $barcode = $item->barcode;
2017 my $title = $hostrecord->subfield('245','a');
2019 # record control number, 001 with 003 and prefix
2021 if ($hostrecord->field('001')){
2022 $recctrlno = $hostrecord->field('001')->data();
2023 if ($hostrecord->field('003')){
2024 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
2029 my $issn = $hostrecord->subfield('022','a');
2030 my $isbn = $hostrecord->subfield('020','a');
2033 $hostmarcfield = MARC::Field->new(
2035 '0' => $hostbiblionumber,
2036 '9' => $hostitemnumber,
2046 } elsif ($marcflavour eq "UNIMARC") {
2047 $hostmarcfield = MARC::Field->new(
2049 '0' => $hostbiblionumber,
2050 't' => $hostrecord->subfield('200','a'),
2051 '9' => $hostitemnumber
2055 return $hostmarcfield;
2058 =head2 TransformHtmlToXml
2060 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
2061 $ind_tag, $auth_type )
2063 $auth_type contains :
2067 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
2069 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2071 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2077 sub TransformHtmlToXml {
2078 my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2079 # NOTE: The parameter $ind_tag is NOT USED -- BZ 11247
2081 my $xml = MARC::File::XML::header('UTF-8');
2082 $xml .= "<record>\n";
2083 $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2084 MARC::File::XML->default_record_format($auth_type);
2086 # in UNIMARC, field 100 contains the encoding
2087 # check that there is one, otherwise the
2088 # MARC::Record->new_from_xml will fail (and Koha will die)
2089 my $unimarc_and_100_exist = 0;
2090 $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
2095 for ( my $i = 0 ; $i < @$tags ; $i++ ) {
2097 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
2099 # if we have a 100 field and it's values are not correct, skip them.
2100 # if we don't have any valid 100 field, we will create a default one at the end
2101 my $enc = substr( @$values[$i], 26, 2 );
2102 if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2103 $unimarc_and_100_exist = 1;
2108 @$values[$i] =~ s/&/&/g;
2109 @$values[$i] =~ s/</</g;
2110 @$values[$i] =~ s/>/>/g;
2111 @$values[$i] =~ s/"/"/g;
2112 @$values[$i] =~ s/'/'/g;
2114 if ( ( @$tags[$i] ne $prevtag ) ) {
2115 $close_last_tag = 0;
2116 $j++ unless ( @$tags[$i] eq "" );
2117 my $str = ( $indicator->[$j] // q{} ) . ' '; # extra space prevents substr outside of string warn
2118 my $ind1 = _default_ind_to_space( substr( $str, 0, 1 ) );
2119 my $ind2 = _default_ind_to_space( substr( $str, 1, 1 ) );
2121 $xml .= "</datafield>\n";
2122 if ( ( @$tags[$i] && @$tags[$i] > 10 )
2123 && ( @$values[$i] ne "" ) ) {
2124 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2125 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2127 $close_last_tag = 1;
2132 if ( @$values[$i] ne "" ) {
2135 if ( @$tags[$i] eq "000" ) {
2136 $xml .= "<leader>@$values[$i]</leader>\n";
2139 # rest of the fixed fields
2140 } elsif ( @$tags[$i] < 10 ) {
2141 $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2144 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2145 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2147 $close_last_tag = 1;
2151 } else { # @$tags[$i] eq $prevtag
2152 if ( @$values[$i] eq "" ) {
2155 my $str = ( $indicator->[$j] // q{} ) . ' '; # extra space prevents substr outside of string warn
2156 my $ind1 = _default_ind_to_space( substr( $str, 0, 1 ) );
2157 my $ind2 = _default_ind_to_space( substr( $str, 1, 1 ) );
2158 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2160 $close_last_tag = 1;
2162 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2165 $prevtag = @$tags[$i];
2167 $xml .= "</datafield>\n" if $close_last_tag;
2168 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2170 # warn "SETTING 100 for $auth_type";
2171 my $string = strftime( "%Y%m%d", localtime(time) );
2173 # set 50 to position 26 is biblios, 13 if authorities
2175 $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2176 $string = sprintf( "%-*s", 35, $string );
2177 substr( $string, $pos, 6, "50" );
2178 $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2179 $xml .= "<subfield code=\"a\">$string</subfield>\n";
2180 $xml .= "</datafield>\n";
2182 $xml .= "</record>\n";
2183 $xml .= MARC::File::XML::footer();
2187 =head2 _default_ind_to_space
2189 Passed what should be an indicator returns a space
2190 if its undefined or zero length
2194 sub _default_ind_to_space {
2196 if ( !defined $s || $s eq q{} ) {
2202 =head2 TransformHtmlToMarc
2204 L<$record> = TransformHtmlToMarc(L<$cgi>)
2205 L<$cgi> is the CGI object which contains the values for subfields
2207 'tag_010_indicator1_531951' ,
2208 'tag_010_indicator2_531951' ,
2209 'tag_010_code_a_531951_145735' ,
2210 'tag_010_subfield_a_531951_145735' ,
2211 'tag_200_indicator1_873510' ,
2212 'tag_200_indicator2_873510' ,
2213 'tag_200_code_a_873510_673465' ,
2214 'tag_200_subfield_a_873510_673465' ,
2215 'tag_200_code_b_873510_704318' ,
2216 'tag_200_subfield_b_873510_704318' ,
2217 'tag_200_code_e_873510_280822' ,
2218 'tag_200_subfield_e_873510_280822' ,
2219 'tag_200_code_f_873510_110730' ,
2220 'tag_200_subfield_f_873510_110730' ,
2222 L<$record> is the MARC::Record object.
2226 sub TransformHtmlToMarc {
2227 my ($cgi, $isbiblio) = @_;
2229 my @params = $cgi->multi_param();
2231 # explicitly turn on the UTF-8 flag for all
2232 # 'tag_' parameters to avoid incorrect character
2233 # conversion later on
2234 my $cgi_params = $cgi->Vars;
2235 foreach my $param_name ( keys %$cgi_params ) {
2236 if ( $param_name =~ /^tag_/ ) {
2237 my $param_value = $cgi_params->{$param_name};
2238 unless ( Encode::is_utf8( $param_value ) ) {
2239 $cgi_params->{$param_name} = Encode::decode('UTF-8', $param_value );
2244 # creating a new record
2245 my $record = MARC::Record->new();
2247 my ($biblionumbertagfield, $biblionumbertagsubfield) = (-1, -1);
2248 ($biblionumbertagfield, $biblionumbertagsubfield) =
2249 &GetMarcFromKohaField( "biblio.biblionumber", '' ) if $isbiblio;
2250 #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!
2251 for (my $i = 0; $params[$i]; $i++ ) { # browse all CGI params
2252 my $param = $params[$i];
2255 # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2256 if ( $param eq 'biblionumber' ) {
2257 if ( $biblionumbertagfield < 10 ) {
2258 $newfield = MARC::Field->new( $biblionumbertagfield, scalar $cgi->param($param), );
2260 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => scalar $cgi->param($param), );
2262 push @fields, $newfield if ($newfield);
2263 } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) { # new field start when having 'input name="..._indicator1_..."
2266 my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2267 my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2271 if ( $tag < 10 ) { # no code for theses fields
2272 # in MARC editor, 000 contains the leader.
2273 next if $tag == $biblionumbertagfield;
2274 my $fval= $cgi->param($params[$j+1]);
2275 if ( $tag eq '000' ) {
2276 # Force a fake leader even if not provided to avoid crashing
2277 # during decoding MARC record containing UTF-8 characters
2279 length( $fval ) == 24
2284 # between 001 and 009 (included)
2285 } elsif ( $fval ne '' ) {
2286 $newfield = MARC::Field->new( $tag, $fval, );
2289 # > 009, deal with subfields
2291 # browse subfields for this tag (reason for _code_ match)
2292 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2293 last unless defined $params[$j+1];
2295 if $tag == $biblionumbertagfield and
2296 $cgi->param($params[$j]) eq $biblionumbertagsubfield;
2297 #if next param ne subfield, then it was probably empty
2298 #try next param by incrementing j
2299 if($params[$j+1]!~/_subfield_/) {$j++; next; }
2300 my $fkey= $cgi->param($params[$j]);
2301 my $fval= $cgi->param($params[$j+1]);
2302 #check if subfield value not empty and field exists
2303 if($fval ne '' && $newfield) {
2304 $newfield->add_subfields( $fkey => $fval);
2306 elsif($fval ne '') {
2307 $newfield = MARC::Field->new( $tag, $ind1, $ind2, $fkey => $fval );
2311 $i= $j-1; #update i for outer loop accordingly
2313 push @fields, $newfield if ($newfield);
2317 @fields = sort { $a->tag() cmp $b->tag() } @fields;
2318 $record->append_fields(@fields);
2322 =head2 TransformMarcToKoha
2324 $result = TransformMarcToKoha( $record, undef, $limit )
2326 Extract data from a MARC bib record into a hashref representing
2327 Koha biblio, biblioitems, and items fields.
2329 If passed an undefined record will log the error and return an empty
2334 sub TransformMarcToKoha {
2335 my ( $record, $frameworkcode, $limit_table ) = @_;
2336 # FIXME Parameter $frameworkcode is obsolete and will be removed
2337 $limit_table //= q{};
2340 if (!defined $record) {
2341 carp('TransformMarcToKoha called with undefined record');
2345 my %tables = ( biblio => 1, biblioitems => 1, items => 1 );
2346 if( $limit_table eq 'items' ) {
2347 %tables = ( items => 1 );
2350 # The next call acknowledges Default as the authoritative framework
2351 # for Koha to MARC mappings.
2352 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
2353 foreach my $kohafield ( keys %{ $mss } ) {
2354 my ( $table, $column ) = split /[.]/, $kohafield, 2;
2355 next unless $tables{$table};
2356 my $val = TransformMarcToKohaOneField( $kohafield, $record );
2357 next if !defined $val;
2358 my $key = _disambiguate( $table, $column );
2359 $result->{$key} = $val;
2364 =head2 _disambiguate
2366 $newkey = _disambiguate($table, $field);
2368 This is a temporary hack to distinguish between the
2369 following sets of columns when using TransformMarcToKoha.
2371 items.cn_source & biblioitems.cn_source
2372 items.cn_sort & biblioitems.cn_sort
2374 Columns that are currently NOT distinguished (FIXME
2375 due to lack of time to fully test) are:
2377 biblio.notes and biblioitems.notes
2382 FIXME - this is necessary because prefixing each column
2383 name with the table name would require changing lots
2384 of code and templates, and exposing more of the DB
2385 structure than is good to the UI templates, particularly
2386 since biblio and bibloitems may well merge in a future
2387 version. In the future, it would also be good to
2388 separate DB access and UI presentation field names
2394 my ( $table, $column ) = @_;
2395 if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2396 return $table . '.' . $column;
2403 =head2 TransformMarcToKohaOneField
2405 $val = TransformMarcToKohaOneField( 'biblio.title', $marc );
2407 Note: The authoritative Default framework is used implicitly.
2411 sub TransformMarcToKohaOneField {
2412 my ( $kohafield, $marc ) = @_;
2414 my ( @rv, $retval );
2415 my @mss = GetMarcSubfieldStructureFromKohaField($kohafield);
2416 foreach my $fldhash ( @mss ) {
2417 my $tag = $fldhash->{tagfield};
2418 my $sub = $fldhash->{tagsubfield};
2419 foreach my $fld ( $marc->field($tag) ) {
2420 if( $sub eq '@' || $fld->is_control_field ) {
2421 push @rv, $fld->data if $fld->data;
2423 push @rv, grep { $_ } $fld->subfield($sub);
2428 $retval = join ' | ', uniq(@rv);
2430 # Additional polishing for individual kohafields
2431 if( $kohafield =~ /copyrightdate|publicationyear/ ) {
2432 $retval = _adjust_pubyear( $retval );
2438 =head2 _adjust_pubyear
2440 Helper routine for TransformMarcToKohaOneField
2444 sub _adjust_pubyear {
2446 # modify return value to keep only the 1st year found
2447 if( $retval =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2449 } elsif( $retval =~ m/(\d\d\d\d)/ && $1 > 0 ) {
2451 } elsif( $retval =~ m/
2452 (?<year>\d)[-]?[.Xx?]{3}
2453 |(?<year>\d{2})[.Xx?]{2}
2454 |(?<year>\d{3})[.Xx?]
2455 |(?<year>\d)[-]{3}\?
2456 |(?<year>\d\d)[-]{2}\?
2457 |(?<year>\d{3})[-]\?
2458 /xms ) { # the form 198-? occurred in Dutch ISBD rules
2459 my $digits = $+{year};
2460 $retval = $digits * ( 10 ** ( 4 - length($digits) ));
2467 =head2 CountItemsIssued
2469 my $count = CountItemsIssued( $biblionumber );
2473 sub CountItemsIssued {
2474 my ($biblionumber) = @_;
2475 my $dbh = C4::Context->dbh;
2476 my $sth = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2477 $sth->execute($biblionumber);
2478 my $row = $sth->fetchrow_hashref();
2479 return $row->{'issuedCount'};
2484 ModZebra( $record_number, $op, $server );
2486 $record_number is the authid or biblionumber we want to index
2488 $op is the operation: specialUpdate or recordDelete
2490 $server is authorityserver or biblioserver
2495 my ( $record_number, $op, $server ) = @_;
2496 $debug && warn "ModZebra: updates requested for: $record_number $op $server\n";
2497 my $dbh = C4::Context->dbh;
2499 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2501 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2502 # the table is emptied by rebuild_zebra.pl script (using the -z switch)
2503 my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2505 AND biblio_auth_number = ?
2508 my $check_sth = $dbh->prepare_cached($check_sql);
2509 $check_sth->execute( $server, $record_number, $op );
2510 my ($count) = $check_sth->fetchrow_array;
2511 $check_sth->finish();
2512 if ( $count == 0 ) {
2513 my $sth = $dbh->prepare("INSERT INTO zebraqueue (biblio_auth_number,server,operation) VALUES(?,?,?)");
2514 $sth->execute( $record_number, $server, $op );
2519 =head2 EmbedItemsInMarcBiblio
2521 EmbedItemsInMarcBiblio({
2522 marc_record => $marc,
2523 biblionumber => $biblionumber,
2524 item_numbers => $itemnumbers,
2527 Given a MARC::Record object containing a bib record,
2528 modify it to include the items attached to it as 9XX
2529 per the bib's MARC framework.
2530 if $itemnumbers is defined, only specified itemnumbers are embedded.
2532 If $opac is true, then opac-relevant suppressions are included.
2534 If opac filtering will be done, borcat should be passed to properly
2535 override if necessary.
2539 sub EmbedItemsInMarcBiblio {
2541 my ($marc, $biblionumber, $itemnumbers, $opac, $borcat);
2542 $marc = $params->{marc_record};
2544 carp 'EmbedItemsInMarcBiblio: No MARC record passed';
2547 $biblionumber = $params->{biblionumber};
2548 $itemnumbers = $params->{item_numbers};
2549 $opac = $params->{opac};
2550 $borcat = $params->{borcat} // q{};
2552 $itemnumbers = [] unless defined $itemnumbers;
2554 my $frameworkcode = GetFrameworkCode($biblionumber);
2555 _strip_item_fields($marc, $frameworkcode);
2557 # ... and embed the current items
2558 my $dbh = C4::Context->dbh;
2559 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2560 $sth->execute($biblionumber);
2561 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber" );
2563 my @item_fields; # Array holding the actual MARC data for items to be included.
2564 my @items; # Array holding items which are both in the list (sitenumbers)
2565 # and on this biblionumber
2567 # Flag indicating if there is potential hiding.
2568 my $opachiddenitems = $opac
2569 && ( C4::Context->preference('OpacHiddenItems') !~ /^\s*$/ );
2572 while ( my ($itemnumber) = $sth->fetchrow_array ) {
2573 next if @$itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers;
2575 if ( $opachiddenitems ) {
2576 $item = Koha::Items->find($itemnumber);
2577 $item = $item ? $item->unblessed : undef;
2579 push @items, { itemnumber => $itemnumber, item => $item };
2581 my @items2pass = map { $_->{item} } @items;
2584 ? C4::Items::GetHiddenItemnumbers({
2585 items => \@items2pass,
2586 borcat => $borcat })
2588 # Convert to a hash for quick searching
2589 my %hiddenitems = map { $_ => 1 } @hiddenitems;
2590 foreach my $itemnumber ( map { $_->{itemnumber} } @items ) {
2591 next if $hiddenitems{$itemnumber};
2592 my $item_marc = C4::Items::GetMarcItem( $biblionumber, $itemnumber );
2593 push @item_fields, $item_marc->field($itemtag);
2595 $marc->append_fields(@item_fields);
2598 =head1 INTERNAL FUNCTIONS
2600 =head2 _koha_marc_update_bib_ids
2603 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2605 Internal function to add or update biblionumber and biblioitemnumber to
2610 sub _koha_marc_update_bib_ids {
2611 my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
2613 my ( $biblio_tag, $biblio_subfield ) = GetMarcFromKohaField( "biblio.biblionumber" );
2614 die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
2615 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber" );
2616 die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
2618 if ( $biblio_tag < 10 ) {
2619 C4::Biblio::UpsertMarcControlField( $record, $biblio_tag, $biblionumber );
2621 C4::Biblio::UpsertMarcSubfield($record, $biblio_tag, $biblio_subfield, $biblionumber);
2623 if ( $biblioitem_tag < 10 ) {
2624 C4::Biblio::UpsertMarcControlField( $record, $biblioitem_tag, $biblioitemnumber );
2626 C4::Biblio::UpsertMarcSubfield($record, $biblioitem_tag, $biblioitem_subfield, $biblioitemnumber);
2630 =head2 _koha_marc_update_biblioitem_cn_sort
2632 _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
2634 Given a MARC bib record and the biblioitem hash, update the
2635 subfield that contains a copy of the value of biblioitems.cn_sort.
2639 sub _koha_marc_update_biblioitem_cn_sort {
2641 my $biblioitem = shift;
2642 my $frameworkcode = shift;
2644 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort" );
2645 return unless $biblioitem_tag;
2647 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2649 if ( my $field = $marc->field($biblioitem_tag) ) {
2650 $field->delete_subfield( code => $biblioitem_subfield );
2651 if ( $cn_sort ne '' ) {
2652 $field->add_subfields( $biblioitem_subfield => $cn_sort );
2656 # if we get here, no biblioitem tag is present in the MARC record, so
2657 # we'll create it if $cn_sort is not empty -- this would be
2658 # an odd combination of events, however
2660 $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
2665 =head2 _koha_modify_biblio
2667 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
2669 Internal function for updating the biblio table
2673 sub _koha_modify_biblio {
2674 my ( $dbh, $biblio, $frameworkcode ) = @_;
2679 SET frameworkcode = ?,
2692 WHERE biblionumber = ?
2695 my $sth = $dbh->prepare($query);
2698 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'subtitle'},
2699 $biblio->{'medium'}, $biblio->{'part_number'}, $biblio->{'part_name'}, $biblio->{'unititle'},
2700 $biblio->{'notes'}, $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'} ? int($biblio->{'copyrightdate'}) : undef,
2701 $biblio->{'abstract'}, $biblio->{'biblionumber'}
2702 ) if $biblio->{'biblionumber'};
2704 if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
2705 $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
2708 return ( $biblio->{'biblionumber'}, $error );
2711 =head2 _koha_modify_biblioitem_nonmarc
2713 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
2717 sub _koha_modify_biblioitem_nonmarc {
2718 my ( $dbh, $biblioitem ) = @_;
2721 # re-calculate the cn_sort, it may have changed
2722 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2724 my $query = "UPDATE biblioitems
2725 SET biblionumber = ?,
2731 publicationyear = ?,
2735 collectiontitle = ?,
2737 collectionvolume= ?,
2738 editionstatement= ?,
2739 editionresponsibility = ?,
2755 where biblioitemnumber = ?
2757 my $sth = $dbh->prepare($query);
2759 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
2760 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
2761 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
2762 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
2763 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
2764 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
2765 $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort, $biblioitem->{'totalissues'},
2766 $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}, $biblioitem->{'biblioitemnumber'}
2768 if ( $dbh->errstr ) {
2769 $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
2772 return ( $biblioitem->{'biblioitemnumber'}, $error );
2775 =head2 _koha_delete_biblio
2777 $error = _koha_delete_biblio($dbh,$biblionumber);
2779 Internal sub for deleting from biblio table -- also saves to deletedbiblio
2781 C<$dbh> - the database handle
2783 C<$biblionumber> - the biblionumber of the biblio to be deleted
2787 # FIXME: add error handling
2789 sub _koha_delete_biblio {
2790 my ( $dbh, $biblionumber ) = @_;
2792 # get all the data for this biblio
2793 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
2794 $sth->execute($biblionumber);
2796 # FIXME There is a transaction in _koha_delete_biblio_metadata
2797 # But actually all the following should be done inside a single transaction
2798 if ( my $data = $sth->fetchrow_hashref ) {
2800 # save the record in deletedbiblio
2801 # find the fields to save
2802 my $query = "INSERT INTO deletedbiblio SET ";
2804 foreach my $temp ( keys %$data ) {
2805 $query .= "$temp = ?,";
2806 push( @bind, $data->{$temp} );
2809 # replace the last , by ",?)"
2811 my $bkup_sth = $dbh->prepare($query);
2812 $bkup_sth->execute(@bind);
2815 _koha_delete_biblio_metadata( $biblionumber );
2818 my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
2819 $sth2->execute($biblionumber);
2820 # update the timestamp (Bugzilla 7146)
2821 $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
2822 $sth2->execute($biblionumber);
2829 =head2 _koha_delete_biblioitems
2831 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
2833 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
2835 C<$dbh> - the database handle
2836 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
2840 # FIXME: add error handling
2842 sub _koha_delete_biblioitems {
2843 my ( $dbh, $biblioitemnumber ) = @_;
2845 # get all the data for this biblioitem
2846 my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
2847 $sth->execute($biblioitemnumber);
2849 if ( my $data = $sth->fetchrow_hashref ) {
2851 # save the record in deletedbiblioitems
2852 # find the fields to save
2853 my $query = "INSERT INTO deletedbiblioitems SET ";
2855 foreach my $temp ( keys %$data ) {
2856 $query .= "$temp = ?,";
2857 push( @bind, $data->{$temp} );
2860 # replace the last , by ",?)"
2862 my $bkup_sth = $dbh->prepare($query);
2863 $bkup_sth->execute(@bind);
2866 # delete the biblioitem
2867 my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
2868 $sth2->execute($biblioitemnumber);
2869 # update the timestamp (Bugzilla 7146)
2870 $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
2871 $sth2->execute($biblioitemnumber);
2878 =head2 _koha_delete_biblio_metadata
2880 $error = _koha_delete_biblio_metadata($biblionumber);
2882 C<$biblionumber> - the biblionumber of the biblio metadata to be deleted
2886 sub _koha_delete_biblio_metadata {
2887 my ($biblionumber) = @_;
2889 my $dbh = C4::Context->dbh;
2890 my $schema = Koha::Database->new->schema;
2894 INSERT INTO deletedbiblio_metadata (biblionumber, format, `schema`, metadata)
2895 SELECT biblionumber, format, `schema`, metadata FROM biblio_metadata WHERE biblionumber=?
2896 |, undef, $biblionumber );
2897 $dbh->do( q|DELETE FROM biblio_metadata WHERE biblionumber=?|,
2898 undef, $biblionumber );
2903 =head1 UNEXPORTED FUNCTIONS
2905 =head2 ModBiblioMarc
2907 &ModBiblioMarc($newrec,$biblionumber);
2909 Add MARC XML data for a biblio to koha
2911 Function exported, but should NOT be used, unless you really know what you're doing
2916 # pass the MARC::Record to this function, and it will create the records in
2918 my ( $record, $biblionumber ) = @_;
2920 carp 'ModBiblioMarc passed an undefined record';
2924 # Clone record as it gets modified
2925 $record = $record->clone();
2926 my $dbh = C4::Context->dbh;
2927 my @fields = $record->fields();
2928 my $encoding = C4::Context->preference("marcflavour");
2930 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
2931 if ( $encoding eq "UNIMARC" ) {
2932 my $defaultlanguage = C4::Context->preference("UNIMARCField100Language");
2933 $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
2934 my $string = $record->subfield( 100, "a" );
2935 if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
2936 my $f100 = $record->field(100);
2937 $record->delete_field($f100);
2939 $string = POSIX::strftime( "%Y%m%d", localtime );
2941 $string = sprintf( "%-*s", 35, $string );
2942 substr ( $string, 22, 3, $defaultlanguage);
2944 substr( $string, 25, 3, "y50" );
2945 unless ( $record->subfield( 100, "a" ) ) {
2946 $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
2950 #enhancement 5374: update transaction date (005) for marc21/unimarc
2951 if($encoding =~ /MARC21|UNIMARC/) {
2952 my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
2953 # YY MM DD HH MM SS (update year and month)
2954 my $f005= $record->field('005');
2955 $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
2959 biblionumber => $biblionumber,
2960 format => 'marcxml',
2961 schema => C4::Context->preference('marcflavour'),
2963 $record->as_usmarc; # Bug 20126/10455 This triggers field length calculation
2965 my $m_rs = Koha::Biblio::Metadatas->find($metadata) //
2966 Koha::Biblio::Metadata->new($metadata);
2968 my $userenv = C4::Context->userenv;
2970 my $borrowernumber = $userenv->{number};
2971 my $borrowername = join ' ', map { $_ // q{} } @$userenv{qw(firstname surname)};
2972 unless ($m_rs->in_storage) {
2973 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorId'), $borrowernumber);
2974 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorName'), $borrowername);
2976 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierId'), $borrowernumber);
2977 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierName'), $borrowername);
2980 $m_rs->metadata( $record->as_xml_record($encoding) );
2983 my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
2984 $indexer->index_records( $biblionumber, "specialUpdate", "biblioserver" );
2986 return $biblionumber;
2989 =head2 prepare_host_field
2991 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
2992 Generate the host item entry for an analytic child entry
2996 sub prepare_host_field {
2997 my ( $hostbiblio, $marcflavour ) = @_;
2998 $marcflavour ||= C4::Context->preference('marcflavour');
2999 my $host = GetMarcBiblio({ biblionumber => $hostbiblio });
3000 # unfortunately as_string does not 'do the right thing'
3001 # if field returns undef
3005 if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
3006 if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
3007 my $s = $field->as_string('ab');
3012 if ( $field = $host->field('245') ) {
3013 my $s = $field->as_string('a');
3018 if ( $field = $host->field('260') ) {
3019 my $s = $field->as_string('abc');
3024 if ( $field = $host->field('240') ) {
3025 my $s = $field->as_string();
3030 if ( $field = $host->field('022') ) {
3031 my $s = $field->as_string('a');
3036 if ( $field = $host->field('020') ) {
3037 my $s = $field->as_string('a');
3042 if ( $field = $host->field('001') ) {
3043 $sfd{w} = $field->data(),;
3045 $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
3048 elsif ( $marcflavour eq 'UNIMARC' ) {
3050 if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3051 my $s = $field->as_string('ab');
3057 if ( $field = $host->field('200') ) {
3058 my $s = $field->as_string('a');
3063 #place of publicaton
3064 if ( $field = $host->field('210') ) {
3065 my $s = $field->as_string('a');
3070 #date of publication
3071 if ( $field = $host->field('210') ) {
3072 my $s = $field->as_string('d');
3078 if ( $field = $host->field('205') ) {
3079 my $s = $field->as_string();
3085 if ( $field = $host->field('856') ) {
3086 my $s = $field->as_string('u');
3092 if ( $field = $host->field('011') ) {
3093 my $s = $field->as_string('a');
3099 if ( $field = $host->field('010') ) {
3100 my $s = $field->as_string('a');
3105 if ( $field = $host->field('001') ) {
3106 $sfd{0} = $field->data(),;
3108 $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
3115 =head2 UpdateTotalIssues
3117 UpdateTotalIssues($biblionumber, $increase, [$value])
3119 Update the total issue count for a particular bib record.
3123 =item C<$biblionumber> is the biblionumber of the bib to update
3125 =item C<$increase> is the amount to increase (or decrease) the total issues count by
3127 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
3133 sub UpdateTotalIssues {
3134 my ($biblionumber, $increase, $value) = @_;
3137 my $record = GetMarcBiblio({ biblionumber => $biblionumber });
3139 carp "UpdateTotalIssues could not get biblio record";
3142 my $biblio = Koha::Biblios->find( $biblionumber );
3144 carp "UpdateTotalIssues could not get datas of biblio";
3147 my $biblioitem = $biblio->biblioitem;
3148 my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField( 'biblioitems.totalissues' );
3149 unless ($totalissuestag) {
3150 return 1; # There is nothing to do
3153 if (defined $value) {
3154 $totalissues = $value;
3156 $totalissues = $biblioitem->totalissues + $increase;
3159 my $field = $record->field($totalissuestag);
3160 if (defined $field) {
3161 $field->update( $totalissuessubfield => $totalissues );
3163 $field = MARC::Field->new($totalissuestag, '0', '0',
3164 $totalissuessubfield => $totalissues);
3165 $record->insert_grouped_field($field);
3168 return ModBiblio($record, $biblionumber, $biblio->frameworkcode);
3173 &RemoveAllNsb($record);
3175 Removes all nsb/nse chars from a record
3182 carp 'RemoveAllNsb called with undefined record';
3186 SetUTF8Flag($record);
3188 foreach my $field ($record->fields()) {
3189 if ($field->is_control_field()) {
3190 $field->update(nsb_clean($field->data()));
3192 my @subfields = $field->subfields();
3194 foreach my $subfield (@subfields) {
3195 push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
3197 if (scalar(@new_subfields) > 0) {
3200 $new_field = MARC::Field->new(
3202 $field->indicator(1),
3203 $field->indicator(2),
3208 warn "error in RemoveAllNsb : $@";
3210 $field->replace_with($new_field);
3222 =head2 _after_biblio_action_hooks
3224 Helper method that takes care of calling all plugin hooks
3228 sub _after_biblio_action_hooks {
3231 my $biblio_id = $args->{biblio_id};
3232 my $action = $args->{action};
3234 my $biblio = Koha::Biblios->find( $biblio_id );
3235 Koha::Plugins->call(
3236 'after_biblio_action',
3240 biblio_id => $biblio_id,
3249 Koha Development Team <http://koha-community.org/>
3251 Paul POULAIN paul.poulain@free.fr
3253 Joshua Ferraro jmf@liblime.com