Bug 21983: Make DelBiblio update linked ILL requests
[koha.git] / C4 / Biblio.pm
1 package C4::Biblio;
2
3 # Copyright 2000-2002 Katipo Communications
4 # Copyright 2010 BibLibre
5 # Copyright 2011 Equinox Software, Inc.
6 #
7 # This file is part of Koha.
8 #
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.
13 #
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.
18 #
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>.
21
22 use Modern::Perl;
23
24 use vars qw(@ISA @EXPORT_OK);
25 BEGIN {
26     require Exporter;
27     @ISA = qw(Exporter);
28
29     @EXPORT_OK = qw(
30         AddBiblio
31         GetBiblioData
32         GetISBDView
33         GetMarcControlnumber
34         GetMarcISBN
35         GetMarcISSN
36         GetMarcSubjects
37         GetMarcSeries
38         GetMarcUrls
39         GetUsedMarcStructure
40         GetXmlBiblio
41         GetMarcPrice
42         MungeMarcPrice
43         GetMarcQuantity
44         GetAuthorisedValueDesc
45         GetMarcStructure
46         GetMarcSubfieldStructure
47         IsMarcStructureInternal
48         GetMarcFromKohaField
49         GetMarcSubfieldStructureFromKohaField
50         GetFrameworkCode
51         TransformKohaToMarc
52         PrepHostMarcField
53         CountItemsIssued
54         ModBiblio
55         ModZebra
56         UpdateTotalIssues
57         RemoveAllNsb
58         DelBiblio
59         BiblioAutoLink
60         LinkBibHeadingsToAuthorities
61         ApplyMarcOverlayRules
62         TransformMarcToKoha
63         TransformHtmlToMarc
64         TransformHtmlToXml
65         prepare_host_field
66     );
67
68     # Internal functions
69     # those functions are exported but should not be used
70     # they are useful in a few circumstances, so they are exported,
71     # but don't use them unless you are a core developer ;-)
72     push @EXPORT_OK, qw(
73       ModBiblioMarc
74     );
75 }
76
77 use Carp qw( carp );
78 use Try::Tiny qw( catch try );
79
80 use Encode;
81 use List::MoreUtils qw( uniq );
82 use MARC::Record;
83 use MARC::File::USMARC;
84 use MARC::File::XML;
85 use POSIX qw( strftime );
86 use Module::Load::Conditional qw( can_load );
87
88 use C4::Koha;
89 use C4::Log qw( logaction );    # logaction
90 use C4::Budgets;
91 use C4::ClassSource qw( GetClassSort GetClassSource );
92 use C4::Charset qw(
93     nsb_clean
94     SetMarcUnicodeFlag
95     SetUTF8Flag
96 );
97 use C4::Languages;
98 use C4::Linker;
99 use C4::OAI::Sets;
100 use C4::Items qw( GetMarcItem );
101
102 use Koha::Logger;
103 use Koha::Caches;
104 use Koha::ClassSources;
105 use Koha::Authority::Types;
106 use Koha::Acquisition::Currencies;
107 use Koha::BackgroundJob::BatchUpdateBiblioHoldsQueue;
108 use Koha::Biblio::Metadatas;
109 use Koha::Holds;
110 use Koha::ItemTypes;
111 use Koha::MarcOverlayRules;
112 use Koha::Plugins;
113 use Koha::SearchEngine;
114 use Koha::SearchEngine::Indexer;
115 use Koha::Libraries;
116 use Koha::Util::MARC;
117
118 =head1 NAME
119
120 C4::Biblio - cataloging management functions
121
122 =head1 DESCRIPTION
123
124 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:
125
126 =over 4
127
128 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
129
130 =item 2. as raw MARC in the Zebra index and storage engine
131
132 =item 3. as MARC XML in biblio_metadata.metadata
133
134 =back
135
136 In the 3.0 version of Koha, the authoritative record-level information is in biblio_metadata.metadata
137
138 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.
139
140 =over 4
141
142 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
143
144 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
145
146 =back
147
148 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:
149
150 =over 4
151
152 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
153
154 =item 2. _koha_* - low-level internal functions for managing the koha tables
155
156 =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.
157
158 =item 4. Zebra functions used to update the Zebra index
159
160 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
161
162 =back
163
164 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 :
165
166 =over 4
167
168 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
169
170 =item 2. add the biblionumber and biblioitemnumber into the MARC records
171
172 =item 3. save the marc record
173
174 =back
175
176 =head1 EXPORTED FUNCTIONS
177
178 =head2 AddBiblio
179
180   ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
181
182 Exported function (core API) for adding a new biblio to koha.
183
184 The first argument is a C<MARC::Record> object containing the
185 bib to add, while the second argument is the desired MARC
186 framework code.
187
188 The C<$options> argument is a hashref with additional parameters:
189
190 =over 4
191
192 =item B<defer_marc_save>: used when ModBiblioMarc is handled by the caller
193
194 =item B<skip_record_index>: used when the indexing schedulling will be handled by the caller
195
196 =back
197
198 =cut
199
200 sub AddBiblio {
201     my ( $record, $frameworkcode, $options ) = @_;
202
203     $options //= {};
204     my $skip_record_index = $options->{skip_record_index} || 0;
205     my $defer_marc_save   = $options->{defer_marc_save}   || 0;
206
207     if (!$record) {
208         carp('AddBiblio called with undefined record');
209         return;
210     }
211
212     my $schema = Koha::Database->schema;
213     my ( $biblionumber, $biblioitemnumber );
214     try {
215         $schema->txn_do(sub {
216
217             # transform the data into koha-table style data
218             SetUTF8Flag($record);
219             my $olddata = TransformMarcToKoha({ record => $record, limit_table => 'no_items' });
220
221             my $biblio = Koha::Biblio->new(
222                 {
223                     frameworkcode => $frameworkcode,
224                     author        => $olddata->{author},
225                     title         => $olddata->{title},
226                     subtitle      => $olddata->{subtitle},
227                     medium        => $olddata->{medium},
228                     part_number   => $olddata->{part_number},
229                     part_name     => $olddata->{part_name},
230                     unititle      => $olddata->{unititle},
231                     notes         => $olddata->{notes},
232                     serial =>
233                       ( $olddata->{serial} || $olddata->{seriestitle} ? 1 : 0 ),
234                     seriestitle   => $olddata->{seriestitle},
235                     copyrightdate => $olddata->{copyrightdate},
236                     datecreated   => \'NOW()',
237                     abstract      => $olddata->{abstract},
238                 }
239             )->store;
240             $biblionumber = $biblio->biblionumber;
241             Koha::Exceptions::ObjectNotCreated->throw unless $biblio;
242
243             my ($cn_sort) = GetClassSort( $olddata->{'biblioitems.cn_source'}, $olddata->{'cn_class'}, $olddata->{'cn_item'} );
244             my $biblioitem = Koha::Biblioitem->new(
245                 {
246                     biblionumber          => $biblionumber,
247                     volume                => $olddata->{volume},
248                     number                => $olddata->{number},
249                     itemtype              => $olddata->{itemtype},
250                     isbn                  => $olddata->{isbn},
251                     issn                  => $olddata->{issn},
252                     publicationyear       => $olddata->{publicationyear},
253                     publishercode         => $olddata->{publishercode},
254                     volumedate            => $olddata->{volumedate},
255                     volumedesc            => $olddata->{volumedesc},
256                     collectiontitle       => $olddata->{collectiontitle},
257                     collectionissn        => $olddata->{collectionissn},
258                     collectionvolume      => $olddata->{collectionvolume},
259                     editionstatement      => $olddata->{editionstatement},
260                     editionresponsibility => $olddata->{editionresponsibility},
261                     illus                 => $olddata->{illus},
262                     pages                 => $olddata->{pages},
263                     notes                 => $olddata->{bnotes},
264                     size                  => $olddata->{size},
265                     place                 => $olddata->{place},
266                     lccn                  => $olddata->{lccn},
267                     url                   => $olddata->{url},
268                     cn_source      => $olddata->{'biblioitems.cn_source'},
269                     cn_class       => $olddata->{cn_class},
270                     cn_item        => $olddata->{cn_item},
271                     cn_suffix      => $olddata->{cn_suff},
272                     cn_sort        => $cn_sort,
273                     totalissues    => $olddata->{totalissues},
274                     ean            => $olddata->{ean},
275                     agerestriction => $olddata->{agerestriction},
276                 }
277             )->store;
278             Koha::Exceptions::ObjectNotCreated->throw unless $biblioitem;
279             $biblioitemnumber = $biblioitem->biblioitemnumber;
280
281             _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
282
283             # update MARC subfield that stores biblioitems.cn_sort
284             _koha_marc_update_biblioitem_cn_sort( $record, $olddata, $frameworkcode );
285
286             if (C4::Context->preference('AutoLinkBiblios')) {
287                 BiblioAutoLink( $record, $frameworkcode );
288             }
289
290             # now add the record, don't index while we are in the transaction though
291             ModBiblioMarc( $record, $biblionumber, { skip_record_index => 1 } ) unless $defer_marc_save;
292
293             # update OAI-PMH sets
294             if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
295                 C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
296             }
297
298             _after_biblio_action_hooks({ action => 'create', biblio_id => $biblionumber });
299
300             logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
301
302         });
303         # We index now, after the transaction is committed
304         unless ( $skip_record_index ) {
305             my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
306             $indexer->index_records( $biblionumber, "specialUpdate", "biblioserver" );
307         }
308     } catch {
309         warn $_;
310         ( $biblionumber, $biblioitemnumber ) = ( undef, undef );
311     };
312     return ( $biblionumber, $biblioitemnumber );
313 }
314
315 =head2 ModBiblio
316
317   ModBiblio($record, $biblionumber, $frameworkcode, $options);
318
319 Replace an existing bib record identified by C<$biblionumber>
320 with one supplied by the MARC::Record object C<$record>.  The embedded
321 item, biblioitem, and biblionumber fields from the previous
322 version of the bib record replace any such fields of those tags that
323 are present in C<$record>.  Consequently, ModBiblio() is not
324 to be used to try to modify item records.
325
326 C<$frameworkcode> specifies the MARC framework to use
327 when storing the modified bib record; among other things,
328 this controls how MARC fields get mapped to display columns
329 in the C<biblio> and C<biblioitems> tables, as well as
330 which fields are used to store embedded item, biblioitem,
331 and biblionumber data for indexing.
332
333 The C<$options> argument is a hashref with additional parameters:
334
335 =over 4
336
337 =item C<overlay_context>
338
339 This parameter is forwarded to L</ApplyMarcOverlayRules> where it is used for
340 selecting the current rule set if MARCOverlayRules is enabled.
341 See L</ApplyMarcOverlayRules> for more details.
342
343 =item C<disable_autolink>
344
345 Unless C<disable_autolink> is passed ModBiblio will relink record headings
346 to authorities based on settings in the system preferences. This flag allows
347 us to not relink records when the authority linker is saving modifications.
348
349 =item C<skip_holds_queue>
350
351 Unless C<skip_holds_queue> is passed, ModBiblio will trigger the BatchUpdateBiblioHoldsQueue
352 task to rebuild the holds queue for the biblio if I<RealTimeHoldsQueue> is enabled.
353
354 =back
355
356 Returns 1 on success 0 on failure
357
358 =cut
359
360 sub ModBiblio {
361     my ( $record, $biblionumber, $frameworkcode, $options ) = @_;
362
363     $options //= {};
364     my $skip_record_index = $options->{skip_record_index} || 0;
365
366     if (!$record) {
367         carp 'No record passed to ModBiblio';
368         return 0;
369     }
370
371     if ( C4::Context->preference("CataloguingLog") ) {
372         my $biblio = Koha::Biblios->find($biblionumber);
373         logaction( "CATALOGUING", "MODIFY", $biblionumber, "biblio BEFORE=>" . $biblio->metadata->record->as_formatted );
374     }
375
376     if ( !$options->{disable_autolink} && C4::Context->preference('AutoLinkBiblios') ) {
377         BiblioAutoLink( $record, $frameworkcode );
378     }
379
380     # Cleaning up invalid fields must be done early or SetUTF8Flag is liable to
381     # throw an exception which probably won't be handled.
382     foreach my $field ($record->fields()) {
383         if (! $field->is_control_field()) {
384             if (scalar($field->subfields()) == 0 || (scalar($field->subfields()) == 1 && $field->subfield('9'))) {
385                 $record->delete_field($field);
386             }
387         }
388     }
389
390     SetUTF8Flag($record);
391     my $dbh = C4::Context->dbh;
392
393     $frameworkcode = "" if !$frameworkcode || $frameworkcode eq "Default"; # XXX
394
395     _strip_item_fields($record, $frameworkcode);
396
397     # apply overlay rules
398     if (   C4::Context->preference('MARCOverlayRules')
399         && $biblionumber
400         && defined $options
401         && exists $options->{overlay_context} )
402     {
403         $record = ApplyMarcOverlayRules(
404             {
405                 biblionumber    => $biblionumber,
406                 record          => $record,
407                 overlay_context => $options->{overlay_context},
408             }
409         );
410     }
411
412     # update biblionumber and biblioitemnumber in MARC
413     # FIXME - this is assuming a 1 to 1 relationship between
414     # biblios and biblioitems
415     my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
416     $sth->execute($biblionumber);
417     my ($biblioitemnumber) = $sth->fetchrow;
418     $sth->finish();
419     _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
420
421     # load the koha-table data object
422     my $oldbiblio = TransformMarcToKoha({ record => $record });
423
424     # update MARC subfield that stores biblioitems.cn_sort
425     _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode );
426
427     # update the MARC record (that now contains biblio and items) with the new record data
428     ModBiblioMarc( $record, $biblionumber, { skip_record_index => $skip_record_index } );
429
430     # modify the other koha tables
431     _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
432     _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
433
434     _after_biblio_action_hooks({ action => 'modify', biblio_id => $biblionumber });
435
436     # update OAI-PMH sets
437     if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
438         C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
439     }
440
441     Koha::BackgroundJob::BatchUpdateBiblioHoldsQueue->new->enqueue(
442         {
443             biblio_ids => [ $biblionumber ]
444         }
445     ) unless $options->{skip_holds_queue} or !C4::Context->preference('RealTimeHoldsQueue');
446
447     return 1;
448 }
449
450 =head2 _strip_item_fields
451
452   _strip_item_fields($record, $frameworkcode)
453
454 Utility routine to remove item tags from a
455 MARC bib.
456
457 =cut
458
459 sub _strip_item_fields {
460     my $record = shift;
461     my $frameworkcode = shift;
462     # get the items before and append them to the biblio before updating the record, atm we just have the biblio
463     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber" );
464
465     # delete any item fields from incoming record to avoid
466     # duplication or incorrect data - use AddItem() or ModItem()
467     # to change items
468     foreach my $field ( $record->field($itemtag) ) {
469         $record->delete_field($field);
470     }
471 }
472
473 =head2 DelBiblio
474
475   my $error = &DelBiblio($biblionumber, $params);
476
477 Exported function (core API) for deleting a biblio in koha.
478 Deletes biblio record from Zebra and Koha tables (biblio & biblioitems)
479 Also backs it up to deleted* tables.
480 Checks to make sure that the biblio has no items attached.
481 return:
482 C<$error> : undef unless an error occurs
483
484 I<$params> is a hashref containing extra parameters. Valid keys are:
485
486 =over 4
487
488 =item B<skip_holds_queue>: used when the holds queue update will be handled by the caller
489
490 =item B<skip_record_index>: used when the indexing schedulling will be handled by the caller
491
492 =back
493 =cut
494
495 sub DelBiblio {
496     my ($biblionumber, $params) = @_;
497
498     my $biblio = Koha::Biblios->find( $biblionumber );
499     return unless $biblio; # Should we throw an exception instead?
500
501     my $dbh = C4::Context->dbh;
502     my $error;    # for error handling
503
504     # First make sure this biblio has no items attached
505     my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
506     $sth->execute($biblionumber);
507     if ( my $itemnumber = $sth->fetchrow ) {
508
509         # Fix this to use a status the template can understand
510         $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
511     }
512
513     return $error if $error;
514
515     # We delete any existing holds
516     my $holds = $biblio->holds;
517     while ( my $hold = $holds->next ) {
518         # no need to update the holds queue on each step, we'll do it at the end
519         $hold->cancel({ skip_holds_queue => 1 });
520     }
521
522     # We update any existing orders
523     my $orders = $biblio->orders;
524     $orders->update({ deleted_biblionumber => $biblionumber}, { no_triggers => 1 });
525     # Update related ILL requests
526     $biblio->ill_requests->update({ deleted_biblio_id => $biblio->id, biblio_id => undef });
527
528     unless ( $params->{skip_record_index} ){
529         my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
530         $indexer->index_records( $biblionumber, "recordDelete", "biblioserver" );
531     }
532
533     # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
534     $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
535     $sth->execute($biblionumber);
536     while ( my $biblioitemnumber = $sth->fetchrow ) {
537
538         # delete this biblioitem
539         $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
540         return $error if $error;
541     }
542
543
544     # delete biblio from Koha tables and save in deletedbiblio
545     # must do this *after* _koha_delete_biblioitems, otherwise
546     # delete cascade will prevent deletedbiblioitems rows
547     # from being generated by _koha_delete_biblioitems
548     $error = _koha_delete_biblio( $dbh, $biblionumber );
549
550     _after_biblio_action_hooks({ action => 'delete', biblio_id => $biblionumber });
551
552     logaction( "CATALOGUING", "DELETE", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
553
554     Koha::BackgroundJob::BatchUpdateBiblioHoldsQueue->new->enqueue(
555         {
556             biblio_ids => [ $biblionumber ]
557         }
558     ) unless $params->{skip_holds_queue} or !C4::Context->preference('RealTimeHoldsQueue');
559
560     return;
561 }
562
563
564 =head2 BiblioAutoLink
565
566   my $headings_linked = BiblioAutoLink($record, $frameworkcode)
567
568 Automatically links headings in a bib record to authorities.
569
570 Returns the number of headings changed
571
572 =cut
573
574 sub BiblioAutoLink {
575     my $record        = shift;
576     my $frameworkcode = shift;
577     my $verbose = shift;
578     if (!$record) {
579         carp('Undefined record passed to BiblioAutoLink');
580         return 0;
581     }
582     my ( $num_headings_changed, %results );
583
584     my $linker_module =
585       "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
586     unless ( can_load( modules => { $linker_module => undef } ) ) {
587         $linker_module = 'C4::Linker::Default';
588         unless ( can_load( modules => { $linker_module => undef } ) ) {
589             return 0;
590         }
591     }
592
593     my $linker = $linker_module->new(
594         { 'options' => C4::Context->preference("LinkerOptions") } );
595     my ( $headings_changed, $results ) =
596       LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, C4::Context->preference("CatalogModuleRelink") || '', undef, $verbose );
597     # By default we probably don't want to relink things when cataloging
598     return $headings_changed, $results;
599 }
600
601 =head2 LinkBibHeadingsToAuthorities
602
603   my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink, $tagtolink,  $verbose]);
604
605 Links bib headings to authority records by checking
606 each authority-controlled field in the C<MARC::Record>
607 object C<$marc>, looking for a matching authority record,
608 and setting the linking subfield $9 to the ID of that
609 authority record.  
610
611 If $allowrelink is false, existing authids will never be
612 replaced, regardless of the values of LinkerKeepStale and
613 LinkerRelink.
614
615 Returns the number of heading links changed in the
616 MARC record.
617
618 =cut
619
620 sub LinkBibHeadingsToAuthorities {
621     my $linker        = shift;
622     my $bib           = shift;
623     my $frameworkcode = shift;
624     my $allowrelink = shift;
625     my $tagtolink     = shift;
626     my $verbose = shift;
627     my %results;
628     if (!$bib) {
629         carp 'LinkBibHeadingsToAuthorities called on undefined bib record';
630         return ( 0, {});
631     }
632     require C4::Heading;
633     require C4::AuthoritiesMarc;
634
635     $allowrelink = 1 unless defined $allowrelink;
636     my $num_headings_changed = 0;
637     foreach my $field ( $bib->fields() ) {
638         if ( defined $tagtolink ) {
639           next unless $field->tag() == $tagtolink ;
640         }
641         my $heading = C4::Heading->new_from_field( $field, $frameworkcode );
642         next unless defined $heading;
643
644         # check existing $9
645         my $current_link = $field->subfield('9');
646
647         if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) )
648         {
649             $results{'linked'}->{ $heading->display_form() }++;
650             push(@{$results{'details'}}, { tag => $field->tag(), authid => $current_link, status => 'UNCHANGED'}) if $verbose;
651             next;
652         }
653
654         my ( $authid, $fuzzy, $match_count ) = $linker->get_link($heading);
655         if ($authid) {
656             $results{ $fuzzy ? 'fuzzy' : 'linked' }
657               ->{ $heading->display_form() }++;
658             if(defined $current_link and $current_link == $authid) {
659                 push(@{$results{'details'}}, { tag => $field->tag(), authid => $current_link, status => 'UNCHANGED'}) if $verbose;
660                 next;
661             }
662
663             $field->delete_subfield( code => '9' ) if defined $current_link;
664             $field->add_subfields( '9', $authid );
665             $num_headings_changed++;
666             push(@{$results{'details'}}, { tag => $field->tag(), authid => $authid, status => 'LOCAL_FOUND'}) if $verbose;
667         }
668         else {
669             my $authority_type = Koha::Authority::Types->find( $heading->auth_type() );
670             if ( defined $current_link
671                 && (!$allowrelink || C4::Context->preference('LinkerKeepStale')) )
672             {
673                 $results{'fuzzy'}->{ $heading->display_form() }++;
674                 push(@{$results{'details'}}, { tag => $field->tag(), authid => $current_link, status => 'UNCHANGED'}) if $verbose;
675             }
676             elsif ( C4::Context->preference('AutoCreateAuthorities') ) {
677                 if ( _check_valid_auth_link( $current_link, $field ) ) {
678                     $results{'linked'}->{ $heading->display_form() }++;
679                 }
680                 elsif ( !$match_count ) {
681                     my $authority_type = Koha::Authority::Types->find( $heading->auth_type() );
682                     my $marcrecordauth = MARC::Record->new();
683                     if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
684                         $marcrecordauth->leader('     nz  a22     o  4500');
685                         SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
686                     }
687                     $field->delete_subfield( code => '9' )
688                       if defined $current_link;
689                     my @auth_subfields;
690                     foreach my $subfield ( $field->subfields() ){
691                         if ( $subfield->[0] =~ /[A-z]/
692                             && C4::Heading::valid_heading_subfield(
693                                 $field->tag, $subfield->[0] )
694                            ){
695                             push @auth_subfields, $subfield->[0] => $subfield->[1];
696                         }
697                     }
698                     # Bib headings contain some ending punctuation that should NOT
699                     # be included in the authority record. Strip those before creation
700                     next unless @auth_subfields; # Don't try to create a record if we have no fields;
701                     my $last_sub = pop @auth_subfields;
702                     $last_sub =~ s/[\s]*[,.:=;!%\/][\s]*$//;
703                     push @auth_subfields, $last_sub;
704                     my $authfield = MARC::Field->new( $authority_type->auth_tag_to_report, '', '', @auth_subfields );
705                     $marcrecordauth->insert_fields_ordered($authfield);
706
707 # bug 2317: ensure new authority knows it's using UTF-8; currently
708 # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
709 # automatically for UNIMARC (by not transcoding)
710 # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
711 # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
712 # of change to a core API just before the 3.0 release.
713
714                     if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
715                         my $userenv = C4::Context->userenv;
716                         my $library;
717                         if ( $userenv && $userenv->{'branch'} ) {
718                             $library = Koha::Libraries->find( $userenv->{'branch'} );
719                         }
720                         $marcrecordauth->insert_fields_ordered(
721                             MARC::Field->new(
722                                 '667', '', '',
723                                 'a' => C4::Context->preference('GenerateAuthorityField667')
724                             )
725                         );
726                         my $cite =
727                             $bib->author() . ", "
728                           . $bib->title_proper() . ", "
729                           . $bib->publication_date() . " ";
730                         $cite =~ s/^[\s\,]*//;
731                         $cite =~ s/[\s\,]*$//;
732                         $cite =
733                             C4::Context->preference('GenerateAuthorityField670') . ": ("
734                           . ( $library ? $library->get_effective_marcorgcode : C4::Context->preference('MARCOrgCode') ) . ")"
735                           . $bib->subfield( '999', 'c' ) . ": "
736                           . $cite;
737                         $marcrecordauth->insert_fields_ordered(
738                             MARC::Field->new( '670', '', '', 'a' => $cite ) );
739                     }
740
741            #          warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
742
743                     $authid =
744                       C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '',
745                         $heading->auth_type() );
746                     $field->add_subfields( '9', $authid );
747                     $num_headings_changed++;
748                     $linker->update_cache($heading, $authid);
749                     $results{'added'}->{ $heading->display_form() }++;
750                     push(@{$results{'details'}}, { tag => $field->tag(), authid => $authid, status => 'CREATED'}) if $verbose;
751                 }
752             }
753             elsif ( defined $current_link ) {
754                 if ( _check_valid_auth_link( $current_link, $field ) ) {
755                     $results{'linked'}->{ $heading->display_form() }++;
756                     push(@{$results{'details'}}, { tag => $field->tag(), authid => $authid, status => 'UNCHANGED'}) if $verbose;
757                 }
758                 else {
759                     $field->delete_subfield( code => '9' );
760                     $num_headings_changed++;
761                     $results{'unlinked'}->{ $heading->display_form() }++;
762                     push(@{$results{'details'}}, { tag => $field->tag(), authid => undef, status => 'NONE_FOUND', auth_type => $heading->auth_type(), tag_to_report => $authority_type->auth_tag_to_report}) if $verbose;
763                 }
764             }
765             else {
766                 $results{'unlinked'}->{ $heading->display_form() }++;
767                 push(@{$results{'details'}}, { tag => $field->tag(), authid => undef, status => 'NONE_FOUND', auth_type => $heading->auth_type(), tag_to_report => $authority_type->auth_tag_to_report}) if $verbose;
768             }
769         }
770
771     }
772     push(@{$results{'details'}}, { tag => '', authid => undef, status => 'UNCHANGED'}) unless %results;
773     return $num_headings_changed, \%results;
774 }
775
776 =head2 _check_valid_auth_link
777
778     if ( _check_valid_auth_link($authid, $field) ) {
779         ...
780     }
781
782 Check whether the specified heading-auth link is valid without reference
783 to Zebra. Ideally this code would be in C4::Heading, but that won't be
784 possible until we have de-cycled C4::AuthoritiesMarc, so this is the
785 safest place.
786
787 =cut
788
789 sub _check_valid_auth_link {
790     my ( $authid, $field ) = @_;
791     require C4::AuthoritiesMarc;
792
793     return C4::AuthoritiesMarc::CompareFieldWithAuthority( { 'field' => $field, 'authid' => $authid } );
794 }
795
796 =head2 GetBiblioData
797
798   $data = &GetBiblioData($biblionumber);
799
800 Returns information about the book with the given biblionumber.
801 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
802 the C<biblio> and C<biblioitems> tables in the
803 Koha database.
804
805 In addition, C<$data-E<gt>{subject}> is the list of the book's
806 subjects, separated by C<" , "> (space, comma, space).
807 If there are multiple biblioitems with the given biblionumber, only
808 the first one is considered.
809
810 =cut
811
812 sub GetBiblioData {
813     my ($bibnum) = @_;
814     my $dbh = C4::Context->dbh;
815
816     my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
817             FROM biblio
818             LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
819             LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
820             WHERE biblio.biblionumber = ?";
821
822     my $sth = $dbh->prepare($query);
823     $sth->execute($bibnum);
824     my $data;
825     $data = $sth->fetchrow_hashref;
826     $sth->finish;
827
828     return ($data);
829 }    # sub GetBiblioData
830
831 =head2 GetISBDView 
832
833   $isbd = &GetISBDView({
834       'record'    => $marc_record,
835       'template'  => $interface, # opac/intranet
836       'framework' => $framework,
837   });
838
839 Return the ISBD view which can be included in opac and intranet
840
841 =cut
842
843 sub GetISBDView {
844     my ( $params ) = @_;
845
846     # Expecting record WITH items.
847     my $record    = $params->{record};
848     return unless defined $record;
849
850     my $template  = $params->{template} // q{};
851     my $sysprefname = $template eq 'opac' ? 'opacisbd' : 'isbd';
852     my $framework = $params->{framework};
853     my $itemtype  = $framework;
854     my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField( "items.holdingbranch" );
855     my $tagslib = GetMarcStructure( 1, $itemtype, { unsafe => 1 } );
856
857     my $ISBD = C4::Context->preference($sysprefname);
858     my $bloc = $ISBD;
859     my $res;
860     my $blocres;
861
862     foreach my $isbdfield ( split( /#/, $bloc ) ) {
863
864         #         $isbdfield= /(.?.?.?)/;
865         $isbdfield =~ /(\d\d\d)([^\|])?\|(.*)\|(.*)\|(.*)/;
866         my $fieldvalue = $1 || 0;
867         my $subfvalue  = $2 || "";
868         my $textbefore = $3;
869         my $analysestring = $4;
870         my $textafter     = $5;
871
872         #         warn "==> $1 / $2 / $3 / $4";
873         #         my $fieldvalue=substr($isbdfield,0,3);
874         if ( $fieldvalue > 0 ) {
875             my $hasputtextbefore = 0;
876             my @fieldslist       = $record->field($fieldvalue);
877             @fieldslist = sort { $a->subfield($holdingbrtagsubf) cmp $b->subfield($holdingbrtagsubf) } @fieldslist if ( $fieldvalue eq $holdingbrtagf );
878
879             #         warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
880             #             warn "FV : $fieldvalue";
881             if ( $subfvalue ne "" ) {
882                 # OPAC hidden subfield
883                 next
884                   if ( ( $template eq 'opac' )
885                     && ( $tagslib->{$fieldvalue}->{$subfvalue}->{'hidden'} || 0 ) > 0 );
886                 foreach my $field (@fieldslist) {
887                     foreach my $subfield ( $field->subfield($subfvalue) ) {
888                         my $calculated = $analysestring;
889                         my $tag        = $field->tag();
890                         if ( $tag < 10 ) {
891                         } else {
892                             my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subfvalue, $subfield, '', $tagslib );
893                             my $tagsubf = $tag . $subfvalue;
894                             $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
895                             if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
896
897                             # field builded, store the result
898                             if ( $calculated && !$hasputtextbefore ) {    # put textbefore if not done
899                                 $blocres .= $textbefore;
900                                 $hasputtextbefore = 1;
901                             }
902
903                             # remove punctuation at start
904                             $calculated =~ s/^( |;|:|\.|-)*//g;
905                             $blocres .= $calculated;
906
907                         }
908                     }
909                 }
910                 $blocres .= $textafter if $hasputtextbefore;
911             } else {
912                 foreach my $field (@fieldslist) {
913                     my $calculated = $analysestring;
914                     my $tag        = $field->tag();
915                     if ( $tag < 10 ) {
916                     } else {
917                         my @subf = $field->subfields;
918                         for my $i ( 0 .. $#subf ) {
919                             my $valuecode     = $subf[$i][1];
920                             my $subfieldcode  = $subf[$i][0];
921                             # OPAC hidden subfield
922                             next
923                               if ( ( $template eq 'opac' )
924                                 && ( $tagslib->{$fieldvalue}->{$subfieldcode}->{'hidden'} || 0 ) > 0 );
925                             my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subf[$i][0], $subf[$i][1], '', $tagslib );
926                             my $tagsubf       = $tag . $subfieldcode;
927
928                             $calculated =~ s/                  # replace all {{}} codes by the value code.
929                                   \{\{$tagsubf\}\} # catch the {{actualcode}}
930                                 /
931                                   $valuecode     # replace by the value code
932                                /gx;
933
934                             $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
935                             if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
936                         }
937
938                         # field builded, store the result
939                         if ( $calculated && !$hasputtextbefore ) {    # put textbefore if not done
940                             $blocres .= $textbefore;
941                             $hasputtextbefore = 1;
942                         }
943
944                         # remove punctuation at start
945                         $calculated =~ s/^( |;|:|\.|-)*//g;
946                         $blocres .= $calculated;
947                     }
948                 }
949                 $blocres .= $textafter if $hasputtextbefore;
950             }
951         } else {
952             $blocres .= $isbdfield;
953         }
954     }
955     $res .= $blocres;
956
957     $res =~ s/\{(.*?)\}//g;
958     $res =~ s/\\n/\n/g;
959     $res =~ s/\n/<br\/>/g;
960
961     # remove empty ()
962     $res =~ s/\(\)//g;
963
964     return $res;
965 }
966
967 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
968
969 =head2 IsMarcStructureInternal
970
971     my $tagslib = C4::Biblio::GetMarcStructure();
972     for my $tag ( sort keys %$tagslib ) {
973         next unless $tag;
974         for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
975             next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
976         }
977         # Process subfield
978     }
979
980 GetMarcStructure creates keys (lib, tab, mandatory, repeatable, important) for a display purpose.
981 These different values should not be processed as valid subfields.
982
983 =cut
984
985 sub IsMarcStructureInternal {
986     my ( $subfield ) = @_;
987     return ref $subfield ? 0 : 1;
988 }
989
990 =head2 GetMarcStructure
991
992   $res = GetMarcStructure($forlibrarian, $frameworkcode, [ $params ]);
993
994 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
995 $forlibrarian  :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
996 $frameworkcode : the framework code to read
997 $params allows you to pass { unsafe => 1 } for better performance.
998
999 Note: If you call GetMarcStructure with unsafe => 1, do not modify or
1000 even autovivify its contents. It is a cached/shared data structure. Your
1001 changes c/would be passed around in subsequent calls.
1002
1003 =cut
1004
1005 sub GetMarcStructure {
1006     my ( $forlibrarian, $frameworkcode, $params ) = @_;
1007     $frameworkcode = "" unless $frameworkcode;
1008
1009     $forlibrarian = $forlibrarian ? 1 : 0;
1010     my $unsafe = ($params && $params->{unsafe})? 1: 0;
1011     my $cache = Koha::Caches->get_instance();
1012     my $cache_key = "MarcStructure-$forlibrarian-$frameworkcode";
1013     my $cached = $cache->get_from_cache($cache_key, { unsafe => $unsafe });
1014     return $cached if $cached;
1015
1016     my $dbh = C4::Context->dbh;
1017     my $sth = $dbh->prepare(
1018         "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable,important,ind1_defaultvalue,ind2_defaultvalue
1019         FROM marc_tag_structure 
1020         WHERE frameworkcode=? 
1021         ORDER BY tagfield"
1022     );
1023     $sth->execute($frameworkcode);
1024     my ( $liblibrarian, $libopac, $tag, $res, $mandatory, $repeatable, $important, $ind1_defaultvalue, $ind2_defaultvalue );
1025
1026     while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable, $important, $ind1_defaultvalue, $ind2_defaultvalue ) = $sth->fetchrow ) {
1027         $res->{$tag}->{lib}        = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1028         $res->{$tag}->{tab}        = "";
1029         $res->{$tag}->{mandatory}  = $mandatory;
1030         $res->{$tag}->{important}  = $important;
1031         $res->{$tag}->{repeatable} = $repeatable;
1032     $res->{$tag}->{ind1_defaultvalue} = $ind1_defaultvalue;
1033     $res->{$tag}->{ind2_defaultvalue} = $ind2_defaultvalue;
1034     }
1035
1036     my $mss = Koha::MarcSubfieldStructures->search( { frameworkcode => $frameworkcode } )->unblessed;
1037     for my $m (@$mss) {
1038         $res->{ $m->{tagfield} }->{ $m->{tagsubfield} } = {
1039             lib => ( $forlibrarian or !$m->{libopac} ) ? $m->{liblibrarian} : $m->{libopac},
1040             subfield => $m->{tagsubfield},
1041             %$m
1042         };
1043     }
1044
1045     $cache->set_in_cache($cache_key, $res);
1046     return $res;
1047 }
1048
1049 =head2 GetUsedMarcStructure
1050
1051 The same function as GetMarcStructure except it just takes field
1052 in tab 0-9. (used field)
1053
1054   my $results = GetUsedMarcStructure($frameworkcode);
1055
1056 C<$results> is a ref to an array which each case contains a ref
1057 to a hash which each keys is the columns from marc_subfield_structure
1058
1059 C<$frameworkcode> is the framework code. 
1060
1061 =cut
1062
1063 sub GetUsedMarcStructure {
1064     my $frameworkcode = shift || '';
1065     my $query = q{
1066         SELECT *
1067         FROM   marc_subfield_structure
1068         WHERE   tab > -1 
1069             AND frameworkcode = ?
1070         ORDER BY tagfield, display_order, tagsubfield
1071     };
1072     my $sth = C4::Context->dbh->prepare($query);
1073     $sth->execute($frameworkcode);
1074     return $sth->fetchall_arrayref( {} );
1075 }
1076
1077 =pod
1078
1079 =head2 GetMarcSubfieldStructure
1080
1081   my $structure = GetMarcSubfieldStructure($frameworkcode, [$params]);
1082
1083 Returns a reference to hash representing MARC subfield structure
1084 for framework with framework code C<$frameworkcode>, C<$params> is
1085 optional and may contain additional options.
1086
1087 =over 4
1088
1089 =item C<$frameworkcode>
1090
1091 The framework code.
1092
1093 =item C<$params>
1094
1095 An optional hash reference with additional options.
1096 The following options are supported:
1097
1098 =over 4
1099
1100 =item unsafe
1101
1102 Pass { unsafe => 1 } do disable cached object cloning,
1103 and instead get a shared reference, resulting in better
1104 performance (but care must be taken so that retured object
1105 is never modified).
1106
1107 Note: If you call GetMarcSubfieldStructure with unsafe => 1, do not modify or
1108 even autovivify its contents. It is a cached/shared data structure. Your
1109 changes would be passed around in subsequent calls.
1110
1111 =back
1112
1113 =back
1114
1115 =cut
1116
1117 sub GetMarcSubfieldStructure {
1118     my ( $frameworkcode, $params ) = @_;
1119
1120     $frameworkcode //= '';
1121
1122     my $cache     = Koha::Caches->get_instance();
1123     my $cache_key = "MarcSubfieldStructure-$frameworkcode";
1124     my $cached  = $cache->get_from_cache($cache_key, { unsafe => ($params && $params->{unsafe}) });
1125     return $cached if $cached;
1126
1127     my $dbh = C4::Context->dbh;
1128     # We moved to selectall_arrayref since selectall_hashref does not
1129     # keep duplicate mappings on kohafield (like place in 260 vs 264)
1130     my $subfield_aref = $dbh->selectall_arrayref( q|
1131         SELECT *
1132         FROM marc_subfield_structure
1133         WHERE frameworkcode = ?
1134         AND kohafield > ''
1135         ORDER BY frameworkcode, tagfield, display_order, tagsubfield
1136     |, { Slice => {} }, $frameworkcode );
1137     # Now map the output to a hash structure
1138     my $subfield_structure = {};
1139     foreach my $row ( @$subfield_aref ) {
1140         push @{ $subfield_structure->{ $row->{kohafield} }}, $row;
1141     }
1142     $cache->set_in_cache( $cache_key, $subfield_structure );
1143     return $subfield_structure;
1144 }
1145
1146 =head2 GetMarcFromKohaField
1147
1148     ( $field,$subfield ) = GetMarcFromKohaField( $kohafield );
1149     @fields = GetMarcFromKohaField( $kohafield );
1150     $field = GetMarcFromKohaField( $kohafield );
1151
1152     Returns the MARC fields & subfields mapped to $kohafield.
1153     Since the Default framework is considered as authoritative for such
1154     mappings, the former frameworkcode parameter is obsoleted.
1155
1156     In list context all mappings are returned; there can be multiple
1157     mappings. Note that in the above example you could miss a second
1158     mappings in the first call.
1159     In scalar context only the field tag of the first mapping is returned.
1160
1161 =cut
1162
1163 sub GetMarcFromKohaField {
1164     my ( $kohafield ) = @_;
1165     return unless $kohafield;
1166     # The next call uses the Default framework since it is AUTHORITATIVE
1167     # for all Koha to MARC mappings.
1168     my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
1169     my @retval;
1170     foreach( @{ $mss->{$kohafield} } ) {
1171         push @retval, $_->{tagfield}, $_->{tagsubfield};
1172     }
1173     return wantarray ? @retval : ( @retval ? $retval[0] : undef );
1174 }
1175
1176 =head2 GetMarcSubfieldStructureFromKohaField
1177
1178     my $str = GetMarcSubfieldStructureFromKohaField( $kohafield );
1179
1180     Returns marc subfield structure information for $kohafield.
1181     The Default framework is used, since it is authoritative for kohafield
1182     mappings.
1183     In list context returns a list of all hashrefs, since there may be
1184     multiple mappings. In scalar context the first hashref is returned.
1185
1186 =cut
1187
1188 sub GetMarcSubfieldStructureFromKohaField {
1189     my ( $kohafield ) = @_;
1190
1191     return unless $kohafield;
1192
1193     # The next call uses the Default framework since it is AUTHORITATIVE
1194     # for all Koha to MARC mappings.
1195     my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
1196     return unless $mss->{$kohafield};
1197     return wantarray ? @{$mss->{$kohafield}} : $mss->{$kohafield}->[0];
1198 }
1199
1200 =head2 GetXmlBiblio
1201
1202   my $marcxml = GetXmlBiblio($biblionumber);
1203
1204 Returns biblio_metadata.metadata/marcxml of the biblionumber passed in parameter.
1205 The XML should only contain biblio information (item information is no longer stored in marcxml field)
1206
1207 =cut
1208
1209 sub GetXmlBiblio {
1210     my ($biblionumber) = @_;
1211     my $dbh = C4::Context->dbh;
1212     return unless $biblionumber;
1213     my ($marcxml) = $dbh->selectrow_array(
1214         q|
1215         SELECT metadata
1216         FROM biblio_metadata
1217         WHERE biblionumber=?
1218             AND format='marcxml'
1219             AND `schema`=?
1220     |, undef, $biblionumber, C4::Context->preference('marcflavour')
1221     );
1222     return $marcxml;
1223 }
1224
1225 =head2 GetMarcPrice
1226
1227 return the prices in accordance with the Marc format.
1228
1229 returns 0 if no price found
1230 returns undef if called without a marc record or with
1231 an unrecognized marc format
1232
1233 =cut
1234
1235 sub GetMarcPrice {
1236     my ( $record, $marcflavour ) = @_;
1237     if (!$record) {
1238         carp 'GetMarcPrice called on undefined record';
1239         return;
1240     }
1241
1242     my @listtags;
1243     my $subfield;
1244     
1245     if ( $marcflavour eq "MARC21" ) {
1246         @listtags = ('345', '020');
1247         $subfield="c";
1248     } elsif ( $marcflavour eq "UNIMARC" ) {
1249         @listtags = ('345', '010');
1250         $subfield="d";
1251     } else {
1252         return;
1253     }
1254     
1255     for my $field ( $record->field(@listtags) ) {
1256         for my $subfield_value  ($field->subfield($subfield)){
1257             #check value
1258             $subfield_value = MungeMarcPrice( $subfield_value );
1259             return $subfield_value if ($subfield_value);
1260         }
1261     }
1262     return 0; # no price found
1263 }
1264
1265 =head2 MungeMarcPrice
1266
1267 Return the best guess at what the actual price is from a price field.
1268
1269 =cut
1270
1271 sub MungeMarcPrice {
1272     my ( $price ) = @_;
1273     return unless ( $price =~ m/\d/ ); ## No digits means no price.
1274     # Look for the currency symbol and the normalized code of the active currency, if it's there,
1275     my $active_currency = Koha::Acquisition::Currencies->get_active;
1276     my $symbol = $active_currency->symbol;
1277     my $isocode = $active_currency->isocode;
1278     $isocode = $active_currency->currency unless defined $isocode;
1279     my $localprice;
1280     if ( $symbol ) {
1281         my @matches =($price=~ /
1282             \s?
1283             (                          # start of capturing parenthesis
1284             (?:
1285             (?:[\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'
1286             |(?:\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'
1287             )
1288             \s?\p{Sc}?\s?              # followed or not by a whitespace. \p{Sc}?\s? are for cases like '25$ USD'
1289             (?:
1290             (?:[\p{Sc}\p{L}\/.]){1,4}  # followed by same block as symbol block
1291             |(?:\d+[\p{P}\s]?){1,4}    # or by same block as digits block
1292             )
1293             \s?\p{L}{0,4}\s?           # followed or not by a whitespace. \p{L}{0,4}\s? are for cases like '$9.50 USD'
1294             )                          # end of capturing parenthesis
1295             (?:\p{P}|\z)               # followed by a punctuation sign or by the end of the string
1296             /gx);
1297
1298         if ( @matches ) {
1299             foreach ( @matches ) {
1300                 $localprice = $_ and last if index($_, $isocode)>=0;
1301             }
1302             if ( !$localprice ) {
1303                 foreach ( @matches ) {
1304                     $localprice = $_ and last if $_=~ /(^|[^\p{Sc}\p{L}\/])\Q$symbol\E([^\p{Sc}\p{L}\/]+\z|\z)/;
1305                 }
1306             }
1307         }
1308     }
1309     if ( $localprice ) {
1310         $price = $localprice;
1311     } else {
1312         ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
1313         ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
1314     }
1315     # eliminate symbol/isocode, space and any final dot from the string
1316     $price =~ s/[\p{Sc}\p{L}\/ ]|\.$//g;
1317     # remove comma,dot when used as separators from hundreds
1318     $price =~s/[\,\.](\d{3})/$1/g;
1319     # convert comma to dot to ensure correct display of decimals if existing
1320     $price =~s/,/./;
1321     return $price;
1322 }
1323
1324
1325 =head2 GetMarcQuantity
1326
1327 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
1328 Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
1329
1330 returns 0 if no quantity found
1331 returns undef if called without a marc record or with
1332 an unrecognized marc format
1333
1334 =cut
1335
1336 sub GetMarcQuantity {
1337     my ( $record, $marcflavour ) = @_;
1338     if (!$record) {
1339         carp 'GetMarcQuantity called on undefined record';
1340         return;
1341     }
1342
1343     my @listtags;
1344     my $subfield;
1345     
1346     if ( $marcflavour eq "MARC21" ) {
1347         return 0
1348     } elsif ( $marcflavour eq "UNIMARC" ) {
1349         @listtags = ('969');
1350         $subfield="a";
1351     } else {
1352         return;
1353     }
1354     
1355     for my $field ( $record->field(@listtags) ) {
1356         for my $subfield_value  ($field->subfield($subfield)){
1357             #check value
1358             if ($subfield_value) {
1359                  # in France, the cents separator is the , but sometimes, ppl use a .
1360                  # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1361                 $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
1362                 return $subfield_value;
1363             }
1364         }
1365     }
1366     return 0; # no price found
1367 }
1368
1369
1370 =head2 GetAuthorisedValueDesc
1371
1372   my $subfieldvalue =get_authorised_value_desc(
1373     $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1374
1375 Retrieve the complete description for a given authorised value.
1376
1377 Now takes $category and $value pair too.
1378
1379   my $auth_value_desc =GetAuthorisedValueDesc(
1380     '','', 'DVD' ,'','','CCODE');
1381
1382 If the optional $opac parameter is set to a true value, displays OPAC 
1383 descriptions rather than normal ones when they exist.
1384
1385 =cut
1386
1387 sub GetAuthorisedValueDesc {
1388     my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1389
1390     return q{} unless defined($value);
1391
1392     my $cache     = Koha::Caches->get_instance();
1393     my $cache_key;
1394     if ( !$category ) {
1395
1396         return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1397
1398         #---- branch
1399         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1400             $cache_key = "libraries:name";
1401             my $libraries = $cache->get_from_cache( $cache_key, { unsafe => 1 } );
1402             if ( !$libraries ) {
1403                 $libraries = {
1404                     map { $_->branchcode => $_->branchname }
1405                       Koha::Libraries->search( {},
1406                         { columns => [ 'branchcode', 'branchname' ] } )
1407                       ->as_list
1408                 };
1409                 $cache->set_in_cache($cache_key, $libraries);
1410             }
1411             return $libraries->{$value};
1412         }
1413
1414         #---- itemtypes
1415         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1416             my $lang = C4::Languages::getlanguage;
1417             $lang //= 'en';
1418             $cache_key = 'itemtype:description:' . $lang;
1419             my $itypes = $cache->get_from_cache( $cache_key, { unsafe => 1 } );
1420             if ( !$itypes ) {
1421                 $itypes =
1422                   { map { $_->itemtype => $_->translated_description }
1423                       Koha::ItemTypes->search()->as_list };
1424                 $cache->set_in_cache( $cache_key, $itypes );
1425             }
1426             return $itypes->{$value};
1427         }
1428
1429         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "cn_source" ) {
1430             $cache_key = "cn_sources:description";
1431             my $cn_sources = $cache->get_from_cache( $cache_key, { unsafe => 1 } );
1432             if ( !$cn_sources ) {
1433                 $cn_sources = {
1434                     map { $_->cn_source => $_->description }
1435                       Koha::ClassSources->search( {},
1436                         { columns => [ 'cn_source', 'description' ] } )
1437                       ->as_list
1438                 };
1439                 $cache->set_in_cache($cache_key, $cn_sources);
1440             }
1441             return $cn_sources->{$value};
1442         }
1443
1444         #---- "true" authorized value
1445         $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1446     }
1447
1448     my $dbh = C4::Context->dbh;
1449     if ( $category ne "" ) {
1450         $cache_key = "AV_descriptions:" . $category;
1451         my $av_descriptions = $cache->get_from_cache( $cache_key, { unsafe => 1 } );
1452         if ( !$av_descriptions ) {
1453             $av_descriptions = {
1454                 map {
1455                     $_->authorised_value =>
1456                       { lib => $_->lib, lib_opac => $_->lib_opac }
1457                 } Koha::AuthorisedValues->search(
1458                     { category => $category },
1459                     {
1460                         columns => [ 'authorised_value', 'lib_opac', 'lib' ]
1461                     }
1462                 )->as_list
1463             };
1464             $cache->set_in_cache($cache_key, $av_descriptions);
1465         }
1466         return ( $opac && $av_descriptions->{$value}->{'lib_opac'} )
1467           ? $av_descriptions->{$value}->{'lib_opac'}
1468           : $av_descriptions->{$value}->{'lib'};
1469     } else {
1470         return $value;    # if nothing is found return the original value
1471     }
1472 }
1473
1474 =head2 GetMarcControlnumber
1475
1476   $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1477
1478 Get the control number / record Identifier from the MARC record and return it.
1479
1480 =cut
1481
1482 sub GetMarcControlnumber {
1483     my ( $record, $marcflavour ) = @_;
1484     if (!$record) {
1485         carp 'GetMarcControlnumber called on undefined record';
1486         return;
1487     }
1488     my $controlnumber = "";
1489     # Control number or Record identifier are the same field in MARC21 and UNIMARC
1490     # Keep $marcflavour for possible later use
1491     if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" ) {
1492         my $controlnumberField = $record->field('001');
1493         if ($controlnumberField) {
1494             $controlnumber = $controlnumberField->data();
1495         }
1496     }
1497     return $controlnumber;
1498 }
1499
1500 =head2 GetMarcISBN
1501
1502   $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1503
1504 Get all ISBNs from the MARC record and returns them in an array.
1505 ISBNs stored in different fields depending on MARC flavour
1506
1507 =cut
1508
1509 sub GetMarcISBN {
1510     my ( $record, $marcflavour ) = @_;
1511     if (!$record) {
1512         carp 'GetMarcISBN called on undefined record';
1513         return;
1514     }
1515     my $scope;
1516     if ( $marcflavour eq "UNIMARC" ) {
1517         $scope = '010';
1518     } else {    # assume marc21 if not unimarc
1519         $scope = '020';
1520     }
1521
1522     my @marcisbns;
1523     foreach my $field ( $record->field($scope) ) {
1524         my $isbn = $field->subfield( 'a' );
1525         if ( $isbn && $isbn ne "" ) {
1526             push @marcisbns, $isbn;
1527         }
1528     }
1529
1530     return \@marcisbns;
1531 }    # end GetMarcISBN
1532
1533
1534 =head2 GetMarcISSN
1535
1536   $marcissnsarray = GetMarcISSN( $record, $marcflavour );
1537
1538 Get all valid ISSNs from the MARC record and returns them in an array.
1539 ISSNs are stored in different fields depending on MARC flavour
1540
1541 =cut
1542
1543 sub GetMarcISSN {
1544     my ( $record, $marcflavour ) = @_;
1545     if (!$record) {
1546         carp 'GetMarcISSN called on undefined record';
1547         return;
1548     }
1549     my $scope;
1550     if ( $marcflavour eq "UNIMARC" ) {
1551         $scope = '011';
1552     }
1553     else {    # assume MARC21
1554         $scope = '022';
1555     }
1556     my @marcissns;
1557     foreach my $field ( $record->field($scope) ) {
1558         push @marcissns, $field->subfield( 'a' )
1559             if ( $field->subfield( 'a' ) ne "" );
1560     }
1561     return \@marcissns;
1562 }    # end GetMarcISSN
1563
1564 =head2 GetMarcSubjects
1565
1566   $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1567
1568 Get all subjects from the MARC record and returns them in an array.
1569 The subjects are stored in different fields depending on MARC flavour
1570
1571 =cut
1572
1573 sub GetMarcSubjects {
1574     my ( $record, $marcflavour ) = @_;
1575     if (!$record) {
1576         carp 'GetMarcSubjects called on undefined record';
1577         return;
1578     }
1579     my ( $mintag, $maxtag, $fields_filter );
1580     if ( $marcflavour eq "UNIMARC" ) {
1581         $mintag = "600";
1582         $maxtag = "611";
1583         $fields_filter = '6..';
1584     } else { # marc21
1585         $mintag = "600";
1586         $maxtag = "699";
1587         $fields_filter = '6..';
1588     }
1589
1590     my @marcsubjects;
1591
1592     my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1593     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1594
1595     foreach my $field ( $record->field($fields_filter) ) {
1596         next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
1597         my @subfields_loop;
1598         my @subfields = $field->subfields();
1599         my @link_loop;
1600
1601         # if there is an authority link, build the links with an= subfield9
1602         my $subfield9 = $field->subfield('9');
1603         my $authoritylink;
1604         if ($subfield9) {
1605             my $linkvalue = $subfield9;
1606             $linkvalue =~ s/(\(|\))//g;
1607             @link_loop = ( { limit => 'an', 'link' => $linkvalue } );
1608             $authoritylink = $linkvalue
1609         }
1610
1611         # other subfields
1612         for my $subject_subfield (@subfields) {
1613             next if ( $subject_subfield->[0] eq '9' );
1614
1615             # don't load unimarc subfields 3,4,5
1616             next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1617             # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1618             next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1619
1620             my $code      = $subject_subfield->[0];
1621             my $value     = $subject_subfield->[1];
1622             my $linkvalue = $value;
1623             $linkvalue =~ s/(\(|\))//g;
1624             # if no authority link, build a search query
1625             unless ($subfield9) {
1626                 push @link_loop, {
1627                     limit    => $subject_limit,
1628                     'link'   => $linkvalue,
1629                     operator => (scalar @link_loop) ? ' AND ' : undef
1630                 };
1631             }
1632             my @this_link_loop = @link_loop;
1633             # do not display $0
1634             unless ( $code eq '0' ) {
1635                 push @subfields_loop, {
1636                     code      => $code,
1637                     value     => $value,
1638                     link_loop => \@this_link_loop,
1639                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1640                 };
1641             }
1642         }
1643
1644         push @marcsubjects, {
1645             MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop,
1646             authoritylink => $authoritylink,
1647         } if $authoritylink || @subfields_loop;
1648
1649     }
1650     return \@marcsubjects;
1651 }    #end getMARCsubjects
1652
1653 =head2 GetMarcUrls
1654
1655   $marcurls = GetMarcUrls($record,$marcflavour);
1656
1657 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1658 Assumes web resources (not uncommon in MARC21 to omit resource type ind) 
1659
1660 =cut
1661
1662 sub GetMarcUrls {
1663     my ( $record, $marcflavour ) = @_;
1664     if (!$record) {
1665         carp 'GetMarcUrls called on undefined record';
1666         return;
1667     }
1668
1669     my @marcurls;
1670     for my $field ( $record->field('856') ) {
1671         my @notes;
1672         for my $note ( $field->subfield('z') ) {
1673             push @notes, { note => $note };
1674         }
1675         my @urls = $field->subfield('u');
1676         foreach my $url (@urls) {
1677             $url =~ s/^\s+|\s+$//g; # trim
1678             my $marcurl;
1679             if ( $marcflavour eq 'MARC21' ) {
1680                 my $s3   = $field->subfield('3');
1681                 my $link = $field->subfield('y');
1682                 unless ( $url =~ /^\w+:/ ) {
1683                     if ( $field->indicator(1) eq '7' ) {
1684                         $url = $field->subfield('2') . "://" . $url;
1685                     } elsif ( $field->indicator(1) eq '1' ) {
1686                         $url = 'ftp://' . $url;
1687                     } else {
1688
1689                         #  properly, this should be if ind1=4,
1690                         #  however we will assume http protocol since we're building a link.
1691                         $url = 'http://' . $url;
1692                     }
1693                 }
1694
1695                 # TODO handle ind 2 (relationship)
1696                 $marcurl = {
1697                     MARCURL => $url,
1698                     notes   => \@notes,
1699                 };
1700                 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
1701                 $marcurl->{'part'} = $s3 if ($link);
1702                 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1703             } else {
1704                 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
1705                 $marcurl->{'MARCURL'} = $url;
1706             }
1707             push @marcurls, $marcurl;
1708         }
1709     }
1710     return \@marcurls;
1711 }
1712
1713 =head2 GetMarcSeries
1714
1715   $marcseriesarray = GetMarcSeries($record,$marcflavour);
1716
1717 Get all series from the MARC record and returns them in an array.
1718 The series are stored in different fields depending on MARC flavour
1719
1720 =cut
1721
1722 sub GetMarcSeries {
1723     my ( $record, $marcflavour ) = @_;
1724     if (!$record) {
1725         carp 'GetMarcSeries called on undefined record';
1726         return;
1727     }
1728
1729     my ( $mintag, $maxtag, $fields_filter );
1730     if ( $marcflavour eq "UNIMARC" ) {
1731         $mintag = "225";
1732         $maxtag = "225";
1733         $fields_filter = '2..';
1734     } else {    # marc21
1735         $mintag = "440";
1736         $maxtag = "490";
1737         $fields_filter = '4..';
1738     }
1739
1740     my @marcseries;
1741     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1742
1743     foreach my $field ( $record->field($fields_filter) ) {
1744         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1745         my @subfields_loop;
1746         my @subfields = $field->subfields();
1747         my @link_loop;
1748
1749         for my $series_subfield (@subfields) {
1750
1751             # ignore $9, used for authority link
1752             next if ( $series_subfield->[0] eq '9' );
1753
1754             my $volume_number;
1755             my $code      = $series_subfield->[0];
1756             my $value     = $series_subfield->[1];
1757             my $linkvalue = $value;
1758             $linkvalue =~ s/(\(|\))//g;
1759
1760             # see if this is an instance of a volume
1761             if ( $code eq 'v' ) {
1762                 $volume_number = 1;
1763             }
1764
1765             push @link_loop, {
1766                 'link' => $linkvalue,
1767                 operator => (scalar @link_loop) ? ' AND ' : undef
1768             };
1769
1770             if ($volume_number) {
1771                 push @subfields_loop, { volumenum => $value };
1772             } else {
1773                 push @subfields_loop, {
1774                     code      => $code,
1775                     value     => $value,
1776                     link_loop => \@link_loop,
1777                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : '',
1778                     volumenum => $volume_number,
1779                 }
1780             }
1781         }
1782         push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1783
1784     }
1785     return \@marcseries;
1786 }    #end getMARCseriess
1787
1788 =head2 UpsertMarcSubfield
1789
1790     my $record = C4::Biblio::UpsertMarcSubfield($MARC::Record, $fieldTag, $subfieldCode, $subfieldContent);
1791
1792 =cut
1793
1794 sub UpsertMarcSubfield {
1795     my ($record, $tag, $code, $content) = @_;
1796     my $f = $record->field($tag);
1797
1798     if ($f) {
1799         $f->update( $code => $content );
1800     }
1801     else {
1802         my $f = MARC::Field->new( $tag, '', '', $code => $content);
1803         $record->insert_fields_ordered( $f );
1804     }
1805 }
1806
1807 =head2 UpsertMarcControlField
1808
1809     my $record = C4::Biblio::UpsertMarcControlField($MARC::Record, $fieldTag, $content);
1810
1811 =cut
1812
1813 sub UpsertMarcControlField {
1814     my ($record, $tag, $content) = @_;
1815     die "UpsertMarcControlField() \$tag '$tag' is not a control field\n" unless 0+$tag < 10;
1816     my $f = $record->field($tag);
1817
1818     if ($f) {
1819         $f->update( $content );
1820     }
1821     else {
1822         my $f = MARC::Field->new($tag, $content);
1823         $record->insert_fields_ordered( $f );
1824     }
1825 }
1826
1827 =head2 GetFrameworkCode
1828
1829   $frameworkcode = GetFrameworkCode( $biblionumber )
1830
1831 =cut
1832
1833 sub GetFrameworkCode {
1834     my ($biblionumber) = @_;
1835     my $dbh            = C4::Context->dbh;
1836     my $sth            = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
1837     $sth->execute($biblionumber);
1838     my ($frameworkcode) = $sth->fetchrow;
1839     return $frameworkcode;
1840 }
1841
1842 =head2 TransformKohaToMarc
1843
1844     $record = TransformKohaToMarc( $hash [, $params ]  )
1845
1846 This function builds a (partial) MARC::Record from a hash.
1847 Hash entries can be from biblio, biblioitems or items.
1848 The params hash includes the parameter no_split used in C4::Items.
1849
1850 This function is called in acquisition module, to create a basic catalogue
1851 entry from user entry.
1852
1853 =cut
1854
1855
1856 sub TransformKohaToMarc {
1857     my ( $hash, $params ) = @_;
1858     my $record = MARC::Record->new();
1859     SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
1860
1861     # In the next call we use the Default framework, since it is considered
1862     # authoritative for Koha to Marc mappings.
1863     my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # do not change framework
1864     my $tag_hr = {};
1865     while ( my ($kohafield, $value) = each %$hash ) {
1866         foreach my $fld ( @{ $mss->{$kohafield} } ) {
1867             my $tagfield    = $fld->{tagfield};
1868             my $tagsubfield = $fld->{tagsubfield};
1869             next if !$tagfield;
1870
1871             # BZ 21800: split value if field is repeatable.
1872             my @values = _check_split($params, $fld, $value)
1873                 ? split(/\s?\|\s?/, $value, -1)
1874                 : ( $value );
1875             foreach my $value ( @values ) {
1876                 next if $value eq '';
1877                 $tag_hr->{$tagfield} //= [];
1878                 push @{$tag_hr->{$tagfield}}, [($tagsubfield, $value)];
1879             }
1880         }
1881     }
1882     foreach my $tag (sort keys %$tag_hr) {
1883         my @sfl = @{$tag_hr->{$tag}};
1884         @sfl = sort { $a->[0] cmp $b->[0]; } @sfl;
1885         @sfl = map { @{$_}; } @sfl;
1886         # Special care for control fields: remove the subfield indication @
1887         # and do not insert indicators.
1888         my @ind = $tag < 10 ? () : ( " ", " " );
1889         @sfl = grep { $_ ne '@' } @sfl if $tag < 10;
1890         $record->insert_fields_ordered( MARC::Field->new($tag, @ind, @sfl) );
1891     }
1892     return $record;
1893 }
1894
1895 sub _check_split {
1896 # Checks if $value must be split; may consult passed framework
1897     my ($params, $fld, $value) = @_;
1898     return if index($value,'|') == -1; # nothing to worry about
1899     return if $params->{no_split};
1900
1901     # if we did not get a specific framework, check default in $mss
1902     return $fld->{repeatable} if !$params->{framework};
1903
1904     # here we need to check the specific framework
1905     my $mss = GetMarcSubfieldStructure($params->{framework}, { unsafe => 1 });
1906     foreach my $fld2 ( @{ $mss->{ $fld->{kohafield} } } ) {
1907         next if $fld2->{tagfield} ne $fld->{tagfield};
1908         next if $fld2->{tagsubfield} ne $fld->{tagsubfield};
1909         return 1 if $fld2->{repeatable};
1910     }
1911     return;
1912 }
1913
1914 =head2 PrepHostMarcField
1915
1916     $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
1917
1918 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
1919
1920 =cut
1921
1922 sub PrepHostMarcField {
1923     my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
1924     $marcflavour ||="MARC21";
1925
1926     my $biblio = Koha::Biblios->find($hostbiblionumber);
1927     my $hostrecord = $biblio->metadata->record;
1928     my $item = Koha::Items->find($hostitemnumber);
1929
1930         my $hostmarcfield;
1931     if ( $marcflavour eq "MARC21" ) {
1932         
1933         #main entry
1934         my $mainentry;
1935         if ($hostrecord->subfield('100','a')){
1936             $mainentry = $hostrecord->subfield('100','a');
1937         } elsif ($hostrecord->subfield('110','a')){
1938             $mainentry = $hostrecord->subfield('110','a');
1939         } else {
1940             $mainentry = $hostrecord->subfield('111','a');
1941         }
1942         
1943         # qualification info
1944         my $qualinfo;
1945         if (my $field260 = $hostrecord->field('260')){
1946             $qualinfo =  $field260->as_string( 'abc' );
1947         }
1948         
1949
1950         #other fields
1951         my $ed = $hostrecord->subfield('250','a');
1952         my $barcode = $item->barcode;
1953         my $title = $hostrecord->subfield('245','a');
1954
1955         # record control number, 001 with 003 and prefix
1956         my $recctrlno;
1957         if ($hostrecord->field('001')){
1958             $recctrlno = $hostrecord->field('001')->data();
1959             if ($hostrecord->field('003')){
1960                 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
1961             }
1962         }
1963
1964         # issn/isbn
1965         my $issn = $hostrecord->subfield('022','a');
1966         my $isbn = $hostrecord->subfield('020','a');
1967
1968
1969         $hostmarcfield = MARC::Field->new(
1970                 773, '0', '',
1971                 '0' => $hostbiblionumber,
1972                 '9' => $hostitemnumber,
1973                 'a' => $mainentry,
1974                 'b' => $ed,
1975                 'd' => $qualinfo,
1976                 'o' => $barcode,
1977                 't' => $title,
1978                 'w' => $recctrlno,
1979                 'x' => $issn,
1980                 'z' => $isbn
1981                 );
1982     } elsif ($marcflavour eq "UNIMARC") {
1983         $hostmarcfield = MARC::Field->new(
1984             461, '', '',
1985             '0' => $hostbiblionumber,
1986             't' => $hostrecord->subfield('200','a'), 
1987             '9' => $hostitemnumber
1988         );      
1989     };
1990
1991     return $hostmarcfield;
1992 }
1993
1994 =head2 TransformHtmlToXml
1995
1996   $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator, 
1997                              $ind_tag, $auth_type )
1998
1999 $auth_type contains :
2000
2001 =over
2002
2003 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
2004
2005 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2006
2007 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2008
2009 =back
2010
2011 =cut
2012
2013 sub TransformHtmlToXml {
2014     my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2015     # NOTE: The parameter $ind_tag is NOT USED -- BZ 11247
2016
2017     my ( $perm_loc_tag, $perm_loc_subfield ) = C4::Biblio::GetMarcFromKohaField( "items.permanent_location" );
2018
2019     my $xml = MARC::File::XML::header('UTF-8');
2020     $xml .= "<record>\n";
2021     $auth_type = C4::Context->preference('marcflavour') unless $auth_type; # FIXME auth_type must be removed
2022     MARC::File::XML->default_record_format($auth_type);
2023
2024     # in UNIMARC, field 100 contains the encoding
2025     # check that there is one, otherwise the
2026     # MARC::Record->new_from_xml will fail (and Koha will die)
2027     my $unimarc_and_100_exist = 0;
2028     $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM';    # if we rebuild an item, no need of a 100 field
2029     my $prevtag = -1;
2030     my $first   = 1;
2031     my $j       = -1;
2032     my $close_last_tag;
2033     for ( my $i = 0 ; $i < @$tags ; $i++ ) {
2034         if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
2035
2036             # if we have a 100 field and it's values are not correct, skip them.
2037             # if we don't have any valid 100 field, we will create a default one at the end
2038             my $enc = substr( @$values[$i], 26, 2 );
2039             if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2040                 $unimarc_and_100_exist = 1;
2041             } else {
2042                 next;
2043             }
2044         }
2045         @$values[$i] =~ s/&/&amp;/g;
2046         @$values[$i] =~ s/</&lt;/g;
2047         @$values[$i] =~ s/>/&gt;/g;
2048         @$values[$i] =~ s/"/&quot;/g;
2049         @$values[$i] =~ s/'/&apos;/g;
2050
2051         my $skip = @$values[$i] eq q{};
2052         $skip = 0
2053           if $perm_loc_tag
2054           && $perm_loc_subfield
2055           && @$tags[$i] eq $perm_loc_tag
2056           && @$subfields[$i] eq $perm_loc_subfield;
2057
2058         if ( ( @$tags[$i] ne $prevtag ) ) {
2059             $close_last_tag = 0;
2060             $j++ unless ( @$tags[$i] eq "" );
2061             my $str = ( $indicator->[$j] // q{} ) . '  '; # extra space prevents substr outside of string warn
2062             my $ind1 = _default_ind_to_space( substr( $str, 0, 1 ) );
2063             my $ind2 = _default_ind_to_space( substr( $str, 1, 1 ) );
2064             if ( !$first ) {
2065                 $xml .= "</datafield>\n";
2066                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
2067                     && ( !$skip ) ) {
2068                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2069                     $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2070                     $first = 0;
2071                     $close_last_tag = 1;
2072                 } else {
2073                     $first = 1;
2074                 }
2075             } else {
2076                 if ( !$skip ) {
2077
2078                     # leader
2079                     if ( @$tags[$i] eq "000" ) {
2080                         $xml .= "<leader>@$values[$i]</leader>\n";
2081                         $first = 1;
2082
2083                         # rest of the fixed fields
2084                     } elsif ( @$tags[$i] < 10 ) {
2085                         $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2086                         $first = 1;
2087                     } else {
2088                         $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2089                         $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2090                         $first = 0;
2091                         $close_last_tag = 1;
2092                     }
2093                 }
2094             }
2095         } else {    # @$tags[$i] eq $prevtag
2096             if ( !$skip ) {
2097                 if ($first) {
2098                     my $str = ( $indicator->[$j] // q{} ) . '  '; # extra space prevents substr outside of string warn
2099                     my $ind1 = _default_ind_to_space( substr( $str, 0, 1 ) );
2100                     my $ind2 = _default_ind_to_space( substr( $str, 1, 1 ) );
2101                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2102                     $first = 0;
2103                     $close_last_tag = 1;
2104                 }
2105                 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2106             }
2107         }
2108         $prevtag = @$tags[$i];
2109     }
2110     $xml .= "</datafield>\n" if $close_last_tag;
2111     if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2112
2113         #     warn "SETTING 100 for $auth_type";
2114         my $string = strftime( "%Y%m%d", localtime(time) );
2115
2116         # set 50 to position 26 is biblios, 13 if authorities
2117         my $pos = 26;
2118         $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2119         $string = sprintf( "%-*s", 35, $string );
2120         substr( $string, $pos, 6, "50" );
2121         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2122         $xml .= "<subfield code=\"a\">$string</subfield>\n";
2123         $xml .= "</datafield>\n";
2124     }
2125     $xml .= "</record>\n";
2126     $xml .= MARC::File::XML::footer();
2127     return $xml;
2128 }
2129
2130 =head2 _default_ind_to_space
2131
2132 Passed what should be an indicator returns a space
2133 if its undefined or zero length
2134
2135 =cut
2136
2137 sub _default_ind_to_space {
2138     my $s = shift;
2139     if ( !defined $s || $s eq q{} ) {
2140         return ' ';
2141     }
2142     return $s;
2143 }
2144
2145 =head2 TransformHtmlToMarc
2146
2147     L<$record> = TransformHtmlToMarc(L<$cgi>)
2148     L<$cgi> is the CGI object which contains the values for subfields
2149     {
2150         'tag_010_indicator1_531951' ,
2151         'tag_010_indicator2_531951' ,
2152         'tag_010_code_a_531951_145735' ,
2153         'tag_010_subfield_a_531951_145735' ,
2154         'tag_200_indicator1_873510' ,
2155         'tag_200_indicator2_873510' ,
2156         'tag_200_code_a_873510_673465' ,
2157         'tag_200_subfield_a_873510_673465' ,
2158         'tag_200_code_b_873510_704318' ,
2159         'tag_200_subfield_b_873510_704318' ,
2160         'tag_200_code_e_873510_280822' ,
2161         'tag_200_subfield_e_873510_280822' ,
2162         'tag_200_code_f_873510_110730' ,
2163         'tag_200_subfield_f_873510_110730' ,
2164     }
2165     L<$record> is the MARC::Record object.
2166
2167 =cut
2168
2169 sub TransformHtmlToMarc {
2170     my ($cgi, $isbiblio) = @_;
2171
2172     my @params = $cgi->multi_param();
2173
2174     # explicitly turn on the UTF-8 flag for all
2175     # 'tag_' parameters to avoid incorrect character
2176     # conversion later on
2177     my $cgi_params = $cgi->Vars;
2178     foreach my $param_name ( keys %$cgi_params ) {
2179         if ( $param_name =~ /^tag_/ ) {
2180             my $param_value = $cgi_params->{$param_name};
2181             unless ( Encode::is_utf8( $param_value ) ) {
2182                 $cgi_params->{$param_name} = Encode::decode('UTF-8', $param_value );
2183             }
2184         }
2185     }
2186
2187     # creating a new record
2188     my $record = MARC::Record->new();
2189     my @fields;
2190     my ($biblionumbertagfield, $biblionumbertagsubfield) = (-1, -1);
2191     ($biblionumbertagfield, $biblionumbertagsubfield) =
2192         &GetMarcFromKohaField( "biblio.biblionumber", '' ) if $isbiblio;
2193 #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!
2194     for (my $i = 0; $params[$i]; $i++ ) {    # browse all CGI params
2195         my $param    = $params[$i];
2196         my $newfield = 0;
2197
2198         # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2199         if ( $param eq 'biblionumber' ) {
2200             if ( $biblionumbertagfield < 10 ) {
2201                 $newfield = MARC::Field->new( $biblionumbertagfield, scalar $cgi->param($param), );
2202             } else {
2203                 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => scalar $cgi->param($param), );
2204             }
2205             push @fields, $newfield if ($newfield);
2206         } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) {    # new field start when having 'input name="..._indicator1_..."
2207             my $tag = $1;
2208
2209             my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2210             my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2211             $newfield = 0;
2212             my $j = $i + 2;
2213
2214             if ( $tag < 10 ) {                              # no code for theses fields
2215                                                             # in MARC editor, 000 contains the leader.
2216                 next if $tag == $biblionumbertagfield;
2217                 my $fval= $cgi->param($params[$j+1]);
2218                 if ( $tag eq '000' ) {
2219                     # Force a fake leader even if not provided to avoid crashing
2220                     # during decoding MARC record containing UTF-8 characters
2221                     $record->leader(
2222                         length( $fval ) == 24
2223                         ? $fval
2224                         : '     nam a22        4500'
2225                         )
2226                     ;
2227                     # between 001 and 009 (included)
2228                 } elsif ( $fval ne '' ) {
2229                     $newfield = MARC::Field->new( $tag, $fval, );
2230                 }
2231
2232                 # > 009, deal with subfields
2233             } else {
2234                 # browse subfields for this tag (reason for _code_ match)
2235                 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2236                     last unless defined $params[$j+1];
2237                     $j += 2 and next
2238                         if $tag == $biblionumbertagfield and
2239                            $cgi->param($params[$j]) eq $biblionumbertagsubfield;
2240                     #if next param ne subfield, then it was probably empty
2241                     #try next param by incrementing j
2242                     if($params[$j+1]!~/_subfield_/) {$j++; next; }
2243                     my $fkey= $cgi->param($params[$j]);
2244                     my $fval= $cgi->param($params[$j+1]);
2245                     #check if subfield value not empty and field exists
2246                     if($fval ne '' && $newfield) {
2247                         $newfield->add_subfields( $fkey => $fval);
2248                     }
2249                     elsif($fval ne '') {
2250                         $newfield = MARC::Field->new( $tag, $ind1, $ind2, $fkey => $fval );
2251                     }
2252                     $j += 2;
2253                 } #end-of-while
2254                 $i= $j-1; #update i for outer loop accordingly
2255             }
2256             push @fields, $newfield if ($newfield);
2257         }
2258     }
2259
2260     @fields = sort { $a->tag() cmp $b->tag() } @fields;
2261     $record->append_fields(@fields);
2262     return $record;
2263 }
2264
2265 =head2 TransformMarcToKoha
2266
2267     $result = TransformMarcToKoha({ record => $record, limit_table => $limit })
2268
2269 Extract data from a MARC bib record into a hashref representing
2270 Koha biblio, biblioitems, and items fields.
2271
2272 If passed an undefined record will log the error and return an empty
2273 hash_ref.
2274
2275 =cut
2276
2277 sub TransformMarcToKoha {
2278     my ( $params ) = @_;
2279
2280     my $record = $params->{record};
2281     my $limit_table = $params->{limit_table} // q{};
2282     my $kohafields = $params->{kohafields};
2283
2284     my $result = {};
2285     if (!defined $record) {
2286         carp('TransformMarcToKoha called with undefined record');
2287         return $result;
2288     }
2289
2290     my %tables = ( biblio => 1, biblioitems => 1, items => 1 );
2291     if( $limit_table eq 'items' ) {
2292         %tables = ( items => 1 );
2293     } elsif ( $limit_table eq 'no_items' ){
2294         %tables = ( biblio => 1, biblioitems => 1 );
2295     }
2296
2297     # The next call acknowledges Default as the authoritative framework
2298     # for Koha to MARC mappings.
2299     my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
2300     @{$kohafields} = keys %{ $mss } unless $kohafields;
2301     foreach my $kohafield ( @{$kohafields} ) {
2302         my ( $table, $column ) = split /[.]/, $kohafield, 2;
2303         next unless $tables{$table};
2304         my ( $value, @values );
2305         foreach my $fldhash ( @{$mss->{$kohafield}} ) {
2306             my $tag = $fldhash->{tagfield};
2307             my $sub = $fldhash->{tagsubfield};
2308             foreach my $fld ( $record->field($tag) ) {
2309                 if( $sub eq '@' || $fld->is_control_field ) {
2310                     push @values, $fld->data if $fld->data;
2311                 } else {
2312                     push @values, grep { $_ } $fld->subfield($sub);
2313                 }
2314             }
2315         }
2316         if ( @values ){
2317             $value = join ' | ', uniq(@values);
2318
2319             # Additional polishing for individual kohafields
2320             if( $kohafield =~ /copyrightdate|publicationyear/ ) {
2321                 $value = _adjust_pubyear( $value );
2322             }
2323         }
2324
2325         next if !defined $value;
2326         my $key = _disambiguate( $table, $column );
2327         $result->{$key} = $value;
2328     }
2329     return $result;
2330 }
2331
2332 =head2 _disambiguate
2333
2334   $newkey = _disambiguate($table, $field);
2335
2336 This is a temporary hack to distinguish between the
2337 following sets of columns when using TransformMarcToKoha.
2338
2339   items.cn_source & biblioitems.cn_source
2340   items.cn_sort & biblioitems.cn_sort
2341
2342 Columns that are currently NOT distinguished (FIXME
2343 due to lack of time to fully test) are:
2344
2345   biblio.notes and biblioitems.notes
2346   biblionumber
2347   timestamp
2348   biblioitemnumber
2349
2350 FIXME - this is necessary because prefixing each column
2351 name with the table name would require changing lots
2352 of code and templates, and exposing more of the DB
2353 structure than is good to the UI templates, particularly
2354 since biblio and bibloitems may well merge in a future
2355 version.  In the future, it would also be good to 
2356 separate DB access and UI presentation field names
2357 more.
2358
2359 =cut
2360
2361 sub _disambiguate {
2362     my ( $table, $column ) = @_;
2363     if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2364         return $table . '.' . $column;
2365     } else {
2366         return $column;
2367     }
2368
2369 }
2370
2371 =head2 _adjust_pubyear
2372
2373     Helper routine for TransformMarcToKoha
2374
2375 =cut
2376
2377 sub _adjust_pubyear {
2378     my $retval = shift;
2379     # modify return value to keep only the 1st year found
2380     if( $retval =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2381         $retval = $1;
2382     } elsif( $retval =~ m/(\d\d\d\d)/ && $1 > 0 ) {
2383         $retval = $1;
2384     } elsif( $retval =~ m/(?<year>\d{1,3})[.Xx?-]/ ) {
2385         # See also bug 24674: enough to look at one unknown year char like .Xx-?
2386         # At this point in code 1234? or 1234- already passed the earlier regex
2387         # Things like 2-, 1xx, 1??? are now converted to a four positions-year.
2388         $retval = $+{year} * ( 10 ** (4-length($+{year})) );
2389     } else {
2390         $retval = undef;
2391     }
2392     return $retval;
2393 }
2394
2395 =head2 CountItemsIssued
2396
2397     my $count = CountItemsIssued( $biblionumber );
2398
2399 =cut
2400
2401 sub CountItemsIssued {
2402     my ($biblionumber) = @_;
2403     my $dbh            = C4::Context->dbh;
2404     my $sth            = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2405     $sth->execute($biblionumber);
2406     my $row = $sth->fetchrow_hashref();
2407     return $row->{'issuedCount'};
2408 }
2409
2410 =head2 ModZebra
2411
2412     ModZebra( $record_number, $op, $server );
2413
2414 $record_number is the authid or biblionumber we want to index
2415
2416 $op is the operation: specialUpdate or recordDelete
2417
2418 $server is authorityserver or biblioserver
2419
2420 =cut
2421
2422 sub ModZebra {
2423     my ( $record_number, $op, $server ) = @_;
2424     Koha::Logger->get->debug("ModZebra: updates requested for: $record_number $op $server");
2425     my $dbh = C4::Context->dbh;
2426
2427     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2428     # at the same time
2429     # replaced by a zebraqueue table, that is filled with ModZebra to run.
2430     # the table is emptied by rebuild_zebra.pl script (using the -z switch)
2431     my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2432     WHERE server = ?
2433         AND   biblio_auth_number = ?
2434         AND   operation = ?
2435         AND   done = 0";
2436     my $check_sth = $dbh->prepare_cached($check_sql);
2437     $check_sth->execute( $server, $record_number, $op );
2438     my ($count) = $check_sth->fetchrow_array;
2439     $check_sth->finish();
2440     if ( $count == 0 ) {
2441         my $sth = $dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
2442         $sth->execute( $record_number, $server, $op );
2443         $sth->finish;
2444     }
2445 }
2446
2447 =head1 INTERNAL FUNCTIONS
2448
2449 =head2 _koha_marc_update_bib_ids
2450
2451
2452   _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2453
2454 Internal function to add or update biblionumber and biblioitemnumber to
2455 the MARC XML.
2456
2457 =cut
2458
2459 sub _koha_marc_update_bib_ids {
2460     my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
2461
2462     my ( $biblio_tag,     $biblio_subfield )     = GetMarcFromKohaField( "biblio.biblionumber" );
2463     die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
2464     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber" );
2465     die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
2466
2467     if ( $biblio_tag < 10 ) {
2468         C4::Biblio::UpsertMarcControlField( $record, $biblio_tag, $biblionumber );
2469     } else {
2470         C4::Biblio::UpsertMarcSubfield($record, $biblio_tag, $biblio_subfield, $biblionumber);
2471     }
2472     if ( $biblioitem_tag < 10 ) {
2473         C4::Biblio::UpsertMarcControlField( $record, $biblioitem_tag, $biblioitemnumber );
2474     } else {
2475         C4::Biblio::UpsertMarcSubfield($record, $biblioitem_tag, $biblioitem_subfield, $biblioitemnumber);
2476     }
2477
2478     # update the control number (001) in MARC
2479     if(C4::Context->preference('autoControlNumber') eq 'biblionumber'){
2480         unless($record->field('001')){
2481             $record->insert_fields_ordered(MARC::Field->new('001', $biblionumber));
2482         }
2483     }
2484 }
2485
2486 =head2 _koha_marc_update_biblioitem_cn_sort
2487
2488   _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
2489
2490 Given a MARC bib record and the biblioitem hash, update the
2491 subfield that contains a copy of the value of biblioitems.cn_sort.
2492
2493 =cut
2494
2495 sub _koha_marc_update_biblioitem_cn_sort {
2496     my $marc          = shift;
2497     my $biblioitem    = shift;
2498     my $frameworkcode = shift;
2499
2500     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort" );
2501     return unless $biblioitem_tag;
2502
2503     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2504
2505     if ( my $field = $marc->field($biblioitem_tag) ) {
2506         $field->delete_subfield( code => $biblioitem_subfield );
2507         if ( $cn_sort ne '' ) {
2508             $field->add_subfields( $biblioitem_subfield => $cn_sort );
2509         }
2510     } else {
2511
2512         # if we get here, no biblioitem tag is present in the MARC record, so
2513         # we'll create it if $cn_sort is not empty -- this would be
2514         # an odd combination of events, however
2515         if ($cn_sort) {
2516             $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
2517         }
2518     }
2519 }
2520
2521 =head2 _koha_modify_biblio
2522
2523   my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
2524
2525 Internal function for updating the biblio table
2526
2527 =cut
2528
2529 sub _koha_modify_biblio {
2530     my ( $dbh, $biblio, $frameworkcode ) = @_;
2531     my $error;
2532
2533     my $query = "
2534         UPDATE biblio
2535         SET    frameworkcode = ?,
2536                author = ?,
2537                title = ?,
2538                subtitle = ?,
2539                medium = ?,
2540                part_number = ?,
2541                part_name = ?,
2542                unititle = ?,
2543                notes = ?,
2544                serial = ?,
2545                seriestitle = ?,
2546                copyrightdate = ?,
2547                abstract = ?
2548         WHERE  biblionumber = ?
2549         "
2550       ;
2551     my $sth = $dbh->prepare($query);
2552
2553     $sth->execute(
2554         $frameworkcode,        $biblio->{'author'},      $biblio->{'title'},       $biblio->{'subtitle'},
2555         $biblio->{'medium'},   $biblio->{'part_number'}, $biblio->{'part_name'},   $biblio->{'unititle'},
2556         $biblio->{'notes'},    $biblio->{'serial'},      $biblio->{'seriestitle'}, $biblio->{'copyrightdate'} ? int($biblio->{'copyrightdate'}) : undef,
2557         $biblio->{'abstract'}, $biblio->{'biblionumber'}
2558     ) if $biblio->{'biblionumber'};
2559
2560     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
2561         $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
2562         warn $error;
2563     }
2564     return ( $biblio->{'biblionumber'}, $error );
2565 }
2566
2567 =head2 _koha_modify_biblioitem_nonmarc
2568
2569   my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
2570
2571 =cut
2572
2573 sub _koha_modify_biblioitem_nonmarc {
2574     my ( $dbh, $biblioitem ) = @_;
2575     my $error;
2576
2577     # re-calculate the cn_sort, it may have changed
2578     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2579
2580     my $query = "UPDATE biblioitems 
2581     SET biblionumber    = ?,
2582         volume          = ?,
2583         number          = ?,
2584         itemtype        = ?,
2585         isbn            = ?,
2586         issn            = ?,
2587         publicationyear = ?,
2588         publishercode   = ?,
2589         volumedate      = ?,
2590         volumedesc      = ?,
2591         collectiontitle = ?,
2592         collectionissn  = ?,
2593         collectionvolume= ?,
2594         editionstatement= ?,
2595         editionresponsibility = ?,
2596         illus           = ?,
2597         pages           = ?,
2598         notes           = ?,
2599         size            = ?,
2600         place           = ?,
2601         lccn            = ?,
2602         url             = ?,
2603         cn_source       = ?,
2604         cn_class        = ?,
2605         cn_item         = ?,
2606         cn_suffix       = ?,
2607         cn_sort         = ?,
2608         totalissues     = ?,
2609         ean             = ?,
2610         agerestriction  = ?
2611         where biblioitemnumber = ?
2612         ";
2613     my $sth = $dbh->prepare($query);
2614     $sth->execute(
2615         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
2616         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
2617         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
2618         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
2619         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
2620         $biblioitem->{'lccn'},             $biblioitem->{'url'},              $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
2621         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},        $cn_sort,                               $biblioitem->{'totalissues'},
2622         $biblioitem->{'ean'},              $biblioitem->{'agerestriction'},   $biblioitem->{'biblioitemnumber'}
2623     );
2624     if ( $dbh->errstr ) {
2625         $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
2626         warn $error;
2627     }
2628     return ( $biblioitem->{'biblioitemnumber'}, $error );
2629 }
2630
2631 =head2 _koha_delete_biblio
2632
2633   $error = _koha_delete_biblio($dbh,$biblionumber);
2634
2635 Internal sub for deleting from biblio table -- also saves to deletedbiblio
2636
2637 C<$dbh> - the database handle
2638
2639 C<$biblionumber> - the biblionumber of the biblio to be deleted
2640
2641 =cut
2642
2643 # FIXME: add error handling
2644
2645 sub _koha_delete_biblio {
2646     my ( $dbh, $biblionumber ) = @_;
2647
2648     # get all the data for this biblio
2649     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
2650     $sth->execute($biblionumber);
2651
2652     # FIXME There is a transaction in _koha_delete_biblio_metadata
2653     # But actually all the following should be done inside a single transaction
2654     if ( my $data = $sth->fetchrow_hashref ) {
2655
2656         # save the record in deletedbiblio
2657         # find the fields to save
2658         my $query = "INSERT INTO deletedbiblio SET ";
2659         my @bind  = ();
2660         foreach my $temp ( keys %$data ) {
2661             $query .= "$temp = ?,";
2662             push( @bind, $data->{$temp} );
2663         }
2664
2665         # replace the last , by ",?)"
2666         $query =~ s/\,$//;
2667         my $bkup_sth = $dbh->prepare($query);
2668         $bkup_sth->execute(@bind);
2669         $bkup_sth->finish;
2670
2671         _koha_delete_biblio_metadata( $biblionumber );
2672
2673         # delete the biblio
2674         my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
2675         $sth2->execute($biblionumber);
2676         # update the timestamp (Bugzilla 7146)
2677         $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
2678         $sth2->execute($biblionumber);
2679         $sth2->finish;
2680     }
2681     $sth->finish;
2682     return;
2683 }
2684
2685 =head2 _koha_delete_biblioitems
2686
2687   $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
2688
2689 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
2690
2691 C<$dbh> - the database handle
2692 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
2693
2694 =cut
2695
2696 # FIXME: add error handling
2697
2698 sub _koha_delete_biblioitems {
2699     my ( $dbh, $biblioitemnumber ) = @_;
2700
2701     # get all the data for this biblioitem
2702     my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
2703     $sth->execute($biblioitemnumber);
2704
2705     if ( my $data = $sth->fetchrow_hashref ) {
2706
2707         # save the record in deletedbiblioitems
2708         # find the fields to save
2709         my $query = "INSERT INTO deletedbiblioitems SET ";
2710         my @bind  = ();
2711         foreach my $temp ( keys %$data ) {
2712             $query .= "$temp = ?,";
2713             push( @bind, $data->{$temp} );
2714         }
2715
2716         # replace the last , by ",?)"
2717         $query =~ s/\,$//;
2718         my $bkup_sth = $dbh->prepare($query);
2719         $bkup_sth->execute(@bind);
2720         $bkup_sth->finish;
2721
2722         # delete the biblioitem
2723         my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
2724         $sth2->execute($biblioitemnumber);
2725         # update the timestamp (Bugzilla 7146)
2726         $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
2727         $sth2->execute($biblioitemnumber);
2728         $sth2->finish;
2729     }
2730     $sth->finish;
2731     return;
2732 }
2733
2734 =head2 _koha_delete_biblio_metadata
2735
2736   $error = _koha_delete_biblio_metadata($biblionumber);
2737
2738 C<$biblionumber> - the biblionumber of the biblio metadata to be deleted
2739
2740 =cut
2741
2742 sub _koha_delete_biblio_metadata {
2743     my ($biblionumber) = @_;
2744
2745     my $dbh    = C4::Context->dbh;
2746     my $schema = Koha::Database->new->schema;
2747     $schema->txn_do(
2748         sub {
2749             $dbh->do( q|
2750                 INSERT INTO deletedbiblio_metadata (biblionumber, format, `schema`, metadata)
2751                 SELECT biblionumber, format, `schema`, metadata FROM biblio_metadata WHERE biblionumber=?
2752             |,  undef, $biblionumber );
2753             $dbh->do( q|DELETE FROM biblio_metadata WHERE biblionumber=?|,
2754                 undef, $biblionumber );
2755         }
2756     );
2757 }
2758
2759 =head1 UNEXPORTED FUNCTIONS
2760
2761 =head2 ModBiblioMarc
2762
2763   ModBiblioMarc($newrec,$biblionumber);
2764
2765 Add MARC XML data for a biblio to koha
2766
2767 Function exported, but should NOT be used, unless you really know what you're doing
2768
2769 =cut
2770
2771 sub ModBiblioMarc {
2772     # pass the MARC::Record to this function, and it will create the records in
2773     # the marcxml field
2774     my ( $record, $biblionumber, $params ) = @_;
2775     if ( !$record ) {
2776         carp 'ModBiblioMarc passed an undefined record';
2777         return;
2778     }
2779
2780     my $skip_record_index = $params->{skip_record_index} || 0;
2781
2782     # Clone record as it gets modified
2783     $record = $record->clone();
2784     my $dbh    = C4::Context->dbh;
2785     my @fields = $record->fields();
2786     my $encoding = C4::Context->preference("marcflavour");
2787
2788     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
2789     if ( $encoding eq "UNIMARC" ) {
2790         my $defaultlanguage = C4::Context->preference("UNIMARCField100Language");
2791         $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
2792         my $string = $record->subfield( 100, "a" );
2793         if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
2794             my $f100 = $record->field(100);
2795             $record->delete_field($f100);
2796         } else {
2797             $string = POSIX::strftime( "%Y%m%d", localtime );
2798             $string =~ s/\-//g;
2799             $string = sprintf( "%-*s", 35, $string );
2800             substr ( $string, 22, 3, $defaultlanguage);
2801         }
2802         substr( $string, 25, 3, "y50" );
2803         unless ( $record->subfield( 100, "a" ) ) {
2804             $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
2805         }
2806     }
2807
2808     #enhancement 5374: update transaction date (005) for marc21/unimarc
2809     if($encoding =~ /MARC21|UNIMARC/) {
2810       my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
2811         # YY MM DD HH MM SS (update year and month)
2812       my $f005= $record->field('005');
2813       $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
2814     }
2815
2816     my $metadata = {
2817         biblionumber => $biblionumber,
2818         format       => 'marcxml',
2819         schema       => C4::Context->preference('marcflavour'),
2820     };
2821     $record->as_usmarc; # Bug 20126/10455 This triggers field length calculation
2822
2823     my $m_rs = Koha::Biblio::Metadatas->find($metadata) //
2824         Koha::Biblio::Metadata->new($metadata);
2825
2826     my $userenv = C4::Context->userenv;
2827     if ($userenv) {
2828         my $borrowernumber = $userenv->{number};
2829         my $borrowername = join ' ', map { $_ // q{} } @$userenv{qw(firstname surname)};
2830         unless ($m_rs->in_storage) {
2831             Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorId'), $borrowernumber);
2832             Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorName'), $borrowername);
2833         }
2834         Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierId'), $borrowernumber);
2835         Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierName'), $borrowername);
2836     }
2837
2838     $m_rs->metadata( $record->as_xml_record($encoding) );
2839     $m_rs->store;
2840
2841     unless ( $skip_record_index ) {
2842         my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
2843         $indexer->index_records( $biblionumber, "specialUpdate", "biblioserver" );
2844     }
2845
2846     return $biblionumber;
2847 }
2848
2849 =head2 prepare_host_field
2850
2851 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
2852 Generate the host item entry for an analytic child entry
2853
2854 =cut
2855
2856 sub prepare_host_field {
2857     my ( $hostbiblio, $marcflavour ) = @_;
2858     $marcflavour ||= C4::Context->preference('marcflavour');
2859
2860     my $biblio = Koha::Biblios->find($hostbiblio);
2861     my $host = $biblio->metadata->record;
2862     # unfortunately as_string does not 'do the right thing'
2863     # if field returns undef
2864     my %sfd;
2865     my $field;
2866     my $host_field;
2867     if ( $marcflavour eq 'MARC21' ) {
2868         if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
2869             my $s = $field->as_string('ab');
2870             if ($s) {
2871                 $sfd{a} = $s;
2872             }
2873         }
2874         if ( $field = $host->field('245') ) {
2875             my $s = $field->as_string('a');
2876             if ($s) {
2877                 $sfd{t} = $s;
2878             }
2879         }
2880         if ( $field = $host->field('260') ) {
2881             my $s = $field->as_string('abc');
2882             if ($s) {
2883                 $sfd{d} = $s;
2884             }
2885         }
2886         if ( $field = $host->field('240') ) {
2887             my $s = $field->as_string();
2888             if ($s) {
2889                 $sfd{b} = $s;
2890             }
2891         }
2892         if ( $field = $host->field('022') ) {
2893             my $s = $field->as_string('a');
2894             if ($s) {
2895                 $sfd{x} = $s;
2896             }
2897         }
2898         if ( $field = $host->field('020') ) {
2899             my $s = $field->as_string('a');
2900             if ($s) {
2901                 $sfd{z} = $s;
2902             }
2903         }
2904         if ( $field = $host->field('001') ) {
2905             $sfd{w} = $field->data(),;
2906         }
2907         $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
2908         return $host_field;
2909     }
2910     elsif ( $marcflavour eq 'UNIMARC' ) {
2911         #author
2912         if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
2913             my $s = $field->as_string('ab');
2914             if ($s) {
2915                 $sfd{a} = $s;
2916             }
2917         }
2918         #title
2919         if ( $field = $host->field('200') ) {
2920             my $s = $field->as_string('a');
2921             if ($s) {
2922                 $sfd{t} = $s;
2923             }
2924         }
2925         #place of publicaton
2926         if ( $field = $host->field('210') ) {
2927             my $s = $field->as_string('a');
2928             if ($s) {
2929                 $sfd{c} = $s;
2930             }
2931         }
2932         #date of publication
2933         if ( $field = $host->field('210') ) {
2934             my $s = $field->as_string('d');
2935             if ($s) {
2936                 $sfd{d} = $s;
2937             }
2938         }
2939         #edition statement
2940         if ( $field = $host->field('205') ) {
2941             my $s = $field->as_string();
2942             if ($s) {
2943                 $sfd{e} = $s;
2944             }
2945         }
2946         #URL
2947         if ( $field = $host->field('856') ) {
2948             my $s = $field->as_string('u');
2949             if ($s) {
2950                 $sfd{u} = $s;
2951             }
2952         }
2953         #ISSN
2954         if ( $field = $host->field('011') ) {
2955             my $s = $field->as_string('a');
2956             if ($s) {
2957                 $sfd{x} = $s;
2958             }
2959         }
2960         #ISBN
2961         if ( $field = $host->field('010') ) {
2962             my $s = $field->as_string('a');
2963             if ($s) {
2964                 $sfd{y} = $s;
2965             }
2966         }
2967         if ( $field = $host->field('001') ) {
2968             $sfd{0} = $field->data(),;
2969         }
2970         $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
2971         return $host_field;
2972     }
2973     return;
2974 }
2975
2976
2977 =head2 UpdateTotalIssues
2978
2979   UpdateTotalIssues($biblionumber, $increase, [$value])
2980
2981 Update the total issue count for a particular bib record.
2982
2983 =over 4
2984
2985 =item C<$biblionumber> is the biblionumber of the bib to update
2986
2987 =item C<$increase> is the amount to increase (or decrease) the total issues count by
2988
2989 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
2990
2991 =back
2992
2993 =cut
2994
2995 sub UpdateTotalIssues {
2996     my ($biblionumber, $increase, $value, $skip_holds_queue) = @_;
2997     my $totalissues;
2998
2999     my $biblio = Koha::Biblios->find($biblionumber);
3000     unless ($biblio) {
3001         carp "UpdateTotalIssues could not get biblio";
3002         return;
3003     }
3004
3005     my $record = $biblio->metadata->record;
3006     unless ($record) {
3007         carp "UpdateTotalIssues could not get biblio record";
3008         return;
3009     }
3010     my $biblioitem = $biblio->biblioitem;
3011     my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField( 'biblioitems.totalissues' );
3012     unless ($totalissuestag) {
3013         return 1; # There is nothing to do
3014     }
3015
3016     if (defined $value) {
3017         $totalissues = $value;
3018     } else {
3019         $totalissues = $biblioitem->totalissues + $increase;
3020     }
3021
3022      my $field = $record->field($totalissuestag);
3023      if (defined $field) {
3024          $field->update( $totalissuessubfield => $totalissues );
3025      } else {
3026          $field = MARC::Field->new($totalissuestag, '0', '0',
3027                  $totalissuessubfield => $totalissues);
3028          $record->insert_grouped_field($field);
3029      }
3030
3031      return ModBiblio($record, $biblionumber, $biblio->frameworkcode, { skip_holds_queue => $skip_holds_queue });
3032 }
3033
3034 =head2 RemoveAllNsb
3035
3036     &RemoveAllNsb($record);
3037
3038 Removes all nsb/nse chars from a record
3039
3040 =cut
3041
3042 sub RemoveAllNsb {
3043     my $record = shift;
3044     if (!$record) {
3045         carp 'RemoveAllNsb called with undefined record';
3046         return;
3047     }
3048
3049     SetUTF8Flag($record);
3050
3051     foreach my $field ($record->fields()) {
3052         if ($field->is_control_field()) {
3053             $field->update(nsb_clean($field->data()));
3054         } else {
3055             my @subfields = $field->subfields();
3056             my @new_subfields;
3057             foreach my $subfield (@subfields) {
3058                 push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
3059             }
3060             if (scalar(@new_subfields) > 0) {
3061                 my $new_field;
3062                 eval {
3063                     $new_field = MARC::Field->new(
3064                         $field->tag(),
3065                         $field->indicator(1),
3066                         $field->indicator(2),
3067                         @new_subfields
3068                     );
3069                 };
3070                 if ($@) {
3071                     warn "error in RemoveAllNsb : $@";
3072                 } else {
3073                     $field->replace_with($new_field);
3074                 }
3075             }
3076         }
3077     }
3078
3079     return $record;
3080 }
3081
3082 =head2 ApplyMarcOverlayRules
3083
3084     my $record = ApplyMarcOverlayRules($params)
3085
3086 Applies marc merge rules to a record.
3087
3088 C<$params> is expected to be a hashref with below keys defined.
3089
3090 =over 4
3091
3092 =item C<biblionumber>
3093 biblionumber of old record
3094
3095 =item C<record>
3096 Incoming record that will be merged with old record
3097
3098 =item C<overlay_context>
3099 hashref containing at least one context module and filter value on
3100 the form {module => filter, ...}.
3101
3102 =back
3103
3104 Returns:
3105
3106 =over 4
3107
3108 =item C<$record>
3109
3110 Merged MARC record based with merge rules for C<context> applied. If no old
3111 record for C<biblionumber> can be found, C<record> is returned unchanged.
3112 Default action when no matching context is found to return C<record> unchanged.
3113 If no rules are found for a certain field tag the default is to overwrite with
3114 fields with this field tag from C<record>.
3115
3116 =back
3117
3118 =cut
3119
3120 sub ApplyMarcOverlayRules {
3121     my ($params) = @_;
3122     my $biblionumber = $params->{biblionumber};
3123     my $incoming_record = $params->{record};
3124
3125     if (!$biblionumber) {
3126         carp 'ApplyMarcOverlayRules called on undefined biblionumber';
3127         return;
3128     }
3129     if (!$incoming_record) {
3130         carp 'ApplyMarcOverlayRules called on undefined record';
3131         return;
3132     }
3133     my $biblio = Koha::Biblios->find($biblionumber);
3134     my $old_record = $biblio->metadata->record;
3135
3136     # Skip overlay rules if called with no context
3137     if ($old_record && defined $params->{overlay_context}) {
3138         return Koha::MarcOverlayRules->merge_records($old_record, $incoming_record, $params->{overlay_context});
3139     }
3140     return $incoming_record;
3141 }
3142
3143 =head2 _after_biblio_action_hooks
3144
3145 Helper method that takes care of calling all plugin hooks
3146
3147 =cut
3148
3149 sub _after_biblio_action_hooks {
3150     my ( $args ) = @_;
3151
3152     my $biblio_id = $args->{biblio_id};
3153     my $action    = $args->{action};
3154
3155     my $biblio = Koha::Biblios->find( $biblio_id );
3156     Koha::Plugins->call(
3157         'after_biblio_action',
3158         {
3159             action    => $action,
3160             biblio    => $biblio,
3161             biblio_id => $biblio_id,
3162         }
3163     );
3164 }
3165
3166 1;
3167
3168 __END__
3169
3170 =head1 AUTHOR
3171
3172 Koha Development Team <http://koha-community.org/>
3173
3174 Paul POULAIN paul.poulain@free.fr
3175
3176 Joshua Ferraro jmf@liblime.com
3177
3178 =cut