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);
49 GetAuthorisedValueDesc
51 IsMarcStructureInternal
53 GetMarcSubfieldStructureFromKohaField
65 LinkBibHeadingsToAuthorities
73 # those functions are exported but should not be used
74 # they are useful in a few circumstances, so they are exported,
75 # but don't use them unless you are a core developer ;-)
83 use Encode qw( decode is_utf8 );
84 use List::MoreUtils qw( uniq );
86 use MARC::File::USMARC;
88 use POSIX qw(strftime);
89 use Module::Load::Conditional qw(can_load);
92 use C4::Log; # logaction
101 use Koha::Authority::Types;
102 use Koha::Acquisition::Currencies;
103 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 logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
237 return ( $biblionumber, $biblioitemnumber );
242 ModBiblio( $record,$biblionumber,$frameworkcode, $disable_autolink);
244 Replace an existing bib record identified by C<$biblionumber>
245 with one supplied by the MARC::Record object C<$record>. The embedded
246 item, biblioitem, and biblionumber fields from the previous
247 version of the bib record replace any such fields of those tags that
248 are present in C<$record>. Consequently, ModBiblio() is not
249 to be used to try to modify item records.
251 C<$frameworkcode> specifies the MARC framework to use
252 when storing the modified bib record; among other things,
253 this controls how MARC fields get mapped to display columns
254 in the C<biblio> and C<biblioitems> tables, as well as
255 which fields are used to store embedded item, biblioitem,
256 and biblionumber data for indexing.
258 Unless C<$disable_autolink> is passed ModBiblio will relink record headings
259 to authorities based on settings in the system preferences. This flag allows
260 us to not relink records when the authority linker is saving modifications.
262 Returns 1 on success 0 on failure
267 my ( $record, $biblionumber, $frameworkcode, $disable_autolink ) = @_;
269 carp 'No record passed to ModBiblio';
273 if ( C4::Context->preference("CataloguingLog") ) {
274 my $newrecord = GetMarcBiblio({ biblionumber => $biblionumber });
275 logaction( "CATALOGUING", "MODIFY", $biblionumber, "biblio BEFORE=>" . $newrecord->as_formatted );
278 if ( !$disable_autolink && C4::Context->preference('BiblioAddsAuthorities') ) {
279 BiblioAutoLink( $record, $frameworkcode );
282 # Cleaning up invalid fields must be done early or SetUTF8Flag is liable to
283 # throw an exception which probably won't be handled.
284 foreach my $field ($record->fields()) {
285 if (! $field->is_control_field()) {
286 if (scalar($field->subfields()) == 0 || (scalar($field->subfields()) == 1 && $field->subfield('9'))) {
287 $record->delete_field($field);
292 SetUTF8Flag($record);
293 my $dbh = C4::Context->dbh;
295 $frameworkcode = "" if !$frameworkcode || $frameworkcode eq "Default"; # XXX
297 _strip_item_fields($record, $frameworkcode);
299 # update biblionumber and biblioitemnumber in MARC
300 # FIXME - this is assuming a 1 to 1 relationship between
301 # biblios and biblioitems
302 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
303 $sth->execute($biblionumber);
304 my ($biblioitemnumber) = $sth->fetchrow;
306 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
308 # load the koha-table data object
309 my $oldbiblio = TransformMarcToKoha( $record, $frameworkcode );
311 # update MARC subfield that stores biblioitems.cn_sort
312 _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode );
314 # update the MARC record (that now contains biblio and items) with the new record data
315 &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
317 # modify the other koha tables
318 _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
319 _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
321 # update OAI-PMH sets
322 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
323 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
329 =head2 _strip_item_fields
331 _strip_item_fields($record, $frameworkcode)
333 Utility routine to remove item tags from a
338 sub _strip_item_fields {
340 my $frameworkcode = shift;
341 # get the items before and append them to the biblio before updating the record, atm we just have the biblio
342 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
344 # delete any item fields from incoming record to avoid
345 # duplication or incorrect data - use AddItem() or ModItem()
347 foreach my $field ( $record->field($itemtag) ) {
348 $record->delete_field($field);
354 my $error = &DelBiblio($biblionumber);
356 Exported function (core API) for deleting a biblio in koha.
357 Deletes biblio record from Zebra and Koha tables (biblio & biblioitems)
358 Also backs it up to deleted* tables.
359 Checks to make sure that the biblio has no items attached.
361 C<$error> : undef unless an error occurs
366 my ($biblionumber) = @_;
368 my $biblio = Koha::Biblios->find( $biblionumber );
369 return unless $biblio; # Should we throw an exception instead?
371 my $dbh = C4::Context->dbh;
372 my $error; # for error handling
374 # First make sure this biblio has no items attached
375 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
376 $sth->execute($biblionumber);
377 if ( my $itemnumber = $sth->fetchrow ) {
379 # Fix this to use a status the template can understand
380 $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
383 return $error if $error;
385 # We delete attached subscriptions
387 my $subscriptions = C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
388 foreach my $subscription (@$subscriptions) {
389 C4::Serials::DelSubscription( $subscription->{subscriptionid} );
392 # We delete any existing holds
393 my $holds = $biblio->holds;
394 while ( my $hold = $holds->next ) {
398 # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
399 # for at least 2 reasons :
400 # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
401 # 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)
402 ModZebra( $biblionumber, "recordDelete", "biblioserver" );
404 # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
405 $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
406 $sth->execute($biblionumber);
407 while ( my $biblioitemnumber = $sth->fetchrow ) {
409 # delete this biblioitem
410 $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
411 return $error if $error;
415 # delete biblio from Koha tables and save in deletedbiblio
416 # must do this *after* _koha_delete_biblioitems, otherwise
417 # delete cascade will prevent deletedbiblioitems rows
418 # from being generated by _koha_delete_biblioitems
419 $error = _koha_delete_biblio( $dbh, $biblionumber );
421 logaction( "CATALOGUING", "DELETE", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
427 =head2 BiblioAutoLink
429 my $headings_linked = BiblioAutoLink($record, $frameworkcode)
431 Automatically links headings in a bib record to authorities.
433 Returns the number of headings changed
439 my $frameworkcode = shift;
441 carp('Undefined record passed to BiblioAutoLink');
444 my ( $num_headings_changed, %results );
447 "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
448 unless ( can_load( modules => { $linker_module => undef } ) ) {
449 $linker_module = 'C4::Linker::Default';
450 unless ( can_load( modules => { $linker_module => undef } ) ) {
455 my $linker = $linker_module->new(
456 { 'options' => C4::Context->preference("LinkerOptions") } );
457 my ( $headings_changed, undef ) =
458 LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, C4::Context->preference("CatalogModuleRelink") || '' );
459 # By default we probably don't want to relink things when cataloging
460 return $headings_changed;
463 =head2 LinkBibHeadingsToAuthorities
465 my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink]);
467 Links bib headings to authority records by checking
468 each authority-controlled field in the C<MARC::Record>
469 object C<$marc>, looking for a matching authority record,
470 and setting the linking subfield $9 to the ID of that
473 If $allowrelink is false, existing authids will never be
474 replaced, regardless of the values of LinkerKeepStale and
477 Returns the number of heading links changed in the
482 sub LinkBibHeadingsToAuthorities {
485 my $frameworkcode = shift;
486 my $allowrelink = shift;
489 carp 'LinkBibHeadingsToAuthorities called on undefined bib record';
493 require C4::AuthoritiesMarc;
495 $allowrelink = 1 unless defined $allowrelink;
496 my $num_headings_changed = 0;
497 foreach my $field ( $bib->fields() ) {
498 my $heading = C4::Heading->new_from_bib_field( $field, $frameworkcode );
499 next unless defined $heading;
502 my $current_link = $field->subfield('9');
504 if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) )
506 $results{'linked'}->{ $heading->display_form() }++;
510 my ( $authid, $fuzzy ) = $linker->get_link($heading);
512 $results{ $fuzzy ? 'fuzzy' : 'linked' }
513 ->{ $heading->display_form() }++;
514 next if defined $current_link and $current_link == $authid;
516 $field->delete_subfield( code => '9' ) if defined $current_link;
517 $field->add_subfields( '9', $authid );
518 $num_headings_changed++;
521 if ( defined $current_link
522 && (!$allowrelink || C4::Context->preference('LinkerKeepStale')) )
524 $results{'fuzzy'}->{ $heading->display_form() }++;
526 elsif ( C4::Context->preference('AutoCreateAuthorities') ) {
527 if ( _check_valid_auth_link( $current_link, $field ) ) {
528 $results{'linked'}->{ $heading->display_form() }++;
531 my $authority_type = Koha::Authority::Types->find( $heading->auth_type() );
532 my $marcrecordauth = MARC::Record->new();
533 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
534 $marcrecordauth->leader(' nz a22 o 4500');
535 SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
537 $field->delete_subfield( code => '9' )
538 if defined $current_link;
540 MARC::Field->new( $authority_type->auth_tag_to_report,
541 '', '', "a" => "" . $field->subfield('a') );
543 $authfield->add_subfields( $_->[0] => $_->[1] )
544 if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a"
545 && C4::Heading::valid_bib_heading_subfield(
546 $authority_type->auth_tag_to_report, $_->[0] )
548 } $field->subfields();
549 $marcrecordauth->insert_fields_ordered($authfield);
551 # bug 2317: ensure new authority knows it's using UTF-8; currently
552 # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
553 # automatically for UNIMARC (by not transcoding)
554 # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
555 # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
556 # of change to a core API just before the 3.0 release.
558 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
559 my $userenv = C4::Context->userenv;
561 if ( $userenv && $userenv->{'branch'} ) {
562 $library = Koha::Libraries->find( $userenv->{'branch'} );
564 $marcrecordauth->insert_fields_ordered(
567 'a' => "Machine generated authority record."
571 $bib->author() . ", "
572 . $bib->title_proper() . ", "
573 . $bib->publication_date() . " ";
574 $cite =~ s/^[\s\,]*//;
575 $cite =~ s/[\s\,]*$//;
578 . ( $library ? $library->get_effective_marcorgcode : C4::Context->preference('MARCOrgCode') ) . ")"
579 . $bib->subfield( '999', 'c' ) . ": "
581 $marcrecordauth->insert_fields_ordered(
582 MARC::Field->new( '670', '', '', 'a' => $cite ) );
585 # warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
588 C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '',
589 $heading->auth_type() );
590 $field->add_subfields( '9', $authid );
591 $num_headings_changed++;
592 $linker->update_cache($heading, $authid);
593 $results{'added'}->{ $heading->display_form() }++;
596 elsif ( defined $current_link ) {
597 if ( _check_valid_auth_link( $current_link, $field ) ) {
598 $results{'linked'}->{ $heading->display_form() }++;
601 $field->delete_subfield( code => '9' );
602 $num_headings_changed++;
603 $results{'unlinked'}->{ $heading->display_form() }++;
607 $results{'unlinked'}->{ $heading->display_form() }++;
612 return $num_headings_changed, \%results;
615 =head2 _check_valid_auth_link
617 if ( _check_valid_auth_link($authid, $field) ) {
621 Check whether the specified heading-auth link is valid without reference
622 to Zebra. Ideally this code would be in C4::Heading, but that won't be
623 possible until we have de-cycled C4::AuthoritiesMarc, so this is the
628 sub _check_valid_auth_link {
629 my ( $authid, $field ) = @_;
630 require C4::AuthoritiesMarc;
632 my $authorized_heading =
633 C4::AuthoritiesMarc::GetAuthorizedHeading( { 'authid' => $authid } ) || '';
634 return ($field->as_string('abcdefghijklmnopqrstuvwxyz') eq $authorized_heading);
637 =head2 GetRecordValue
639 my $values = GetRecordValue($field, $record, $frameworkcode);
641 Get MARC fields from a keyword defined in fieldmapping table.
646 my ( $field, $record, $frameworkcode ) = @_;
649 carp 'GetRecordValue called with undefined record';
652 my $dbh = C4::Context->dbh;
654 my $sth = $dbh->prepare('SELECT fieldcode, subfieldcode FROM fieldmapping WHERE frameworkcode = ? AND field = ?');
655 $sth->execute( $frameworkcode, $field );
659 while ( my $row = $sth->fetchrow_hashref ) {
660 foreach my $field ( $record->field( $row->{fieldcode} ) ) {
661 if ( ( $row->{subfieldcode} ne "" && $field->subfield( $row->{subfieldcode} ) ) ) {
662 foreach my $subfield ( $field->subfield( $row->{subfieldcode} ) ) {
663 push @result, { 'subfield' => $subfield };
666 } elsif ( $row->{subfieldcode} eq "" ) {
667 push @result, { 'subfield' => $field->as_string() };
677 $data = &GetBiblioData($biblionumber);
679 Returns information about the book with the given biblionumber.
680 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
681 the C<biblio> and C<biblioitems> tables in the
684 In addition, C<$data-E<gt>{subject}> is the list of the book's
685 subjects, separated by C<" , "> (space, comma, space).
686 If there are multiple biblioitems with the given biblionumber, only
687 the first one is considered.
693 my $dbh = C4::Context->dbh;
695 my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
697 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
698 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
699 WHERE biblio.biblionumber = ?";
701 my $sth = $dbh->prepare($query);
702 $sth->execute($bibnum);
704 $data = $sth->fetchrow_hashref;
708 } # sub GetBiblioData
712 $isbd = &GetISBDView({
713 'record' => $marc_record,
714 'template' => $interface, # opac/intranet
715 'framework' => $framework,
718 Return the ISBD view which can be included in opac and intranet
725 # Expecting record WITH items.
726 my $record = $params->{record};
727 return unless defined $record;
729 my $template = $params->{template} // q{};
730 my $sysprefname = $template eq 'opac' ? 'opacisbd' : 'isbd';
731 my $framework = $params->{framework};
732 my $itemtype = $framework;
733 my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField( "items.holdingbranch", $itemtype );
734 my $tagslib = GetMarcStructure( 1, $itemtype, { unsafe => 1 } );
736 my $ISBD = C4::Context->preference($sysprefname);
741 foreach my $isbdfield ( split( /#/, $bloc ) ) {
743 # $isbdfield= /(.?.?.?)/;
744 $isbdfield =~ /(\d\d\d)([^\|])?\|(.*)\|(.*)\|(.*)/;
745 my $fieldvalue = $1 || 0;
746 my $subfvalue = $2 || "";
748 my $analysestring = $4;
751 # warn "==> $1 / $2 / $3 / $4";
752 # my $fieldvalue=substr($isbdfield,0,3);
753 if ( $fieldvalue > 0 ) {
754 my $hasputtextbefore = 0;
755 my @fieldslist = $record->field($fieldvalue);
756 @fieldslist = sort { $a->subfield($holdingbrtagsubf) cmp $b->subfield($holdingbrtagsubf) } @fieldslist if ( $fieldvalue eq $holdingbrtagf );
758 # warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
759 # warn "FV : $fieldvalue";
760 if ( $subfvalue ne "" ) {
761 # OPAC hidden subfield
763 if ( ( $template eq 'opac' )
764 && ( $tagslib->{$fieldvalue}->{$subfvalue}->{'hidden'} || 0 ) > 0 );
765 foreach my $field (@fieldslist) {
766 foreach my $subfield ( $field->subfield($subfvalue) ) {
767 my $calculated = $analysestring;
768 my $tag = $field->tag();
771 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subfvalue, $subfield, '', $tagslib );
772 my $tagsubf = $tag . $subfvalue;
773 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
774 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
776 # field builded, store the result
777 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
778 $blocres .= $textbefore;
779 $hasputtextbefore = 1;
782 # remove punctuation at start
783 $calculated =~ s/^( |;|:|\.|-)*//g;
784 $blocres .= $calculated;
789 $blocres .= $textafter if $hasputtextbefore;
791 foreach my $field (@fieldslist) {
792 my $calculated = $analysestring;
793 my $tag = $field->tag();
796 my @subf = $field->subfields;
797 for my $i ( 0 .. $#subf ) {
798 my $valuecode = $subf[$i][1];
799 my $subfieldcode = $subf[$i][0];
800 # OPAC hidden subfield
802 if ( ( $template eq 'opac' )
803 && ( $tagslib->{$fieldvalue}->{$subfieldcode}->{'hidden'} || 0 ) > 0 );
804 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subf[$i][0], $subf[$i][1], '', $tagslib );
805 my $tagsubf = $tag . $subfieldcode;
807 $calculated =~ s/ # replace all {{}} codes by the value code.
808 \{\{$tagsubf\}\} # catch the {{actualcode}}
810 $valuecode # replace by the value code
813 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
814 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
817 # field builded, store the result
818 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
819 $blocres .= $textbefore;
820 $hasputtextbefore = 1;
823 # remove punctuation at start
824 $calculated =~ s/^( |;|:|\.|-)*//g;
825 $blocres .= $calculated;
828 $blocres .= $textafter if $hasputtextbefore;
831 $blocres .= $isbdfield;
836 $res =~ s/\{(.*?)\}//g;
838 $res =~ s/\n/<br\/>/g;
846 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
848 =head2 IsMarcStructureInternal
850 my $tagslib = C4::Biblio::GetMarcStructure();
851 for my $tag ( sort keys %$tagslib ) {
853 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
854 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
859 GetMarcStructure creates keys (lib, tab, mandatory, repeatable) for a display purpose.
860 These different values should not be processed as valid subfields.
864 sub IsMarcStructureInternal {
865 my ( $subfield ) = @_;
866 return ref $subfield ? 0 : 1;
869 =head2 GetMarcStructure
871 $res = GetMarcStructure($forlibrarian, $frameworkcode, [ $params ]);
873 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
874 $forlibrarian :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
875 $frameworkcode : the framework code to read
876 $params allows you to pass { unsafe => 1 } for better performance.
878 Note: If you call GetMarcStructure with unsafe => 1, do not modify or
879 even autovivify its contents. It is a cached/shared data structure. Your
880 changes c/would be passed around in subsequent calls.
884 sub GetMarcStructure {
885 my ( $forlibrarian, $frameworkcode, $params ) = @_;
886 $frameworkcode = "" unless $frameworkcode;
888 $forlibrarian = $forlibrarian ? 1 : 0;
889 my $unsafe = ($params && $params->{unsafe})? 1: 0;
890 my $cache = Koha::Caches->get_instance();
891 my $cache_key = "MarcStructure-$forlibrarian-$frameworkcode";
892 my $cached = $cache->get_from_cache($cache_key, { unsafe => $unsafe });
893 return $cached if $cached;
895 my $dbh = C4::Context->dbh;
896 my $sth = $dbh->prepare(
897 "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable,ind1_defaultvalue,ind2_defaultvalue
898 FROM marc_tag_structure
899 WHERE frameworkcode=?
902 $sth->execute($frameworkcode);
903 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable, $ind1_defaultvalue, $ind2_defaultvalue );
905 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable, $ind1_defaultvalue, $ind2_defaultvalue ) = $sth->fetchrow ) {
906 $res->{$tag}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
907 $res->{$tag}->{tab} = "";
908 $res->{$tag}->{mandatory} = $mandatory;
909 $res->{$tag}->{repeatable} = $repeatable;
910 $res->{$tag}->{ind1_defaultvalue} = $ind1_defaultvalue;
911 $res->{$tag}->{ind2_defaultvalue} = $ind2_defaultvalue;
914 $sth = $dbh->prepare(
915 "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue,maxlength
916 FROM marc_subfield_structure
917 WHERE frameworkcode=?
918 ORDER BY tagfield,tagsubfield
922 $sth->execute($frameworkcode);
925 my $authorised_value;
937 ( $tag, $subfield, $liblibrarian, $libopac, $tab, $mandatory, $repeatable, $authorised_value,
938 $authtypecode, $value_builder, $kohafield, $seealso, $hidden, $isurl, $link, $defaultvalue,
943 $res->{$tag}->{$subfield}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
944 $res->{$tag}->{$subfield}->{tab} = $tab;
945 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
946 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
947 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
948 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
949 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
950 $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
951 $res->{$tag}->{$subfield}->{seealso} = $seealso;
952 $res->{$tag}->{$subfield}->{hidden} = $hidden;
953 $res->{$tag}->{$subfield}->{isurl} = $isurl;
954 $res->{$tag}->{$subfield}->{'link'} = $link;
955 $res->{$tag}->{$subfield}->{defaultvalue} = $defaultvalue;
956 $res->{$tag}->{$subfield}->{maxlength} = $maxlength;
959 $cache->set_in_cache($cache_key, $res);
963 =head2 GetUsedMarcStructure
965 The same function as GetMarcStructure except it just takes field
966 in tab 0-9. (used field)
968 my $results = GetUsedMarcStructure($frameworkcode);
970 C<$results> is a ref to an array which each case contains a ref
971 to a hash which each keys is the columns from marc_subfield_structure
973 C<$frameworkcode> is the framework code.
977 sub GetUsedMarcStructure {
978 my $frameworkcode = shift || '';
981 FROM marc_subfield_structure
983 AND frameworkcode = ?
984 ORDER BY tagfield, tagsubfield
986 my $sth = C4::Context->dbh->prepare($query);
987 $sth->execute($frameworkcode);
988 return $sth->fetchall_arrayref( {} );
993 =head2 GetMarcSubfieldStructure
995 my $structure = GetMarcSubfieldStructure($frameworkcode, [$params]);
997 Returns a reference to hash representing MARC subfield structure
998 for framework with framework code C<$frameworkcode>, C<$params> is
999 optional and may contain additional options.
1003 =item C<$frameworkcode>
1009 An optional hash reference with additional options.
1010 The following options are supported:
1016 Pass { unsafe => 1 } do disable cached object cloning,
1017 and instead get a shared reference, resulting in better
1018 performance (but care must be taken so that retured object
1021 Note: If you call GetMarcSubfieldStructure with unsafe => 1, do not modify or
1022 even autovivify its contents. It is a cached/shared data structure. Your
1023 changes would be passed around in subsequent calls.
1031 sub GetMarcSubfieldStructure {
1032 my ( $frameworkcode, $params ) = @_;
1034 $frameworkcode //= '';
1036 my $cache = Koha::Caches->get_instance();
1037 my $cache_key = "MarcSubfieldStructure-$frameworkcode";
1038 my $cached = $cache->get_from_cache($cache_key, { unsafe => ($params && $params->{unsafe}) });
1039 return $cached if $cached;
1041 my $dbh = C4::Context->dbh;
1042 # We moved to selectall_arrayref since selectall_hashref does not
1043 # keep duplicate mappings on kohafield (like place in 260 vs 264)
1044 my $subfield_aref = $dbh->selectall_arrayref( q|
1046 FROM marc_subfield_structure
1047 WHERE frameworkcode = ?
1049 ORDER BY frameworkcode,tagfield,tagsubfield
1050 |, { Slice => {} }, $frameworkcode );
1051 # Now map the output to a hash structure
1052 my $subfield_structure = {};
1053 foreach my $row ( @$subfield_aref ) {
1054 push @{ $subfield_structure->{ $row->{kohafield} }}, $row;
1056 $cache->set_in_cache( $cache_key, $subfield_structure );
1057 return $subfield_structure;
1060 =head2 GetMarcFromKohaField
1062 ( $field,$subfield ) = GetMarcFromKohaField( $kohafield );
1063 @fields = GetMarcFromKohaField( $kohafield );
1064 $field = GetMarcFromKohaField( $kohafield );
1066 Returns the MARC fields & subfields mapped to $kohafield.
1067 Since the Default framework is considered as authoritative for such
1068 mappings, the former frameworkcode parameter is obsoleted.
1070 In list context all mappings are returned; there can be multiple
1071 mappings. Note that in the above example you could miss a second
1072 mappings in the first call.
1073 In scalar context only the field tag of the first mapping is returned.
1077 sub GetMarcFromKohaField {
1078 my ( $kohafield ) = @_;
1079 return unless $kohafield;
1080 # The next call uses the Default framework since it is AUTHORITATIVE
1081 # for all Koha to MARC mappings.
1082 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
1084 foreach( @{ $mss->{$kohafield} } ) {
1085 push @retval, $_->{tagfield}, $_->{tagsubfield};
1087 return wantarray ? @retval : ( @retval ? $retval[0] : undef );
1090 =head2 GetMarcSubfieldStructureFromKohaField
1092 my $str = GetMarcSubfieldStructureFromKohaField( $kohafield );
1094 Returns marc subfield structure information for $kohafield.
1095 The Default framework is used, since it is authoritative for kohafield
1097 In list context returns a list of all hashrefs, since there may be
1098 multiple mappings. In scalar context the first hashref is returned.
1102 sub GetMarcSubfieldStructureFromKohaField {
1103 my ( $kohafield ) = @_;
1105 return unless $kohafield;
1107 # The next call uses the Default framework since it is AUTHORITATIVE
1108 # for all Koha to MARC mappings.
1109 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
1110 return unless $mss->{$kohafield};
1111 return wantarray ? @{$mss->{$kohafield}} : $mss->{$kohafield}->[0];
1114 =head2 GetMarcBiblio
1116 my $record = GetMarcBiblio({
1117 biblionumber => $biblionumber,
1118 embed_items => $embeditems,
1120 borcat => $patron_category });
1122 Returns MARC::Record representing a biblio record, or C<undef> if the
1123 biblionumber doesn't exist.
1125 Both embed_items and opac are optional.
1126 If embed_items is passed and is 1, items are embedded.
1127 If opac is passed and is 1, the record is filtered as needed.
1131 =item C<$biblionumber>
1135 =item C<$embeditems>
1137 set to true to include item information.
1141 set to true to make the result suited for OPAC view. This causes things like
1142 OpacHiddenItems to be applied.
1146 If the OpacHiddenItemsExceptions system preference is set, this patron category
1147 can be used to make visible OPAC items which would be normally hidden.
1148 It only makes sense in combination both embed_items and opac values true.
1157 if (not defined $params) {
1158 carp 'GetMarcBiblio called without parameters';
1162 my $biblionumber = $params->{biblionumber};
1163 my $embeditems = $params->{embed_items} || 0;
1164 my $opac = $params->{opac} || 0;
1165 my $borcat = $params->{borcat} // q{};
1167 if (not defined $biblionumber) {
1168 carp 'GetMarcBiblio called with undefined biblionumber';
1172 my $dbh = C4::Context->dbh;
1173 my $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=? ");
1174 $sth->execute($biblionumber);
1175 my $row = $sth->fetchrow_hashref;
1176 my $biblioitemnumber = $row->{'biblioitemnumber'};
1177 my $marcxml = GetXmlBiblio( $biblionumber );
1178 $marcxml = StripNonXmlChars( $marcxml );
1179 my $frameworkcode = GetFrameworkCode($biblionumber);
1180 MARC::File::XML->default_record_format( C4::Context->preference('marcflavour') );
1181 my $record = MARC::Record->new();
1185 MARC::Record::new_from_xml( $marcxml, "utf8",
1186 C4::Context->preference('marcflavour') );
1188 if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; }
1189 return unless $record;
1191 C4::Biblio::_koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber,
1192 $biblioitemnumber );
1193 C4::Biblio::EmbedItemsInMarcBiblio({
1194 marc_record => $record,
1195 biblionumber => $biblionumber,
1197 borcat => $borcat })
1209 my $marcxml = GetXmlBiblio($biblionumber);
1211 Returns biblio_metadata.metadata/marcxml of the biblionumber passed in parameter.
1212 The XML should only contain biblio information (item information is no longer stored in marcxml field)
1217 my ($biblionumber) = @_;
1218 my $dbh = C4::Context->dbh;
1219 return unless $biblionumber;
1220 my ($marcxml) = $dbh->selectrow_array(
1223 FROM biblio_metadata
1224 WHERE biblionumber=?
1225 AND format='marcxml'
1227 |, undef, $biblionumber, C4::Context->preference('marcflavour')
1234 return the prices in accordance with the Marc format.
1236 returns 0 if no price found
1237 returns undef if called without a marc record or with
1238 an unrecognized marc format
1243 my ( $record, $marcflavour ) = @_;
1245 carp 'GetMarcPrice called on undefined record';
1252 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1253 @listtags = ('345', '020');
1255 } elsif ( $marcflavour eq "UNIMARC" ) {
1256 @listtags = ('345', '010');
1262 for my $field ( $record->field(@listtags) ) {
1263 for my $subfield_value ($field->subfield($subfield)){
1265 $subfield_value = MungeMarcPrice( $subfield_value );
1266 return $subfield_value if ($subfield_value);
1269 return 0; # no price found
1272 =head2 MungeMarcPrice
1274 Return the best guess at what the actual price is from a price field.
1278 sub MungeMarcPrice {
1280 return unless ( $price =~ m/\d/ ); ## No digits means no price.
1281 # Look for the currency symbol and the normalized code of the active currency, if it's there,
1282 my $active_currency = Koha::Acquisition::Currencies->get_active;
1283 my $symbol = $active_currency->symbol;
1284 my $isocode = $active_currency->isocode;
1285 $isocode = $active_currency->currency unless defined $isocode;
1288 my @matches =($price=~ /
1290 ( # start of capturing parenthesis
1292 (?:[\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'
1293 |(?:\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'
1295 \s?\p{Sc}?\s? # followed or not by a whitespace. \p{Sc}?\s? are for cases like '25$ USD'
1297 (?:[\p{Sc}\p{L}\/.]){1,4} # followed by same block as symbol block
1298 |(?:\d+[\p{P}\s]?){1,4} # or by same block as digits block
1300 \s?\p{L}{0,4}\s? # followed or not by a whitespace. \p{L}{0,4}\s? are for cases like '$9.50 USD'
1301 ) # end of capturing parenthesis
1302 (?:\p{P}|\z) # followed by a punctuation sign or by the end of the string
1306 foreach ( @matches ) {
1307 $localprice = $_ and last if index($_, $isocode)>=0;
1309 if ( !$localprice ) {
1310 foreach ( @matches ) {
1311 $localprice = $_ and last if $_=~ /(^|[^\p{Sc}\p{L}\/])\Q$symbol\E([^\p{Sc}\p{L}\/]+\z|\z)/;
1316 if ( $localprice ) {
1317 $price = $localprice;
1319 ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
1320 ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
1322 # eliminate symbol/isocode, space and any final dot from the string
1323 $price =~ s/[\p{Sc}\p{L}\/ ]|\.$//g;
1324 # remove comma,dot when used as separators from hundreds
1325 $price =~s/[\,\.](\d{3})/$1/g;
1326 # convert comma to dot to ensure correct display of decimals if existing
1332 =head2 GetMarcQuantity
1334 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
1335 Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
1337 returns 0 if no quantity found
1338 returns undef if called without a marc record or with
1339 an unrecognized marc format
1343 sub GetMarcQuantity {
1344 my ( $record, $marcflavour ) = @_;
1346 carp 'GetMarcQuantity called on undefined record';
1353 if ( $marcflavour eq "MARC21" ) {
1355 } elsif ( $marcflavour eq "UNIMARC" ) {
1356 @listtags = ('969');
1362 for my $field ( $record->field(@listtags) ) {
1363 for my $subfield_value ($field->subfield($subfield)){
1365 if ($subfield_value) {
1366 # in France, the cents separator is the , but sometimes, ppl use a .
1367 # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1368 $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
1369 return $subfield_value;
1373 return 0; # no price found
1377 =head2 GetAuthorisedValueDesc
1379 my $subfieldvalue =get_authorised_value_desc(
1380 $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1382 Retrieve the complete description for a given authorised value.
1384 Now takes $category and $value pair too.
1386 my $auth_value_desc =GetAuthorisedValueDesc(
1387 '','', 'DVD' ,'','','CCODE');
1389 If the optional $opac parameter is set to a true value, displays OPAC
1390 descriptions rather than normal ones when they exist.
1394 sub GetAuthorisedValueDesc {
1395 my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1399 return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1402 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1403 my $branch = Koha::Libraries->find($value);
1404 return $branch? $branch->branchname: q{};
1408 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1409 my $itemtype = Koha::ItemTypes->find( $value );
1410 return $itemtype ? $itemtype->translated_description : q||;
1413 #---- "true" authorized value
1414 $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1417 my $dbh = C4::Context->dbh;
1418 if ( $category ne "" ) {
1419 my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1420 $sth->execute( $category, $value );
1421 my $data = $sth->fetchrow_hashref;
1422 return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
1424 return $value; # if nothing is found return the original value
1428 =head2 GetMarcControlnumber
1430 $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1432 Get the control number / record Identifier from the MARC record and return it.
1436 sub GetMarcControlnumber {
1437 my ( $record, $marcflavour ) = @_;
1439 carp 'GetMarcControlnumber called on undefined record';
1442 my $controlnumber = "";
1443 # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
1444 # Keep $marcflavour for possible later use
1445 if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" || $marcflavour eq "NORMARC") {
1446 my $controlnumberField = $record->field('001');
1447 if ($controlnumberField) {
1448 $controlnumber = $controlnumberField->data();
1451 return $controlnumber;
1456 $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1458 Get all ISBNs from the MARC record and returns them in an array.
1459 ISBNs stored in different fields depending on MARC flavour
1464 my ( $record, $marcflavour ) = @_;
1466 carp 'GetMarcISBN called on undefined record';
1470 if ( $marcflavour eq "UNIMARC" ) {
1472 } else { # assume marc21 if not unimarc
1477 foreach my $field ( $record->field($scope) ) {
1478 my $isbn = $field->subfield( 'a' );
1479 if ( $isbn ne "" ) {
1480 push @marcisbns, $isbn;
1490 $marcissnsarray = GetMarcISSN( $record, $marcflavour );
1492 Get all valid ISSNs from the MARC record and returns them in an array.
1493 ISSNs are stored in different fields depending on MARC flavour
1498 my ( $record, $marcflavour ) = @_;
1500 carp 'GetMarcISSN called on undefined record';
1504 if ( $marcflavour eq "UNIMARC" ) {
1507 else { # assume MARC21 or NORMARC
1511 foreach my $field ( $record->field($scope) ) {
1512 push @marcissns, $field->subfield( 'a' )
1513 if ( $field->subfield( 'a' ) ne "" );
1520 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1522 Get all notes from the MARC record and returns them in an array.
1523 The notes are stored in different fields depending on MARC flavour.
1524 MARC21 5XX $u subfields receive special attention as they are URIs.
1529 my ( $record, $marcflavour ) = @_;
1531 carp 'GetMarcNotes called on undefined record';
1535 my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
1537 my %blacklist = map { $_ => 1 }
1538 split( /,/, C4::Context->preference('NotesBlacklist'));
1539 foreach my $field ( $record->field($scope) ) {
1540 my $tag = $field->tag();
1541 next if $blacklist{ $tag };
1542 if( $marcflavour ne 'UNIMARC' && $field->subfield('u') ) {
1543 # Field 5XX$u always contains URI
1544 # Examples: 505u, 506u, 510u, 514u, 520u, 530u, 538u, 540u, 542u, 552u, 555u, 561u, 563u, 583u
1545 # We first push the other subfields, then all $u's separately
1546 # Leave further actions to the template (see e.g. opac-detail)
1548 join '', ( 'a' .. 't', 'v' .. 'z', '0' .. '9' ); # excl 'u'
1549 push @marcnotes, { marcnote => $field->as_string($othersub) };
1550 foreach my $sub ( $field->subfield('u') ) {
1551 $sub =~ s/^\s+|\s+$//g; # trim
1552 push @marcnotes, { marcnote => $sub };
1555 push @marcnotes, { marcnote => $field->as_string() };
1561 =head2 GetMarcSubjects
1563 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1565 Get all subjects from the MARC record and returns them in an array.
1566 The subjects are stored in different fields depending on MARC flavour
1570 sub GetMarcSubjects {
1571 my ( $record, $marcflavour ) = @_;
1573 carp 'GetMarcSubjects called on undefined record';
1576 my ( $mintag, $maxtag, $fields_filter );
1577 if ( $marcflavour eq "UNIMARC" ) {
1580 $fields_filter = '6..';
1581 } else { # marc21/normarc
1584 $fields_filter = '6..';
1589 my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1590 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1592 foreach my $field ( $record->field($fields_filter) ) {
1593 next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
1595 my @subfields = $field->subfields();
1598 # if there is an authority link, build the links with an= subfield9
1599 my $subfield9 = $field->subfield('9');
1602 my $linkvalue = $subfield9;
1603 $linkvalue =~ s/(\(|\))//g;
1604 @link_loop = ( { limit => 'an', 'link' => $linkvalue } );
1605 $authoritylink = $linkvalue
1609 for my $subject_subfield (@subfields) {
1610 next if ( $subject_subfield->[0] eq '9' );
1612 # don't load unimarc subfields 3,4,5
1613 next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1614 # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1615 next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1617 my $code = $subject_subfield->[0];
1618 my $value = $subject_subfield->[1];
1619 my $linkvalue = $value;
1620 $linkvalue =~ s/(\(|\))//g;
1621 # if no authority link, build a search query
1622 unless ($subfield9) {
1624 limit => $subject_limit,
1625 'link' => $linkvalue,
1626 operator => (scalar @link_loop) ? ' and ' : undef
1629 my @this_link_loop = @link_loop;
1631 unless ( $code eq '0' ) {
1632 push @subfields_loop, {
1635 link_loop => \@this_link_loop,
1636 separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1641 push @marcsubjects, {
1642 MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop,
1643 authoritylink => $authoritylink,
1644 } if $authoritylink || @subfields_loop;
1647 return \@marcsubjects;
1648 } #end getMARCsubjects
1650 =head2 GetMarcAuthors
1652 authors = GetMarcAuthors($record,$marcflavour);
1654 Get all authors from the MARC record and returns them in an array.
1655 The authors are stored in different fields depending on MARC flavour
1659 sub GetMarcAuthors {
1660 my ( $record, $marcflavour ) = @_;
1662 carp 'GetMarcAuthors called on undefined record';
1665 my ( $mintag, $maxtag, $fields_filter );
1667 # tagslib useful only for UNIMARC author responsibilities
1669 if ( $marcflavour eq "UNIMARC" ) {
1670 # FIXME : we don't have the framework available, we take the default framework. May be buggy on some setups, will be usually correct.
1671 $tagslib = GetMarcStructure( 1, '', { unsafe => 1 });
1674 $fields_filter = '7..';
1675 } else { # marc21/normarc
1678 $fields_filter = '7..';
1682 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1684 foreach my $field ( $record->field($fields_filter) ) {
1685 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1688 my @subfields = $field->subfields();
1691 # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1692 my $subfield9 = $field->subfield('9');
1694 my $linkvalue = $subfield9;
1695 $linkvalue =~ s/(\(|\))//g;
1696 @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1701 for my $authors_subfield (@subfields) {
1702 next if ( $authors_subfield->[0] eq '9' );
1704 # unimarc3 contains the $3 of the author for UNIMARC.
1705 # For french academic libraries, it's the "ppn", and it's required for idref webservice
1706 $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1708 # don't load unimarc subfields 3, 5
1709 next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1711 my $code = $authors_subfield->[0];
1712 my $value = $authors_subfield->[1];
1713 my $linkvalue = $value;
1714 $linkvalue =~ s/(\(|\))//g;
1715 # UNIMARC author responsibility
1716 if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1717 $value = GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1718 $linkvalue = "($value)";
1720 # if no authority link, build a search query
1721 unless ($subfield9) {
1724 'link' => $linkvalue,
1725 operator => (scalar @link_loop) ? ' and ' : undef
1728 my @this_link_loop = @link_loop;
1730 unless ( $code eq '0') {
1731 push @subfields_loop, {
1732 tag => $field->tag(),
1735 link_loop => \@this_link_loop,
1736 separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1740 push @marcauthors, {
1741 MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
1742 authoritylink => $subfield9,
1743 unimarc3 => $unimarc3
1746 return \@marcauthors;
1751 $marcurls = GetMarcUrls($record,$marcflavour);
1753 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1754 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1759 my ( $record, $marcflavour ) = @_;
1761 carp 'GetMarcUrls called on undefined record';
1766 for my $field ( $record->field('856') ) {
1768 for my $note ( $field->subfield('z') ) {
1769 push @notes, { note => $note };
1771 my @urls = $field->subfield('u');
1772 foreach my $url (@urls) {
1773 $url =~ s/^\s+|\s+$//g; # trim
1775 if ( $marcflavour eq 'MARC21' ) {
1776 my $s3 = $field->subfield('3');
1777 my $link = $field->subfield('y');
1778 unless ( $url =~ /^\w+:/ ) {
1779 if ( $field->indicator(1) eq '7' ) {
1780 $url = $field->subfield('2') . "://" . $url;
1781 } elsif ( $field->indicator(1) eq '1' ) {
1782 $url = 'ftp://' . $url;
1785 # properly, this should be if ind1=4,
1786 # however we will assume http protocol since we're building a link.
1787 $url = 'http://' . $url;
1791 # TODO handle ind 2 (relationship)
1796 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
1797 $marcurl->{'part'} = $s3 if ($link);
1798 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1800 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
1801 $marcurl->{'MARCURL'} = $url;
1803 push @marcurls, $marcurl;
1809 =head2 GetMarcSeries
1811 $marcseriesarray = GetMarcSeries($record,$marcflavour);
1813 Get all series from the MARC record and returns them in an array.
1814 The series are stored in different fields depending on MARC flavour
1819 my ( $record, $marcflavour ) = @_;
1821 carp 'GetMarcSeries called on undefined record';
1825 my ( $mintag, $maxtag, $fields_filter );
1826 if ( $marcflavour eq "UNIMARC" ) {
1829 $fields_filter = '2..';
1830 } else { # marc21/normarc
1833 $fields_filter = '4..';
1837 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1839 foreach my $field ( $record->field($fields_filter) ) {
1840 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1842 my @subfields = $field->subfields();
1845 for my $series_subfield (@subfields) {
1847 # ignore $9, used for authority link
1848 next if ( $series_subfield->[0] eq '9' );
1851 my $code = $series_subfield->[0];
1852 my $value = $series_subfield->[1];
1853 my $linkvalue = $value;
1854 $linkvalue =~ s/(\(|\))//g;
1856 # see if this is an instance of a volume
1857 if ( $code eq 'v' ) {
1862 'link' => $linkvalue,
1863 operator => (scalar @link_loop) ? ' and ' : undef
1866 if ($volume_number) {
1867 push @subfields_loop, { volumenum => $value };
1869 push @subfields_loop, {
1872 link_loop => \@link_loop,
1873 separator => (scalar @subfields_loop) ? $AuthoritySeparator : '',
1874 volumenum => $volume_number,
1878 push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1881 return \@marcseries;
1882 } #end getMARCseriess
1886 $marchostsarray = GetMarcHosts($record,$marcflavour);
1888 Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns them in an array.
1893 my ( $record, $marcflavour ) = @_;
1895 carp 'GetMarcHosts called on undefined record';
1899 my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
1900 $marcflavour ||="MARC21";
1901 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1904 $bibnumber_subf ="0";
1905 $itemnumber_subf='9';
1907 elsif ($marcflavour eq "UNIMARC") {
1910 $bibnumber_subf ="0";
1911 $itemnumber_subf='9';
1916 foreach my $field ( $record->field($tag)) {
1920 my $hostbiblionumber = $field->subfield("$bibnumber_subf");
1921 my $hosttitle = $field->subfield($title_subf);
1922 my $hostitemnumber=$field->subfield($itemnumber_subf);
1923 push @fields_loop, { hostbiblionumber => $hostbiblionumber, hosttitle => $hosttitle, hostitemnumber => $hostitemnumber};
1924 push @marchosts, { MARCHOSTS_FIELDS_LOOP => \@fields_loop };
1927 my $marchostsarray = \@marchosts;
1928 return $marchostsarray;
1931 =head2 UpsertMarcSubfield
1933 my $record = C4::Biblio::UpsertMarcSubfield($MARC::Record, $fieldTag, $subfieldCode, $subfieldContent);
1937 sub UpsertMarcSubfield {
1938 my ($record, $tag, $code, $content) = @_;
1939 my $f = $record->field($tag);
1942 $f->update( $code => $content );
1945 my $f = MARC::Field->new( $tag, '', '', $code => $content);
1946 $record->insert_fields_ordered( $f );
1950 =head2 UpsertMarcControlField
1952 my $record = C4::Biblio::UpsertMarcControlField($MARC::Record, $fieldTag, $content);
1956 sub UpsertMarcControlField {
1957 my ($record, $tag, $content) = @_;
1958 die "UpsertMarcControlField() \$tag '$tag' is not a control field\n" unless 0+$tag < 10;
1959 my $f = $record->field($tag);
1962 $f->update( $content );
1965 my $f = MARC::Field->new($tag, $content);
1966 $record->insert_fields_ordered( $f );
1970 =head2 GetFrameworkCode
1972 $frameworkcode = GetFrameworkCode( $biblionumber )
1976 sub GetFrameworkCode {
1977 my ($biblionumber) = @_;
1978 my $dbh = C4::Context->dbh;
1979 my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
1980 $sth->execute($biblionumber);
1981 my ($frameworkcode) = $sth->fetchrow;
1982 return $frameworkcode;
1985 =head2 TransformKohaToMarc
1987 $record = TransformKohaToMarc( $hash [, $params ] )
1989 This function builds a (partial) MARC::Record from a hash.
1990 Hash entries can be from biblio, biblioitems or items.
1991 The params hash includes the parameter no_split used in C4::Items.
1993 This function is called in acquisition module, to create a basic catalogue
1994 entry from user entry.
1999 sub TransformKohaToMarc {
2000 my ( $hash, $params ) = @_;
2001 my $record = MARC::Record->new();
2002 SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
2004 # In the next call we use the Default framework, since it is considered
2005 # authoritative for Koha to Marc mappings.
2006 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # do not change framewok
2008 while ( my ($kohafield, $value) = each %$hash ) {
2009 foreach my $fld ( @{ $mss->{$kohafield} } ) {
2010 my $tagfield = $fld->{tagfield};
2011 my $tagsubfield = $fld->{tagsubfield};
2013 my @values = $params->{no_split}
2015 : split(/\s?\|\s?/, $value, -1);
2016 foreach my $value ( @values ) {
2017 next if $value eq '';
2018 $tag_hr->{$tagfield} //= [];
2019 push @{$tag_hr->{$tagfield}}, [($tagsubfield, $value)];
2023 foreach my $tag (sort keys %$tag_hr) {
2024 my @sfl = @{$tag_hr->{$tag}};
2025 @sfl = sort { $a->[0] cmp $b->[0]; } @sfl;
2026 @sfl = map { @{$_}; } @sfl;
2027 # Special care for control fields: remove the subfield indication @
2028 # and do not insert indicators.
2029 my @ind = $tag < 10 ? () : ( " ", " " );
2030 @sfl = grep { $_ ne '@' } @sfl if $tag < 10;
2031 $record->insert_fields_ordered( MARC::Field->new($tag, @ind, @sfl) );
2036 =head2 PrepHostMarcField
2038 $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
2040 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
2044 sub PrepHostMarcField {
2045 my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
2046 $marcflavour ||="MARC21";
2048 my $hostrecord = GetMarcBiblio({ biblionumber => $hostbiblionumber });
2049 my $item = Koha::Items->find($hostitemnumber);
2052 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2056 if ($hostrecord->subfield('100','a')){
2057 $mainentry = $hostrecord->subfield('100','a');
2058 } elsif ($hostrecord->subfield('110','a')){
2059 $mainentry = $hostrecord->subfield('110','a');
2061 $mainentry = $hostrecord->subfield('111','a');
2064 # qualification info
2066 if (my $field260 = $hostrecord->field('260')){
2067 $qualinfo = $field260->as_string( 'abc' );
2072 my $ed = $hostrecord->subfield('250','a');
2073 my $barcode = $item->barcode;
2074 my $title = $hostrecord->subfield('245','a');
2076 # record control number, 001 with 003 and prefix
2078 if ($hostrecord->field('001')){
2079 $recctrlno = $hostrecord->field('001')->data();
2080 if ($hostrecord->field('003')){
2081 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
2086 my $issn = $hostrecord->subfield('022','a');
2087 my $isbn = $hostrecord->subfield('020','a');
2090 $hostmarcfield = MARC::Field->new(
2092 '0' => $hostbiblionumber,
2093 '9' => $hostitemnumber,
2103 } elsif ($marcflavour eq "UNIMARC") {
2104 $hostmarcfield = MARC::Field->new(
2106 '0' => $hostbiblionumber,
2107 't' => $hostrecord->subfield('200','a'),
2108 '9' => $hostitemnumber
2112 return $hostmarcfield;
2115 =head2 TransformHtmlToXml
2117 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
2118 $ind_tag, $auth_type )
2120 $auth_type contains :
2124 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
2126 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2128 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2134 sub TransformHtmlToXml {
2135 my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2136 # NOTE: The parameter $ind_tag is NOT USED -- BZ 11247
2138 my $xml = MARC::File::XML::header('UTF-8');
2139 $xml .= "<record>\n";
2140 $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2141 MARC::File::XML->default_record_format($auth_type);
2143 # in UNIMARC, field 100 contains the encoding
2144 # check that there is one, otherwise the
2145 # MARC::Record->new_from_xml will fail (and Koha will die)
2146 my $unimarc_and_100_exist = 0;
2147 $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
2153 for ( my $i = 0 ; $i < @$tags ; $i++ ) {
2155 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
2157 # if we have a 100 field and it's values are not correct, skip them.
2158 # if we don't have any valid 100 field, we will create a default one at the end
2159 my $enc = substr( @$values[$i], 26, 2 );
2160 if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2161 $unimarc_and_100_exist = 1;
2166 @$values[$i] =~ s/&/&/g;
2167 @$values[$i] =~ s/</</g;
2168 @$values[$i] =~ s/>/>/g;
2169 @$values[$i] =~ s/"/"/g;
2170 @$values[$i] =~ s/'/'/g;
2172 if ( ( @$tags[$i] ne $prevtag ) ) {
2173 $close_last_tag = 0;
2174 $j++ unless ( @$tags[$i] eq "" );
2175 my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2176 my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2177 my $ind1 = _default_ind_to_space($indicator1);
2179 if ( @$indicator[$j] ) {
2180 $ind2 = _default_ind_to_space($indicator2);
2182 warn "Indicator in @$tags[$i] is empty";
2186 $xml .= "</datafield>\n";
2187 if ( ( @$tags[$i] && @$tags[$i] > 10 )
2188 && ( @$values[$i] ne "" ) ) {
2189 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2190 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2192 $close_last_tag = 1;
2197 if ( @$values[$i] ne "" ) {
2200 if ( @$tags[$i] eq "000" ) {
2201 $xml .= "<leader>@$values[$i]</leader>\n";
2204 # rest of the fixed fields
2205 } elsif ( @$tags[$i] < 10 ) {
2206 $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2209 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2210 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2212 $close_last_tag = 1;
2216 } else { # @$tags[$i] eq $prevtag
2217 my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2218 my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2219 my $ind1 = _default_ind_to_space($indicator1);
2221 if ( @$indicator[$j] ) {
2222 $ind2 = _default_ind_to_space($indicator2);
2224 warn "Indicator in @$tags[$i] is empty";
2227 if ( @$values[$i] eq "" ) {
2230 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2232 $close_last_tag = 1;
2234 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2237 $prevtag = @$tags[$i];
2239 $xml .= "</datafield>\n" if $close_last_tag;
2240 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2242 # warn "SETTING 100 for $auth_type";
2243 my $string = strftime( "%Y%m%d", localtime(time) );
2245 # set 50 to position 26 is biblios, 13 if authorities
2247 $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2248 $string = sprintf( "%-*s", 35, $string );
2249 substr( $string, $pos, 6, "50" );
2250 $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2251 $xml .= "<subfield code=\"a\">$string</subfield>\n";
2252 $xml .= "</datafield>\n";
2254 $xml .= "</record>\n";
2255 $xml .= MARC::File::XML::footer();
2259 =head2 _default_ind_to_space
2261 Passed what should be an indicator returns a space
2262 if its undefined or zero length
2266 sub _default_ind_to_space {
2268 if ( !defined $s || $s eq q{} ) {
2274 =head2 TransformHtmlToMarc
2276 L<$record> = TransformHtmlToMarc(L<$cgi>)
2277 L<$cgi> is the CGI object which contains the values for subfields
2279 'tag_010_indicator1_531951' ,
2280 'tag_010_indicator2_531951' ,
2281 'tag_010_code_a_531951_145735' ,
2282 'tag_010_subfield_a_531951_145735' ,
2283 'tag_200_indicator1_873510' ,
2284 'tag_200_indicator2_873510' ,
2285 'tag_200_code_a_873510_673465' ,
2286 'tag_200_subfield_a_873510_673465' ,
2287 'tag_200_code_b_873510_704318' ,
2288 'tag_200_subfield_b_873510_704318' ,
2289 'tag_200_code_e_873510_280822' ,
2290 'tag_200_subfield_e_873510_280822' ,
2291 'tag_200_code_f_873510_110730' ,
2292 'tag_200_subfield_f_873510_110730' ,
2294 L<$record> is the MARC::Record object.
2298 sub TransformHtmlToMarc {
2299 my ($cgi, $isbiblio) = @_;
2301 my @params = $cgi->multi_param();
2303 # explicitly turn on the UTF-8 flag for all
2304 # 'tag_' parameters to avoid incorrect character
2305 # conversion later on
2306 my $cgi_params = $cgi->Vars;
2307 foreach my $param_name ( keys %$cgi_params ) {
2308 if ( $param_name =~ /^tag_/ ) {
2309 my $param_value = $cgi_params->{$param_name};
2310 unless ( Encode::is_utf8( $param_value ) ) {
2311 $cgi_params->{$param_name} = Encode::decode('UTF-8', $param_value );
2316 # creating a new record
2317 my $record = MARC::Record->new();
2319 my ($biblionumbertagfield, $biblionumbertagsubfield) = (-1, -1);
2320 ($biblionumbertagfield, $biblionumbertagsubfield) =
2321 &GetMarcFromKohaField( "biblio.biblionumber", '' ) if $isbiblio;
2322 #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!
2323 for (my $i = 0; $params[$i]; $i++ ) { # browse all CGI params
2324 my $param = $params[$i];
2327 # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2328 if ( $param eq 'biblionumber' ) {
2329 if ( $biblionumbertagfield < 10 ) {
2330 $newfield = MARC::Field->new( $biblionumbertagfield, scalar $cgi->param($param), );
2332 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => scalar $cgi->param($param), );
2334 push @fields, $newfield if ($newfield);
2335 } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) { # new field start when having 'input name="..._indicator1_..."
2338 my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2339 my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2343 if ( $tag < 10 ) { # no code for theses fields
2344 # in MARC editor, 000 contains the leader.
2345 next if $tag == $biblionumbertagfield;
2346 my $fval= $cgi->param($params[$j+1]);
2347 if ( $tag eq '000' ) {
2348 # Force a fake leader even if not provided to avoid crashing
2349 # during decoding MARC record containing UTF-8 characters
2351 length( $fval ) == 24
2356 # between 001 and 009 (included)
2357 } elsif ( $fval ne '' ) {
2358 $newfield = MARC::Field->new( $tag, $fval, );
2361 # > 009, deal with subfields
2363 # browse subfields for this tag (reason for _code_ match)
2364 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2365 last unless defined $params[$j+1];
2367 if $tag == $biblionumbertagfield and
2368 $cgi->param($params[$j]) eq $biblionumbertagsubfield;
2369 #if next param ne subfield, then it was probably empty
2370 #try next param by incrementing j
2371 if($params[$j+1]!~/_subfield_/) {$j++; next; }
2372 my $fkey= $cgi->param($params[$j]);
2373 my $fval= $cgi->param($params[$j+1]);
2374 #check if subfield value not empty and field exists
2375 if($fval ne '' && $newfield) {
2376 $newfield->add_subfields( $fkey => $fval);
2378 elsif($fval ne '') {
2379 $newfield = MARC::Field->new( $tag, $ind1, $ind2, $fkey => $fval );
2383 $i= $j-1; #update i for outer loop accordingly
2385 push @fields, $newfield if ($newfield);
2389 $record->append_fields(@fields);
2393 =head2 TransformMarcToKoha
2395 $result = TransformMarcToKoha( $record, undef, $limit )
2397 Extract data from a MARC bib record into a hashref representing
2398 Koha biblio, biblioitems, and items fields.
2400 If passed an undefined record will log the error and return an empty
2405 sub TransformMarcToKoha {
2406 my ( $record, $frameworkcode, $limit_table ) = @_;
2407 # FIXME Parameter $frameworkcode is obsolete and will be removed
2408 $limit_table //= q{};
2411 if (!defined $record) {
2412 carp('TransformMarcToKoha called with undefined record');
2416 my %tables = ( biblio => 1, biblioitems => 1, items => 1 );
2417 if( $limit_table eq 'items' ) {
2418 %tables = ( items => 1 );
2421 # The next call acknowledges Default as the authoritative framework
2422 # for Koha to MARC mappings.
2423 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
2424 foreach my $kohafield ( keys %{ $mss } ) {
2425 my ( $table, $column ) = split /[.]/, $kohafield, 2;
2426 next unless $tables{$table};
2427 my $val = TransformMarcToKohaOneField( $kohafield, $record );
2428 next if !defined $val;
2429 my $key = _disambiguate( $table, $column );
2430 $result->{$key} = $val;
2435 =head2 _disambiguate
2437 $newkey = _disambiguate($table, $field);
2439 This is a temporary hack to distinguish between the
2440 following sets of columns when using TransformMarcToKoha.
2442 items.cn_source & biblioitems.cn_source
2443 items.cn_sort & biblioitems.cn_sort
2445 Columns that are currently NOT distinguished (FIXME
2446 due to lack of time to fully test) are:
2448 biblio.notes and biblioitems.notes
2453 FIXME - this is necessary because prefixing each column
2454 name with the table name would require changing lots
2455 of code and templates, and exposing more of the DB
2456 structure than is good to the UI templates, particularly
2457 since biblio and bibloitems may well merge in a future
2458 version. In the future, it would also be good to
2459 separate DB access and UI presentation field names
2465 my ( $table, $column ) = @_;
2466 if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2467 return $table . '.' . $column;
2474 =head2 TransformMarcToKohaOneField
2476 $val = TransformMarcToKohaOneField( 'biblio.title', $marc );
2478 Note: The authoritative Default framework is used implicitly.
2482 sub TransformMarcToKohaOneField {
2483 my ( $kohafield, $marc ) = @_;
2485 my ( @rv, $retval );
2486 my @mss = GetMarcSubfieldStructureFromKohaField($kohafield);
2487 foreach my $fldhash ( @mss ) {
2488 my $tag = $fldhash->{tagfield};
2489 my $sub = $fldhash->{tagsubfield};
2490 foreach my $fld ( $marc->field($tag) ) {
2491 if( $sub eq '@' || $fld->is_control_field ) {
2492 push @rv, $fld->data if $fld->data;
2494 push @rv, grep { $_ } $fld->subfield($sub);
2499 $retval = join ' | ', uniq(@rv);
2501 # Additional polishing for individual kohafields
2502 if( $kohafield =~ /copyrightdate|publicationyear/ ) {
2503 $retval = _adjust_pubyear( $retval );
2509 =head2 _adjust_pubyear
2511 Helper routine for TransformMarcToKohaOneField
2515 sub _adjust_pubyear {
2517 # modify return value to keep only the 1st year found
2518 if( $retval =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2520 } elsif( $retval =~ m/(\d\d\d\d)/ && $1 > 0 ) {
2522 } elsif( $retval =~ m/
2523 (?<year>\d)[-]?[.Xx?]{3}
2524 |(?<year>\d{2})[.Xx?]{2}
2525 |(?<year>\d{3})[.Xx?]
2526 |(?<year>\d)[-]{3}\?
2527 |(?<year>\d\d)[-]{2}\?
2528 |(?<year>\d{3})[-]\?
2529 /xms ) { # the form 198-? occurred in Dutch ISBD rules
2530 my $digits = $+{year};
2531 $retval = $digits * ( 10 ** ( 4 - length($digits) ));
2536 =head2 CountItemsIssued
2538 my $count = CountItemsIssued( $biblionumber );
2542 sub CountItemsIssued {
2543 my ($biblionumber) = @_;
2544 my $dbh = C4::Context->dbh;
2545 my $sth = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2546 $sth->execute($biblionumber);
2547 my $row = $sth->fetchrow_hashref();
2548 return $row->{'issuedCount'};
2553 ModZebra( $biblionumber, $op, $server, $record );
2555 $biblionumber is the biblionumber we want to index
2557 $op is specialUpdate or recordDelete, and is used to know what we want to do
2559 $server is the server that we want to update
2561 $record is the update MARC record if it's available. If it's not supplied
2562 and is needed, it'll be loaded from the database.
2567 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2568 my ( $biblionumber, $op, $server, $record ) = @_;
2569 $debug && warn "ModZebra: update requested for: $biblionumber $op $server\n";
2570 if ( C4::Context->preference('SearchEngine') eq 'Elasticsearch' ) {
2572 # TODO abstract to a standard API that'll work for whatever
2573 require Koha::SearchEngine::Elasticsearch::Indexer;
2574 my $indexer = Koha::SearchEngine::Elasticsearch::Indexer->new(
2576 index => $server eq 'biblioserver'
2577 ? $Koha::SearchEngine::BIBLIOS_INDEX
2578 : $Koha::SearchEngine::AUTHORITIES_INDEX
2581 if ( $op eq 'specialUpdate' ) {
2583 $record = GetMarcBiblio({
2584 biblionumber => $biblionumber,
2585 embed_items => 1 });
2587 my $records = [$record];
2588 $indexer->update_index_background( [$biblionumber], [$record] );
2590 elsif ( $op eq 'recordDelete' ) {
2591 $indexer->delete_index_background( [$biblionumber] );
2594 croak "ModZebra called with unknown operation: $op";
2598 my $dbh = C4::Context->dbh;
2600 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2602 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2603 # the table is emptied by rebuild_zebra.pl script (using the -z switch)
2604 my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2606 AND biblio_auth_number = ?
2609 my $check_sth = $dbh->prepare_cached($check_sql);
2610 $check_sth->execute( $server, $biblionumber, $op );
2611 my ($count) = $check_sth->fetchrow_array;
2612 $check_sth->finish();
2613 if ( $count == 0 ) {
2614 my $sth = $dbh->prepare("INSERT INTO zebraqueue (biblio_auth_number,server,operation) VALUES(?,?,?)");
2615 $sth->execute( $biblionumber, $server, $op );
2621 =head2 EmbedItemsInMarcBiblio
2623 EmbedItemsInMarcBiblio({
2624 marc_record => $marc,
2625 biblionumber => $biblionumber,
2626 item_numbers => $itemnumbers,
2629 Given a MARC::Record object containing a bib record,
2630 modify it to include the items attached to it as 9XX
2631 per the bib's MARC framework.
2632 if $itemnumbers is defined, only specified itemnumbers are embedded.
2634 If $opac is true, then opac-relevant suppressions are included.
2636 If opac filtering will be done, borcat should be passed to properly
2637 override if necessary.
2641 sub EmbedItemsInMarcBiblio {
2643 my ($marc, $biblionumber, $itemnumbers, $opac, $borcat);
2644 $marc = $params->{marc_record};
2646 carp 'EmbedItemsInMarcBiblio: No MARC record passed';
2649 $biblionumber = $params->{biblionumber};
2650 $itemnumbers = $params->{item_numbers};
2651 $opac = $params->{opac};
2652 $borcat = $params->{borcat} // q{};
2654 $itemnumbers = [] unless defined $itemnumbers;
2656 my $frameworkcode = GetFrameworkCode($biblionumber);
2657 _strip_item_fields($marc, $frameworkcode);
2659 # ... and embed the current items
2660 my $dbh = C4::Context->dbh;
2661 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2662 $sth->execute($biblionumber);
2663 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2665 my @item_fields; # Array holding the actual MARC data for items to be included.
2666 my @items; # Array holding items which are both in the list (sitenumbers)
2667 # and on this biblionumber
2669 # Flag indicating if there is potential hiding.
2670 my $opachiddenitems = $opac
2671 && ( C4::Context->preference('OpacHiddenItems') !~ /^\s*$/ );
2674 while ( my ($itemnumber) = $sth->fetchrow_array ) {
2675 next if @$itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers;
2677 if ( $opachiddenitems ) {
2678 $item = Koha::Items->find($itemnumber);
2679 $item = $item ? $item->unblessed : undef;
2681 push @items, { itemnumber => $itemnumber, item => $item };
2683 my @items2pass = map { $_->{item} } @items;
2686 ? C4::Items::GetHiddenItemnumbers({
2687 items => \@items2pass,
2688 borcat => $borcat })
2690 # Convert to a hash for quick searching
2691 my %hiddenitems = map { $_ => 1 } @hiddenitems;
2692 foreach my $itemnumber ( map { $_->{itemnumber} } @items ) {
2693 next if $hiddenitems{$itemnumber};
2694 my $item_marc = C4::Items::GetMarcItem( $biblionumber, $itemnumber );
2695 push @item_fields, $item_marc->field($itemtag);
2697 $marc->append_fields(@item_fields);
2700 =head1 INTERNAL FUNCTIONS
2702 =head2 _koha_marc_update_bib_ids
2705 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2707 Internal function to add or update biblionumber and biblioitemnumber to
2712 sub _koha_marc_update_bib_ids {
2713 my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
2715 my ( $biblio_tag, $biblio_subfield ) = GetMarcFromKohaField( "biblio.biblionumber", $frameworkcode );
2716 die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
2717 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
2718 die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
2720 if ( $biblio_tag < 10 ) {
2721 C4::Biblio::UpsertMarcControlField( $record, $biblio_tag, $biblionumber );
2723 C4::Biblio::UpsertMarcSubfield($record, $biblio_tag, $biblio_subfield, $biblionumber);
2725 if ( $biblioitem_tag < 10 ) {
2726 C4::Biblio::UpsertMarcControlField( $record, $biblioitem_tag, $biblioitemnumber );
2728 C4::Biblio::UpsertMarcSubfield($record, $biblioitem_tag, $biblioitem_subfield, $biblioitemnumber);
2732 =head2 _koha_marc_update_biblioitem_cn_sort
2734 _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
2736 Given a MARC bib record and the biblioitem hash, update the
2737 subfield that contains a copy of the value of biblioitems.cn_sort.
2741 sub _koha_marc_update_biblioitem_cn_sort {
2743 my $biblioitem = shift;
2744 my $frameworkcode = shift;
2746 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort", $frameworkcode );
2747 return unless $biblioitem_tag;
2749 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2751 if ( my $field = $marc->field($biblioitem_tag) ) {
2752 $field->delete_subfield( code => $biblioitem_subfield );
2753 if ( $cn_sort ne '' ) {
2754 $field->add_subfields( $biblioitem_subfield => $cn_sort );
2758 # if we get here, no biblioitem tag is present in the MARC record, so
2759 # we'll create it if $cn_sort is not empty -- this would be
2760 # an odd combination of events, however
2762 $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
2767 =head2 _koha_add_biblio
2769 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
2771 Internal function to add a biblio ($biblio is a hash with the values)
2775 sub _koha_add_biblio {
2776 my ( $dbh, $biblio, $frameworkcode ) = @_;
2780 # set the series flag
2781 unless (defined $biblio->{'serial'}){
2782 $biblio->{'serial'} = 0;
2783 if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
2786 my $query = "INSERT INTO biblio
2787 SET frameworkcode = ?,
2798 my $sth = $dbh->prepare($query);
2800 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
2801 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
2804 my $biblionumber = $dbh->{'mysql_insertid'};
2805 if ( $dbh->errstr ) {
2806 $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
2812 #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
2813 return ( $biblionumber, $error );
2816 =head2 _koha_modify_biblio
2818 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
2820 Internal function for updating the biblio table
2824 sub _koha_modify_biblio {
2825 my ( $dbh, $biblio, $frameworkcode ) = @_;
2830 SET frameworkcode = ?,
2839 WHERE biblionumber = ?
2842 my $sth = $dbh->prepare($query);
2845 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'},
2846 $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'} ? int($biblio->{'copyrightdate'}) : undef, $biblio->{'abstract'}, $biblio->{'biblionumber'}
2847 ) if $biblio->{'biblionumber'};
2849 if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
2850 $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
2853 return ( $biblio->{'biblionumber'}, $error );
2856 =head2 _koha_modify_biblioitem_nonmarc
2858 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
2862 sub _koha_modify_biblioitem_nonmarc {
2863 my ( $dbh, $biblioitem ) = @_;
2866 # re-calculate the cn_sort, it may have changed
2867 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2869 my $query = "UPDATE biblioitems
2870 SET biblionumber = ?,
2876 publicationyear = ?,
2880 collectiontitle = ?,
2882 collectionvolume= ?,
2883 editionstatement= ?,
2884 editionresponsibility = ?,
2900 where biblioitemnumber = ?
2902 my $sth = $dbh->prepare($query);
2904 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
2905 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
2906 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
2907 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
2908 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
2909 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
2910 $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort, $biblioitem->{'totalissues'},
2911 $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}, $biblioitem->{'biblioitemnumber'}
2913 if ( $dbh->errstr ) {
2914 $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
2917 return ( $biblioitem->{'biblioitemnumber'}, $error );
2920 =head2 _koha_add_biblioitem
2922 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
2924 Internal function to add a biblioitem
2928 sub _koha_add_biblioitem {
2929 my ( $dbh, $biblioitem ) = @_;
2932 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2933 my $query = "INSERT INTO biblioitems SET
2940 publicationyear = ?,
2944 collectiontitle = ?,
2946 collectionvolume= ?,
2947 editionstatement= ?,
2948 editionresponsibility = ?,
2965 my $sth = $dbh->prepare($query);
2967 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
2968 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
2969 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
2970 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
2971 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
2972 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'},
2973 $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort,
2974 $biblioitem->{'totalissues'}, $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}
2976 my $bibitemnum = $dbh->{'mysql_insertid'};
2978 if ( $dbh->errstr ) {
2979 $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
2983 return ( $bibitemnum, $error );
2986 =head2 _koha_delete_biblio
2988 $error = _koha_delete_biblio($dbh,$biblionumber);
2990 Internal sub for deleting from biblio table -- also saves to deletedbiblio
2992 C<$dbh> - the database handle
2994 C<$biblionumber> - the biblionumber of the biblio to be deleted
2998 # FIXME: add error handling
3000 sub _koha_delete_biblio {
3001 my ( $dbh, $biblionumber ) = @_;
3003 # get all the data for this biblio
3004 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3005 $sth->execute($biblionumber);
3007 # FIXME There is a transaction in _koha_delete_biblio_metadata
3008 # But actually all the following should be done inside a single transaction
3009 if ( my $data = $sth->fetchrow_hashref ) {
3011 # save the record in deletedbiblio
3012 # find the fields to save
3013 my $query = "INSERT INTO deletedbiblio SET ";
3015 foreach my $temp ( keys %$data ) {
3016 $query .= "$temp = ?,";
3017 push( @bind, $data->{$temp} );
3020 # replace the last , by ",?)"
3022 my $bkup_sth = $dbh->prepare($query);
3023 $bkup_sth->execute(@bind);
3026 _koha_delete_biblio_metadata( $biblionumber );
3029 my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3030 $sth2->execute($biblionumber);
3031 # update the timestamp (Bugzilla 7146)
3032 $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
3033 $sth2->execute($biblionumber);
3040 =head2 _koha_delete_biblioitems
3042 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3044 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3046 C<$dbh> - the database handle
3047 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3051 # FIXME: add error handling
3053 sub _koha_delete_biblioitems {
3054 my ( $dbh, $biblioitemnumber ) = @_;
3056 # get all the data for this biblioitem
3057 my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3058 $sth->execute($biblioitemnumber);
3060 if ( my $data = $sth->fetchrow_hashref ) {
3062 # save the record in deletedbiblioitems
3063 # find the fields to save
3064 my $query = "INSERT INTO deletedbiblioitems SET ";
3066 foreach my $temp ( keys %$data ) {
3067 $query .= "$temp = ?,";
3068 push( @bind, $data->{$temp} );
3071 # replace the last , by ",?)"
3073 my $bkup_sth = $dbh->prepare($query);
3074 $bkup_sth->execute(@bind);
3077 # delete the biblioitem
3078 my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3079 $sth2->execute($biblioitemnumber);
3080 # update the timestamp (Bugzilla 7146)
3081 $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
3082 $sth2->execute($biblioitemnumber);
3089 =head2 _koha_delete_biblio_metadata
3091 $error = _koha_delete_biblio_metadata($biblionumber);
3093 C<$biblionumber> - the biblionumber of the biblio metadata to be deleted
3097 sub _koha_delete_biblio_metadata {
3098 my ($biblionumber) = @_;
3100 my $dbh = C4::Context->dbh;
3101 my $schema = Koha::Database->new->schema;
3105 INSERT INTO deletedbiblio_metadata (biblionumber, format, `schema`, metadata)
3106 SELECT biblionumber, format, `schema`, metadata FROM biblio_metadata WHERE biblionumber=?
3107 |, undef, $biblionumber );
3108 $dbh->do( q|DELETE FROM biblio_metadata WHERE biblionumber=?|,
3109 undef, $biblionumber );
3114 =head1 UNEXPORTED FUNCTIONS
3116 =head2 ModBiblioMarc
3118 &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3120 Add MARC XML data for a biblio to koha
3122 Function exported, but should NOT be used, unless you really know what you're doing
3127 # pass the MARC::Record to this function, and it will create the records in
3129 my ( $record, $biblionumber, $frameworkcode ) = @_;
3131 carp 'ModBiblioMarc passed an undefined record';
3135 # Clone record as it gets modified
3136 $record = $record->clone();
3137 my $dbh = C4::Context->dbh;
3138 my @fields = $record->fields();
3139 if ( !$frameworkcode ) {
3140 $frameworkcode = "";
3142 my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3143 $sth->execute( $frameworkcode, $biblionumber );
3145 my $encoding = C4::Context->preference("marcflavour");
3147 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3148 if ( $encoding eq "UNIMARC" ) {
3149 my $defaultlanguage = C4::Context->preference("UNIMARCField100Language");
3150 $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
3151 my $string = $record->subfield( 100, "a" );
3152 if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3153 my $f100 = $record->field(100);
3154 $record->delete_field($f100);
3156 $string = POSIX::strftime( "%Y%m%d", localtime );
3158 $string = sprintf( "%-*s", 35, $string );
3159 substr ( $string, 22, 3, $defaultlanguage);
3161 substr( $string, 25, 3, "y50" );
3162 unless ( $record->subfield( 100, "a" ) ) {
3163 $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
3167 #enhancement 5374: update transaction date (005) for marc21/unimarc
3168 if($encoding =~ /MARC21|UNIMARC/) {
3169 my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3170 # YY MM DD HH MM SS (update year and month)
3171 my $f005= $record->field('005');
3172 $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3176 biblionumber => $biblionumber,
3177 format => 'marcxml',
3178 schema => C4::Context->preference('marcflavour'),
3180 $record->as_usmarc; # Bug 20126/10455 This triggers field length calculation
3182 my $m_rs = Koha::Biblio::Metadatas->find($metadata) //
3183 Koha::Biblio::Metadata->new($metadata);
3185 my $userenv = C4::Context->userenv;
3187 my $borrowernumber = $userenv->{number};
3188 my $borrowername = join ' ', map { $_ // q{} } @$userenv{qw(firstname surname)};
3189 unless ($m_rs->in_storage) {
3190 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorId'), $borrowernumber);
3191 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorName'), $borrowername);
3193 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierId'), $borrowernumber);
3194 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierName'), $borrowername);
3197 $m_rs->metadata( $record->as_xml_record($encoding) );
3200 ModZebra( $biblionumber, "specialUpdate", "biblioserver" );
3201 return $biblionumber;
3204 =head2 CountBiblioInOrders
3206 $count = &CountBiblioInOrders( $biblionumber);
3208 This function return count of biblios in orders with $biblionumber
3212 sub CountBiblioInOrders {
3213 my ($biblionumber) = @_;
3214 my $dbh = C4::Context->dbh;
3215 my $query = "SELECT count(*)
3217 WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')";
3218 my $sth = $dbh->prepare($query);
3219 $sth->execute($biblionumber);
3220 my $count = $sth->fetchrow;
3224 =head2 prepare_host_field
3226 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
3227 Generate the host item entry for an analytic child entry
3231 sub prepare_host_field {
3232 my ( $hostbiblio, $marcflavour ) = @_;
3233 $marcflavour ||= C4::Context->preference('marcflavour');
3234 my $host = GetMarcBiblio({ biblionumber => $hostbiblio });
3235 # unfortunately as_string does not 'do the right thing'
3236 # if field returns undef
3240 if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
3241 if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
3242 my $s = $field->as_string('ab');
3247 if ( $field = $host->field('245') ) {
3248 my $s = $field->as_string('a');
3253 if ( $field = $host->field('260') ) {
3254 my $s = $field->as_string('abc');
3259 if ( $field = $host->field('240') ) {
3260 my $s = $field->as_string();
3265 if ( $field = $host->field('022') ) {
3266 my $s = $field->as_string('a');
3271 if ( $field = $host->field('020') ) {
3272 my $s = $field->as_string('a');
3277 if ( $field = $host->field('001') ) {
3278 $sfd{w} = $field->data(),;
3280 $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
3283 elsif ( $marcflavour eq 'UNIMARC' ) {
3285 if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3286 my $s = $field->as_string('ab');
3292 if ( $field = $host->field('200') ) {
3293 my $s = $field->as_string('a');
3298 #place of publicaton
3299 if ( $field = $host->field('210') ) {
3300 my $s = $field->as_string('a');
3305 #date of publication
3306 if ( $field = $host->field('210') ) {
3307 my $s = $field->as_string('d');
3313 if ( $field = $host->field('205') ) {
3314 my $s = $field->as_string();
3320 if ( $field = $host->field('856') ) {
3321 my $s = $field->as_string('u');
3327 if ( $field = $host->field('011') ) {
3328 my $s = $field->as_string('a');
3334 if ( $field = $host->field('010') ) {
3335 my $s = $field->as_string('a');
3340 if ( $field = $host->field('001') ) {
3341 $sfd{0} = $field->data(),;
3343 $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
3350 =head2 UpdateTotalIssues
3352 UpdateTotalIssues($biblionumber, $increase, [$value])
3354 Update the total issue count for a particular bib record.
3358 =item C<$biblionumber> is the biblionumber of the bib to update
3360 =item C<$increase> is the amount to increase (or decrease) the total issues count by
3362 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
3368 sub UpdateTotalIssues {
3369 my ($biblionumber, $increase, $value) = @_;
3372 my $record = GetMarcBiblio({ biblionumber => $biblionumber });
3374 carp "UpdateTotalIssues could not get biblio record";
3377 my $biblio = Koha::Biblios->find( $biblionumber );
3379 carp "UpdateTotalIssues could not get datas of biblio";
3382 my $biblioitem = $biblio->biblioitem;
3383 my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField('biblioitems.totalissues', $biblio->frameworkcode);
3384 unless ($totalissuestag) {
3385 return 1; # There is nothing to do
3388 if (defined $value) {
3389 $totalissues = $value;
3391 $totalissues = $biblioitem->totalissues + $increase;
3394 my $field = $record->field($totalissuestag);
3395 if (defined $field) {
3396 $field->update( $totalissuessubfield => $totalissues );
3398 $field = MARC::Field->new($totalissuestag, '0', '0',
3399 $totalissuessubfield => $totalissues);
3400 $record->insert_grouped_field($field);
3403 return ModBiblio($record, $biblionumber, $biblio->frameworkcode);
3408 &RemoveAllNsb($record);
3410 Removes all nsb/nse chars from a record
3417 carp 'RemoveAllNsb called with undefined record';
3421 SetUTF8Flag($record);
3423 foreach my $field ($record->fields()) {
3424 if ($field->is_control_field()) {
3425 $field->update(nsb_clean($field->data()));
3427 my @subfields = $field->subfields();
3429 foreach my $subfield (@subfields) {
3430 push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
3432 if (scalar(@new_subfields) > 0) {
3435 $new_field = MARC::Field->new(
3437 $field->indicator(1),
3438 $field->indicator(2),
3443 warn "error in RemoveAllNsb : $@";
3445 $field->replace_with($new_field);
3461 Koha Development Team <http://koha-community.org/>
3463 Paul POULAIN paul.poulain@free.fr
3465 Joshua Ferraro jmf@liblime.com