Bug 18309: UNIMARC update from IFLA - authority (fr) (FAM)
[koha.git] / C4 / Biblio.pm
blob55a2c018905551e7733062df9db3977d10cf69c8
1 package C4::Biblio;
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>.
22 use Modern::Perl;
24 use vars qw(@ISA @EXPORT);
25 BEGIN {
26 require Exporter;
27 @ISA = qw(Exporter);
29 @EXPORT = qw(
30 AddBiblio
31 GetBiblioData
32 GetMarcBiblio
33 GetISBDView
34 GetMarcControlnumber
35 GetMarcNotes
36 GetMarcISBN
37 GetMarcISSN
38 GetMarcSubjects
39 GetMarcAuthors
40 GetMarcSeries
41 GetMarcHosts
42 GetMarcUrls
43 GetUsedMarcStructure
44 GetXmlBiblio
45 GetMarcPrice
46 MungeMarcPrice
47 GetMarcQuantity
48 GetAuthorisedValueDesc
49 GetMarcStructure
50 IsMarcStructureInternal
51 GetMarcFromKohaField
52 GetMarcSubfieldStructureFromKohaField
53 GetFrameworkCode
54 TransformKohaToMarc
55 PrepHostMarcField
56 CountItemsIssued
57 CountBiblioInOrders
58 ModBiblio
59 ModZebra
60 UpdateTotalIssues
61 RemoveAllNsb
62 DelBiblio
63 BiblioAutoLink
64 LinkBibHeadingsToAuthorities
65 TransformMarcToKoha
66 TransformHtmlToMarc
67 TransformHtmlToXml
68 prepare_host_field
71 # Internal functions
72 # those functions are exported but should not be used
73 # they are useful in a few circumstances, so they are exported,
74 # but don't use them unless you are a core developer ;-)
75 push @EXPORT, qw(
76 ModBiblioMarc
80 use Carp;
81 use Try::Tiny;
83 use Encode qw( decode is_utf8 );
84 use List::MoreUtils qw( uniq );
85 use MARC::Record;
86 use MARC::File::USMARC;
87 use MARC::File::XML;
88 use POSIX qw(strftime);
89 use Module::Load::Conditional qw(can_load);
91 use C4::Koha;
92 use C4::Log; # logaction
93 use C4::Budgets;
94 use C4::ClassSource;
95 use C4::Charset;
96 use C4::Linker;
97 use C4::OAI::Sets;
98 use C4::Debug;
100 use Koha::Caches;
101 use Koha::Authority::Types;
102 use Koha::Acquisition::Currencies;
103 use Koha::Biblio::Metadatas;
104 use Koha::Holds;
105 use Koha::ItemTypes;
106 use Koha::Plugins;
107 use Koha::SearchEngine;
108 use Koha::Libraries;
109 use Koha::Util::MARC;
111 use vars qw($debug $cgi_debug);
114 =head1 NAME
116 C4::Biblio - cataloging management functions
118 =head1 DESCRIPTION
120 Biblio.pm contains functions for managing storage and editing of bibliographic data within Koha. Most of the functions in this module are used for cataloging records: adding, editing, or removing biblios, biblioitems, or items. Koha's stores bibliographic information in three places:
122 =over 4
124 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
126 =item 2. as raw MARC in the Zebra index and storage engine
128 =item 3. as MARC XML in biblio_metadata.metadata
130 =back
132 In the 3.0 version of Koha, the authoritative record-level information is in biblio_metadata.metadata
134 Because the data isn't completely normalized there's a chance for information to get out of sync. The design choice to go with a un-normalized schema was driven by performance and stability concerns. However, if this occur, it can be considered as a bug : The API is (or should be) complete & the only entry point for all biblio/items managements.
136 =over 4
138 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
140 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
142 =back
144 Because of this design choice, the process of managing storage and editing is a bit convoluted. Historically, Biblio.pm's grown to an unmanagable size and as a result we have several types of functions currently:
146 =over 4
148 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
150 =item 2. _koha_* - low-level internal functions for managing the koha tables
152 =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.
154 =item 4. Zebra functions used to update the Zebra index
156 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
158 =back
160 The MARC record (in biblio_metadata.metadata) contains the complete marc record, including items. It also contains the biblionumber. That is the reason why it is not stored directly by AddBiblio, with all other fields . To save a biblio, we need to :
162 =over 4
164 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
166 =item 2. add the biblionumber and biblioitemnumber into the MARC records
168 =item 3. save the marc record
170 =back
172 =head1 EXPORTED FUNCTIONS
174 =head2 AddBiblio
176 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
178 Exported function (core API) for adding a new biblio to koha.
180 The first argument is a C<MARC::Record> object containing the
181 bib to add, while the second argument is the desired MARC
182 framework code.
184 This function also accepts a third, optional argument: a hashref
185 to additional options. The only defined option is C<defer_marc_save>,
186 which if present and mapped to a true value, causes C<AddBiblio>
187 to omit the call to save the MARC in C<biblio_metadata.metadata>
188 This option is provided B<only>
189 for the use of scripts such as C<bulkmarcimport.pl> that may need
190 to do some manipulation of the MARC record for item parsing before
191 saving it and which cannot afford the performance hit of saving
192 the MARC record twice. Consequently, do not use that option
193 unless you can guarantee that C<ModBiblioMarc> will be called.
195 =cut
197 sub AddBiblio {
198 my $record = shift;
199 my $frameworkcode = shift;
200 my $options = @_ ? shift : undef;
201 my $defer_marc_save = 0;
202 if (!$record) {
203 carp('AddBiblio called with undefined record');
204 return;
206 if ( defined $options and exists $options->{'defer_marc_save'} and $options->{'defer_marc_save'} ) {
207 $defer_marc_save = 1;
210 if (C4::Context->preference('BiblioAddsAuthorities')) {
211 BiblioAutoLink( $record, $frameworkcode );
214 my ( $biblionumber, $biblioitemnumber, $error );
215 my $dbh = C4::Context->dbh;
217 # transform the data into koha-table style data
218 SetUTF8Flag($record);
219 my $olddata = TransformMarcToKoha( $record, $frameworkcode );
220 ( $biblionumber, $error ) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
221 $olddata->{'biblionumber'} = $biblionumber;
222 ( $biblioitemnumber, $error ) = _koha_add_biblioitem( $dbh, $olddata );
224 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
226 # update MARC subfield that stores biblioitems.cn_sort
227 _koha_marc_update_biblioitem_cn_sort( $record, $olddata, $frameworkcode );
229 # now add the record
230 ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
232 # update OAI-PMH sets
233 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
234 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
237 _after_biblio_action_hooks({ action => 'create', biblio_id => $biblionumber });
239 logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
240 return ( $biblionumber, $biblioitemnumber );
243 =head2 ModBiblio
245 ModBiblio( $record,$biblionumber,$frameworkcode, $disable_autolink);
247 Replace an existing bib record identified by C<$biblionumber>
248 with one supplied by the MARC::Record object C<$record>. The embedded
249 item, biblioitem, and biblionumber fields from the previous
250 version of the bib record replace any such fields of those tags that
251 are present in C<$record>. Consequently, ModBiblio() is not
252 to be used to try to modify item records.
254 C<$frameworkcode> specifies the MARC framework to use
255 when storing the modified bib record; among other things,
256 this controls how MARC fields get mapped to display columns
257 in the C<biblio> and C<biblioitems> tables, as well as
258 which fields are used to store embedded item, biblioitem,
259 and biblionumber data for indexing.
261 Unless C<$disable_autolink> is passed ModBiblio will relink record headings
262 to authorities based on settings in the system preferences. This flag allows
263 us to not relink records when the authority linker is saving modifications.
265 Returns 1 on success 0 on failure
267 =cut
269 sub ModBiblio {
270 my ( $record, $biblionumber, $frameworkcode, $disable_autolink ) = @_;
271 if (!$record) {
272 carp 'No record passed to ModBiblio';
273 return 0;
276 if ( C4::Context->preference("CataloguingLog") ) {
277 my $newrecord = GetMarcBiblio({ biblionumber => $biblionumber });
278 logaction( "CATALOGUING", "MODIFY", $biblionumber, "biblio BEFORE=>" . $newrecord->as_formatted );
281 if ( !$disable_autolink && C4::Context->preference('BiblioAddsAuthorities') ) {
282 BiblioAutoLink( $record, $frameworkcode );
285 # Cleaning up invalid fields must be done early or SetUTF8Flag is liable to
286 # throw an exception which probably won't be handled.
287 foreach my $field ($record->fields()) {
288 if (! $field->is_control_field()) {
289 if (scalar($field->subfields()) == 0 || (scalar($field->subfields()) == 1 && $field->subfield('9'))) {
290 $record->delete_field($field);
295 SetUTF8Flag($record);
296 my $dbh = C4::Context->dbh;
298 $frameworkcode = "" if !$frameworkcode || $frameworkcode eq "Default"; # XXX
300 _strip_item_fields($record, $frameworkcode);
302 # update biblionumber and biblioitemnumber in MARC
303 # FIXME - this is assuming a 1 to 1 relationship between
304 # biblios and biblioitems
305 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
306 $sth->execute($biblionumber);
307 my ($biblioitemnumber) = $sth->fetchrow;
308 $sth->finish();
309 _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
311 # load the koha-table data object
312 my $oldbiblio = TransformMarcToKoha( $record, $frameworkcode );
314 # update MARC subfield that stores biblioitems.cn_sort
315 _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode );
317 # update the MARC record (that now contains biblio and items) with the new record data
318 &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
320 # modify the other koha tables
321 _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
322 _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
324 _after_biblio_action_hooks({ action => 'modify', biblio_id => $biblionumber });
326 # update OAI-PMH sets
327 if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
328 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
331 return 1;
334 =head2 _strip_item_fields
336 _strip_item_fields($record, $frameworkcode)
338 Utility routine to remove item tags from a
339 MARC bib.
341 =cut
343 sub _strip_item_fields {
344 my $record = shift;
345 my $frameworkcode = shift;
346 # get the items before and append them to the biblio before updating the record, atm we just have the biblio
347 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber" );
349 # delete any item fields from incoming record to avoid
350 # duplication or incorrect data - use AddItem() or ModItem()
351 # to change items
352 foreach my $field ( $record->field($itemtag) ) {
353 $record->delete_field($field);
357 =head2 DelBiblio
359 my $error = &DelBiblio($biblionumber);
361 Exported function (core API) for deleting a biblio in koha.
362 Deletes biblio record from Zebra and Koha tables (biblio & biblioitems)
363 Also backs it up to deleted* tables.
364 Checks to make sure that the biblio has no items attached.
365 return:
366 C<$error> : undef unless an error occurs
368 =cut
370 sub DelBiblio {
371 my ($biblionumber) = @_;
373 my $biblio = Koha::Biblios->find( $biblionumber );
374 return unless $biblio; # Should we throw an exception instead?
376 my $dbh = C4::Context->dbh;
377 my $error; # for error handling
379 # First make sure this biblio has no items attached
380 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
381 $sth->execute($biblionumber);
382 if ( my $itemnumber = $sth->fetchrow ) {
384 # Fix this to use a status the template can understand
385 $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
388 return $error if $error;
390 # We delete attached subscriptions
391 require C4::Serials;
392 my $subscriptions = C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
393 foreach my $subscription (@$subscriptions) {
394 C4::Serials::DelSubscription( $subscription->{subscriptionid} );
397 # We delete any existing holds
398 my $holds = $biblio->holds;
399 while ( my $hold = $holds->next ) {
400 $hold->cancel;
403 # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
404 # for at least 2 reasons :
405 # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
406 # 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)
407 ModZebra( $biblionumber, "recordDelete", "biblioserver" );
409 # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
410 $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
411 $sth->execute($biblionumber);
412 while ( my $biblioitemnumber = $sth->fetchrow ) {
414 # delete this biblioitem
415 $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
416 return $error if $error;
420 # delete biblio from Koha tables and save in deletedbiblio
421 # must do this *after* _koha_delete_biblioitems, otherwise
422 # delete cascade will prevent deletedbiblioitems rows
423 # from being generated by _koha_delete_biblioitems
424 $error = _koha_delete_biblio( $dbh, $biblionumber );
426 _after_biblio_action_hooks({ action => 'delete', biblio_id => $biblionumber });
428 logaction( "CATALOGUING", "DELETE", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
430 return;
434 =head2 BiblioAutoLink
436 my $headings_linked = BiblioAutoLink($record, $frameworkcode)
438 Automatically links headings in a bib record to authorities.
440 Returns the number of headings changed
442 =cut
444 sub BiblioAutoLink {
445 my $record = shift;
446 my $frameworkcode = shift;
447 if (!$record) {
448 carp('Undefined record passed to BiblioAutoLink');
449 return 0;
451 my ( $num_headings_changed, %results );
453 my $linker_module =
454 "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
455 unless ( can_load( modules => { $linker_module => undef } ) ) {
456 $linker_module = 'C4::Linker::Default';
457 unless ( can_load( modules => { $linker_module => undef } ) ) {
458 return 0;
462 my $linker = $linker_module->new(
463 { 'options' => C4::Context->preference("LinkerOptions") } );
464 my ( $headings_changed, undef ) =
465 LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, C4::Context->preference("CatalogModuleRelink") || '' );
466 # By default we probably don't want to relink things when cataloging
467 return $headings_changed;
470 =head2 LinkBibHeadingsToAuthorities
472 my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink]);
474 Links bib headings to authority records by checking
475 each authority-controlled field in the C<MARC::Record>
476 object C<$marc>, looking for a matching authority record,
477 and setting the linking subfield $9 to the ID of that
478 authority record.
480 If $allowrelink is false, existing authids will never be
481 replaced, regardless of the values of LinkerKeepStale and
482 LinkerRelink.
484 Returns the number of heading links changed in the
485 MARC record.
487 =cut
489 sub LinkBibHeadingsToAuthorities {
490 my $linker = shift;
491 my $bib = shift;
492 my $frameworkcode = shift;
493 my $allowrelink = shift;
494 my %results;
495 if (!$bib) {
496 carp 'LinkBibHeadingsToAuthorities called on undefined bib record';
497 return ( 0, {});
499 require C4::Heading;
500 require C4::AuthoritiesMarc;
502 $allowrelink = 1 unless defined $allowrelink;
503 my $num_headings_changed = 0;
504 foreach my $field ( $bib->fields() ) {
505 my $heading = C4::Heading->new_from_bib_field( $field, $frameworkcode );
506 next unless defined $heading;
508 # check existing $9
509 my $current_link = $field->subfield('9');
511 if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) )
513 $results{'linked'}->{ $heading->display_form() }++;
514 next;
517 my ( $authid, $fuzzy ) = $linker->get_link($heading);
518 if ($authid) {
519 $results{ $fuzzy ? 'fuzzy' : 'linked' }
520 ->{ $heading->display_form() }++;
521 next if defined $current_link and $current_link == $authid;
523 $field->delete_subfield( code => '9' ) if defined $current_link;
524 $field->add_subfields( '9', $authid );
525 $num_headings_changed++;
527 else {
528 if ( defined $current_link
529 && (!$allowrelink || C4::Context->preference('LinkerKeepStale')) )
531 $results{'fuzzy'}->{ $heading->display_form() }++;
533 elsif ( C4::Context->preference('AutoCreateAuthorities') ) {
534 if ( _check_valid_auth_link( $current_link, $field ) ) {
535 $results{'linked'}->{ $heading->display_form() }++;
537 else {
538 my $authority_type = Koha::Authority::Types->find( $heading->auth_type() );
539 my $marcrecordauth = MARC::Record->new();
540 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
541 $marcrecordauth->leader(' nz a22 o 4500');
542 SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
544 $field->delete_subfield( code => '9' )
545 if defined $current_link;
546 my $authfield =
547 MARC::Field->new( $authority_type->auth_tag_to_report,
548 '', '', "a" => "" . $field->subfield('a') );
549 map {
550 $authfield->add_subfields( $_->[0] => $_->[1] )
551 if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a"
552 && C4::Heading::valid_bib_heading_subfield(
553 $authority_type->auth_tag_to_report, $_->[0] )
555 } $field->subfields();
556 $marcrecordauth->insert_fields_ordered($authfield);
558 # bug 2317: ensure new authority knows it's using UTF-8; currently
559 # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
560 # automatically for UNIMARC (by not transcoding)
561 # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
562 # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
563 # of change to a core API just before the 3.0 release.
565 if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
566 my $userenv = C4::Context->userenv;
567 my $library;
568 if ( $userenv && $userenv->{'branch'} ) {
569 $library = Koha::Libraries->find( $userenv->{'branch'} );
571 $marcrecordauth->insert_fields_ordered(
572 MARC::Field->new(
573 '667', '', '',
574 'a' => "Machine generated authority record."
577 my $cite =
578 $bib->author() . ", "
579 . $bib->title_proper() . ", "
580 . $bib->publication_date() . " ";
581 $cite =~ s/^[\s\,]*//;
582 $cite =~ s/[\s\,]*$//;
583 $cite =
584 "Work cat.: ("
585 . ( $library ? $library->get_effective_marcorgcode : C4::Context->preference('MARCOrgCode') ) . ")"
586 . $bib->subfield( '999', 'c' ) . ": "
587 . $cite;
588 $marcrecordauth->insert_fields_ordered(
589 MARC::Field->new( '670', '', '', 'a' => $cite ) );
592 # warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
594 $authid =
595 C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '',
596 $heading->auth_type() );
597 $field->add_subfields( '9', $authid );
598 $num_headings_changed++;
599 $linker->update_cache($heading, $authid);
600 $results{'added'}->{ $heading->display_form() }++;
603 elsif ( defined $current_link ) {
604 if ( _check_valid_auth_link( $current_link, $field ) ) {
605 $results{'linked'}->{ $heading->display_form() }++;
607 else {
608 $field->delete_subfield( code => '9' );
609 $num_headings_changed++;
610 $results{'unlinked'}->{ $heading->display_form() }++;
613 else {
614 $results{'unlinked'}->{ $heading->display_form() }++;
619 return $num_headings_changed, \%results;
622 =head2 _check_valid_auth_link
624 if ( _check_valid_auth_link($authid, $field) ) {
628 Check whether the specified heading-auth link is valid without reference
629 to Zebra. Ideally this code would be in C4::Heading, but that won't be
630 possible until we have de-cycled C4::AuthoritiesMarc, so this is the
631 safest place.
633 =cut
635 sub _check_valid_auth_link {
636 my ( $authid, $field ) = @_;
637 require C4::AuthoritiesMarc;
639 my $authorized_heading =
640 C4::AuthoritiesMarc::GetAuthorizedHeading( { 'authid' => $authid } ) || '';
641 return ($field->as_string('abcdefghijklmnopqrstuvwxyz') eq $authorized_heading);
644 =head2 GetBiblioData
646 $data = &GetBiblioData($biblionumber);
648 Returns information about the book with the given biblionumber.
649 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
650 the C<biblio> and C<biblioitems> tables in the
651 Koha database.
653 In addition, C<$data-E<gt>{subject}> is the list of the book's
654 subjects, separated by C<" , "> (space, comma, space).
655 If there are multiple biblioitems with the given biblionumber, only
656 the first one is considered.
658 =cut
660 sub GetBiblioData {
661 my ($bibnum) = @_;
662 my $dbh = C4::Context->dbh;
664 my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
665 FROM biblio
666 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
667 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
668 WHERE biblio.biblionumber = ?";
670 my $sth = $dbh->prepare($query);
671 $sth->execute($bibnum);
672 my $data;
673 $data = $sth->fetchrow_hashref;
674 $sth->finish;
676 return ($data);
677 } # sub GetBiblioData
679 =head2 GetISBDView
681 $isbd = &GetISBDView({
682 'record' => $marc_record,
683 'template' => $interface, # opac/intranet
684 'framework' => $framework,
687 Return the ISBD view which can be included in opac and intranet
689 =cut
691 sub GetISBDView {
692 my ( $params ) = @_;
694 # Expecting record WITH items.
695 my $record = $params->{record};
696 return unless defined $record;
698 my $template = $params->{template} // q{};
699 my $sysprefname = $template eq 'opac' ? 'opacisbd' : 'isbd';
700 my $framework = $params->{framework};
701 my $itemtype = $framework;
702 my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField( "items.holdingbranch" );
703 my $tagslib = GetMarcStructure( 1, $itemtype, { unsafe => 1 } );
705 my $ISBD = C4::Context->preference($sysprefname);
706 my $bloc = $ISBD;
707 my $res;
708 my $blocres;
710 foreach my $isbdfield ( split( /#/, $bloc ) ) {
712 # $isbdfield= /(.?.?.?)/;
713 $isbdfield =~ /(\d\d\d)([^\|])?\|(.*)\|(.*)\|(.*)/;
714 my $fieldvalue = $1 || 0;
715 my $subfvalue = $2 || "";
716 my $textbefore = $3;
717 my $analysestring = $4;
718 my $textafter = $5;
720 # warn "==> $1 / $2 / $3 / $4";
721 # my $fieldvalue=substr($isbdfield,0,3);
722 if ( $fieldvalue > 0 ) {
723 my $hasputtextbefore = 0;
724 my @fieldslist = $record->field($fieldvalue);
725 @fieldslist = sort { $a->subfield($holdingbrtagsubf) cmp $b->subfield($holdingbrtagsubf) } @fieldslist if ( $fieldvalue eq $holdingbrtagf );
727 # warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
728 # warn "FV : $fieldvalue";
729 if ( $subfvalue ne "" ) {
730 # OPAC hidden subfield
731 next
732 if ( ( $template eq 'opac' )
733 && ( $tagslib->{$fieldvalue}->{$subfvalue}->{'hidden'} || 0 ) > 0 );
734 foreach my $field (@fieldslist) {
735 foreach my $subfield ( $field->subfield($subfvalue) ) {
736 my $calculated = $analysestring;
737 my $tag = $field->tag();
738 if ( $tag < 10 ) {
739 } else {
740 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subfvalue, $subfield, '', $tagslib );
741 my $tagsubf = $tag . $subfvalue;
742 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
743 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
745 # field builded, store the result
746 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
747 $blocres .= $textbefore;
748 $hasputtextbefore = 1;
751 # remove punctuation at start
752 $calculated =~ s/^( |;|:|\.|-)*//g;
753 $blocres .= $calculated;
758 $blocres .= $textafter if $hasputtextbefore;
759 } else {
760 foreach my $field (@fieldslist) {
761 my $calculated = $analysestring;
762 my $tag = $field->tag();
763 if ( $tag < 10 ) {
764 } else {
765 my @subf = $field->subfields;
766 for my $i ( 0 .. $#subf ) {
767 my $valuecode = $subf[$i][1];
768 my $subfieldcode = $subf[$i][0];
769 # OPAC hidden subfield
770 next
771 if ( ( $template eq 'opac' )
772 && ( $tagslib->{$fieldvalue}->{$subfieldcode}->{'hidden'} || 0 ) > 0 );
773 my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subf[$i][0], $subf[$i][1], '', $tagslib );
774 my $tagsubf = $tag . $subfieldcode;
776 $calculated =~ s/ # replace all {{}} codes by the value code.
777 \{\{$tagsubf\}\} # catch the {{actualcode}}
779 $valuecode # replace by the value code
780 /gx;
782 $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
783 if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
786 # field builded, store the result
787 if ( $calculated && !$hasputtextbefore ) { # put textbefore if not done
788 $blocres .= $textbefore;
789 $hasputtextbefore = 1;
792 # remove punctuation at start
793 $calculated =~ s/^( |;|:|\.|-)*//g;
794 $blocres .= $calculated;
797 $blocres .= $textafter if $hasputtextbefore;
799 } else {
800 $blocres .= $isbdfield;
803 $res .= $blocres;
805 $res =~ s/\{(.*?)\}//g;
806 $res =~ s/\\n/\n/g;
807 $res =~ s/\n/<br\/>/g;
809 # remove empty ()
810 $res =~ s/\(\)//g;
812 return $res;
815 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
817 =head2 IsMarcStructureInternal
819 my $tagslib = C4::Biblio::GetMarcStructure();
820 for my $tag ( sort keys %$tagslib ) {
821 next unless $tag;
822 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
823 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
825 # Process subfield
828 GetMarcStructure creates keys (lib, tab, mandatory, repeatable) for a display purpose.
829 These different values should not be processed as valid subfields.
831 =cut
833 sub IsMarcStructureInternal {
834 my ( $subfield ) = @_;
835 return ref $subfield ? 0 : 1;
838 =head2 GetMarcStructure
840 $res = GetMarcStructure($forlibrarian, $frameworkcode, [ $params ]);
842 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
843 $forlibrarian :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
844 $frameworkcode : the framework code to read
845 $params allows you to pass { unsafe => 1 } for better performance.
847 Note: If you call GetMarcStructure with unsafe => 1, do not modify or
848 even autovivify its contents. It is a cached/shared data structure. Your
849 changes c/would be passed around in subsequent calls.
851 =cut
853 sub GetMarcStructure {
854 my ( $forlibrarian, $frameworkcode, $params ) = @_;
855 $frameworkcode = "" unless $frameworkcode;
857 $forlibrarian = $forlibrarian ? 1 : 0;
858 my $unsafe = ($params && $params->{unsafe})? 1: 0;
859 my $cache = Koha::Caches->get_instance();
860 my $cache_key = "MarcStructure-$forlibrarian-$frameworkcode";
861 my $cached = $cache->get_from_cache($cache_key, { unsafe => $unsafe });
862 return $cached if $cached;
864 my $dbh = C4::Context->dbh;
865 my $sth = $dbh->prepare(
866 "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable,ind1_defaultvalue,ind2_defaultvalue
867 FROM marc_tag_structure
868 WHERE frameworkcode=?
869 ORDER BY tagfield"
871 $sth->execute($frameworkcode);
872 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable, $ind1_defaultvalue, $ind2_defaultvalue );
874 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable, $ind1_defaultvalue, $ind2_defaultvalue ) = $sth->fetchrow ) {
875 $res->{$tag}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
876 $res->{$tag}->{tab} = "";
877 $res->{$tag}->{mandatory} = $mandatory;
878 $res->{$tag}->{repeatable} = $repeatable;
879 $res->{$tag}->{ind1_defaultvalue} = $ind1_defaultvalue;
880 $res->{$tag}->{ind2_defaultvalue} = $ind2_defaultvalue;
883 $sth = $dbh->prepare(
884 "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue,maxlength
885 FROM marc_subfield_structure
886 WHERE frameworkcode=?
887 ORDER BY tagfield,tagsubfield
891 $sth->execute($frameworkcode);
893 my $subfield;
894 my $authorised_value;
895 my $authtypecode;
896 my $value_builder;
897 my $kohafield;
898 my $seealso;
899 my $hidden;
900 my $isurl;
901 my $link;
902 my $defaultvalue;
903 my $maxlength;
905 while (
906 ( $tag, $subfield, $liblibrarian, $libopac, $tab, $mandatory, $repeatable, $authorised_value,
907 $authtypecode, $value_builder, $kohafield, $seealso, $hidden, $isurl, $link, $defaultvalue,
908 $maxlength
910 = $sth->fetchrow
912 $res->{$tag}->{$subfield}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
913 $res->{$tag}->{$subfield}->{tab} = $tab;
914 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
915 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
916 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
917 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
918 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
919 $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
920 $res->{$tag}->{$subfield}->{seealso} = $seealso;
921 $res->{$tag}->{$subfield}->{hidden} = $hidden;
922 $res->{$tag}->{$subfield}->{isurl} = $isurl;
923 $res->{$tag}->{$subfield}->{'link'} = $link;
924 $res->{$tag}->{$subfield}->{defaultvalue} = $defaultvalue;
925 $res->{$tag}->{$subfield}->{maxlength} = $maxlength;
928 $cache->set_in_cache($cache_key, $res);
929 return $res;
932 =head2 GetUsedMarcStructure
934 The same function as GetMarcStructure except it just takes field
935 in tab 0-9. (used field)
937 my $results = GetUsedMarcStructure($frameworkcode);
939 C<$results> is a ref to an array which each case contains a ref
940 to a hash which each keys is the columns from marc_subfield_structure
942 C<$frameworkcode> is the framework code.
944 =cut
946 sub GetUsedMarcStructure {
947 my $frameworkcode = shift || '';
948 my $query = q{
949 SELECT *
950 FROM marc_subfield_structure
951 WHERE tab > -1
952 AND frameworkcode = ?
953 ORDER BY tagfield, tagsubfield
955 my $sth = C4::Context->dbh->prepare($query);
956 $sth->execute($frameworkcode);
957 return $sth->fetchall_arrayref( {} );
960 =pod
962 =head2 GetMarcSubfieldStructure
964 my $structure = GetMarcSubfieldStructure($frameworkcode, [$params]);
966 Returns a reference to hash representing MARC subfield structure
967 for framework with framework code C<$frameworkcode>, C<$params> is
968 optional and may contain additional options.
970 =over 4
972 =item C<$frameworkcode>
974 The framework code.
976 =item C<$params>
978 An optional hash reference with additional options.
979 The following options are supported:
981 =over 4
983 =item unsafe
985 Pass { unsafe => 1 } do disable cached object cloning,
986 and instead get a shared reference, resulting in better
987 performance (but care must be taken so that retured object
988 is never modified).
990 Note: If you call GetMarcSubfieldStructure with unsafe => 1, do not modify or
991 even autovivify its contents. It is a cached/shared data structure. Your
992 changes would be passed around in subsequent calls.
994 =back
996 =back
998 =cut
1000 sub GetMarcSubfieldStructure {
1001 my ( $frameworkcode, $params ) = @_;
1003 $frameworkcode //= '';
1005 my $cache = Koha::Caches->get_instance();
1006 my $cache_key = "MarcSubfieldStructure-$frameworkcode";
1007 my $cached = $cache->get_from_cache($cache_key, { unsafe => ($params && $params->{unsafe}) });
1008 return $cached if $cached;
1010 my $dbh = C4::Context->dbh;
1011 # We moved to selectall_arrayref since selectall_hashref does not
1012 # keep duplicate mappings on kohafield (like place in 260 vs 264)
1013 my $subfield_aref = $dbh->selectall_arrayref( q|
1014 SELECT *
1015 FROM marc_subfield_structure
1016 WHERE frameworkcode = ?
1017 AND kohafield > ''
1018 ORDER BY frameworkcode,tagfield,tagsubfield
1019 |, { Slice => {} }, $frameworkcode );
1020 # Now map the output to a hash structure
1021 my $subfield_structure = {};
1022 foreach my $row ( @$subfield_aref ) {
1023 push @{ $subfield_structure->{ $row->{kohafield} }}, $row;
1025 $cache->set_in_cache( $cache_key, $subfield_structure );
1026 return $subfield_structure;
1029 =head2 GetMarcFromKohaField
1031 ( $field,$subfield ) = GetMarcFromKohaField( $kohafield );
1032 @fields = GetMarcFromKohaField( $kohafield );
1033 $field = GetMarcFromKohaField( $kohafield );
1035 Returns the MARC fields & subfields mapped to $kohafield.
1036 Since the Default framework is considered as authoritative for such
1037 mappings, the former frameworkcode parameter is obsoleted.
1039 In list context all mappings are returned; there can be multiple
1040 mappings. Note that in the above example you could miss a second
1041 mappings in the first call.
1042 In scalar context only the field tag of the first mapping is returned.
1044 =cut
1046 sub GetMarcFromKohaField {
1047 my ( $kohafield ) = @_;
1048 return unless $kohafield;
1049 # The next call uses the Default framework since it is AUTHORITATIVE
1050 # for all Koha to MARC mappings.
1051 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
1052 my @retval;
1053 foreach( @{ $mss->{$kohafield} } ) {
1054 push @retval, $_->{tagfield}, $_->{tagsubfield};
1056 return wantarray ? @retval : ( @retval ? $retval[0] : undef );
1059 =head2 GetMarcSubfieldStructureFromKohaField
1061 my $str = GetMarcSubfieldStructureFromKohaField( $kohafield );
1063 Returns marc subfield structure information for $kohafield.
1064 The Default framework is used, since it is authoritative for kohafield
1065 mappings.
1066 In list context returns a list of all hashrefs, since there may be
1067 multiple mappings. In scalar context the first hashref is returned.
1069 =cut
1071 sub GetMarcSubfieldStructureFromKohaField {
1072 my ( $kohafield ) = @_;
1074 return unless $kohafield;
1076 # The next call uses the Default framework since it is AUTHORITATIVE
1077 # for all Koha to MARC mappings.
1078 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
1079 return unless $mss->{$kohafield};
1080 return wantarray ? @{$mss->{$kohafield}} : $mss->{$kohafield}->[0];
1083 =head2 GetMarcBiblio
1085 my $record = GetMarcBiblio({
1086 biblionumber => $biblionumber,
1087 embed_items => $embeditems,
1088 opac => $opac,
1089 borcat => $patron_category });
1091 Returns MARC::Record representing a biblio record, or C<undef> if the
1092 biblionumber doesn't exist.
1094 Both embed_items and opac are optional.
1095 If embed_items is passed and is 1, items are embedded.
1096 If opac is passed and is 1, the record is filtered as needed.
1098 =over 4
1100 =item C<$biblionumber>
1102 the biblionumber
1104 =item C<$embeditems>
1106 set to true to include item information.
1108 =item C<$opac>
1110 set to true to make the result suited for OPAC view. This causes things like
1111 OpacHiddenItems to be applied.
1113 =item C<$borcat>
1115 If the OpacHiddenItemsExceptions system preference is set, this patron category
1116 can be used to make visible OPAC items which would be normally hidden.
1117 It only makes sense in combination both embed_items and opac values true.
1119 =back
1121 =cut
1123 sub GetMarcBiblio {
1124 my ($params) = @_;
1126 if (not defined $params) {
1127 carp 'GetMarcBiblio called without parameters';
1128 return;
1131 my $biblionumber = $params->{biblionumber};
1132 my $embeditems = $params->{embed_items} || 0;
1133 my $opac = $params->{opac} || 0;
1134 my $borcat = $params->{borcat} // q{};
1136 if (not defined $biblionumber) {
1137 carp 'GetMarcBiblio called with undefined biblionumber';
1138 return;
1141 my $dbh = C4::Context->dbh;
1142 my $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=? ");
1143 $sth->execute($biblionumber);
1144 my $row = $sth->fetchrow_hashref;
1145 my $biblioitemnumber = $row->{'biblioitemnumber'};
1146 my $marcxml = GetXmlBiblio( $biblionumber );
1147 $marcxml = StripNonXmlChars( $marcxml );
1148 my $frameworkcode = GetFrameworkCode($biblionumber);
1149 MARC::File::XML->default_record_format( C4::Context->preference('marcflavour') );
1150 my $record = MARC::Record->new();
1152 if ($marcxml) {
1153 $record = eval {
1154 MARC::Record::new_from_xml( $marcxml, "utf8",
1155 C4::Context->preference('marcflavour') );
1157 if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; }
1158 return unless $record;
1160 C4::Biblio::_koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber,
1161 $biblioitemnumber );
1162 C4::Biblio::EmbedItemsInMarcBiblio({
1163 marc_record => $record,
1164 biblionumber => $biblionumber,
1165 opac => $opac,
1166 borcat => $borcat })
1167 if ($embeditems);
1169 return $record;
1171 else {
1172 return;
1176 =head2 GetXmlBiblio
1178 my $marcxml = GetXmlBiblio($biblionumber);
1180 Returns biblio_metadata.metadata/marcxml of the biblionumber passed in parameter.
1181 The XML should only contain biblio information (item information is no longer stored in marcxml field)
1183 =cut
1185 sub GetXmlBiblio {
1186 my ($biblionumber) = @_;
1187 my $dbh = C4::Context->dbh;
1188 return unless $biblionumber;
1189 my ($marcxml) = $dbh->selectrow_array(
1191 SELECT metadata
1192 FROM biblio_metadata
1193 WHERE biblionumber=?
1194 AND format='marcxml'
1195 AND `schema`=?
1196 |, undef, $biblionumber, C4::Context->preference('marcflavour')
1198 return $marcxml;
1201 =head2 GetMarcPrice
1203 return the prices in accordance with the Marc format.
1205 returns 0 if no price found
1206 returns undef if called without a marc record or with
1207 an unrecognized marc format
1209 =cut
1211 sub GetMarcPrice {
1212 my ( $record, $marcflavour ) = @_;
1213 if (!$record) {
1214 carp 'GetMarcPrice called on undefined record';
1215 return;
1218 my @listtags;
1219 my $subfield;
1221 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1222 @listtags = ('345', '020');
1223 $subfield="c";
1224 } elsif ( $marcflavour eq "UNIMARC" ) {
1225 @listtags = ('345', '010');
1226 $subfield="d";
1227 } else {
1228 return;
1231 for my $field ( $record->field(@listtags) ) {
1232 for my $subfield_value ($field->subfield($subfield)){
1233 #check value
1234 $subfield_value = MungeMarcPrice( $subfield_value );
1235 return $subfield_value if ($subfield_value);
1238 return 0; # no price found
1241 =head2 MungeMarcPrice
1243 Return the best guess at what the actual price is from a price field.
1245 =cut
1247 sub MungeMarcPrice {
1248 my ( $price ) = @_;
1249 return unless ( $price =~ m/\d/ ); ## No digits means no price.
1250 # Look for the currency symbol and the normalized code of the active currency, if it's there,
1251 my $active_currency = Koha::Acquisition::Currencies->get_active;
1252 my $symbol = $active_currency->symbol;
1253 my $isocode = $active_currency->isocode;
1254 $isocode = $active_currency->currency unless defined $isocode;
1255 my $localprice;
1256 if ( $symbol ) {
1257 my @matches =($price=~ /
1259 ( # start of capturing parenthesis
1261 (?:[\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'
1262 |(?:\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'
1264 \s?\p{Sc}?\s? # followed or not by a whitespace. \p{Sc}?\s? are for cases like '25$ USD'
1266 (?:[\p{Sc}\p{L}\/.]){1,4} # followed by same block as symbol block
1267 |(?:\d+[\p{P}\s]?){1,4} # or by same block as digits block
1269 \s?\p{L}{0,4}\s? # followed or not by a whitespace. \p{L}{0,4}\s? are for cases like '$9.50 USD'
1270 ) # end of capturing parenthesis
1271 (?:\p{P}|\z) # followed by a punctuation sign or by the end of the string
1272 /gx);
1274 if ( @matches ) {
1275 foreach ( @matches ) {
1276 $localprice = $_ and last if index($_, $isocode)>=0;
1278 if ( !$localprice ) {
1279 foreach ( @matches ) {
1280 $localprice = $_ and last if $_=~ /(^|[^\p{Sc}\p{L}\/])\Q$symbol\E([^\p{Sc}\p{L}\/]+\z|\z)/;
1285 if ( $localprice ) {
1286 $price = $localprice;
1287 } else {
1288 ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
1289 ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
1291 # eliminate symbol/isocode, space and any final dot from the string
1292 $price =~ s/[\p{Sc}\p{L}\/ ]|\.$//g;
1293 # remove comma,dot when used as separators from hundreds
1294 $price =~s/[\,\.](\d{3})/$1/g;
1295 # convert comma to dot to ensure correct display of decimals if existing
1296 $price =~s/,/./;
1297 return $price;
1301 =head2 GetMarcQuantity
1303 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
1304 Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
1306 returns 0 if no quantity found
1307 returns undef if called without a marc record or with
1308 an unrecognized marc format
1310 =cut
1312 sub GetMarcQuantity {
1313 my ( $record, $marcflavour ) = @_;
1314 if (!$record) {
1315 carp 'GetMarcQuantity called on undefined record';
1316 return;
1319 my @listtags;
1320 my $subfield;
1322 if ( $marcflavour eq "MARC21" ) {
1323 return 0
1324 } elsif ( $marcflavour eq "UNIMARC" ) {
1325 @listtags = ('969');
1326 $subfield="a";
1327 } else {
1328 return;
1331 for my $field ( $record->field(@listtags) ) {
1332 for my $subfield_value ($field->subfield($subfield)){
1333 #check value
1334 if ($subfield_value) {
1335 # in France, the cents separator is the , but sometimes, ppl use a .
1336 # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1337 $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
1338 return $subfield_value;
1342 return 0; # no price found
1346 =head2 GetAuthorisedValueDesc
1348 my $subfieldvalue =get_authorised_value_desc(
1349 $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1351 Retrieve the complete description for a given authorised value.
1353 Now takes $category and $value pair too.
1355 my $auth_value_desc =GetAuthorisedValueDesc(
1356 '','', 'DVD' ,'','','CCODE');
1358 If the optional $opac parameter is set to a true value, displays OPAC
1359 descriptions rather than normal ones when they exist.
1361 =cut
1363 sub GetAuthorisedValueDesc {
1364 my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1366 if ( !$category ) {
1368 return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1370 #---- branch
1371 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1372 my $branch = Koha::Libraries->find($value);
1373 return $branch? $branch->branchname: q{};
1376 #---- itemtypes
1377 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1378 my $itemtype = Koha::ItemTypes->find( $value );
1379 return $itemtype ? $itemtype->translated_description : q||;
1382 #---- "true" authorized value
1383 $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1386 my $dbh = C4::Context->dbh;
1387 if ( $category ne "" ) {
1388 my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1389 $sth->execute( $category, $value );
1390 my $data = $sth->fetchrow_hashref;
1391 return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
1392 } else {
1393 return $value; # if nothing is found return the original value
1397 =head2 GetMarcControlnumber
1399 $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1401 Get the control number / record Identifier from the MARC record and return it.
1403 =cut
1405 sub GetMarcControlnumber {
1406 my ( $record, $marcflavour ) = @_;
1407 if (!$record) {
1408 carp 'GetMarcControlnumber called on undefined record';
1409 return;
1411 my $controlnumber = "";
1412 # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
1413 # Keep $marcflavour for possible later use
1414 if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" || $marcflavour eq "NORMARC") {
1415 my $controlnumberField = $record->field('001');
1416 if ($controlnumberField) {
1417 $controlnumber = $controlnumberField->data();
1420 return $controlnumber;
1423 =head2 GetMarcISBN
1425 $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1427 Get all ISBNs from the MARC record and returns them in an array.
1428 ISBNs stored in different fields depending on MARC flavour
1430 =cut
1432 sub GetMarcISBN {
1433 my ( $record, $marcflavour ) = @_;
1434 if (!$record) {
1435 carp 'GetMarcISBN called on undefined record';
1436 return;
1438 my $scope;
1439 if ( $marcflavour eq "UNIMARC" ) {
1440 $scope = '010';
1441 } else { # assume marc21 if not unimarc
1442 $scope = '020';
1445 my @marcisbns;
1446 foreach my $field ( $record->field($scope) ) {
1447 my $isbn = $field->subfield( 'a' );
1448 if ( $isbn && $isbn ne "" ) {
1449 push @marcisbns, $isbn;
1453 return \@marcisbns;
1454 } # end GetMarcISBN
1457 =head2 GetMarcISSN
1459 $marcissnsarray = GetMarcISSN( $record, $marcflavour );
1461 Get all valid ISSNs from the MARC record and returns them in an array.
1462 ISSNs are stored in different fields depending on MARC flavour
1464 =cut
1466 sub GetMarcISSN {
1467 my ( $record, $marcflavour ) = @_;
1468 if (!$record) {
1469 carp 'GetMarcISSN called on undefined record';
1470 return;
1472 my $scope;
1473 if ( $marcflavour eq "UNIMARC" ) {
1474 $scope = '011';
1476 else { # assume MARC21 or NORMARC
1477 $scope = '022';
1479 my @marcissns;
1480 foreach my $field ( $record->field($scope) ) {
1481 push @marcissns, $field->subfield( 'a' )
1482 if ( $field->subfield( 'a' ) ne "" );
1484 return \@marcissns;
1485 } # end GetMarcISSN
1487 =head2 GetMarcNotes
1489 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1491 Get all notes from the MARC record and returns them in an array.
1492 The notes are stored in different fields depending on MARC flavour.
1493 MARC21 5XX $u subfields receive special attention as they are URIs.
1495 =cut
1497 sub GetMarcNotes {
1498 my ( $record, $marcflavour ) = @_;
1499 if (!$record) {
1500 carp 'GetMarcNotes called on undefined record';
1501 return;
1504 my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
1505 my @marcnotes;
1506 my %blacklist = map { $_ => 1 }
1507 split( /,/, C4::Context->preference('NotesBlacklist'));
1508 foreach my $field ( $record->field($scope) ) {
1509 my $tag = $field->tag();
1510 next if $blacklist{ $tag };
1511 if( $marcflavour ne 'UNIMARC' && $field->subfield('u') ) {
1512 # Field 5XX$u always contains URI
1513 # Examples: 505u, 506u, 510u, 514u, 520u, 530u, 538u, 540u, 542u, 552u, 555u, 561u, 563u, 583u
1514 # We first push the other subfields, then all $u's separately
1515 # Leave further actions to the template (see e.g. opac-detail)
1516 my $othersub =
1517 join '', ( 'a' .. 't', 'v' .. 'z', '0' .. '9' ); # excl 'u'
1518 push @marcnotes, { marcnote => $field->as_string($othersub) };
1519 foreach my $sub ( $field->subfield('u') ) {
1520 $sub =~ s/^\s+|\s+$//g; # trim
1521 push @marcnotes, { marcnote => $sub };
1523 } else {
1524 push @marcnotes, { marcnote => $field->as_string() };
1527 return \@marcnotes;
1530 =head2 GetMarcSubjects
1532 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1534 Get all subjects from the MARC record and returns them in an array.
1535 The subjects are stored in different fields depending on MARC flavour
1537 =cut
1539 sub GetMarcSubjects {
1540 my ( $record, $marcflavour ) = @_;
1541 if (!$record) {
1542 carp 'GetMarcSubjects called on undefined record';
1543 return;
1545 my ( $mintag, $maxtag, $fields_filter );
1546 if ( $marcflavour eq "UNIMARC" ) {
1547 $mintag = "600";
1548 $maxtag = "611";
1549 $fields_filter = '6..';
1550 } else { # marc21/normarc
1551 $mintag = "600";
1552 $maxtag = "699";
1553 $fields_filter = '6..';
1556 my @marcsubjects;
1558 my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1559 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1561 foreach my $field ( $record->field($fields_filter) ) {
1562 next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
1563 my @subfields_loop;
1564 my @subfields = $field->subfields();
1565 my @link_loop;
1567 # if there is an authority link, build the links with an= subfield9
1568 my $subfield9 = $field->subfield('9');
1569 my $authoritylink;
1570 if ($subfield9) {
1571 my $linkvalue = $subfield9;
1572 $linkvalue =~ s/(\(|\))//g;
1573 @link_loop = ( { limit => 'an', 'link' => $linkvalue } );
1574 $authoritylink = $linkvalue
1577 # other subfields
1578 for my $subject_subfield (@subfields) {
1579 next if ( $subject_subfield->[0] eq '9' );
1581 # don't load unimarc subfields 3,4,5
1582 next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1583 # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1584 next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1586 my $code = $subject_subfield->[0];
1587 my $value = $subject_subfield->[1];
1588 my $linkvalue = $value;
1589 $linkvalue =~ s/(\(|\))//g;
1590 # if no authority link, build a search query
1591 unless ($subfield9) {
1592 push @link_loop, {
1593 limit => $subject_limit,
1594 'link' => $linkvalue,
1595 operator => (scalar @link_loop) ? ' and ' : undef
1598 my @this_link_loop = @link_loop;
1599 # do not display $0
1600 unless ( $code eq '0' ) {
1601 push @subfields_loop, {
1602 code => $code,
1603 value => $value,
1604 link_loop => \@this_link_loop,
1605 separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1610 push @marcsubjects, {
1611 MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop,
1612 authoritylink => $authoritylink,
1613 } if $authoritylink || @subfields_loop;
1616 return \@marcsubjects;
1617 } #end getMARCsubjects
1619 =head2 GetMarcAuthors
1621 authors = GetMarcAuthors($record,$marcflavour);
1623 Get all authors from the MARC record and returns them in an array.
1624 The authors are stored in different fields depending on MARC flavour
1626 =cut
1628 sub GetMarcAuthors {
1629 my ( $record, $marcflavour ) = @_;
1630 if (!$record) {
1631 carp 'GetMarcAuthors called on undefined record';
1632 return;
1634 my ( $mintag, $maxtag, $fields_filter );
1636 # tagslib useful only for UNIMARC author responsibilities
1637 my $tagslib;
1638 if ( $marcflavour eq "UNIMARC" ) {
1639 # FIXME : we don't have the framework available, we take the default framework. May be buggy on some setups, will be usually correct.
1640 $tagslib = GetMarcStructure( 1, '', { unsafe => 1 });
1641 $mintag = "700";
1642 $maxtag = "712";
1643 $fields_filter = '7..';
1644 } else { # marc21/normarc
1645 $mintag = "700";
1646 $maxtag = "720";
1647 $fields_filter = '7..';
1650 my @marcauthors;
1651 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1653 foreach my $field ( $record->field($fields_filter) ) {
1654 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1655 my @subfields_loop;
1656 my @link_loop;
1657 my @subfields = $field->subfields();
1658 my $count_auth = 0;
1660 # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1661 my $subfield9 = $field->subfield('9');
1662 if ($subfield9) {
1663 my $linkvalue = $subfield9;
1664 $linkvalue =~ s/(\(|\))//g;
1665 @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1668 # other subfields
1669 my $unimarc3;
1670 for my $authors_subfield (@subfields) {
1671 next if ( $authors_subfield->[0] eq '9' );
1673 # unimarc3 contains the $3 of the author for UNIMARC.
1674 # For french academic libraries, it's the "ppn", and it's required for idref webservice
1675 $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1677 # don't load unimarc subfields 3, 5
1678 next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1680 my $code = $authors_subfield->[0];
1681 my $value = $authors_subfield->[1];
1682 my $linkvalue = $value;
1683 $linkvalue =~ s/(\(|\))//g;
1684 # UNIMARC author responsibility
1685 if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1686 $value = GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1687 $linkvalue = "($value)";
1689 # if no authority link, build a search query
1690 unless ($subfield9) {
1691 push @link_loop, {
1692 limit => 'au',
1693 'link' => $linkvalue,
1694 operator => (scalar @link_loop) ? ' and ' : undef
1697 my @this_link_loop = @link_loop;
1698 # do not display $0
1699 unless ( $code eq '0') {
1700 push @subfields_loop, {
1701 tag => $field->tag(),
1702 code => $code,
1703 value => $value,
1704 link_loop => \@this_link_loop,
1705 separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1709 push @marcauthors, {
1710 MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
1711 authoritylink => $subfield9,
1712 unimarc3 => $unimarc3
1715 return \@marcauthors;
1718 =head2 GetMarcUrls
1720 $marcurls = GetMarcUrls($record,$marcflavour);
1722 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1723 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1725 =cut
1727 sub GetMarcUrls {
1728 my ( $record, $marcflavour ) = @_;
1729 if (!$record) {
1730 carp 'GetMarcUrls called on undefined record';
1731 return;
1734 my @marcurls;
1735 for my $field ( $record->field('856') ) {
1736 my @notes;
1737 for my $note ( $field->subfield('z') ) {
1738 push @notes, { note => $note };
1740 my @urls = $field->subfield('u');
1741 foreach my $url (@urls) {
1742 $url =~ s/^\s+|\s+$//g; # trim
1743 my $marcurl;
1744 if ( $marcflavour eq 'MARC21' ) {
1745 my $s3 = $field->subfield('3');
1746 my $link = $field->subfield('y');
1747 unless ( $url =~ /^\w+:/ ) {
1748 if ( $field->indicator(1) eq '7' ) {
1749 $url = $field->subfield('2') . "://" . $url;
1750 } elsif ( $field->indicator(1) eq '1' ) {
1751 $url = 'ftp://' . $url;
1752 } else {
1754 # properly, this should be if ind1=4,
1755 # however we will assume http protocol since we're building a link.
1756 $url = 'http://' . $url;
1760 # TODO handle ind 2 (relationship)
1761 $marcurl = {
1762 MARCURL => $url,
1763 notes => \@notes,
1765 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
1766 $marcurl->{'part'} = $s3 if ($link);
1767 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1768 } else {
1769 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
1770 $marcurl->{'MARCURL'} = $url;
1772 push @marcurls, $marcurl;
1775 return \@marcurls;
1778 =head2 GetMarcSeries
1780 $marcseriesarray = GetMarcSeries($record,$marcflavour);
1782 Get all series from the MARC record and returns them in an array.
1783 The series are stored in different fields depending on MARC flavour
1785 =cut
1787 sub GetMarcSeries {
1788 my ( $record, $marcflavour ) = @_;
1789 if (!$record) {
1790 carp 'GetMarcSeries called on undefined record';
1791 return;
1794 my ( $mintag, $maxtag, $fields_filter );
1795 if ( $marcflavour eq "UNIMARC" ) {
1796 $mintag = "225";
1797 $maxtag = "225";
1798 $fields_filter = '2..';
1799 } else { # marc21/normarc
1800 $mintag = "440";
1801 $maxtag = "490";
1802 $fields_filter = '4..';
1805 my @marcseries;
1806 my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1808 foreach my $field ( $record->field($fields_filter) ) {
1809 next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1810 my @subfields_loop;
1811 my @subfields = $field->subfields();
1812 my @link_loop;
1814 for my $series_subfield (@subfields) {
1816 # ignore $9, used for authority link
1817 next if ( $series_subfield->[0] eq '9' );
1819 my $volume_number;
1820 my $code = $series_subfield->[0];
1821 my $value = $series_subfield->[1];
1822 my $linkvalue = $value;
1823 $linkvalue =~ s/(\(|\))//g;
1825 # see if this is an instance of a volume
1826 if ( $code eq 'v' ) {
1827 $volume_number = 1;
1830 push @link_loop, {
1831 'link' => $linkvalue,
1832 operator => (scalar @link_loop) ? ' and ' : undef
1835 if ($volume_number) {
1836 push @subfields_loop, { volumenum => $value };
1837 } else {
1838 push @subfields_loop, {
1839 code => $code,
1840 value => $value,
1841 link_loop => \@link_loop,
1842 separator => (scalar @subfields_loop) ? $AuthoritySeparator : '',
1843 volumenum => $volume_number,
1847 push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1850 return \@marcseries;
1851 } #end getMARCseriess
1853 =head2 GetMarcHosts
1855 $marchostsarray = GetMarcHosts($record,$marcflavour);
1857 Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns them in an array.
1859 =cut
1861 sub GetMarcHosts {
1862 my ( $record, $marcflavour ) = @_;
1863 if (!$record) {
1864 carp 'GetMarcHosts called on undefined record';
1865 return;
1868 my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
1869 $marcflavour ||="MARC21";
1870 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1871 $tag = "773";
1872 $title_subf = "t";
1873 $bibnumber_subf ="0";
1874 $itemnumber_subf='9';
1876 elsif ($marcflavour eq "UNIMARC") {
1877 $tag = "461";
1878 $title_subf = "t";
1879 $bibnumber_subf ="0";
1880 $itemnumber_subf='9';
1883 my @marchosts;
1885 foreach my $field ( $record->field($tag)) {
1887 my @fields_loop;
1889 my $hostbiblionumber = $field->subfield("$bibnumber_subf");
1890 my $hosttitle = $field->subfield($title_subf);
1891 my $hostitemnumber=$field->subfield($itemnumber_subf);
1892 push @fields_loop, { hostbiblionumber => $hostbiblionumber, hosttitle => $hosttitle, hostitemnumber => $hostitemnumber};
1893 push @marchosts, { MARCHOSTS_FIELDS_LOOP => \@fields_loop };
1896 my $marchostsarray = \@marchosts;
1897 return $marchostsarray;
1900 =head2 UpsertMarcSubfield
1902 my $record = C4::Biblio::UpsertMarcSubfield($MARC::Record, $fieldTag, $subfieldCode, $subfieldContent);
1904 =cut
1906 sub UpsertMarcSubfield {
1907 my ($record, $tag, $code, $content) = @_;
1908 my $f = $record->field($tag);
1910 if ($f) {
1911 $f->update( $code => $content );
1913 else {
1914 my $f = MARC::Field->new( $tag, '', '', $code => $content);
1915 $record->insert_fields_ordered( $f );
1919 =head2 UpsertMarcControlField
1921 my $record = C4::Biblio::UpsertMarcControlField($MARC::Record, $fieldTag, $content);
1923 =cut
1925 sub UpsertMarcControlField {
1926 my ($record, $tag, $content) = @_;
1927 die "UpsertMarcControlField() \$tag '$tag' is not a control field\n" unless 0+$tag < 10;
1928 my $f = $record->field($tag);
1930 if ($f) {
1931 $f->update( $content );
1933 else {
1934 my $f = MARC::Field->new($tag, $content);
1935 $record->insert_fields_ordered( $f );
1939 =head2 GetFrameworkCode
1941 $frameworkcode = GetFrameworkCode( $biblionumber )
1943 =cut
1945 sub GetFrameworkCode {
1946 my ($biblionumber) = @_;
1947 my $dbh = C4::Context->dbh;
1948 my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
1949 $sth->execute($biblionumber);
1950 my ($frameworkcode) = $sth->fetchrow;
1951 return $frameworkcode;
1954 =head2 TransformKohaToMarc
1956 $record = TransformKohaToMarc( $hash [, $params ] )
1958 This function builds a (partial) MARC::Record from a hash.
1959 Hash entries can be from biblio, biblioitems or items.
1960 The params hash includes the parameter no_split used in C4::Items.
1962 This function is called in acquisition module, to create a basic catalogue
1963 entry from user entry.
1965 =cut
1968 sub TransformKohaToMarc {
1969 my ( $hash, $params ) = @_;
1970 my $record = MARC::Record->new();
1971 SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
1973 # In the next call we use the Default framework, since it is considered
1974 # authoritative for Koha to Marc mappings.
1975 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # do not change framewok
1976 my $tag_hr = {};
1977 while ( my ($kohafield, $value) = each %$hash ) {
1978 foreach my $fld ( @{ $mss->{$kohafield} } ) {
1979 my $tagfield = $fld->{tagfield};
1980 my $tagsubfield = $fld->{tagsubfield};
1981 next if !$tagfield;
1982 my @values = $params->{no_split}
1983 ? ( $value )
1984 : split(/\s?\|\s?/, $value, -1);
1985 foreach my $value ( @values ) {
1986 next if $value eq '';
1987 $tag_hr->{$tagfield} //= [];
1988 push @{$tag_hr->{$tagfield}}, [($tagsubfield, $value)];
1992 foreach my $tag (sort keys %$tag_hr) {
1993 my @sfl = @{$tag_hr->{$tag}};
1994 @sfl = sort { $a->[0] cmp $b->[0]; } @sfl;
1995 @sfl = map { @{$_}; } @sfl;
1996 # Special care for control fields: remove the subfield indication @
1997 # and do not insert indicators.
1998 my @ind = $tag < 10 ? () : ( " ", " " );
1999 @sfl = grep { $_ ne '@' } @sfl if $tag < 10;
2000 $record->insert_fields_ordered( MARC::Field->new($tag, @ind, @sfl) );
2002 return $record;
2005 =head2 PrepHostMarcField
2007 $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
2009 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
2011 =cut
2013 sub PrepHostMarcField {
2014 my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
2015 $marcflavour ||="MARC21";
2017 my $hostrecord = GetMarcBiblio({ biblionumber => $hostbiblionumber });
2018 my $item = Koha::Items->find($hostitemnumber);
2020 my $hostmarcfield;
2021 if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2023 #main entry
2024 my $mainentry;
2025 if ($hostrecord->subfield('100','a')){
2026 $mainentry = $hostrecord->subfield('100','a');
2027 } elsif ($hostrecord->subfield('110','a')){
2028 $mainentry = $hostrecord->subfield('110','a');
2029 } else {
2030 $mainentry = $hostrecord->subfield('111','a');
2033 # qualification info
2034 my $qualinfo;
2035 if (my $field260 = $hostrecord->field('260')){
2036 $qualinfo = $field260->as_string( 'abc' );
2040 #other fields
2041 my $ed = $hostrecord->subfield('250','a');
2042 my $barcode = $item->barcode;
2043 my $title = $hostrecord->subfield('245','a');
2045 # record control number, 001 with 003 and prefix
2046 my $recctrlno;
2047 if ($hostrecord->field('001')){
2048 $recctrlno = $hostrecord->field('001')->data();
2049 if ($hostrecord->field('003')){
2050 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
2054 # issn/isbn
2055 my $issn = $hostrecord->subfield('022','a');
2056 my $isbn = $hostrecord->subfield('020','a');
2059 $hostmarcfield = MARC::Field->new(
2060 773, '0', '',
2061 '0' => $hostbiblionumber,
2062 '9' => $hostitemnumber,
2063 'a' => $mainentry,
2064 'b' => $ed,
2065 'd' => $qualinfo,
2066 'o' => $barcode,
2067 't' => $title,
2068 'w' => $recctrlno,
2069 'x' => $issn,
2070 'z' => $isbn
2072 } elsif ($marcflavour eq "UNIMARC") {
2073 $hostmarcfield = MARC::Field->new(
2074 461, '', '',
2075 '0' => $hostbiblionumber,
2076 't' => $hostrecord->subfield('200','a'),
2077 '9' => $hostitemnumber
2081 return $hostmarcfield;
2084 =head2 TransformHtmlToXml
2086 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
2087 $ind_tag, $auth_type )
2089 $auth_type contains :
2091 =over
2093 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
2095 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2097 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2099 =back
2101 =cut
2103 sub TransformHtmlToXml {
2104 my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2105 # NOTE: The parameter $ind_tag is NOT USED -- BZ 11247
2107 my $xml = MARC::File::XML::header('UTF-8');
2108 $xml .= "<record>\n";
2109 $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2110 MARC::File::XML->default_record_format($auth_type);
2112 # in UNIMARC, field 100 contains the encoding
2113 # check that there is one, otherwise the
2114 # MARC::Record->new_from_xml will fail (and Koha will die)
2115 my $unimarc_and_100_exist = 0;
2116 $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
2117 my $prevvalue;
2118 my $prevtag = -1;
2119 my $first = 1;
2120 my $j = -1;
2121 my $close_last_tag;
2122 for ( my $i = 0 ; $i < @$tags ; $i++ ) {
2124 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
2126 # if we have a 100 field and it's values are not correct, skip them.
2127 # if we don't have any valid 100 field, we will create a default one at the end
2128 my $enc = substr( @$values[$i], 26, 2 );
2129 if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2130 $unimarc_and_100_exist = 1;
2131 } else {
2132 next;
2135 @$values[$i] =~ s/&/&amp;/g;
2136 @$values[$i] =~ s/</&lt;/g;
2137 @$values[$i] =~ s/>/&gt;/g;
2138 @$values[$i] =~ s/"/&quot;/g;
2139 @$values[$i] =~ s/'/&apos;/g;
2141 if ( ( @$tags[$i] ne $prevtag ) ) {
2142 $close_last_tag = 0;
2143 $j++ unless ( @$tags[$i] eq "" );
2144 my $str = ( $indicator->[$j] // q{} ) . ' '; # extra space prevents substr outside of string warn
2145 my $ind1 = _default_ind_to_space( substr( $str, 0, 1 ) );
2146 my $ind2 = _default_ind_to_space( substr( $str, 1, 1 ) );
2147 if ( !$first ) {
2148 $xml .= "</datafield>\n";
2149 if ( ( @$tags[$i] && @$tags[$i] > 10 )
2150 && ( @$values[$i] ne "" ) ) {
2151 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2152 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2153 $first = 0;
2154 $close_last_tag = 1;
2155 } else {
2156 $first = 1;
2158 } else {
2159 if ( @$values[$i] ne "" ) {
2161 # leader
2162 if ( @$tags[$i] eq "000" ) {
2163 $xml .= "<leader>@$values[$i]</leader>\n";
2164 $first = 1;
2166 # rest of the fixed fields
2167 } elsif ( @$tags[$i] < 10 ) {
2168 $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2169 $first = 1;
2170 } else {
2171 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2172 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2173 $first = 0;
2174 $close_last_tag = 1;
2178 } else { # @$tags[$i] eq $prevtag
2179 if ( @$values[$i] eq "" ) {
2180 } else {
2181 if ($first) {
2182 my $str = ( $indicator->[$j] // q{} ) . ' '; # extra space prevents substr outside of string warn
2183 my $ind1 = _default_ind_to_space( substr( $str, 0, 1 ) );
2184 my $ind2 = _default_ind_to_space( substr( $str, 1, 1 ) );
2185 $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2186 $first = 0;
2187 $close_last_tag = 1;
2189 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2192 $prevtag = @$tags[$i];
2194 $xml .= "</datafield>\n" if $close_last_tag;
2195 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2197 # warn "SETTING 100 for $auth_type";
2198 my $string = strftime( "%Y%m%d", localtime(time) );
2200 # set 50 to position 26 is biblios, 13 if authorities
2201 my $pos = 26;
2202 $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2203 $string = sprintf( "%-*s", 35, $string );
2204 substr( $string, $pos, 6, "50" );
2205 $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2206 $xml .= "<subfield code=\"a\">$string</subfield>\n";
2207 $xml .= "</datafield>\n";
2209 $xml .= "</record>\n";
2210 $xml .= MARC::File::XML::footer();
2211 return $xml;
2214 =head2 _default_ind_to_space
2216 Passed what should be an indicator returns a space
2217 if its undefined or zero length
2219 =cut
2221 sub _default_ind_to_space {
2222 my $s = shift;
2223 if ( !defined $s || $s eq q{} ) {
2224 return ' ';
2226 return $s;
2229 =head2 TransformHtmlToMarc
2231 L<$record> = TransformHtmlToMarc(L<$cgi>)
2232 L<$cgi> is the CGI object which contains the values for subfields
2234 'tag_010_indicator1_531951' ,
2235 'tag_010_indicator2_531951' ,
2236 'tag_010_code_a_531951_145735' ,
2237 'tag_010_subfield_a_531951_145735' ,
2238 'tag_200_indicator1_873510' ,
2239 'tag_200_indicator2_873510' ,
2240 'tag_200_code_a_873510_673465' ,
2241 'tag_200_subfield_a_873510_673465' ,
2242 'tag_200_code_b_873510_704318' ,
2243 'tag_200_subfield_b_873510_704318' ,
2244 'tag_200_code_e_873510_280822' ,
2245 'tag_200_subfield_e_873510_280822' ,
2246 'tag_200_code_f_873510_110730' ,
2247 'tag_200_subfield_f_873510_110730' ,
2249 L<$record> is the MARC::Record object.
2251 =cut
2253 sub TransformHtmlToMarc {
2254 my ($cgi, $isbiblio) = @_;
2256 my @params = $cgi->multi_param();
2258 # explicitly turn on the UTF-8 flag for all
2259 # 'tag_' parameters to avoid incorrect character
2260 # conversion later on
2261 my $cgi_params = $cgi->Vars;
2262 foreach my $param_name ( keys %$cgi_params ) {
2263 if ( $param_name =~ /^tag_/ ) {
2264 my $param_value = $cgi_params->{$param_name};
2265 unless ( Encode::is_utf8( $param_value ) ) {
2266 $cgi_params->{$param_name} = Encode::decode('UTF-8', $param_value );
2271 # creating a new record
2272 my $record = MARC::Record->new();
2273 my @fields;
2274 my ($biblionumbertagfield, $biblionumbertagsubfield) = (-1, -1);
2275 ($biblionumbertagfield, $biblionumbertagsubfield) =
2276 &GetMarcFromKohaField( "biblio.biblionumber", '' ) if $isbiblio;
2277 #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!
2278 for (my $i = 0; $params[$i]; $i++ ) { # browse all CGI params
2279 my $param = $params[$i];
2280 my $newfield = 0;
2282 # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2283 if ( $param eq 'biblionumber' ) {
2284 if ( $biblionumbertagfield < 10 ) {
2285 $newfield = MARC::Field->new( $biblionumbertagfield, scalar $cgi->param($param), );
2286 } else {
2287 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => scalar $cgi->param($param), );
2289 push @fields, $newfield if ($newfield);
2290 } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) { # new field start when having 'input name="..._indicator1_..."
2291 my $tag = $1;
2293 my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2294 my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2295 $newfield = 0;
2296 my $j = $i + 2;
2298 if ( $tag < 10 ) { # no code for theses fields
2299 # in MARC editor, 000 contains the leader.
2300 next if $tag == $biblionumbertagfield;
2301 my $fval= $cgi->param($params[$j+1]);
2302 if ( $tag eq '000' ) {
2303 # Force a fake leader even if not provided to avoid crashing
2304 # during decoding MARC record containing UTF-8 characters
2305 $record->leader(
2306 length( $fval ) == 24
2307 ? $fval
2308 : ' nam a22 4500'
2311 # between 001 and 009 (included)
2312 } elsif ( $fval ne '' ) {
2313 $newfield = MARC::Field->new( $tag, $fval, );
2316 # > 009, deal with subfields
2317 } else {
2318 # browse subfields for this tag (reason for _code_ match)
2319 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2320 last unless defined $params[$j+1];
2321 $j += 2 and next
2322 if $tag == $biblionumbertagfield and
2323 $cgi->param($params[$j]) eq $biblionumbertagsubfield;
2324 #if next param ne subfield, then it was probably empty
2325 #try next param by incrementing j
2326 if($params[$j+1]!~/_subfield_/) {$j++; next; }
2327 my $fkey= $cgi->param($params[$j]);
2328 my $fval= $cgi->param($params[$j+1]);
2329 #check if subfield value not empty and field exists
2330 if($fval ne '' && $newfield) {
2331 $newfield->add_subfields( $fkey => $fval);
2333 elsif($fval ne '') {
2334 $newfield = MARC::Field->new( $tag, $ind1, $ind2, $fkey => $fval );
2336 $j += 2;
2337 } #end-of-while
2338 $i= $j-1; #update i for outer loop accordingly
2340 push @fields, $newfield if ($newfield);
2344 $record->append_fields(@fields);
2345 return $record;
2348 =head2 TransformMarcToKoha
2350 $result = TransformMarcToKoha( $record, undef, $limit )
2352 Extract data from a MARC bib record into a hashref representing
2353 Koha biblio, biblioitems, and items fields.
2355 If passed an undefined record will log the error and return an empty
2356 hash_ref.
2358 =cut
2360 sub TransformMarcToKoha {
2361 my ( $record, $frameworkcode, $limit_table ) = @_;
2362 # FIXME Parameter $frameworkcode is obsolete and will be removed
2363 $limit_table //= q{};
2365 my $result = {};
2366 if (!defined $record) {
2367 carp('TransformMarcToKoha called with undefined record');
2368 return $result;
2371 my %tables = ( biblio => 1, biblioitems => 1, items => 1 );
2372 if( $limit_table eq 'items' ) {
2373 %tables = ( items => 1 );
2376 # The next call acknowledges Default as the authoritative framework
2377 # for Koha to MARC mappings.
2378 my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
2379 foreach my $kohafield ( keys %{ $mss } ) {
2380 my ( $table, $column ) = split /[.]/, $kohafield, 2;
2381 next unless $tables{$table};
2382 my $val = TransformMarcToKohaOneField( $kohafield, $record );
2383 next if !defined $val;
2384 my $key = _disambiguate( $table, $column );
2385 $result->{$key} = $val;
2387 return $result;
2390 =head2 _disambiguate
2392 $newkey = _disambiguate($table, $field);
2394 This is a temporary hack to distinguish between the
2395 following sets of columns when using TransformMarcToKoha.
2397 items.cn_source & biblioitems.cn_source
2398 items.cn_sort & biblioitems.cn_sort
2400 Columns that are currently NOT distinguished (FIXME
2401 due to lack of time to fully test) are:
2403 biblio.notes and biblioitems.notes
2404 biblionumber
2405 timestamp
2406 biblioitemnumber
2408 FIXME - this is necessary because prefixing each column
2409 name with the table name would require changing lots
2410 of code and templates, and exposing more of the DB
2411 structure than is good to the UI templates, particularly
2412 since biblio and bibloitems may well merge in a future
2413 version. In the future, it would also be good to
2414 separate DB access and UI presentation field names
2415 more.
2417 =cut
2419 sub _disambiguate {
2420 my ( $table, $column ) = @_;
2421 if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2422 return $table . '.' . $column;
2423 } else {
2424 return $column;
2429 =head2 TransformMarcToKohaOneField
2431 $val = TransformMarcToKohaOneField( 'biblio.title', $marc );
2433 Note: The authoritative Default framework is used implicitly.
2435 =cut
2437 sub TransformMarcToKohaOneField {
2438 my ( $kohafield, $marc ) = @_;
2440 my ( @rv, $retval );
2441 my @mss = GetMarcSubfieldStructureFromKohaField($kohafield);
2442 foreach my $fldhash ( @mss ) {
2443 my $tag = $fldhash->{tagfield};
2444 my $sub = $fldhash->{tagsubfield};
2445 foreach my $fld ( $marc->field($tag) ) {
2446 if( $sub eq '@' || $fld->is_control_field ) {
2447 push @rv, $fld->data if $fld->data;
2448 } else {
2449 push @rv, grep { $_ } $fld->subfield($sub);
2453 return unless @rv;
2454 $retval = join ' | ', uniq(@rv);
2456 # Additional polishing for individual kohafields
2457 if( $kohafield =~ /copyrightdate|publicationyear/ ) {
2458 $retval = _adjust_pubyear( $retval );
2461 return $retval;
2464 =head2 _adjust_pubyear
2466 Helper routine for TransformMarcToKohaOneField
2468 =cut
2470 sub _adjust_pubyear {
2471 my $retval = shift;
2472 # modify return value to keep only the 1st year found
2473 if( $retval =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2474 $retval = $1;
2475 } elsif( $retval =~ m/(\d\d\d\d)/ && $1 > 0 ) {
2476 $retval = $1;
2477 } elsif( $retval =~ m/
2478 (?<year>\d)[-]?[.Xx?]{3}
2479 |(?<year>\d{2})[.Xx?]{2}
2480 |(?<year>\d{3})[.Xx?]
2481 |(?<year>\d)[-]{3}\?
2482 |(?<year>\d\d)[-]{2}\?
2483 |(?<year>\d{3})[-]\?
2484 /xms ) { # the form 198-? occurred in Dutch ISBD rules
2485 my $digits = $+{year};
2486 $retval = $digits * ( 10 ** ( 4 - length($digits) ));
2488 return $retval;
2491 =head2 CountItemsIssued
2493 my $count = CountItemsIssued( $biblionumber );
2495 =cut
2497 sub CountItemsIssued {
2498 my ($biblionumber) = @_;
2499 my $dbh = C4::Context->dbh;
2500 my $sth = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2501 $sth->execute($biblionumber);
2502 my $row = $sth->fetchrow_hashref();
2503 return $row->{'issuedCount'};
2506 =head2 ModZebra
2508 ModZebra( $biblionumber, $op, $server, $record );
2510 $biblionumber is the biblionumber we want to index
2512 $op is specialUpdate or recordDelete, and is used to know what we want to do
2514 $server is the server that we want to update
2516 $record is the update MARC record if it's available. If it's not supplied
2517 and is needed, it'll be loaded from the database.
2519 =cut
2521 sub ModZebra {
2522 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2523 my ( $biblionumber, $op, $server, $record ) = @_;
2524 $debug && warn "ModZebra: update requested for: $biblionumber $op $server\n";
2525 if ( C4::Context->preference('SearchEngine') eq 'Elasticsearch' ) {
2527 # TODO abstract to a standard API that'll work for whatever
2528 require Koha::SearchEngine::Elasticsearch::Indexer;
2529 my $indexer = Koha::SearchEngine::Elasticsearch::Indexer->new(
2531 index => $server eq 'biblioserver'
2532 ? $Koha::SearchEngine::BIBLIOS_INDEX
2533 : $Koha::SearchEngine::AUTHORITIES_INDEX
2536 if ( $op eq 'specialUpdate' ) {
2537 unless ($record) {
2538 $record = GetMarcBiblio({
2539 biblionumber => $biblionumber,
2540 embed_items => 1 });
2542 my $records = [$record];
2543 $indexer->update_index_background( [$biblionumber], [$record] );
2545 elsif ( $op eq 'recordDelete' ) {
2546 $indexer->delete_index_background( [$biblionumber] );
2548 else {
2549 croak "ModZebra called with unknown operation: $op";
2553 my $dbh = C4::Context->dbh;
2555 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2556 # at the same time
2557 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2558 # the table is emptied by rebuild_zebra.pl script (using the -z switch)
2559 my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2560 WHERE server = ?
2561 AND biblio_auth_number = ?
2562 AND operation = ?
2563 AND done = 0";
2564 my $check_sth = $dbh->prepare_cached($check_sql);
2565 $check_sth->execute( $server, $biblionumber, $op );
2566 my ($count) = $check_sth->fetchrow_array;
2567 $check_sth->finish();
2568 if ( $count == 0 ) {
2569 my $sth = $dbh->prepare("INSERT INTO zebraqueue (biblio_auth_number,server,operation) VALUES(?,?,?)");
2570 $sth->execute( $biblionumber, $server, $op );
2571 $sth->finish;
2576 =head2 EmbedItemsInMarcBiblio
2578 EmbedItemsInMarcBiblio({
2579 marc_record => $marc,
2580 biblionumber => $biblionumber,
2581 item_numbers => $itemnumbers,
2582 opac => $opac });
2584 Given a MARC::Record object containing a bib record,
2585 modify it to include the items attached to it as 9XX
2586 per the bib's MARC framework.
2587 if $itemnumbers is defined, only specified itemnumbers are embedded.
2589 If $opac is true, then opac-relevant suppressions are included.
2591 If opac filtering will be done, borcat should be passed to properly
2592 override if necessary.
2594 =cut
2596 sub EmbedItemsInMarcBiblio {
2597 my ($params) = @_;
2598 my ($marc, $biblionumber, $itemnumbers, $opac, $borcat);
2599 $marc = $params->{marc_record};
2600 if ( !$marc ) {
2601 carp 'EmbedItemsInMarcBiblio: No MARC record passed';
2602 return;
2604 $biblionumber = $params->{biblionumber};
2605 $itemnumbers = $params->{item_numbers};
2606 $opac = $params->{opac};
2607 $borcat = $params->{borcat} // q{};
2609 $itemnumbers = [] unless defined $itemnumbers;
2611 my $frameworkcode = GetFrameworkCode($biblionumber);
2612 _strip_item_fields($marc, $frameworkcode);
2614 # ... and embed the current items
2615 my $dbh = C4::Context->dbh;
2616 my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2617 $sth->execute($biblionumber);
2618 my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber" );
2620 my @item_fields; # Array holding the actual MARC data for items to be included.
2621 my @items; # Array holding items which are both in the list (sitenumbers)
2622 # and on this biblionumber
2624 # Flag indicating if there is potential hiding.
2625 my $opachiddenitems = $opac
2626 && ( C4::Context->preference('OpacHiddenItems') !~ /^\s*$/ );
2628 require C4::Items;
2629 while ( my ($itemnumber) = $sth->fetchrow_array ) {
2630 next if @$itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers;
2631 my $item;
2632 if ( $opachiddenitems ) {
2633 $item = Koha::Items->find($itemnumber);
2634 $item = $item ? $item->unblessed : undef;
2636 push @items, { itemnumber => $itemnumber, item => $item };
2638 my @items2pass = map { $_->{item} } @items;
2639 my @hiddenitems =
2640 $opachiddenitems
2641 ? C4::Items::GetHiddenItemnumbers({
2642 items => \@items2pass,
2643 borcat => $borcat })
2644 : ();
2645 # Convert to a hash for quick searching
2646 my %hiddenitems = map { $_ => 1 } @hiddenitems;
2647 foreach my $itemnumber ( map { $_->{itemnumber} } @items ) {
2648 next if $hiddenitems{$itemnumber};
2649 my $item_marc = C4::Items::GetMarcItem( $biblionumber, $itemnumber );
2650 push @item_fields, $item_marc->field($itemtag);
2652 $marc->append_fields(@item_fields);
2655 =head1 INTERNAL FUNCTIONS
2657 =head2 _koha_marc_update_bib_ids
2660 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2662 Internal function to add or update biblionumber and biblioitemnumber to
2663 the MARC XML.
2665 =cut
2667 sub _koha_marc_update_bib_ids {
2668 my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
2670 my ( $biblio_tag, $biblio_subfield ) = GetMarcFromKohaField( "biblio.biblionumber" );
2671 die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
2672 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber" );
2673 die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
2675 if ( $biblio_tag < 10 ) {
2676 C4::Biblio::UpsertMarcControlField( $record, $biblio_tag, $biblionumber );
2677 } else {
2678 C4::Biblio::UpsertMarcSubfield($record, $biblio_tag, $biblio_subfield, $biblionumber);
2680 if ( $biblioitem_tag < 10 ) {
2681 C4::Biblio::UpsertMarcControlField( $record, $biblioitem_tag, $biblioitemnumber );
2682 } else {
2683 C4::Biblio::UpsertMarcSubfield($record, $biblioitem_tag, $biblioitem_subfield, $biblioitemnumber);
2687 =head2 _koha_marc_update_biblioitem_cn_sort
2689 _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
2691 Given a MARC bib record and the biblioitem hash, update the
2692 subfield that contains a copy of the value of biblioitems.cn_sort.
2694 =cut
2696 sub _koha_marc_update_biblioitem_cn_sort {
2697 my $marc = shift;
2698 my $biblioitem = shift;
2699 my $frameworkcode = shift;
2701 my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort" );
2702 return unless $biblioitem_tag;
2704 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2706 if ( my $field = $marc->field($biblioitem_tag) ) {
2707 $field->delete_subfield( code => $biblioitem_subfield );
2708 if ( $cn_sort ne '' ) {
2709 $field->add_subfields( $biblioitem_subfield => $cn_sort );
2711 } else {
2713 # if we get here, no biblioitem tag is present in the MARC record, so
2714 # we'll create it if $cn_sort is not empty -- this would be
2715 # an odd combination of events, however
2716 if ($cn_sort) {
2717 $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
2722 =head2 _koha_add_biblio
2724 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
2726 Internal function to add a biblio ($biblio is a hash with the values)
2728 =cut
2730 sub _koha_add_biblio {
2731 my ( $dbh, $biblio, $frameworkcode ) = @_;
2733 my $error;
2735 # set the series flag
2736 unless (defined $biblio->{'serial'}){
2737 $biblio->{'serial'} = 0;
2738 if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
2741 my $query = "INSERT INTO biblio
2742 SET frameworkcode = ?,
2743 author = ?,
2744 title = ?,
2745 subtitle = ?,
2746 medium = ?,
2747 part_number = ?,
2748 part_name = ?,
2749 unititle =?,
2750 notes = ?,
2751 serial = ?,
2752 seriestitle = ?,
2753 copyrightdate = ?,
2754 datecreated=NOW(),
2755 abstract = ?
2757 my $sth = $dbh->prepare($query);
2758 $sth->execute(
2759 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'subtitle'},
2760 $biblio->{'medium'}, $biblio->{'part_number'}, $biblio->{'part_name'}, $biblio->{'unititle'},
2761 $biblio->{'notes'}, $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'},
2762 $biblio->{'abstract'}
2765 my $biblionumber = $dbh->{'mysql_insertid'};
2766 if ( $dbh->errstr ) {
2767 $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
2768 warn $error;
2771 $sth->finish();
2773 #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
2774 return ( $biblionumber, $error );
2777 =head2 _koha_modify_biblio
2779 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
2781 Internal function for updating the biblio table
2783 =cut
2785 sub _koha_modify_biblio {
2786 my ( $dbh, $biblio, $frameworkcode ) = @_;
2787 my $error;
2789 my $query = "
2790 UPDATE biblio
2791 SET frameworkcode = ?,
2792 author = ?,
2793 title = ?,
2794 subtitle = ?,
2795 medium = ?,
2796 part_number = ?,
2797 part_name = ?,
2798 unititle = ?,
2799 notes = ?,
2800 serial = ?,
2801 seriestitle = ?,
2802 copyrightdate = ?,
2803 abstract = ?
2804 WHERE biblionumber = ?
2807 my $sth = $dbh->prepare($query);
2809 $sth->execute(
2810 $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'subtitle'},
2811 $biblio->{'medium'}, $biblio->{'part_number'}, $biblio->{'part_name'}, $biblio->{'unititle'},
2812 $biblio->{'notes'}, $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'} ? int($biblio->{'copyrightdate'}) : undef,
2813 $biblio->{'abstract'}, $biblio->{'biblionumber'}
2814 ) if $biblio->{'biblionumber'};
2816 if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
2817 $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
2818 warn $error;
2820 return ( $biblio->{'biblionumber'}, $error );
2823 =head2 _koha_modify_biblioitem_nonmarc
2825 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
2827 =cut
2829 sub _koha_modify_biblioitem_nonmarc {
2830 my ( $dbh, $biblioitem ) = @_;
2831 my $error;
2833 # re-calculate the cn_sort, it may have changed
2834 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2836 my $query = "UPDATE biblioitems
2837 SET biblionumber = ?,
2838 volume = ?,
2839 number = ?,
2840 itemtype = ?,
2841 isbn = ?,
2842 issn = ?,
2843 publicationyear = ?,
2844 publishercode = ?,
2845 volumedate = ?,
2846 volumedesc = ?,
2847 collectiontitle = ?,
2848 collectionissn = ?,
2849 collectionvolume= ?,
2850 editionstatement= ?,
2851 editionresponsibility = ?,
2852 illus = ?,
2853 pages = ?,
2854 notes = ?,
2855 size = ?,
2856 place = ?,
2857 lccn = ?,
2858 url = ?,
2859 cn_source = ?,
2860 cn_class = ?,
2861 cn_item = ?,
2862 cn_suffix = ?,
2863 cn_sort = ?,
2864 totalissues = ?,
2865 ean = ?,
2866 agerestriction = ?
2867 where biblioitemnumber = ?
2869 my $sth = $dbh->prepare($query);
2870 $sth->execute(
2871 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
2872 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
2873 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
2874 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
2875 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
2876 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
2877 $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort, $biblioitem->{'totalissues'},
2878 $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}, $biblioitem->{'biblioitemnumber'}
2880 if ( $dbh->errstr ) {
2881 $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
2882 warn $error;
2884 return ( $biblioitem->{'biblioitemnumber'}, $error );
2887 =head2 _koha_add_biblioitem
2889 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
2891 Internal function to add a biblioitem
2893 =cut
2895 sub _koha_add_biblioitem {
2896 my ( $dbh, $biblioitem ) = @_;
2897 my $error;
2899 my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2900 my $query = "INSERT INTO biblioitems SET
2901 biblionumber = ?,
2902 volume = ?,
2903 number = ?,
2904 itemtype = ?,
2905 isbn = ?,
2906 issn = ?,
2907 publicationyear = ?,
2908 publishercode = ?,
2909 volumedate = ?,
2910 volumedesc = ?,
2911 collectiontitle = ?,
2912 collectionissn = ?,
2913 collectionvolume= ?,
2914 editionstatement= ?,
2915 editionresponsibility = ?,
2916 illus = ?,
2917 pages = ?,
2918 notes = ?,
2919 size = ?,
2920 place = ?,
2921 lccn = ?,
2922 url = ?,
2923 cn_source = ?,
2924 cn_class = ?,
2925 cn_item = ?,
2926 cn_suffix = ?,
2927 cn_sort = ?,
2928 totalissues = ?,
2929 ean = ?,
2930 agerestriction = ?
2932 my $sth = $dbh->prepare($query);
2933 $sth->execute(
2934 $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'},
2935 $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'},
2936 $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'},
2937 $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
2938 $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'},
2939 $biblioitem->{'lccn'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'},
2940 $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort,
2941 $biblioitem->{'totalissues'}, $biblioitem->{'ean'}, $biblioitem->{'agerestriction'}
2943 my $bibitemnum = $dbh->{'mysql_insertid'};
2945 if ( $dbh->errstr ) {
2946 $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
2947 warn $error;
2949 $sth->finish();
2950 return ( $bibitemnum, $error );
2953 =head2 _koha_delete_biblio
2955 $error = _koha_delete_biblio($dbh,$biblionumber);
2957 Internal sub for deleting from biblio table -- also saves to deletedbiblio
2959 C<$dbh> - the database handle
2961 C<$biblionumber> - the biblionumber of the biblio to be deleted
2963 =cut
2965 # FIXME: add error handling
2967 sub _koha_delete_biblio {
2968 my ( $dbh, $biblionumber ) = @_;
2970 # get all the data for this biblio
2971 my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
2972 $sth->execute($biblionumber);
2974 # FIXME There is a transaction in _koha_delete_biblio_metadata
2975 # But actually all the following should be done inside a single transaction
2976 if ( my $data = $sth->fetchrow_hashref ) {
2978 # save the record in deletedbiblio
2979 # find the fields to save
2980 my $query = "INSERT INTO deletedbiblio SET ";
2981 my @bind = ();
2982 foreach my $temp ( keys %$data ) {
2983 $query .= "$temp = ?,";
2984 push( @bind, $data->{$temp} );
2987 # replace the last , by ",?)"
2988 $query =~ s/\,$//;
2989 my $bkup_sth = $dbh->prepare($query);
2990 $bkup_sth->execute(@bind);
2991 $bkup_sth->finish;
2993 _koha_delete_biblio_metadata( $biblionumber );
2995 # delete the biblio
2996 my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
2997 $sth2->execute($biblionumber);
2998 # update the timestamp (Bugzilla 7146)
2999 $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
3000 $sth2->execute($biblionumber);
3001 $sth2->finish;
3003 $sth->finish;
3004 return;
3007 =head2 _koha_delete_biblioitems
3009 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3011 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3013 C<$dbh> - the database handle
3014 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3016 =cut
3018 # FIXME: add error handling
3020 sub _koha_delete_biblioitems {
3021 my ( $dbh, $biblioitemnumber ) = @_;
3023 # get all the data for this biblioitem
3024 my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3025 $sth->execute($biblioitemnumber);
3027 if ( my $data = $sth->fetchrow_hashref ) {
3029 # save the record in deletedbiblioitems
3030 # find the fields to save
3031 my $query = "INSERT INTO deletedbiblioitems SET ";
3032 my @bind = ();
3033 foreach my $temp ( keys %$data ) {
3034 $query .= "$temp = ?,";
3035 push( @bind, $data->{$temp} );
3038 # replace the last , by ",?)"
3039 $query =~ s/\,$//;
3040 my $bkup_sth = $dbh->prepare($query);
3041 $bkup_sth->execute(@bind);
3042 $bkup_sth->finish;
3044 # delete the biblioitem
3045 my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3046 $sth2->execute($biblioitemnumber);
3047 # update the timestamp (Bugzilla 7146)
3048 $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
3049 $sth2->execute($biblioitemnumber);
3050 $sth2->finish;
3052 $sth->finish;
3053 return;
3056 =head2 _koha_delete_biblio_metadata
3058 $error = _koha_delete_biblio_metadata($biblionumber);
3060 C<$biblionumber> - the biblionumber of the biblio metadata to be deleted
3062 =cut
3064 sub _koha_delete_biblio_metadata {
3065 my ($biblionumber) = @_;
3067 my $dbh = C4::Context->dbh;
3068 my $schema = Koha::Database->new->schema;
3069 $schema->txn_do(
3070 sub {
3071 $dbh->do( q|
3072 INSERT INTO deletedbiblio_metadata (biblionumber, format, `schema`, metadata)
3073 SELECT biblionumber, format, `schema`, metadata FROM biblio_metadata WHERE biblionumber=?
3074 |, undef, $biblionumber );
3075 $dbh->do( q|DELETE FROM biblio_metadata WHERE biblionumber=?|,
3076 undef, $biblionumber );
3081 =head1 UNEXPORTED FUNCTIONS
3083 =head2 ModBiblioMarc
3085 &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3087 Add MARC XML data for a biblio to koha
3089 Function exported, but should NOT be used, unless you really know what you're doing
3091 =cut
3093 sub ModBiblioMarc {
3094 # pass the MARC::Record to this function, and it will create the records in
3095 # the marcxml field
3096 my ( $record, $biblionumber, $frameworkcode ) = @_;
3097 if ( !$record ) {
3098 carp 'ModBiblioMarc passed an undefined record';
3099 return;
3102 # Clone record as it gets modified
3103 $record = $record->clone();
3104 my $dbh = C4::Context->dbh;
3105 my @fields = $record->fields();
3106 if ( !$frameworkcode ) {
3107 $frameworkcode = "";
3109 my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3110 $sth->execute( $frameworkcode, $biblionumber );
3111 $sth->finish;
3112 my $encoding = C4::Context->preference("marcflavour");
3114 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3115 if ( $encoding eq "UNIMARC" ) {
3116 my $defaultlanguage = C4::Context->preference("UNIMARCField100Language");
3117 $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
3118 my $string = $record->subfield( 100, "a" );
3119 if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3120 my $f100 = $record->field(100);
3121 $record->delete_field($f100);
3122 } else {
3123 $string = POSIX::strftime( "%Y%m%d", localtime );
3124 $string =~ s/\-//g;
3125 $string = sprintf( "%-*s", 35, $string );
3126 substr ( $string, 22, 3, $defaultlanguage);
3128 substr( $string, 25, 3, "y50" );
3129 unless ( $record->subfield( 100, "a" ) ) {
3130 $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
3134 #enhancement 5374: update transaction date (005) for marc21/unimarc
3135 if($encoding =~ /MARC21|UNIMARC/) {
3136 my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3137 # YY MM DD HH MM SS (update year and month)
3138 my $f005= $record->field('005');
3139 $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3142 my $metadata = {
3143 biblionumber => $biblionumber,
3144 format => 'marcxml',
3145 schema => C4::Context->preference('marcflavour'),
3147 $record->as_usmarc; # Bug 20126/10455 This triggers field length calculation
3149 my $m_rs = Koha::Biblio::Metadatas->find($metadata) //
3150 Koha::Biblio::Metadata->new($metadata);
3152 my $userenv = C4::Context->userenv;
3153 if ($userenv) {
3154 my $borrowernumber = $userenv->{number};
3155 my $borrowername = join ' ', map { $_ // q{} } @$userenv{qw(firstname surname)};
3156 unless ($m_rs->in_storage) {
3157 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorId'), $borrowernumber);
3158 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorName'), $borrowername);
3160 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierId'), $borrowernumber);
3161 Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierName'), $borrowername);
3164 $m_rs->metadata( $record->as_xml_record($encoding) );
3165 $m_rs->store;
3167 ModZebra( $biblionumber, "specialUpdate", "biblioserver" );
3169 return $biblionumber;
3172 =head2 CountBiblioInOrders
3174 $count = &CountBiblioInOrders( $biblionumber);
3176 This function return count of biblios in orders with $biblionumber
3178 =cut
3180 sub CountBiblioInOrders {
3181 my ($biblionumber) = @_;
3182 my $dbh = C4::Context->dbh;
3183 my $query = "SELECT count(*)
3184 FROM aqorders
3185 WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')";
3186 my $sth = $dbh->prepare($query);
3187 $sth->execute($biblionumber);
3188 my $count = $sth->fetchrow;
3189 return ($count);
3192 =head2 prepare_host_field
3194 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
3195 Generate the host item entry for an analytic child entry
3197 =cut
3199 sub prepare_host_field {
3200 my ( $hostbiblio, $marcflavour ) = @_;
3201 $marcflavour ||= C4::Context->preference('marcflavour');
3202 my $host = GetMarcBiblio({ biblionumber => $hostbiblio });
3203 # unfortunately as_string does not 'do the right thing'
3204 # if field returns undef
3205 my %sfd;
3206 my $field;
3207 my $host_field;
3208 if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
3209 if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
3210 my $s = $field->as_string('ab');
3211 if ($s) {
3212 $sfd{a} = $s;
3215 if ( $field = $host->field('245') ) {
3216 my $s = $field->as_string('a');
3217 if ($s) {
3218 $sfd{t} = $s;
3221 if ( $field = $host->field('260') ) {
3222 my $s = $field->as_string('abc');
3223 if ($s) {
3224 $sfd{d} = $s;
3227 if ( $field = $host->field('240') ) {
3228 my $s = $field->as_string();
3229 if ($s) {
3230 $sfd{b} = $s;
3233 if ( $field = $host->field('022') ) {
3234 my $s = $field->as_string('a');
3235 if ($s) {
3236 $sfd{x} = $s;
3239 if ( $field = $host->field('020') ) {
3240 my $s = $field->as_string('a');
3241 if ($s) {
3242 $sfd{z} = $s;
3245 if ( $field = $host->field('001') ) {
3246 $sfd{w} = $field->data(),;
3248 $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
3249 return $host_field;
3251 elsif ( $marcflavour eq 'UNIMARC' ) {
3252 #author
3253 if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3254 my $s = $field->as_string('ab');
3255 if ($s) {
3256 $sfd{a} = $s;
3259 #title
3260 if ( $field = $host->field('200') ) {
3261 my $s = $field->as_string('a');
3262 if ($s) {
3263 $sfd{t} = $s;
3266 #place of publicaton
3267 if ( $field = $host->field('210') ) {
3268 my $s = $field->as_string('a');
3269 if ($s) {
3270 $sfd{c} = $s;
3273 #date of publication
3274 if ( $field = $host->field('210') ) {
3275 my $s = $field->as_string('d');
3276 if ($s) {
3277 $sfd{d} = $s;
3280 #edition statement
3281 if ( $field = $host->field('205') ) {
3282 my $s = $field->as_string();
3283 if ($s) {
3284 $sfd{e} = $s;
3287 #URL
3288 if ( $field = $host->field('856') ) {
3289 my $s = $field->as_string('u');
3290 if ($s) {
3291 $sfd{u} = $s;
3294 #ISSN
3295 if ( $field = $host->field('011') ) {
3296 my $s = $field->as_string('a');
3297 if ($s) {
3298 $sfd{x} = $s;
3301 #ISBN
3302 if ( $field = $host->field('010') ) {
3303 my $s = $field->as_string('a');
3304 if ($s) {
3305 $sfd{y} = $s;
3308 if ( $field = $host->field('001') ) {
3309 $sfd{0} = $field->data(),;
3311 $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
3312 return $host_field;
3314 return;
3318 =head2 UpdateTotalIssues
3320 UpdateTotalIssues($biblionumber, $increase, [$value])
3322 Update the total issue count for a particular bib record.
3324 =over 4
3326 =item C<$biblionumber> is the biblionumber of the bib to update
3328 =item C<$increase> is the amount to increase (or decrease) the total issues count by
3330 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
3332 =back
3334 =cut
3336 sub UpdateTotalIssues {
3337 my ($biblionumber, $increase, $value) = @_;
3338 my $totalissues;
3340 my $record = GetMarcBiblio({ biblionumber => $biblionumber });
3341 unless ($record) {
3342 carp "UpdateTotalIssues could not get biblio record";
3343 return;
3345 my $biblio = Koha::Biblios->find( $biblionumber );
3346 unless ($biblio) {
3347 carp "UpdateTotalIssues could not get datas of biblio";
3348 return;
3350 my $biblioitem = $biblio->biblioitem;
3351 my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField( 'biblioitems.totalissues' );
3352 unless ($totalissuestag) {
3353 return 1; # There is nothing to do
3356 if (defined $value) {
3357 $totalissues = $value;
3358 } else {
3359 $totalissues = $biblioitem->totalissues + $increase;
3362 my $field = $record->field($totalissuestag);
3363 if (defined $field) {
3364 $field->update( $totalissuessubfield => $totalissues );
3365 } else {
3366 $field = MARC::Field->new($totalissuestag, '0', '0',
3367 $totalissuessubfield => $totalissues);
3368 $record->insert_grouped_field($field);
3371 return ModBiblio($record, $biblionumber, $biblio->frameworkcode);
3374 =head2 RemoveAllNsb
3376 &RemoveAllNsb($record);
3378 Removes all nsb/nse chars from a record
3380 =cut
3382 sub RemoveAllNsb {
3383 my $record = shift;
3384 if (!$record) {
3385 carp 'RemoveAllNsb called with undefined record';
3386 return;
3389 SetUTF8Flag($record);
3391 foreach my $field ($record->fields()) {
3392 if ($field->is_control_field()) {
3393 $field->update(nsb_clean($field->data()));
3394 } else {
3395 my @subfields = $field->subfields();
3396 my @new_subfields;
3397 foreach my $subfield (@subfields) {
3398 push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
3400 if (scalar(@new_subfields) > 0) {
3401 my $new_field;
3402 eval {
3403 $new_field = MARC::Field->new(
3404 $field->tag(),
3405 $field->indicator(1),
3406 $field->indicator(2),
3407 @new_subfields
3410 if ($@) {
3411 warn "error in RemoveAllNsb : $@";
3412 } else {
3413 $field->replace_with($new_field);
3419 return $record;
3425 =head2 _after_biblio_action_hooks
3427 Helper method that takes care of calling all plugin hooks
3429 =cut
3431 sub _after_biblio_action_hooks {
3432 my ( $args ) = @_;
3434 my $biblio_id = $args->{biblio_id};
3435 my $action = $args->{action};
3437 if ( C4::Context->preference('UseKohaPlugins') && C4::Context->config("enable_plugins") ) {
3439 my @plugins = Koha::Plugins->new->GetPlugins({
3440 method => 'after_biblio_action',
3443 if (@plugins) {
3445 my $biblio = Koha::Biblios->find( $biblio_id );
3447 foreach my $plugin ( @plugins ) {
3448 try {
3449 $plugin->after_biblio_action({ action => $action, biblio => $biblio, biblio_id => $biblio_id });
3451 catch {
3452 warn "$_";
3459 __END__
3461 =head1 AUTHOR
3463 Koha Development Team <http://koha-community.org/>
3465 Paul POULAIN paul.poulain@free.fr
3467 Joshua Ferraro jmf@liblime.com
3469 =cut