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);
48 GetAuthorisedValueDesc
50 IsMarcStructureInternal
52 GetMarcSubfieldStructureFromKohaField
63 LinkBibHeadingsToAuthorities
71 # those functions are exported but should not be used
72 # they are useful in a few circumstances, so they are exported,
73 # but don't use them unless you are a core developer ;-)
82 use Encode qw( decode is_utf8 );
83 use List::MoreUtils qw( uniq );
85 use MARC::File::USMARC;
87 use POSIX qw(strftime);
88 use Module::Load::Conditional qw(can_load);
91 use C4::Log; # logaction
100 use Koha::Authority::Types;
101 use Koha::Acquisition::Currencies;
102 use Koha::Biblio::Metadatas;
106 use Koha::SearchEngine;
108 use Koha::Util::MARC;
110 use vars qw($debug $cgi_debug);
115 C4::Biblio - cataloging management functions
119 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:
123 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
125 =item 2. as raw MARC in the Zebra index and storage engine
127 =item 3. as MARC XML in biblio_metadata.metadata
131 In the 3.0 version of Koha, the authoritative record-level information is in biblio_metadata.metadata
133 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.
137 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
139 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
143 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:
147 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
149 =item 2. _koha_* - low-level internal functions for managing the koha tables
151 =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.
153 =item 4. Zebra functions used to update the Zebra index
155 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
159 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 :
163 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
165 =item 2. add the biblionumber and biblioitemnumber into the MARC records
167 =item 3. save the marc record
171 =head1 EXPORTED FUNCTIONS
175 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
177 Exported function (core API) for adding a new biblio to koha.
179 The first argument is a C<MARC::Record> object containing the
180 bib to add, while the second argument is the desired MARC
183 This function also accepts a third, optional argument: a hashref
184 to additional options. The only defined option is C<defer_marc_save>,
185 which if present and mapped to a true value, causes C<AddBiblio>
186 to omit the call to save the MARC in C<biblio_metadata.metadata>
187 This option is provided B<only>
188 for the use of scripts such as C<bulkmarcimport.pl> that may need
189 to do some manipulation of the MARC record for item parsing before
190 saving it and which cannot afford the performance hit of saving
191 the MARC record twice. Consequently, do not use that option
192 unless you can guarantee that C<ModBiblioMarc> will be called.
198 my $frameworkcode = shift;
199 my $options = @_ ? shift : undef;
200 my $defer_marc_save = 0;
202 carp('AddBiblio called with undefined record');
205 if ( defined $options and exists $options->{'defer_marc_save'} and $options->{'defer_marc_save'} ) {
206 $defer_marc_save = 1;
209 if (C4::Context->preference('BiblioAddsAuthorities')) {
210 BiblioAutoLink( $record, $frameworkcode );
213 my ( $biblionumber, $biblioitemnumber, $error );
214 my $dbh = C4::Context->dbh;
216 # transform the data into koha-table style data
217 SetUTF8Flag($record);
218 my $olddata = TransformMarcToKoha( $record, $frameworkcode );
219 ( $biblionumber, $error ) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
220 $olddata->{'biblionumber'} = $biblionumber;
221 ( $biblioitemnumber, $error ) = _koha_add_biblioitem( $dbh, $olddata );
223 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
225 # update MARC subfield that stores biblioitems.cn_sort
226 _koha_marc_update_biblioitem_cn_sort( $record, $olddata, $frameworkcode );
229 ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
231 # update OAI-PMH sets
232 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
233 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
236 _after_biblio_action_hooks({ action => 'create', biblio_id => $biblionumber });
238 logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
239 return ( $biblionumber, $biblioitemnumber );
244 ModBiblio( $record,$biblionumber,$frameworkcode, $disable_autolink);
246 Replace an existing bib record identified by C<$biblionumber>
247 with one supplied by the MARC::Record object C<$record>. The embedded
248 item, biblioitem, and biblionumber fields from the previous
249 version of the bib record replace any such fields of those tags that
250 are present in C<$record>. Consequently, ModBiblio() is not
251 to be used to try to modify item records.
253 C<$frameworkcode> specifies the MARC framework to use
254 when storing the modified bib record; among other things,
255 this controls how MARC fields get mapped to display columns
256 in the C<biblio> and C<biblioitems> tables, as well as
257 which fields are used to store embedded item, biblioitem,
258 and biblionumber data for indexing.
260 Unless C<$disable_autolink> is passed ModBiblio will relink record headings
261 to authorities based on settings in the system preferences. This flag allows
262 us to not relink records when the authority linker is saving modifications.
264 Returns 1 on success 0 on failure
269 my ( $record, $biblionumber, $frameworkcode, $disable_autolink ) = @_;
271 carp 'No record passed to ModBiblio';
275 if ( C4::Context->preference("CataloguingLog") ) {
276 my $newrecord = GetMarcBiblio({ biblionumber => $biblionumber });
277 logaction( "CATALOGUING", "MODIFY", $biblionumber, "biblio BEFORE=>" . $newrecord->as_formatted );
280 if ( !$disable_autolink && C4::Context->preference('BiblioAddsAuthorities') ) {
281 BiblioAutoLink( $record, $frameworkcode );
284 # Cleaning up invalid fields must be done early or SetUTF8Flag is liable to
285 # throw an exception which probably won't be handled.
286 foreach my $field ($record->fields()) {
287 if (! $field->is_control_field()) {
288 if (scalar($field->subfields()) == 0 || (scalar($field->subfields()) == 1 && $field->subfield('9'))) {
289 $record->delete_field($field);
294 SetUTF8Flag($record);
295 my $dbh = C4::Context->dbh;
297 $frameworkcode = "" if !$frameworkcode || $frameworkcode eq "Default"; # XXX
299 _strip_item_fields($record, $frameworkcode);
301 # update biblionumber and biblioitemnumber in MARC
302 # FIXME - this is assuming a 1 to 1 relationship between
303 # biblios and biblioitems
304 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
305 $sth->execute($biblionumber);
306 my ($biblioitemnumber) = $sth->fetchrow;
308 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
310 # load the koha-table data object
311 my $oldbiblio = TransformMarcToKoha( $record, $frameworkcode );
313 # update MARC subfield that stores biblioitems.cn_sort
314 _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode );
316 # update the MARC record (that now contains biblio and items) with the new record data
317 &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
319 # modify the other koha tables
320 _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
321 _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
323 _after_biblio_action_hooks({ action => 'modify', biblio_id => $biblionumber });
325 # update OAI-PMH sets
326 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
327 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
333 =head2 _strip_item_fields
335 _strip_item_fields($record, $frameworkcode)
337 Utility routine to remove item tags from a
342 sub _strip_item_fields {
344 my $frameworkcode = shift;
345 # get the items before and append them to the biblio before updating the record, atm we just have the biblio
346 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber" );
348 # delete any item fields from incoming record to avoid
349 # duplication or incorrect data - use AddItem() or ModItem()
351 foreach my $field ( $record->field($itemtag) ) {
352 $record->delete_field($field);
358 my $error = &DelBiblio($biblionumber);
360 Exported function (core API) for deleting a biblio in koha.
361 Deletes biblio record from Zebra and Koha tables (biblio & biblioitems)
362 Also backs it up to deleted* tables.
363 Checks to make sure that the biblio has no items attached.
365 C<$error> : undef unless an error occurs
370 my ($biblionumber) = @_;
372 my $biblio = Koha::Biblios->find( $biblionumber );
373 return unless $biblio; # Should we throw an exception instead?
375 my $dbh = C4::Context->dbh;
376 my $error; # for error handling
378 # First make sure this biblio has no items attached
379 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
380 $sth->execute($biblionumber);
381 if ( my $itemnumber = $sth->fetchrow ) {
383 # Fix this to use a status the template can understand
384 $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
387 return $error if $error;
389 # We delete attached subscriptions
391 my $subscriptions = C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
392 foreach my $subscription (@$subscriptions) {
393 C4::Serials::DelSubscription( $subscription->{subscriptionid} );
396 # We delete any existing holds
397 my $holds = $biblio->holds;
398 while ( my $hold = $holds->next ) {
402 # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
403 # for at least 2 reasons :
404 # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
405 # and we would have no way to remove it (except manually in zebra, but I bet it would be very hard to handle the problem)
406 ModZebra( $biblionumber, "recordDelete", "biblioserver" );
408 # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
409 $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
410 $sth->execute($biblionumber);
411 while ( my $biblioitemnumber = $sth->fetchrow ) {
413 # delete this biblioitem
414 $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
415 return $error if $error;
419 # delete biblio from Koha tables and save in deletedbiblio
420 # must do this *after* _koha_delete_biblioitems, otherwise
421 # delete cascade will prevent deletedbiblioitems rows
422 # from being generated by _koha_delete_biblioitems
423 $error = _koha_delete_biblio( $dbh, $biblionumber );
425 _after_biblio_action_hooks({ action => 'delete', biblio_id => $biblionumber });
427 logaction( "CATALOGUING", "DELETE", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
433 =head2 BiblioAutoLink
435 my $headings_linked = BiblioAutoLink($record, $frameworkcode)
437 Automatically links headings in a bib record to authorities.
439 Returns the number of headings changed
445 my $frameworkcode = shift;
447 carp('Undefined record passed to BiblioAutoLink');
450 my ( $num_headings_changed, %results );
453 "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
454 unless ( can_load( modules => { $linker_module => undef } ) ) {
455 $linker_module = 'C4::Linker::Default';
456 unless ( can_load( modules => { $linker_module => undef } ) ) {
461 my $linker = $linker_module->new(
462 { 'options' => C4::Context->preference("LinkerOptions") } );
463 my ( $headings_changed, undef ) =
464 LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, C4::Context->preference("CatalogModuleRelink") || '' );
465 # By default we probably don't want to relink things when cataloging
466 return $headings_changed;
469 =head2 LinkBibHeadingsToAuthorities
471 my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink]);
473 Links bib headings to authority records by checking
474 each authority-controlled field in the C<MARC::Record>
475 object C<$marc>, looking for a matching authority record,
476 and setting the linking subfield $9 to the ID of that
479 If $allowrelink is false, existing authids will never be
480 replaced, regardless of the values of LinkerKeepStale and
483 Returns the number of heading links changed in the
488 sub LinkBibHeadingsToAuthorities {
491 my $frameworkcode = shift;
492 my $allowrelink = shift;
495 carp 'LinkBibHeadingsToAuthorities called on undefined bib record';
499 require C4::AuthoritiesMarc;
501 $allowrelink = 1 unless defined $allowrelink;
502 my $num_headings_changed = 0;
503 foreach my $field ( $bib->fields() ) {
504 my $heading = C4::Heading->new_from_field( $field, $frameworkcode );
505 next unless defined $heading;
508 my $current_link = $field->subfield('9');
510 if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) )
512 $results{'linked'}->{ $heading->display_form() }++;
516 my ( $authid, $fuzzy ) = $linker->get_link($heading);
518 $results{ $fuzzy ? 'fuzzy' : 'linked' }
519 ->{ $heading->display_form() }++;
520 next if defined $current_link and $current_link == $authid;
522 $field->delete_subfield( code => '9' ) if defined $current_link;
523 $field->add_subfields( '9', $authid );
524 $num_headings_changed++;
527 if ( defined $current_link
528 && (!$allowrelink || C4::Context->preference('LinkerKeepStale')) )
530 $results{'fuzzy'}->{ $heading->display_form() }++;
532 elsif ( C4::Context->preference('AutoCreateAuthorities') ) {
533 if ( _check_valid_auth_link( $current_link, $field ) ) {
534 $results{'linked'}->{ $heading->display_form() }++;
537 my $authority_type = Koha::Authority::Types->find( $heading->auth_type() );
538 my $marcrecordauth = MARC::Record->new();
539 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
540 $marcrecordauth->leader(' nz a22 o 4500');
541 SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
543 $field->delete_subfield( code => '9' )
544 if defined $current_link;
546 foreach my $subfield ( $field->subfields() ){
547 if ( $subfield->[0] =~ /[A-z]/
548 && C4::Heading::valid_heading_subfield(
549 $field->tag, $subfield->[0] )
551 push @auth_subfields, $subfield->[0] => $subfield->[1];
554 # Bib headings contain some ending punctuation that should NOT
555 # be included in the authority record. Strip those before creation
556 next unless @auth_subfields; # Don't try to create a record if we have no fields;
557 my $last_sub = pop @auth_subfields;
558 $last_sub =~ s/[\s]*[,.:=;!%\/][\s]*$//;
559 push @auth_subfields, $last_sub;
560 my $authfield = MARC::Field->new( $authority_type->auth_tag_to_report, '', '', @auth_subfields );
561 $marcrecordauth->insert_fields_ordered($authfield);
563 # bug 2317: ensure new authority knows it's using UTF-8; currently
564 # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
565 # automatically for UNIMARC (by not transcoding)
566 # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
567 # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
568 # of change to a core API just before the 3.0 release.
570 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
571 my $userenv = C4::Context->userenv;
573 if ( $userenv && $userenv->{'branch'} ) {
574 $library = Koha::Libraries->find( $userenv->{'branch'} );
576 $marcrecordauth->insert_fields_ordered(
579 'a' => "Machine generated authority record."
583 $bib->author() . ", "
584 . $bib->title_proper() . ", "
585 . $bib->publication_date() . " ";
586 $cite =~ s/^[\s\,]*//;
587 $cite =~ s/[\s\,]*$//;
590 . ( $library ? $library->get_effective_marcorgcode : C4::Context->preference('MARCOrgCode') ) . ")"
591 . $bib->subfield( '999', 'c' ) . ": "
593 $marcrecordauth->insert_fields_ordered(
594 MARC::Field->new( '670', '', '', 'a' => $cite ) );
597 # warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
600 C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '',
601 $heading->auth_type() );
602 $field->add_subfields( '9', $authid );
603 $num_headings_changed++;
604 $linker->update_cache($heading, $authid);
605 $results{'added'}->{ $heading->display_form() }++;
608 elsif ( defined $current_link ) {
609 if ( _check_valid_auth_link( $current_link, $field ) ) {
610 $results{'linked'}->{ $heading->display_form() }++;
613 $field->delete_subfield( code => '9' );
614 $num_headings_changed++;
615 $results{'unlinked'}->{ $heading->display_form() }++;
619 $results{'unlinked'}->{ $heading->display_form() }++;
624 return $num_headings_changed, \%results;
627 =head2 _check_valid_auth_link
629 if ( _check_valid_auth_link($authid, $field) ) {
633 Check whether the specified heading-auth link is valid without reference
634 to Zebra. Ideally this code would be in C4::Heading, but that won't be
635 possible until we have de-cycled C4::AuthoritiesMarc, so this is the
640 sub _check_valid_auth_link {
641 my ( $authid, $field ) = @_;
642 require C4::AuthoritiesMarc;
644 my $authorized_heading =
645 C4::AuthoritiesMarc::GetAuthorizedHeading( { 'authid' => $authid } ) || '';
646 return ($field->as_string('abcdefghijklmnopqrstuvwxyz') eq $authorized_heading);
651 $data = &GetBiblioData($biblionumber);
653 Returns information about the book with the given biblionumber.
654 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
655 the C<biblio> and C<biblioitems> tables in the
658 In addition, C<$data-E<gt>{subject}> is the list of the book's
659 subjects, separated by C<" , "> (space, comma, space).
660 If there are multiple biblioitems with the given biblionumber, only
661 the first one is considered.
667 my $dbh = C4::Context->dbh;
669 my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
671 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
672 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
673 WHERE biblio.biblionumber = ?";
675 my $sth = $dbh->prepare($query);
676 $sth->execute($bibnum);
678 $data = $sth->fetchrow_hashref;
682 } # sub GetBiblioData
686 $isbd = &GetISBDView({
687 'record' => $marc_record,
688 'template' => $interface, # opac/intranet
689 'framework' => $framework,
692 Return the ISBD view which can be included in opac and intranet
699 # Expecting record WITH items.
700 my $record = $params->{record};
701 return unless defined $record;
703 my $template = $params->{template} // q{};
704 my $sysprefname = $template eq 'opac' ? 'opacisbd' : 'isbd';
705 my $framework = $params->{framework};
706 my $itemtype = $framework;
707 my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField( "items.holdingbranch" );
708 my $tagslib = GetMarcStructure( 1, $itemtype, { unsafe => 1 } );
710 my $ISBD = C4::Context->preference($sysprefname);
715 foreach my $isbdfield ( split( /#/, $bloc ) ) {
717 # $isbdfield= /(.?.?.?)/;
718 $isbdfield =~ /(\d\d\d)([^\|])?\|(.*)\|(.*)\|(.*)/;
719 my $fieldvalue = $1 || 0;
720 my $subfvalue = $2 || "";
722 my $analysestring = $4;
725 # warn "==> $1 / $2 / $3 / $4";
726 # my $fieldvalue=substr($isbdfield,0,3);
727 if ( $fieldvalue > 0 ) {
728 my $hasputtextbefore = 0;
729 my @fieldslist = $record->field($fieldvalue);
730 @fieldslist = sort { $a->subfield($holdingbrtagsubf) cmp $b->subfield($holdingbrtagsubf) } @fieldslist if ( $fieldvalue eq $holdingbrtagf );
732 # warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
733 # warn "FV : $fieldvalue";
734 if ( $subfvalue ne "" ) {
735 # OPAC hidden subfield
737 if ( ( $template eq 'opac' )
738 && ( $tagslib->{$fieldvalue}->{$subfvalue}->{'hidden'} || 0 ) > 0 );
739 foreach my $field (@fieldslist) {
740 foreach my $subfield ( $field->subfield($subfvalue) ) {
741 my $calculated = $analysestring;
742 my $tag = $field->tag();
745 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subfvalue, $subfield, '', $tagslib );
746 my $tagsubf = $tag . $subfvalue;
747 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
748 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
750 # field builded, store the result
751 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
752 $blocres .= $textbefore;
753 $hasputtextbefore = 1;
756 # remove punctuation at start
757 $calculated =~ s/^( |;|:|\.|-)*//g;
758 $blocres .= $calculated;
763 $blocres .= $textafter if $hasputtextbefore;
765 foreach my $field (@fieldslist) {
766 my $calculated = $analysestring;
767 my $tag = $field->tag();
770 my @subf = $field->subfields;
771 for my $i ( 0 .. $#subf ) {
772 my $valuecode = $subf[$i][1];
773 my $subfieldcode = $subf[$i][0];
774 # OPAC hidden subfield
776 if ( ( $template eq 'opac' )
777 && ( $tagslib->{$fieldvalue}->{$subfieldcode}->{'hidden'} || 0 ) > 0 );
778 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subf[$i][0], $subf[$i][1], '', $tagslib );
779 my $tagsubf = $tag . $subfieldcode;
781 $calculated =~ s/ # replace all {{}} codes by the value code.
782 \{\{$tagsubf\}\} # catch the {{actualcode}}
784 $valuecode # replace by the value code
787 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
788 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
791 # field builded, store the result
792 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
793 $blocres .= $textbefore;
794 $hasputtextbefore = 1;
797 # remove punctuation at start
798 $calculated =~ s/^( |;|:|\.|-)*//g;
799 $blocres .= $calculated;
802 $blocres .= $textafter if $hasputtextbefore;
805 $blocres .= $isbdfield;
810 $res =~ s/\{(.*?)\}//g;
812 $res =~ s/\n/<br\/>/g;
820 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
822 =head2 IsMarcStructureInternal
824 my $tagslib = C4::Biblio::GetMarcStructure();
825 for my $tag ( sort keys %$tagslib ) {
827 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
828 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
833 GetMarcStructure creates keys (lib, tab, mandatory, repeatable, important) for a display purpose.
834 These different values should not be processed as valid subfields.
838 sub IsMarcStructureInternal {
839 my ( $subfield ) = @_;
840 return ref $subfield ? 0 : 1;
843 =head2 GetMarcStructure
845 $res = GetMarcStructure($forlibrarian, $frameworkcode, [ $params ]);
847 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
848 $forlibrarian :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
849 $frameworkcode : the framework code to read
850 $params allows you to pass { unsafe => 1 } for better performance.
852 Note: If you call GetMarcStructure with unsafe => 1, do not modify or
853 even autovivify its contents. It is a cached/shared data structure. Your
854 changes c/would be passed around in subsequent calls.
858 sub GetMarcStructure {
859 my ( $forlibrarian, $frameworkcode, $params ) = @_;
860 $frameworkcode = "" unless $frameworkcode;
862 $forlibrarian = $forlibrarian ? 1 : 0;
863 my $unsafe = ($params && $params->{unsafe})? 1: 0;
864 my $cache = Koha::Caches->get_instance();
865 my $cache_key = "MarcStructure-$forlibrarian-$frameworkcode";
866 my $cached = $cache->get_from_cache($cache_key, { unsafe => $unsafe });
867 return $cached if $cached;
869 my $dbh = C4::Context->dbh;
870 my $sth = $dbh->prepare(
871 "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable,important,ind1_defaultvalue,ind2_defaultvalue
872 FROM marc_tag_structure
873 WHERE frameworkcode=?
876 $sth->execute($frameworkcode);
877 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable, $important, $ind1_defaultvalue, $ind2_defaultvalue );
879 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable, $important, $ind1_defaultvalue, $ind2_defaultvalue ) = $sth->fetchrow ) {
880 $res->{$tag}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
881 $res->{$tag}->{tab} = "";
882 $res->{$tag}->{mandatory} = $mandatory;
883 $res->{$tag}->{important} = $important;
884 $res->{$tag}->{repeatable} = $repeatable;
885 $res->{$tag}->{ind1_defaultvalue} = $ind1_defaultvalue;
886 $res->{$tag}->{ind2_defaultvalue} = $ind2_defaultvalue;
889 $sth = $dbh->prepare(
890 "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue,maxlength,important
891 FROM marc_subfield_structure
892 WHERE frameworkcode=?
893 ORDER BY tagfield,tagsubfield
897 $sth->execute($frameworkcode);
900 my $authorised_value;
912 ( $tag, $subfield, $liblibrarian, $libopac, $tab, $mandatory, $repeatable, $authorised_value,
913 $authtypecode, $value_builder, $kohafield, $seealso, $hidden, $isurl, $link, $defaultvalue,
914 $maxlength, $important
918 $res->{$tag}->{$subfield}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
919 $res->{$tag}->{$subfield}->{tab} = $tab;
920 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
921 $res->{$tag}->{$subfield}->{important} = $important;
922 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
923 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
924 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
925 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
926 $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
927 $res->{$tag}->{$subfield}->{seealso} = $seealso;
928 $res->{$tag}->{$subfield}->{hidden} = $hidden;
929 $res->{$tag}->{$subfield}->{isurl} = $isurl;
930 $res->{$tag}->{$subfield}->{'link'} = $link;
931 $res->{$tag}->{$subfield}->{defaultvalue} = $defaultvalue;
932 $res->{$tag}->{$subfield}->{maxlength} = $maxlength;
935 $cache->set_in_cache($cache_key, $res);
939 =head2 GetUsedMarcStructure
941 The same function as GetMarcStructure except it just takes field
942 in tab 0-9. (used field)
944 my $results = GetUsedMarcStructure($frameworkcode);
946 C<$results> is a ref to an array which each case contains a ref
947 to a hash which each keys is the columns from marc_subfield_structure
949 C<$frameworkcode> is the framework code.
953 sub GetUsedMarcStructure {
954 my $frameworkcode = shift || '';
957 FROM marc_subfield_structure
959 AND frameworkcode = ?
960 ORDER BY tagfield, tagsubfield
962 my $sth = C4::Context->dbh->prepare($query);
963 $sth->execute($frameworkcode);
964 return $sth->fetchall_arrayref( {} );
969 =head2 GetMarcSubfieldStructure
971 my $structure = GetMarcSubfieldStructure($frameworkcode, [$params]);
973 Returns a reference to hash representing MARC subfield structure
974 for framework with framework code C<$frameworkcode>, C<$params> is
975 optional and may contain additional options.
979 =item C<$frameworkcode>
985 An optional hash reference with additional options.
986 The following options are supported:
992 Pass { unsafe => 1 } do disable cached object cloning,
993 and instead get a shared reference, resulting in better
994 performance (but care must be taken so that retured object
997 Note: If you call GetMarcSubfieldStructure with unsafe => 1, do not modify or
998 even autovivify its contents. It is a cached/shared data structure. Your
999 changes would be passed around in subsequent calls.
1007 sub GetMarcSubfieldStructure {
1008 my ( $frameworkcode, $params ) = @_;
1010 $frameworkcode //= '';
1012 my $cache = Koha::Caches->get_instance();
1013 my $cache_key = "MarcSubfieldStructure-$frameworkcode";
1014 my $cached = $cache->get_from_cache($cache_key, { unsafe => ($params && $params->{unsafe}) });
1015 return $cached if $cached;
1017 my $dbh = C4::Context->dbh;
1018 # We moved to selectall_arrayref since selectall_hashref does not
1019 # keep duplicate mappings on kohafield (like place in 260 vs 264)
1020 my $subfield_aref = $dbh->selectall_arrayref( q|
1022 FROM marc_subfield_structure
1023 WHERE frameworkcode = ?
1025 ORDER BY frameworkcode,tagfield,tagsubfield
1026 |, { Slice => {} }, $frameworkcode );
1027 # Now map the output to a hash structure
1028 my $subfield_structure = {};
1029 foreach my $row ( @$subfield_aref ) {
1030 push @{ $subfield_structure->{ $row->{kohafield} }}, $row;
1032 $cache->set_in_cache( $cache_key, $subfield_structure );
1033 return $subfield_structure;
1036 =head2 GetMarcFromKohaField
1038 ( $field,$subfield ) = GetMarcFromKohaField( $kohafield );
1039 @fields = GetMarcFromKohaField( $kohafield );
1040 $field = GetMarcFromKohaField( $kohafield );
1042 Returns the MARC fields & subfields mapped to $kohafield.
1043 Since the Default framework is considered as authoritative for such
1044 mappings, the former frameworkcode parameter is obsoleted.
1046 In list context all mappings are returned; there can be multiple
1047 mappings. Note that in the above example you could miss a second
1048 mappings in the first call.
1049 In scalar context only the field tag of the first mapping is returned.
1053 sub GetMarcFromKohaField {
1054 my ( $kohafield ) = @_;
1055 return unless $kohafield;
1056 # The next call uses the Default framework since it is AUTHORITATIVE
1057 # for all Koha to MARC mappings.
1058 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
1060 foreach( @{ $mss->{$kohafield} } ) {
1061 push @retval, $_->{tagfield}, $_->{tagsubfield};
1063 return wantarray ? @retval : ( @retval ? $retval[0] : undef );
1066 =head2 GetMarcSubfieldStructureFromKohaField
1068 my $str = GetMarcSubfieldStructureFromKohaField( $kohafield );
1070 Returns marc subfield structure information for $kohafield.
1071 The Default framework is used, since it is authoritative for kohafield
1073 In list context returns a list of all hashrefs, since there may be
1074 multiple mappings. In scalar context the first hashref is returned.
1078 sub GetMarcSubfieldStructureFromKohaField {
1079 my ( $kohafield ) = @_;
1081 return unless $kohafield;
1083 # The next call uses the Default framework since it is AUTHORITATIVE
1084 # for all Koha to MARC mappings.
1085 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
1086 return unless $mss->{$kohafield};
1087 return wantarray ? @{$mss->{$kohafield}} : $mss->{$kohafield}->[0];
1090 =head2 GetMarcBiblio
1092 my $record = GetMarcBiblio({
1093 biblionumber => $biblionumber,
1094 embed_items => $embeditems,
1096 borcat => $patron_category });
1098 Returns MARC::Record representing a biblio record, or C<undef> if the
1099 biblionumber doesn't exist.
1101 Both embed_items and opac are optional.
1102 If embed_items is passed and is 1, items are embedded.
1103 If opac is passed and is 1, the record is filtered as needed.
1107 =item C<$biblionumber>
1111 =item C<$embeditems>
1113 set to true to include item information.
1117 set to true to make the result suited for OPAC view. This causes things like
1118 OpacHiddenItems to be applied.
1122 If the OpacHiddenItemsExceptions system preference is set, this patron category
1123 can be used to make visible OPAC items which would be normally hidden.
1124 It only makes sense in combination both embed_items and opac values true.
1133 if (not defined $params) {
1134 carp 'GetMarcBiblio called without parameters';
1138 my $biblionumber = $params->{biblionumber};
1139 my $embeditems = $params->{embed_items} || 0;
1140 my $opac = $params->{opac} || 0;
1141 my $borcat = $params->{borcat} // q{};
1143 if (not defined $biblionumber) {
1144 carp 'GetMarcBiblio called with undefined biblionumber';
1148 my $dbh = C4::Context->dbh;
1149 my $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=? ");
1150 $sth->execute($biblionumber);
1151 my $row = $sth->fetchrow_hashref;
1152 my $biblioitemnumber = $row->{'biblioitemnumber'};
1153 my $marcxml = GetXmlBiblio( $biblionumber );
1154 $marcxml = StripNonXmlChars( $marcxml );
1155 my $frameworkcode = GetFrameworkCode($biblionumber);
1156 MARC::File::XML->default_record_format( C4::Context->preference('marcflavour') );
1157 my $record = MARC::Record->new();
1161 MARC::Record::new_from_xml( $marcxml, "UTF-8",
1162 C4::Context->preference('marcflavour') );
1164 if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; }
1165 return unless $record;
1167 C4::Biblio::_koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber,
1168 $biblioitemnumber );
1169 C4::Biblio::EmbedItemsInMarcBiblio({
1170 marc_record => $record,
1171 biblionumber => $biblionumber,
1173 borcat => $borcat })
1185 my $marcxml = GetXmlBiblio($biblionumber);
1187 Returns biblio_metadata.metadata/marcxml of the biblionumber passed in parameter.
1188 The XML should only contain biblio information (item information is no longer stored in marcxml field)
1193 my ($biblionumber) = @_;
1194 my $dbh = C4::Context->dbh;
1195 return unless $biblionumber;
1196 my ($marcxml) = $dbh->selectrow_array(
1199 FROM biblio_metadata
1200 WHERE biblionumber=?
1201 AND format='marcxml'
1203 |, undef, $biblionumber, C4::Context->preference('marcflavour')
1210 return the prices in accordance with the Marc format.
1212 returns 0 if no price found
1213 returns undef if called without a marc record or with
1214 an unrecognized marc format
1219 my ( $record, $marcflavour ) = @_;
1221 carp 'GetMarcPrice called on undefined record';
1228 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1229 @listtags = ('345', '020');
1231 } elsif ( $marcflavour eq "UNIMARC" ) {
1232 @listtags = ('345', '010');
1238 for my $field ( $record->field(@listtags) ) {
1239 for my $subfield_value ($field->subfield($subfield)){
1241 $subfield_value = MungeMarcPrice( $subfield_value );
1242 return $subfield_value if ($subfield_value);
1245 return 0; # no price found
1248 =head2 MungeMarcPrice
1250 Return the best guess at what the actual price is from a price field.
1254 sub MungeMarcPrice {
1256 return unless ( $price =~ m/\d/ ); ## No digits means no price.
1257 # Look for the currency symbol and the normalized code of the active currency, if it's there,
1258 my $active_currency = Koha::Acquisition::Currencies->get_active;
1259 my $symbol = $active_currency->symbol;
1260 my $isocode = $active_currency->isocode;
1261 $isocode = $active_currency->currency unless defined $isocode;
1264 my @matches =($price=~ /
1266 ( # start of capturing parenthesis
1268 (?:[\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'
1269 |(?:\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'
1271 \s?\p{Sc}?\s? # followed or not by a whitespace. \p{Sc}?\s? are for cases like '25$ USD'
1273 (?:[\p{Sc}\p{L}\/.]){1,4} # followed by same block as symbol block
1274 |(?:\d+[\p{P}\s]?){1,4} # or by same block as digits block
1276 \s?\p{L}{0,4}\s? # followed or not by a whitespace. \p{L}{0,4}\s? are for cases like '$9.50 USD'
1277 ) # end of capturing parenthesis
1278 (?:\p{P}|\z) # followed by a punctuation sign or by the end of the string
1282 foreach ( @matches ) {
1283 $localprice = $_ and last if index($_, $isocode)>=0;
1285 if ( !$localprice ) {
1286 foreach ( @matches ) {
1287 $localprice = $_ and last if $_=~ /(^|[^\p{Sc}\p{L}\/])\Q$symbol\E([^\p{Sc}\p{L}\/]+\z|\z)/;
1292 if ( $localprice ) {
1293 $price = $localprice;
1295 ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
1296 ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
1298 # eliminate symbol/isocode, space and any final dot from the string
1299 $price =~ s/[\p{Sc}\p{L}\/ ]|\.$//g;
1300 # remove comma,dot when used as separators from hundreds
1301 $price =~s/[\,\.](\d{3})/$1/g;
1302 # convert comma to dot to ensure correct display of decimals if existing
1308 =head2 GetMarcQuantity
1310 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
1311 Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
1313 returns 0 if no quantity found
1314 returns undef if called without a marc record or with
1315 an unrecognized marc format
1319 sub GetMarcQuantity {
1320 my ( $record, $marcflavour ) = @_;
1322 carp 'GetMarcQuantity called on undefined record';
1329 if ( $marcflavour eq "MARC21" ) {
1331 } elsif ( $marcflavour eq "UNIMARC" ) {
1332 @listtags = ('969');
1338 for my $field ( $record->field(@listtags) ) {
1339 for my $subfield_value ($field->subfield($subfield)){
1341 if ($subfield_value) {
1342 # in France, the cents separator is the , but sometimes, ppl use a .
1343 # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1344 $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
1345 return $subfield_value;
1349 return 0; # no price found
1353 =head2 GetAuthorisedValueDesc
1355 my $subfieldvalue =get_authorised_value_desc(
1356 $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1358 Retrieve the complete description for a given authorised value.
1360 Now takes $category and $value pair too.
1362 my $auth_value_desc =GetAuthorisedValueDesc(
1363 '','', 'DVD' ,'','','CCODE');
1365 If the optional $opac parameter is set to a true value, displays OPAC
1366 descriptions rather than normal ones when they exist.
1370 sub GetAuthorisedValueDesc {
1371 my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1375 return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1378 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1379 my $branch = Koha::Libraries->find($value);
1380 return $branch? $branch->branchname: q{};
1384 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1385 my $itemtype = Koha::ItemTypes->find( $value );
1386 return $itemtype ? $itemtype->translated_description : q||;
1389 #---- "true" authorized value
1390 $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1393 my $dbh = C4::Context->dbh;
1394 if ( $category ne "" ) {
1395 my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1396 $sth->execute( $category, $value );
1397 my $data = $sth->fetchrow_hashref;
1398 return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
1400 return $value; # if nothing is found return the original value
1404 =head2 GetMarcControlnumber
1406 $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1408 Get the control number / record Identifier from the MARC record and return it.
1412 sub GetMarcControlnumber {
1413 my ( $record, $marcflavour ) = @_;
1415 carp 'GetMarcControlnumber called on undefined record';
1418 my $controlnumber = "";
1419 # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
1420 # Keep $marcflavour for possible later use
1421 if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" || $marcflavour eq "NORMARC") {
1422 my $controlnumberField = $record->field('001');
1423 if ($controlnumberField) {
1424 $controlnumber = $controlnumberField->data();
1427 return $controlnumber;
1432 $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1434 Get all ISBNs from the MARC record and returns them in an array.
1435 ISBNs stored in different fields depending on MARC flavour
1440 my ( $record, $marcflavour ) = @_;
1442 carp 'GetMarcISBN called on undefined record';
1446 if ( $marcflavour eq "UNIMARC" ) {
1448 } else { # assume marc21 if not unimarc
1453 foreach my $field ( $record->field($scope) ) {
1454 my $isbn = $field->subfield( 'a' );
1455 if ( $isbn && $isbn ne "" ) {
1456 push @marcisbns, $isbn;
1466 $marcissnsarray = GetMarcISSN( $record, $marcflavour );
1468 Get all valid ISSNs from the MARC record and returns them in an array.
1469 ISSNs are stored in different fields depending on MARC flavour
1474 my ( $record, $marcflavour ) = @_;
1476 carp 'GetMarcISSN called on undefined record';
1480 if ( $marcflavour eq "UNIMARC" ) {
1483 else { # assume MARC21 or NORMARC
1487 foreach my $field ( $record->field($scope) ) {
1488 push @marcissns, $field->subfield( 'a' )
1489 if ( $field->subfield( 'a' ) ne "" );
1496 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1498 Get all notes from the MARC record and returns them in an array.
1499 The notes are stored in different fields depending on MARC flavour.
1500 MARC21 5XX $u subfields receive special attention as they are URIs.
1505 my ( $record, $marcflavour, $opac ) = @_;
1507 carp 'GetMarcNotes called on undefined record';
1511 my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
1514 #MARC21 specs indicate some notes should be private if first indicator 0
1515 my %maybe_private = (
1523 my %blacklist = map { $_ => 1 }
1524 split( /,/, C4::Context->preference('NotesBlacklist'));
1525 foreach my $field ( $record->field($scope) ) {
1526 my $tag = $field->tag();
1527 next if $blacklist{ $tag };
1528 next if $opac && $maybe_private{$tag} && !$field->indicator(1);
1529 if( $marcflavour ne 'UNIMARC' && $field->subfield('u') ) {
1530 # Field 5XX$u always contains URI
1531 # Examples: 505u, 506u, 510u, 514u, 520u, 530u, 538u, 540u, 542u, 552u, 555u, 561u, 563u, 583u
1532 # We first push the other subfields, then all $u's separately
1533 # Leave further actions to the template (see e.g. opac-detail)
1535 join '', ( 'a' .. 't', 'v' .. 'z', '0' .. '9' ); # excl 'u'
1536 push @marcnotes, { marcnote => $field->as_string($othersub) };
1537 foreach my $sub ( $field->subfield('u') ) {
1538 $sub =~ s/^\s+|\s+$//g; # trim
1539 push @marcnotes, { marcnote => $sub };
1542 push @marcnotes, { marcnote => $field->as_string() };
1548 =head2 GetMarcSubjects
1550 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1552 Get all subjects from the MARC record and returns them in an array.
1553 The subjects are stored in different fields depending on MARC flavour
1557 sub GetMarcSubjects {
1558 my ( $record, $marcflavour ) = @_;
1560 carp 'GetMarcSubjects called on undefined record';
1563 my ( $mintag, $maxtag, $fields_filter );
1564 if ( $marcflavour eq "UNIMARC" ) {
1567 $fields_filter = '6..';
1568 } else { # marc21/normarc
1571 $fields_filter = '6..';
1576 my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1577 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1579 foreach my $field ( $record->field($fields_filter) ) {
1580 next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
1582 my @subfields = $field->subfields();
1585 # if there is an authority link, build the links with an= subfield9
1586 my $subfield9 = $field->subfield('9');
1589 my $linkvalue = $subfield9;
1590 $linkvalue =~ s/(\(|\))//g;
1591 @link_loop = ( { limit => 'an', 'link' => $linkvalue } );
1592 $authoritylink = $linkvalue
1596 for my $subject_subfield (@subfields) {
1597 next if ( $subject_subfield->[0] eq '9' );
1599 # don't load unimarc subfields 3,4,5
1600 next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1601 # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1602 next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1604 my $code = $subject_subfield->[0];
1605 my $value = $subject_subfield->[1];
1606 my $linkvalue = $value;
1607 $linkvalue =~ s/(\(|\))//g;
1608 # if no authority link, build a search query
1609 unless ($subfield9) {
1611 limit => $subject_limit,
1612 'link' => $linkvalue,
1613 operator => (scalar @link_loop) ? ' and ' : undef
1616 my @this_link_loop = @link_loop;
1618 unless ( $code eq '0' ) {
1619 push @subfields_loop, {
1622 link_loop => \@this_link_loop,
1623 separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1628 push @marcsubjects, {
1629 MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop,
1630 authoritylink => $authoritylink,
1631 } if $authoritylink || @subfields_loop;
1634 return \@marcsubjects;
1635 } #end getMARCsubjects
1637 =head2 GetMarcAuthors
1639 authors = GetMarcAuthors($record,$marcflavour);
1641 Get all authors from the MARC record and returns them in an array.
1642 The authors are stored in different fields depending on MARC flavour
1646 sub GetMarcAuthors {
1647 my ( $record, $marcflavour ) = @_;
1649 carp 'GetMarcAuthors called on undefined record';
1652 my ( $mintag, $maxtag, $fields_filter );
1654 # tagslib useful only for UNIMARC author responsibilities
1656 if ( $marcflavour eq "UNIMARC" ) {
1657 # FIXME : we don't have the framework available, we take the default framework. May be buggy on some setups, will be usually correct.
1658 $tagslib = GetMarcStructure( 1, '', { unsafe => 1 });
1661 $fields_filter = '7..';
1662 } else { # marc21/normarc
1665 $fields_filter = '7..';
1669 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1671 foreach my $field ( $record->field($fields_filter) ) {
1672 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1675 my @subfields = $field->subfields();
1678 # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1679 my $subfield9 = $field->subfield('9');
1681 my $linkvalue = $subfield9;
1682 $linkvalue =~ s/(\(|\))//g;
1683 @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1688 for my $authors_subfield (@subfields) {
1689 next if ( $authors_subfield->[0] eq '9' );
1691 # unimarc3 contains the $3 of the author for UNIMARC.
1692 # For french academic libraries, it's the "ppn", and it's required for idref webservice
1693 $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1695 # don't load unimarc subfields 3, 5
1696 next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1698 my $code = $authors_subfield->[0];
1699 my $value = $authors_subfield->[1];
1700 my $linkvalue = $value;
1701 $linkvalue =~ s/(\(|\))//g;
1702 # UNIMARC author responsibility
1703 if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1704 $value = GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1705 $linkvalue = "($value)";
1707 # if no authority link, build a search query
1708 unless ($subfield9) {
1711 'link' => $linkvalue,
1712 operator => (scalar @link_loop) ? ' and ' : undef
1715 my @this_link_loop = @link_loop;
1717 unless ( $code eq '0') {
1718 push @subfields_loop, {
1719 tag => $field->tag(),
1722 link_loop => \@this_link_loop,
1723 separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1727 push @marcauthors, {
1728 MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
1729 authoritylink => $subfield9,
1730 unimarc3 => $unimarc3
1733 return \@marcauthors;
1738 $marcurls = GetMarcUrls($record,$marcflavour);
1740 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1741 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1746 my ( $record, $marcflavour ) = @_;
1748 carp 'GetMarcUrls called on undefined record';
1753 for my $field ( $record->field('856') ) {
1755 for my $note ( $field->subfield('z') ) {
1756 push @notes, { note => $note };
1758 my @urls = $field->subfield('u');
1759 foreach my $url (@urls) {
1760 $url =~ s/^\s+|\s+$//g; # trim
1762 if ( $marcflavour eq 'MARC21' ) {
1763 my $s3 = $field->subfield('3');
1764 my $link = $field->subfield('y');
1765 unless ( $url =~ /^\w+:/ ) {
1766 if ( $field->indicator(1) eq '7' ) {
1767 $url = $field->subfield('2') . "://" . $url;
1768 } elsif ( $field->indicator(1) eq '1' ) {
1769 $url = 'ftp://' . $url;
1772 # properly, this should be if ind1=4,
1773 # however we will assume http protocol since we're building a link.
1774 $url = 'http://' . $url;
1778 # TODO handle ind 2 (relationship)
1783 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
1784 $marcurl->{'part'} = $s3 if ($link);
1785 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1787 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
1788 $marcurl->{'MARCURL'} = $url;
1790 push @marcurls, $marcurl;
1796 =head2 GetMarcSeries
1798 $marcseriesarray = GetMarcSeries($record,$marcflavour);
1800 Get all series from the MARC record and returns them in an array.
1801 The series are stored in different fields depending on MARC flavour
1806 my ( $record, $marcflavour ) = @_;
1808 carp 'GetMarcSeries called on undefined record';
1812 my ( $mintag, $maxtag, $fields_filter );
1813 if ( $marcflavour eq "UNIMARC" ) {
1816 $fields_filter = '2..';
1817 } else { # marc21/normarc
1820 $fields_filter = '4..';
1824 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1826 foreach my $field ( $record->field($fields_filter) ) {
1827 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1829 my @subfields = $field->subfields();
1832 for my $series_subfield (@subfields) {
1834 # ignore $9, used for authority link
1835 next if ( $series_subfield->[0] eq '9' );
1838 my $code = $series_subfield->[0];
1839 my $value = $series_subfield->[1];
1840 my $linkvalue = $value;
1841 $linkvalue =~ s/(\(|\))//g;
1843 # see if this is an instance of a volume
1844 if ( $code eq 'v' ) {
1849 'link' => $linkvalue,
1850 operator => (scalar @link_loop) ? ' and ' : undef
1853 if ($volume_number) {
1854 push @subfields_loop, { volumenum => $value };
1856 push @subfields_loop, {
1859 link_loop => \@link_loop,
1860 separator => (scalar @subfields_loop) ? $AuthoritySeparator : '',
1861 volumenum => $volume_number,
1865 push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1868 return \@marcseries;
1869 } #end getMARCseriess
1873 $marchostsarray = GetMarcHosts($record,$marcflavour);
1875 Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns them in an array.
1880 my ( $record, $marcflavour ) = @_;
1882 carp 'GetMarcHosts called on undefined record';
1886 my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
1887 $marcflavour ||="MARC21";
1888 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1891 $bibnumber_subf ="0";
1892 $itemnumber_subf='9';
1894 elsif ($marcflavour eq "UNIMARC") {
1897 $bibnumber_subf ="0";
1898 $itemnumber_subf='9';
1903 foreach my $field ( $record->field($tag)) {
1907 my $hostbiblionumber = $field->subfield("$bibnumber_subf");
1908 my $hosttitle = $field->subfield($title_subf);
1909 my $hostitemnumber=$field->subfield($itemnumber_subf);
1910 push @fields_loop, { hostbiblionumber => $hostbiblionumber, hosttitle => $hosttitle, hostitemnumber => $hostitemnumber};
1911 push @marchosts, { MARCHOSTS_FIELDS_LOOP => \@fields_loop };
1914 my $marchostsarray = \@marchosts;
1915 return $marchostsarray;
1918 =head2 UpsertMarcSubfield
1920 my $record = C4::Biblio::UpsertMarcSubfield($MARC::Record, $fieldTag, $subfieldCode, $subfieldContent);
1924 sub UpsertMarcSubfield {
1925 my ($record, $tag, $code, $content) = @_;
1926 my $f = $record->field($tag);
1929 $f->update( $code => $content );
1932 my $f = MARC::Field->new( $tag, '', '', $code => $content);
1933 $record->insert_fields_ordered( $f );
1937 =head2 UpsertMarcControlField
1939 my $record = C4::Biblio::UpsertMarcControlField($MARC::Record, $fieldTag, $content);
1943 sub UpsertMarcControlField {
1944 my ($record, $tag, $content) = @_;
1945 die "UpsertMarcControlField() \$tag '$tag' is not a control field\n" unless 0+$tag < 10;
1946 my $f = $record->field($tag);
1949 $f->update( $content );
1952 my $f = MARC::Field->new($tag, $content);
1953 $record->insert_fields_ordered( $f );
1957 =head2 GetFrameworkCode
1959 $frameworkcode = GetFrameworkCode( $biblionumber )
1963 sub GetFrameworkCode {
1964 my ($biblionumber) = @_;
1965 my $dbh = C4::Context->dbh;
1966 my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
1967 $sth->execute($biblionumber);
1968 my ($frameworkcode) = $sth->fetchrow;
1969 return $frameworkcode;
1972 =head2 TransformKohaToMarc
1974 $record = TransformKohaToMarc( $hash [, $params ] )
1976 This function builds a (partial) MARC::Record from a hash.
1977 Hash entries can be from biblio, biblioitems or items.
1978 The params hash includes the parameter no_split used in C4::Items.
1980 This function is called in acquisition module, to create a basic catalogue
1981 entry from user entry.
1986 sub TransformKohaToMarc {
1987 my ( $hash, $params ) = @_;
1988 my $record = MARC::Record->new();
1989 SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
1991 # In the next call we use the Default framework, since it is considered
1992 # authoritative for Koha to Marc mappings.
1993 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # do not change framewok
1995 while ( my ($kohafield, $value) = each %$hash ) {
1996 foreach my $fld ( @{ $mss->{$kohafield} } ) {
1997 my $tagfield = $fld->{tagfield};
1998 my $tagsubfield = $fld->{tagsubfield};
2001 # BZ 21800: split value if field is repeatable; NOTE that this also
2002 # depends on the Default framework.
2003 my @values = $params->{no_split} || !$fld->{repeatable}
2005 : split(/\s?\|\s?/, $value, -1);
2006 foreach my $value ( @values ) {
2007 next if $value eq '';
2008 $tag_hr->{$tagfield} //= [];
2009 push @{$tag_hr->{$tagfield}}, [($tagsubfield, $value)];
2013 foreach my $tag (sort keys %$tag_hr) {
2014 my @sfl = @{$tag_hr->{$tag}};
2015 @sfl = sort { $a->[0] cmp $b->[0]; } @sfl;
2016 @sfl = map { @{$_}; } @sfl;
2017 # Special care for control fields: remove the subfield indication @
2018 # and do not insert indicators.
2019 my @ind = $tag < 10 ? () : ( " ", " " );
2020 @sfl = grep { $_ ne '@' } @sfl if $tag < 10;
2021 $record->insert_fields_ordered( MARC::Field->new($tag, @ind, @sfl) );
2026 =head2 PrepHostMarcField
2028 $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
2030 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
2034 sub PrepHostMarcField {
2035 my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
2036 $marcflavour ||="MARC21";
2038 my $hostrecord = GetMarcBiblio({ biblionumber => $hostbiblionumber });
2039 my $item = Koha::Items->find($hostitemnumber);
2042 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2046 if ($hostrecord->subfield('100','a')){
2047 $mainentry = $hostrecord->subfield('100','a');
2048 } elsif ($hostrecord->subfield('110','a')){
2049 $mainentry = $hostrecord->subfield('110','a');
2051 $mainentry = $hostrecord->subfield('111','a');
2054 # qualification info
2056 if (my $field260 = $hostrecord->field('260')){
2057 $qualinfo = $field260->as_string( 'abc' );
2062 my $ed = $hostrecord->subfield('250','a');
2063 my $barcode = $item->barcode;
2064 my $title = $hostrecord->subfield('245','a');
2066 # record control number, 001 with 003 and prefix
2068 if ($hostrecord->field('001')){
2069 $recctrlno = $hostrecord->field('001')->data();
2070 if ($hostrecord->field('003')){
2071 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
2076 my $issn = $hostrecord->subfield('022','a');
2077 my $isbn = $hostrecord->subfield('020','a');
2080 $hostmarcfield = MARC::Field->new(
2082 '0' => $hostbiblionumber,
2083 '9' => $hostitemnumber,
2093 } elsif ($marcflavour eq "UNIMARC") {
2094 $hostmarcfield = MARC::Field->new(
2096 '0' => $hostbiblionumber,
2097 't' => $hostrecord->subfield('200','a'),
2098 '9' => $hostitemnumber
2102 return $hostmarcfield;
2105 =head2 TransformHtmlToXml
2107 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
2108 $ind_tag, $auth_type )
2110 $auth_type contains :
2114 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
2116 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2118 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2124 sub TransformHtmlToXml {
2125 my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2126 # NOTE: The parameter $ind_tag is NOT USED -- BZ 11247
2128 my $xml = MARC::File::XML::header('UTF-8');
2129 $xml .= "<record>\n";
2130 $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2131 MARC::File::XML->default_record_format($auth_type);
2133 # in UNIMARC, field 100 contains the encoding
2134 # check that there is one, otherwise the
2135 # MARC::Record->new_from_xml will fail (and Koha will die)
2136 my $unimarc_and_100_exist = 0;
2137 $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
2143 for ( my $i = 0 ; $i < @$tags ; $i++ ) {
2145 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
2147 # if we have a 100 field and it's values are not correct, skip them.
2148 # if we don't have any valid 100 field, we will create a default one at the end
2149 my $enc = substr( @$values[$i], 26, 2 );
2150 if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2151 $unimarc_and_100_exist = 1;
2156 @$values[$i] =~ s/&/&/g;
2157 @$values[$i] =~ s/</</g;
2158 @$values[$i] =~ s/>/>/g;
2159 @$values[$i] =~ s/"/"/g;
2160 @$values[$i] =~ s/'/'/g;
2162 if ( ( @$tags[$i] ne $prevtag ) ) {
2163 $close_last_tag = 0;
2164 $j++ unless ( @$tags[$i] eq "" );
2165 my $str = ( $indicator->[$j] // q{} ) . ' '; # extra space prevents substr outside of string warn
2166 my $ind1 = _default_ind_to_space( substr( $str, 0, 1 ) );
2167 my $ind2 = _default_ind_to_space( substr( $str, 1, 1 ) );
2169 $xml .= "</datafield>\n";
2170 if ( ( @$tags[$i] && @$tags[$i] > 10 )
2171 && ( @$values[$i] ne "" ) ) {
2172 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2173 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2175 $close_last_tag = 1;
2180 if ( @$values[$i] ne "" ) {
2183 if ( @$tags[$i] eq "000" ) {
2184 $xml .= "<leader>@$values[$i]</leader>\n";
2187 # rest of the fixed fields
2188 } elsif ( @$tags[$i] < 10 ) {
2189 $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2192 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2193 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2195 $close_last_tag = 1;
2199 } else { # @$tags[$i] eq $prevtag
2200 if ( @$values[$i] eq "" ) {
2203 my $str = ( $indicator->[$j] // q{} ) . ' '; # extra space prevents substr outside of string warn
2204 my $ind1 = _default_ind_to_space( substr( $str, 0, 1 ) );
2205 my $ind2 = _default_ind_to_space( substr( $str, 1, 1 ) );
2206 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2208 $close_last_tag = 1;
2210 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2213 $prevtag = @$tags[$i];
2215 $xml .= "</datafield>\n" if $close_last_tag;
2216 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2218 # warn "SETTING 100 for $auth_type";
2219 my $string = strftime( "%Y%m%d", localtime(time) );
2221 # set 50 to position 26 is biblios, 13 if authorities
2223 $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2224 $string = sprintf( "%-*s", 35, $string );
2225 substr( $string, $pos, 6, "50" );
2226 $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2227 $xml .= "<subfield code=\"a\">$string</subfield>\n";
2228 $xml .= "</datafield>\n";
2230 $xml .= "</record>\n";
2231 $xml .= MARC::File::XML::footer();
2235 =head2 _default_ind_to_space
2237 Passed what should be an indicator returns a space
2238 if its undefined or zero length
2242 sub _default_ind_to_space {
2244 if ( !defined $s || $s eq q{} ) {
2250 =head2 TransformHtmlToMarc
2252 L<$record> = TransformHtmlToMarc(L<$cgi>)
2253 L<$cgi> is the CGI object which contains the values for subfields
2255 'tag_010_indicator1_531951' ,
2256 'tag_010_indicator2_531951' ,
2257 'tag_010_code_a_531951_145735' ,
2258 'tag_010_subfield_a_531951_145735' ,
2259 'tag_200_indicator1_873510' ,
2260 'tag_200_indicator2_873510' ,
2261 'tag_200_code_a_873510_673465' ,
2262 'tag_200_subfield_a_873510_673465' ,
2263 'tag_200_code_b_873510_704318' ,
2264 'tag_200_subfield_b_873510_704318' ,
2265 'tag_200_code_e_873510_280822' ,
2266 'tag_200_subfield_e_873510_280822' ,
2267 'tag_200_code_f_873510_110730' ,
2268 'tag_200_subfield_f_873510_110730' ,
2270 L<$record> is the MARC::Record object.
2274 sub TransformHtmlToMarc {
2275 my ($cgi, $isbiblio) = @_;
2277 my @params = $cgi->multi_param();
2279 # explicitly turn on the UTF-8 flag for all
2280 # 'tag_' parameters to avoid incorrect character
2281 # conversion later on
2282 my $cgi_params = $cgi->Vars;
2283 foreach my $param_name ( keys %$cgi_params ) {
2284 if ( $param_name =~ /^tag_/ ) {
2285 my $param_value = $cgi_params->{$param_name};
2286 unless ( Encode::is_utf8( $param_value ) ) {
2287 $cgi_params->{$param_name} = Encode::decode('UTF-8', $param_value );
2292 # creating a new record
2293 my $record = MARC::Record->new();
2295 my ($biblionumbertagfield, $biblionumbertagsubfield) = (-1, -1);
2296 ($biblionumbertagfield, $biblionumbertagsubfield) =
2297 &GetMarcFromKohaField( "biblio.biblionumber", '' ) if $isbiblio;
2298 #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!
2299 for (my $i = 0; $params[$i]; $i++ ) { # browse all CGI params
2300 my $param = $params[$i];
2303 # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2304 if ( $param eq 'biblionumber' ) {
2305 if ( $biblionumbertagfield < 10 ) {
2306 $newfield = MARC::Field->new( $biblionumbertagfield, scalar $cgi->param($param), );
2308 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => scalar $cgi->param($param), );
2310 push @fields, $newfield if ($newfield);
2311 } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) { # new field start when having 'input name="..._indicator1_..."
2314 my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2315 my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2319 if ( $tag < 10 ) { # no code for theses fields
2320 # in MARC editor, 000 contains the leader.
2321 next if $tag == $biblionumbertagfield;
2322 my $fval= $cgi->param($params[$j+1]);
2323 if ( $tag eq '000' ) {
2324 # Force a fake leader even if not provided to avoid crashing
2325 # during decoding MARC record containing UTF-8 characters
2327 length( $fval ) == 24
2332 # between 001 and 009 (included)
2333 } elsif ( $fval ne '' ) {
2334 $newfield = MARC::Field->new( $tag, $fval, );
2337 # > 009, deal with subfields
2339 # browse subfields for this tag (reason for _code_ match)
2340 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2341 last unless defined $params[$j+1];
2343 if $tag == $biblionumbertagfield and
2344 $cgi->param($params[$j]) eq $biblionumbertagsubfield;
2345 #if next param ne subfield, then it was probably empty
2346 #try next param by incrementing j
2347 if($params[$j+1]!~/_subfield_/) {$j++; next; }
2348 my $fkey= $cgi->param($params[$j]);
2349 my $fval= $cgi->param($params[$j+1]);
2350 #check if subfield value not empty and field exists
2351 if($fval ne '' && $newfield) {
2352 $newfield->add_subfields( $fkey => $fval);
2354 elsif($fval ne '') {
2355 $newfield = MARC::Field->new( $tag, $ind1, $ind2, $fkey => $fval );
2359 $i= $j-1; #update i for outer loop accordingly
2361 push @fields, $newfield if ($newfield);
2365 @fields = sort { $a->tag() cmp $b->tag() } @fields;
2366 $record->append_fields(@fields);
2370 =head2 TransformMarcToKoha
2372 $result = TransformMarcToKoha( $record, undef, $limit )
2374 Extract data from a MARC bib record into a hashref representing
2375 Koha biblio, biblioitems, and items fields.
2377 If passed an undefined record will log the error and return an empty
2382 sub TransformMarcToKoha {
2383 my ( $record, $frameworkcode, $limit_table ) = @_;
2384 # FIXME Parameter $frameworkcode is obsolete and will be removed
2385 $limit_table //= q{};
2388 if (!defined $record) {
2389 carp('TransformMarcToKoha called with undefined record');
2393 my %tables = ( biblio => 1, biblioitems => 1, items => 1 );
2394 if( $limit_table eq 'items' ) {
2395 %tables = ( items => 1 );
2398 # The next call acknowledges Default as the authoritative framework
2399 # for Koha to MARC mappings.
2400 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
2401 foreach my $kohafield ( keys %{ $mss } ) {
2402 my ( $table, $column ) = split /[.]/, $kohafield, 2;
2403 next unless $tables{$table};
2404 my $val = TransformMarcToKohaOneField( $kohafield, $record );
2405 next if !defined $val;
2406 my $key = _disambiguate( $table, $column );
2407 $result->{$key} = $val;
2412 =head2 _disambiguate
2414 $newkey = _disambiguate($table, $field);
2416 This is a temporary hack to distinguish between the
2417 following sets of columns when using TransformMarcToKoha.
2419 items.cn_source & biblioitems.cn_source
2420 items.cn_sort & biblioitems.cn_sort
2422 Columns that are currently NOT distinguished (FIXME
2423 due to lack of time to fully test) are:
2425 biblio.notes and biblioitems.notes
2430 FIXME - this is necessary because prefixing each column
2431 name with the table name would require changing lots
2432 of code and templates, and exposing more of the DB
2433 structure than is good to the UI templates, particularly
2434 since biblio and bibloitems may well merge in a future
2435 version. In the future, it would also be good to
2436 separate DB access and UI presentation field names
2442 my ( $table, $column ) = @_;
2443 if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2444 return $table . '.' . $column;
2451 =head2 TransformMarcToKohaOneField
2453 $val = TransformMarcToKohaOneField( 'biblio.title', $marc );
2455 Note: The authoritative Default framework is used implicitly.
2459 sub TransformMarcToKohaOneField {
2460 my ( $kohafield, $marc ) = @_;
2462 my ( @rv, $retval );
2463 my @mss = GetMarcSubfieldStructureFromKohaField($kohafield);
2464 foreach my $fldhash ( @mss ) {
2465 my $tag = $fldhash->{tagfield};
2466 my $sub = $fldhash->{tagsubfield};
2467 foreach my $fld ( $marc->field($tag) ) {
2468 if( $sub eq '@' || $fld->is_control_field ) {
2469 push @rv, $fld->data if $fld->data;
2471 push @rv, grep { $_ } $fld->subfield($sub);
2476 $retval = join ' | ', uniq(@rv);
2478 # Additional polishing for individual kohafields
2479 if( $kohafield =~ /copyrightdate|publicationyear/ ) {
2480 $retval = _adjust_pubyear( $retval );
2486 =head2 _adjust_pubyear
2488 Helper routine for TransformMarcToKohaOneField
2492 sub _adjust_pubyear {
2494 # modify return value to keep only the 1st year found
2495 if( $retval =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2497 } elsif( $retval =~ m/(\d\d\d\d)/ && $1 > 0 ) {
2499 } elsif( $retval =~ m/
2500 (?<year>\d)[-]?[.Xx?]{3}
2501 |(?<year>\d{2})[.Xx?]{2}
2502 |(?<year>\d{3})[.Xx?]
2503 |(?<year>\d)[-]{3}\?
2504 |(?<year>\d\d)[-]{2}\?
2505 |(?<year>\d{3})[-]\?
2506 /xms ) { # the form 198-? occurred in Dutch ISBD rules
2507 my $digits = $+{year};
2508 $retval = $digits * ( 10 ** ( 4 - length($digits) ));
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( $biblionumber, $op, $server, $record );
2532 $biblionumber is the biblionumber we want to index
2534 $op is specialUpdate or recordDelete, and is used to know what we want to do
2536 $server is the server that we want to update
2538 $record is the update MARC record if it's available. If it's not supplied
2539 and is needed, it'll be loaded from the database.
2544 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2545 my ( $biblionumber, $op, $server, $record ) = @_;
2546 $debug && warn "ModZebra: update requested for: $biblionumber $op $server\n";
2547 if ( C4::Context->preference('SearchEngine') eq 'Elasticsearch' ) {
2549 # TODO abstract to a standard API that'll work for whatever
2550 require Koha::SearchEngine::Elasticsearch::Indexer;
2551 my $indexer = Koha::SearchEngine::Elasticsearch::Indexer->new(
2553 index => $server eq 'biblioserver'
2554 ? $Koha::SearchEngine::BIBLIOS_INDEX
2555 : $Koha::SearchEngine::AUTHORITIES_INDEX
2558 if ( $op eq 'specialUpdate' ) {
2560 $record = GetMarcBiblio({
2561 biblionumber => $biblionumber,
2562 embed_items => 1 });
2564 my $records = [$record];
2565 $indexer->update_index_background( [$biblionumber], [$record] );
2567 elsif ( $op eq 'recordDelete' ) {
2568 $indexer->delete_index_background( [$biblionumber] );
2571 croak "ModZebra called with unknown operation: $op";
2575 my $dbh = C4::Context->dbh;
2577 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2579 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2580 # the table is emptied by rebuild_zebra.pl script (using the -z switch)
2581 my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2583 AND biblio_auth_number = ?
2586 my $check_sth = $dbh->prepare_cached($check_sql);
2587 $check_sth->execute( $server, $biblionumber, $op );
2588 my ($count) = $check_sth->fetchrow_array;
2589 $check_sth->finish();
2590 if ( $count == 0 ) {
2591 my $sth = $dbh->prepare("INSERT INTO zebraqueue (biblio_auth_number,server,operation) VALUES(?,?,?)");
2592 $sth->execute( $biblionumber, $server, $op );
2598 =head2 EmbedItemsInMarcBiblio
2600 EmbedItemsInMarcBiblio({
2601 marc_record => $marc,
2602 biblionumber => $biblionumber,
2603 item_numbers => $itemnumbers,
2606 Given a MARC::Record object containing a bib record,
2607 modify it to include the items attached to it as 9XX
2608 per the bib's MARC framework.
2609 if $itemnumbers is defined, only specified itemnumbers are embedded.
2611 If $opac is true, then opac-relevant suppressions are included.
2613 If opac filtering will be done, borcat should be passed to properly
2614 override if necessary.
2618 sub EmbedItemsInMarcBiblio {
2620 my ($marc, $biblionumber, $itemnumbers, $opac, $borcat);
2621 $marc = $params->{marc_record};
2623 carp 'EmbedItemsInMarcBiblio: No MARC record passed';
2626 $biblionumber = $params->{biblionumber};
2627 $itemnumbers = $params->{item_numbers};
2628 $opac = $params->{opac};
2629 $borcat = $params->{borcat} // q{};
2631 $itemnumbers = [] unless defined $itemnumbers;
2633 my $frameworkcode = GetFrameworkCode($biblionumber);
2634 _strip_item_fields($marc, $frameworkcode);
2636 # ... and embed the current items
2637 my $dbh = C4::Context->dbh;
2638 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2639 $sth->execute($biblionumber);
2640 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber" );
2642 my @item_fields; # Array holding the actual MARC data for items to be included.
2643 my @items; # Array holding items which are both in the list (sitenumbers)
2644 # and on this biblionumber
2646 # Flag indicating if there is potential hiding.
2647 my $opachiddenitems = $opac
2648 && ( C4::Context->preference('OpacHiddenItems') !~ /^\s*$/ );
2651 while ( my ($itemnumber) = $sth->fetchrow_array ) {
2652 next if @$itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers;
2654 if ( $opachiddenitems ) {
2655 $item = Koha::Items->find($itemnumber);
2656 $item = $item ? $item->unblessed : undef;
2658 push @items, { itemnumber => $itemnumber, item => $item };
2660 my @items2pass = map { $_->{item} } @items;
2663 ? C4::Items::GetHiddenItemnumbers({
2664 items => \@items2pass,
2665 borcat => $borcat })
2667 # Convert to a hash for quick searching
2668 my %hiddenitems = map { $_ => 1 } @hiddenitems;
2669 foreach my $itemnumber ( map { $_->{itemnumber} } @items ) {
2670 next if $hiddenitems{$itemnumber};
2671 my $item_marc = C4::Items::GetMarcItem( $biblionumber, $itemnumber );
2672 push @item_fields, $item_marc->field($itemtag);
2674 $marc->append_fields(@item_fields);
2677 =head1 INTERNAL FUNCTIONS
2679 =head2 _koha_marc_update_bib_ids
2682 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2684 Internal function to add or update biblionumber and biblioitemnumber to
2689 sub _koha_marc_update_bib_ids {
2690 my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
2692 my ( $biblio_tag, $biblio_subfield ) = GetMarcFromKohaField( "biblio.biblionumber" );
2693 die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
2694 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber" );
2695 die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
2697 if ( $biblio_tag < 10 ) {
2698 C4::Biblio::UpsertMarcControlField( $record, $biblio_tag, $biblionumber );
2700 C4::Biblio::UpsertMarcSubfield($record, $biblio_tag, $biblio_subfield, $biblionumber);
2702 if ( $biblioitem_tag < 10 ) {
2703 C4::Biblio::UpsertMarcControlField( $record, $biblioitem_tag, $biblioitemnumber );
2705 C4::Biblio::UpsertMarcSubfield($record, $biblioitem_tag, $biblioitem_subfield, $biblioitemnumber);
2709 =head2 _koha_marc_update_biblioitem_cn_sort
2711 _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
2713 Given a MARC bib record and the biblioitem hash, update the
2714 subfield that contains a copy of the value of biblioitems.cn_sort.
2718 sub _koha_marc_update_biblioitem_cn_sort {
2720 my $biblioitem = shift;
2721 my $frameworkcode = shift;
2723 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort" );
2724 return unless $biblioitem_tag;
2726 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2728 if ( my $field = $marc->field($biblioitem_tag) ) {
2729 $field->delete_subfield( code => $biblioitem_subfield );
2730 if ( $cn_sort ne '' ) {
2731 $field->add_subfields( $biblioitem_subfield => $cn_sort );
2735 # if we get here, no biblioitem tag is present in the MARC record, so
2736 # we'll create it if $cn_sort is not empty -- this would be
2737 # an odd combination of events, however
2739 $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
2744 =head2 _koha_add_biblio
2746 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
2748 Internal function to add a biblio ($biblio is a hash with the values)
2752 sub _koha_add_biblio {
2753 my ( $dbh, $biblio, $frameworkcode ) = @_;
2757 # set the series flag
2758 unless (defined $biblio->{'serial'}){
2759 $biblio->{'serial'} = 0;
2760 if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
2763 my $query = "INSERT INTO biblio
2764 SET frameworkcode = ?,
2779 my $sth = $dbh->prepare($query);
2781 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'subtitle'},
2782 $biblio->{'medium'}, $biblio->{'part_number'}, $biblio->{'part_name'}, $biblio->{'unititle'},
2783 $biblio->{'notes'}, $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'},
2784 $biblio->{'abstract'}
2787 my $biblionumber = $dbh->{'mysql_insertid'};
2788 if ( $dbh->errstr ) {
2789 $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
2795 #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
2796 return ( $biblionumber, $error );
2799 =head2 _koha_modify_biblio
2801 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
2803 Internal function for updating the biblio table
2807 sub _koha_modify_biblio {
2808 my ( $dbh, $biblio, $frameworkcode ) = @_;
2813 SET frameworkcode = ?,
2826 WHERE biblionumber = ?
2829 my $sth = $dbh->prepare($query);
2832 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'subtitle'},
2833 $biblio->{'medium'}, $biblio->{'part_number'}, $biblio->{'part_name'}, $biblio->{'unititle'},
2834 $biblio->{'notes'}, $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'} ? int($biblio->{'copyrightdate'}) : undef,
2835 $biblio->{'abstract'}, $biblio->{'biblionumber'}
2836 ) if $biblio->{'biblionumber'};
2838 if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
2839 $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
2842 return ( $biblio->{'biblionumber'}, $error );
2845 =head2 _koha_modify_biblioitem_nonmarc
2847 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
2851 sub _koha_modify_biblioitem_nonmarc {
2852 my ( $dbh, $biblioitem ) = @_;
2855 # re-calculate the cn_sort, it may have changed
2856 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2858 my $query = "UPDATE biblioitems
2859 SET biblionumber = ?,
2865 publicationyear = ?,
2869 collectiontitle = ?,
2871 collectionvolume= ?,
2872 editionstatement= ?,
2873 editionresponsibility = ?,
2889 where biblioitemnumber = ?
2891 my $sth = $dbh->prepare($query);
2893 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
2894 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
2895 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
2896 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
2897 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
2898 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
2899 $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort, $biblioitem->{'totalissues'},
2900 $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}, $biblioitem->{'biblioitemnumber'}
2902 if ( $dbh->errstr ) {
2903 $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
2906 return ( $biblioitem->{'biblioitemnumber'}, $error );
2909 =head2 _koha_add_biblioitem
2911 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
2913 Internal function to add a biblioitem
2917 sub _koha_add_biblioitem {
2918 my ( $dbh, $biblioitem ) = @_;
2921 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2922 my $query = "INSERT INTO biblioitems SET
2929 publicationyear = ?,
2933 collectiontitle = ?,
2935 collectionvolume= ?,
2936 editionstatement= ?,
2937 editionresponsibility = ?,
2954 my $sth = $dbh->prepare($query);
2956 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
2957 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
2958 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
2959 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
2960 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
2961 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'},
2962 $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort,
2963 $biblioitem->{'totalissues'}, $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}
2965 my $bibitemnum = $dbh->{'mysql_insertid'};
2967 if ( $dbh->errstr ) {
2968 $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
2972 return ( $bibitemnum, $error );
2975 =head2 _koha_delete_biblio
2977 $error = _koha_delete_biblio($dbh,$biblionumber);
2979 Internal sub for deleting from biblio table -- also saves to deletedbiblio
2981 C<$dbh> - the database handle
2983 C<$biblionumber> - the biblionumber of the biblio to be deleted
2987 # FIXME: add error handling
2989 sub _koha_delete_biblio {
2990 my ( $dbh, $biblionumber ) = @_;
2992 # get all the data for this biblio
2993 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
2994 $sth->execute($biblionumber);
2996 # FIXME There is a transaction in _koha_delete_biblio_metadata
2997 # But actually all the following should be done inside a single transaction
2998 if ( my $data = $sth->fetchrow_hashref ) {
3000 # save the record in deletedbiblio
3001 # find the fields to save
3002 my $query = "INSERT INTO deletedbiblio SET ";
3004 foreach my $temp ( keys %$data ) {
3005 $query .= "$temp = ?,";
3006 push( @bind, $data->{$temp} );
3009 # replace the last , by ",?)"
3011 my $bkup_sth = $dbh->prepare($query);
3012 $bkup_sth->execute(@bind);
3015 _koha_delete_biblio_metadata( $biblionumber );
3018 my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3019 $sth2->execute($biblionumber);
3020 # update the timestamp (Bugzilla 7146)
3021 $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
3022 $sth2->execute($biblionumber);
3029 =head2 _koha_delete_biblioitems
3031 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3033 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3035 C<$dbh> - the database handle
3036 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3040 # FIXME: add error handling
3042 sub _koha_delete_biblioitems {
3043 my ( $dbh, $biblioitemnumber ) = @_;
3045 # get all the data for this biblioitem
3046 my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3047 $sth->execute($biblioitemnumber);
3049 if ( my $data = $sth->fetchrow_hashref ) {
3051 # save the record in deletedbiblioitems
3052 # find the fields to save
3053 my $query = "INSERT INTO deletedbiblioitems SET ";
3055 foreach my $temp ( keys %$data ) {
3056 $query .= "$temp = ?,";
3057 push( @bind, $data->{$temp} );
3060 # replace the last , by ",?)"
3062 my $bkup_sth = $dbh->prepare($query);
3063 $bkup_sth->execute(@bind);
3066 # delete the biblioitem
3067 my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3068 $sth2->execute($biblioitemnumber);
3069 # update the timestamp (Bugzilla 7146)
3070 $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
3071 $sth2->execute($biblioitemnumber);
3078 =head2 _koha_delete_biblio_metadata
3080 $error = _koha_delete_biblio_metadata($biblionumber);
3082 C<$biblionumber> - the biblionumber of the biblio metadata to be deleted
3086 sub _koha_delete_biblio_metadata {
3087 my ($biblionumber) = @_;
3089 my $dbh = C4::Context->dbh;
3090 my $schema = Koha::Database->new->schema;
3094 INSERT INTO deletedbiblio_metadata (biblionumber, format, `schema`, metadata)
3095 SELECT biblionumber, format, `schema`, metadata FROM biblio_metadata WHERE biblionumber=?
3096 |, undef, $biblionumber );
3097 $dbh->do( q|DELETE FROM biblio_metadata WHERE biblionumber=?|,
3098 undef, $biblionumber );
3103 =head1 UNEXPORTED FUNCTIONS
3105 =head2 ModBiblioMarc
3107 &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3109 Add MARC XML data for a biblio to koha
3111 Function exported, but should NOT be used, unless you really know what you're doing
3116 # pass the MARC::Record to this function, and it will create the records in
3118 my ( $record, $biblionumber, $frameworkcode ) = @_;
3120 carp 'ModBiblioMarc passed an undefined record';
3124 # Clone record as it gets modified
3125 $record = $record->clone();
3126 my $dbh = C4::Context->dbh;
3127 my @fields = $record->fields();
3128 if ( !$frameworkcode ) {
3129 $frameworkcode = "";
3131 my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3132 $sth->execute( $frameworkcode, $biblionumber );
3134 my $encoding = C4::Context->preference("marcflavour");
3136 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3137 if ( $encoding eq "UNIMARC" ) {
3138 my $defaultlanguage = C4::Context->preference("UNIMARCField100Language");
3139 $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
3140 my $string = $record->subfield( 100, "a" );
3141 if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3142 my $f100 = $record->field(100);
3143 $record->delete_field($f100);
3145 $string = POSIX::strftime( "%Y%m%d", localtime );
3147 $string = sprintf( "%-*s", 35, $string );
3148 substr ( $string, 22, 3, $defaultlanguage);
3150 substr( $string, 25, 3, "y50" );
3151 unless ( $record->subfield( 100, "a" ) ) {
3152 $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
3156 #enhancement 5374: update transaction date (005) for marc21/unimarc
3157 if($encoding =~ /MARC21|UNIMARC/) {
3158 my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3159 # YY MM DD HH MM SS (update year and month)
3160 my $f005= $record->field('005');
3161 $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3165 biblionumber => $biblionumber,
3166 format => 'marcxml',
3167 schema => C4::Context->preference('marcflavour'),
3169 $record->as_usmarc; # Bug 20126/10455 This triggers field length calculation
3171 my $m_rs = Koha::Biblio::Metadatas->find($metadata) //
3172 Koha::Biblio::Metadata->new($metadata);
3174 my $userenv = C4::Context->userenv;
3176 my $borrowernumber = $userenv->{number};
3177 my $borrowername = join ' ', map { $_ // q{} } @$userenv{qw(firstname surname)};
3178 unless ($m_rs->in_storage) {
3179 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorId'), $borrowernumber);
3180 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorName'), $borrowername);
3182 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierId'), $borrowernumber);
3183 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierName'), $borrowername);
3186 $m_rs->metadata( $record->as_xml_record($encoding) );
3189 ModZebra( $biblionumber, "specialUpdate", "biblioserver" );
3191 return $biblionumber;
3194 =head2 prepare_host_field
3196 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
3197 Generate the host item entry for an analytic child entry
3201 sub prepare_host_field {
3202 my ( $hostbiblio, $marcflavour ) = @_;
3203 $marcflavour ||= C4::Context->preference('marcflavour');
3204 my $host = GetMarcBiblio({ biblionumber => $hostbiblio });
3205 # unfortunately as_string does not 'do the right thing'
3206 # if field returns undef
3210 if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
3211 if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
3212 my $s = $field->as_string('ab');
3217 if ( $field = $host->field('245') ) {
3218 my $s = $field->as_string('a');
3223 if ( $field = $host->field('260') ) {
3224 my $s = $field->as_string('abc');
3229 if ( $field = $host->field('240') ) {
3230 my $s = $field->as_string();
3235 if ( $field = $host->field('022') ) {
3236 my $s = $field->as_string('a');
3241 if ( $field = $host->field('020') ) {
3242 my $s = $field->as_string('a');
3247 if ( $field = $host->field('001') ) {
3248 $sfd{w} = $field->data(),;
3250 $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
3253 elsif ( $marcflavour eq 'UNIMARC' ) {
3255 if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3256 my $s = $field->as_string('ab');
3262 if ( $field = $host->field('200') ) {
3263 my $s = $field->as_string('a');
3268 #place of publicaton
3269 if ( $field = $host->field('210') ) {
3270 my $s = $field->as_string('a');
3275 #date of publication
3276 if ( $field = $host->field('210') ) {
3277 my $s = $field->as_string('d');
3283 if ( $field = $host->field('205') ) {
3284 my $s = $field->as_string();
3290 if ( $field = $host->field('856') ) {
3291 my $s = $field->as_string('u');
3297 if ( $field = $host->field('011') ) {
3298 my $s = $field->as_string('a');
3304 if ( $field = $host->field('010') ) {
3305 my $s = $field->as_string('a');
3310 if ( $field = $host->field('001') ) {
3311 $sfd{0} = $field->data(),;
3313 $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
3320 =head2 UpdateTotalIssues
3322 UpdateTotalIssues($biblionumber, $increase, [$value])
3324 Update the total issue count for a particular bib record.
3328 =item C<$biblionumber> is the biblionumber of the bib to update
3330 =item C<$increase> is the amount to increase (or decrease) the total issues count by
3332 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
3338 sub UpdateTotalIssues {
3339 my ($biblionumber, $increase, $value) = @_;
3342 my $record = GetMarcBiblio({ biblionumber => $biblionumber });
3344 carp "UpdateTotalIssues could not get biblio record";
3347 my $biblio = Koha::Biblios->find( $biblionumber );
3349 carp "UpdateTotalIssues could not get datas of biblio";
3352 my $biblioitem = $biblio->biblioitem;
3353 my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField( 'biblioitems.totalissues' );
3354 unless ($totalissuestag) {
3355 return 1; # There is nothing to do
3358 if (defined $value) {
3359 $totalissues = $value;
3361 $totalissues = $biblioitem->totalissues + $increase;
3364 my $field = $record->field($totalissuestag);
3365 if (defined $field) {
3366 $field->update( $totalissuessubfield => $totalissues );
3368 $field = MARC::Field->new($totalissuestag, '0', '0',
3369 $totalissuessubfield => $totalissues);
3370 $record->insert_grouped_field($field);
3373 return ModBiblio($record, $biblionumber, $biblio->frameworkcode);
3378 &RemoveAllNsb($record);
3380 Removes all nsb/nse chars from a record
3387 carp 'RemoveAllNsb called with undefined record';
3391 SetUTF8Flag($record);
3393 foreach my $field ($record->fields()) {
3394 if ($field->is_control_field()) {
3395 $field->update(nsb_clean($field->data()));
3397 my @subfields = $field->subfields();
3399 foreach my $subfield (@subfields) {
3400 push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
3402 if (scalar(@new_subfields) > 0) {
3405 $new_field = MARC::Field->new(
3407 $field->indicator(1),
3408 $field->indicator(2),
3413 warn "error in RemoveAllNsb : $@";
3415 $field->replace_with($new_field);
3427 =head2 _after_biblio_action_hooks
3429 Helper method that takes care of calling all plugin hooks
3433 sub _after_biblio_action_hooks {
3436 my $biblio_id = $args->{biblio_id};
3437 my $action = $args->{action};
3439 if ( C4::Context->preference('UseKohaPlugins') && C4::Context->config("enable_plugins") ) {
3441 my @plugins = Koha::Plugins->new->GetPlugins({
3442 method => 'after_biblio_action',
3447 my $biblio = Koha::Biblios->find( $biblio_id );
3449 foreach my $plugin ( @plugins ) {
3451 $plugin->after_biblio_action({ action => $action, biblio => $biblio, biblio_id => $biblio_id });
3465 Koha Development Team <http://koha-community.org/>
3467 Paul POULAIN paul.poulain@free.fr
3469 Joshua Ferraro jmf@liblime.com