Bug 15572: Follow-up to fix error on authority creation
[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 strict;
23 use warnings;
24 use Carp;
25
26 use Encode qw( decode is_utf8 );
27 use MARC::Record;
28 use MARC::File::USMARC;
29 use MARC::File::XML;
30 use POSIX qw(strftime);
31 use Module::Load::Conditional qw(can_load);
32
33 use C4::Koha;
34 use C4::Log;    # logaction
35 use C4::Budgets;
36 use C4::ClassSource;
37 use C4::Charset;
38 use C4::Linker;
39 use C4::OAI::Sets;
40
41 use Koha::Cache;
42 use Koha::Authority::Types;
43
44 use vars qw($VERSION @ISA @EXPORT);
45
46 BEGIN {
47     $VERSION = 3.07.00.049;
48
49     require Exporter;
50     @ISA = qw( Exporter );
51
52     # to add biblios
53     # EXPORTED FUNCTIONS.
54     push @EXPORT, qw(
55       &AddBiblio
56     );
57
58     # to get something
59     push @EXPORT, qw(
60       GetBiblio
61       GetBiblioData
62       GetMarcBiblio
63       GetBiblioItemData
64       GetBiblioItemInfosOf
65       GetBiblioItemByBiblioNumber
66       GetBiblioFromItemNumber
67       GetBiblionumberFromItemnumber
68
69       &GetRecordValue
70       &GetFieldMapping
71       &SetFieldMapping
72       &DeleteFieldMapping
73
74       &GetISBDView
75
76       &GetMarcControlnumber
77       &GetMarcNotes
78       &GetMarcISBN
79       &GetMarcISSN
80       &GetMarcSubjects
81       &GetMarcAuthors
82       &GetMarcSeries
83       &GetMarcHosts
84       GetMarcUrls
85       &GetUsedMarcStructure
86       &GetXmlBiblio
87       &GetCOinSBiblio
88       &GetMarcPrice
89       &MungeMarcPrice
90       &GetMarcQuantity
91
92       &GetAuthorisedValueDesc
93       &GetMarcStructure
94       &GetMarcFromKohaField
95       &GetMarcSubfieldStructureFromKohaField
96       &GetFrameworkCode
97       &TransformKohaToMarc
98       &PrepHostMarcField
99
100       &CountItemsIssued
101       &CountBiblioInOrders
102       &GetSubscriptionsId
103       &GetHolds
104     );
105
106     # To modify something
107     push @EXPORT, qw(
108       &ModBiblio
109       &ModBiblioframework
110       &ModZebra
111       &UpdateTotalIssues
112       &RemoveAllNsb
113     );
114
115     # To delete something
116     push @EXPORT, qw(
117       &DelBiblio
118     );
119
120     # To link headings in a bib record
121     # to authority records.
122     push @EXPORT, qw(
123       &BiblioAutoLink
124       &LinkBibHeadingsToAuthorities
125     );
126
127     # Internal functions
128     # those functions are exported but should not be used
129     # they are useful in a few circumstances, so they are exported,
130     # but don't use them unless you are a core developer ;-)
131     push @EXPORT, qw(
132       &ModBiblioMarc
133     );
134
135     # Others functions
136     push @EXPORT, qw(
137       &TransformMarcToKoha
138       &TransformHtmlToMarc
139       &TransformHtmlToXml
140       prepare_host_field
141     );
142 }
143
144 =head1 NAME
145
146 C4::Biblio - cataloging management functions
147
148 =head1 DESCRIPTION
149
150 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:
151
152 =over 4
153
154 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
155
156 =item 2. as raw MARC in the Zebra index and storage engine
157
158 =item 3. as raw MARC the biblioitems.marc and biblioitems.marcxml
159
160 =back
161
162 In the 3.0 version of Koha, the authoritative record-level information is in biblioitems.marcxml
163
164 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.
165
166 =over 4
167
168 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
169
170 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
171
172 =back
173
174 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:
175
176 =over 4
177
178 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
179
180 =item 2. _koha_* - low-level internal functions for managing the koha tables
181
182 =item 3. Marc management function : as the MARC record is stored in biblioitems.marc(xml), 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.
183
184 =item 4. Zebra functions used to update the Zebra index
185
186 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
187
188 =back
189
190 The MARC record (in biblioitems.marcxml) 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 :
191
192 =over 4
193
194 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
195
196 =item 2. add the biblionumber and biblioitemnumber into the MARC records
197
198 =item 3. save the marc record
199
200 =back
201
202 When dealing with items, we must :
203
204 =over 4
205
206 =item 1. save the item in items table, that gives us an itemnumber
207
208 =item 2. add the itemnumber to the item MARC field
209
210 =item 3. overwrite the MARC record (with the added item) into biblioitems.marc(xml)
211
212 When modifying a biblio or an item, the behaviour is quite similar.
213
214 =back
215
216 =head1 EXPORTED FUNCTIONS
217
218 =head2 AddBiblio
219
220   ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
221
222 Exported function (core API) for adding a new biblio to koha.
223
224 The first argument is a C<MARC::Record> object containing the
225 bib to add, while the second argument is the desired MARC
226 framework code.
227
228 This function also accepts a third, optional argument: a hashref
229 to additional options.  The only defined option is C<defer_marc_save>,
230 which if present and mapped to a true value, causes C<AddBiblio>
231 to omit the call to save the MARC in C<bibilioitems.marc>
232 and C<biblioitems.marcxml>  This option is provided B<only>
233 for the use of scripts such as C<bulkmarcimport.pl> that may need
234 to do some manipulation of the MARC record for item parsing before
235 saving it and which cannot afford the performance hit of saving
236 the MARC record twice.  Consequently, do not use that option
237 unless you can guarantee that C<ModBiblioMarc> will be called.
238
239 =cut
240
241 sub AddBiblio {
242     my $record          = shift;
243     my $frameworkcode   = shift;
244     my $options         = @_ ? shift : undef;
245     my $defer_marc_save = 0;
246     if (!$record) {
247         carp('AddBiblio called with undefined record');
248         return;
249     }
250     if ( defined $options and exists $options->{'defer_marc_save'} and $options->{'defer_marc_save'} ) {
251         $defer_marc_save = 1;
252     }
253
254     my ( $biblionumber, $biblioitemnumber, $error );
255     my $dbh = C4::Context->dbh;
256
257     # transform the data into koha-table style data
258     SetUTF8Flag($record);
259     my $olddata = TransformMarcToKoha( $dbh, $record, $frameworkcode );
260     ( $biblionumber, $error ) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
261     $olddata->{'biblionumber'} = $biblionumber;
262     ( $biblioitemnumber, $error ) = _koha_add_biblioitem( $dbh, $olddata );
263
264     _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
265
266     # update MARC subfield that stores biblioitems.cn_sort
267     _koha_marc_update_biblioitem_cn_sort( $record, $olddata, $frameworkcode );
268
269     # now add the record
270     ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
271
272     # update OAI-PMH sets
273     if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
274         C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
275     }
276
277     logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
278     return ( $biblionumber, $biblioitemnumber );
279 }
280
281 =head2 ModBiblio
282
283   ModBiblio( $record,$biblionumber,$frameworkcode);
284
285 Replace an existing bib record identified by C<$biblionumber>
286 with one supplied by the MARC::Record object C<$record>.  The embedded
287 item, biblioitem, and biblionumber fields from the previous
288 version of the bib record replace any such fields of those tags that
289 are present in C<$record>.  Consequently, ModBiblio() is not
290 to be used to try to modify item records.
291
292 C<$frameworkcode> specifies the MARC framework to use
293 when storing the modified bib record; among other things,
294 this controls how MARC fields get mapped to display columns
295 in the C<biblio> and C<biblioitems> tables, as well as
296 which fields are used to store embedded item, biblioitem,
297 and biblionumber data for indexing.
298
299 Returns 1 on success 0 on failure
300
301 =cut
302
303 sub ModBiblio {
304     my ( $record, $biblionumber, $frameworkcode ) = @_;
305     if (!$record) {
306         carp 'No record passed to ModBiblio';
307         return 0;
308     }
309
310     if ( C4::Context->preference("CataloguingLog") ) {
311         my $newrecord = GetMarcBiblio($biblionumber);
312         logaction( "CATALOGUING", "MODIFY", $biblionumber, "biblio BEFORE=>" . $newrecord->as_formatted );
313     }
314
315     # Cleaning up invalid fields must be done early or SetUTF8Flag is liable to
316     # throw an exception which probably won't be handled.
317     foreach my $field ($record->fields()) {
318         if (! $field->is_control_field()) {
319             if (scalar($field->subfields()) == 0 || (scalar($field->subfields()) == 1 && $field->subfield('9'))) {
320                 $record->delete_field($field);
321             }
322         }
323     }
324
325     SetUTF8Flag($record);
326     my $dbh = C4::Context->dbh;
327
328     $frameworkcode = "" if !$frameworkcode || $frameworkcode eq "Default"; # XXX
329
330     _strip_item_fields($record, $frameworkcode);
331
332     # update biblionumber and biblioitemnumber in MARC
333     # FIXME - this is assuming a 1 to 1 relationship between
334     # biblios and biblioitems
335     my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
336     $sth->execute($biblionumber);
337     my ($biblioitemnumber) = $sth->fetchrow;
338     $sth->finish();
339     _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
340
341     # load the koha-table data object
342     my $oldbiblio = TransformMarcToKoha( $dbh, $record, $frameworkcode );
343
344     # update MARC subfield that stores biblioitems.cn_sort
345     _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode );
346
347     # update the MARC record (that now contains biblio and items) with the new record data
348     &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
349
350     # modify the other koha tables
351     _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
352     _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
353
354     # update OAI-PMH sets
355     if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
356         C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
357     }
358
359     return 1;
360 }
361
362 =head2 _strip_item_fields
363
364   _strip_item_fields($record, $frameworkcode)
365
366 Utility routine to remove item tags from a
367 MARC bib.
368
369 =cut
370
371 sub _strip_item_fields {
372     my $record = shift;
373     my $frameworkcode = shift;
374     # get the items before and append them to the biblio before updating the record, atm we just have the biblio
375     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
376
377     # delete any item fields from incoming record to avoid
378     # duplication or incorrect data - use AddItem() or ModItem()
379     # to change items
380     foreach my $field ( $record->field($itemtag) ) {
381         $record->delete_field($field);
382     }
383 }
384
385 =head2 ModBiblioframework
386
387    ModBiblioframework($biblionumber,$frameworkcode);
388
389 Exported function to modify a biblio framework
390
391 =cut
392
393 sub ModBiblioframework {
394     my ( $biblionumber, $frameworkcode ) = @_;
395     my $dbh = C4::Context->dbh;
396     my $sth = $dbh->prepare( "UPDATE biblio SET frameworkcode=? WHERE biblionumber=?" );
397     $sth->execute( $frameworkcode, $biblionumber );
398     return 1;
399 }
400
401 =head2 DelBiblio
402
403   my $error = &DelBiblio($biblionumber);
404
405 Exported function (core API) for deleting a biblio in koha.
406 Deletes biblio record from Zebra and Koha tables (biblio & biblioitems)
407 Also backs it up to deleted* tables.
408 Checks to make sure that the biblio has no items attached.
409 return:
410 C<$error> : undef unless an error occurs
411
412 =cut
413
414 sub DelBiblio {
415     my ($biblionumber) = @_;
416     my $dbh = C4::Context->dbh;
417     my $error;    # for error handling
418
419     # First make sure this biblio has no items attached
420     my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
421     $sth->execute($biblionumber);
422     if ( my $itemnumber = $sth->fetchrow ) {
423
424         # Fix this to use a status the template can understand
425         $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
426     }
427
428     return $error if $error;
429
430     # We delete attached subscriptions
431     require C4::Serials;
432     my $subscriptions = C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
433     foreach my $subscription (@$subscriptions) {
434         C4::Serials::DelSubscription( $subscription->{subscriptionid} );
435     }
436
437     # We delete any existing holds
438     require C4::Reserves;
439     my $reserves = C4::Reserves::GetReservesFromBiblionumber({ biblionumber => $biblionumber });
440     foreach my $res ( @$reserves ) {
441         C4::Reserves::CancelReserve({ reserve_id => $res->{'reserve_id'} });
442     }
443
444     # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
445     # for at least 2 reasons :
446     # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
447     #   and we would have no way to remove it (except manually in zebra, but I bet it would be very hard to handle the problem)
448     ModZebra( $biblionumber, "recordDelete", "biblioserver" );
449
450     # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
451     $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
452     $sth->execute($biblionumber);
453     while ( my $biblioitemnumber = $sth->fetchrow ) {
454
455         # delete this biblioitem
456         $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
457         return $error if $error;
458     }
459
460     # delete biblio from Koha tables and save in deletedbiblio
461     # must do this *after* _koha_delete_biblioitems, otherwise
462     # delete cascade will prevent deletedbiblioitems rows
463     # from being generated by _koha_delete_biblioitems
464     $error = _koha_delete_biblio( $dbh, $biblionumber );
465
466     logaction( "CATALOGUING", "DELETE", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
467
468     return;
469 }
470
471
472 =head2 BiblioAutoLink
473
474   my $headings_linked = BiblioAutoLink($record, $frameworkcode)
475
476 Automatically links headings in a bib record to authorities.
477
478 Returns the number of headings changed
479
480 =cut
481
482 sub BiblioAutoLink {
483     my $record        = shift;
484     my $frameworkcode = shift;
485     if (!$record) {
486         carp('Undefined record passed to BiblioAutoLink');
487         return 0;
488     }
489     my ( $num_headings_changed, %results );
490
491     my $linker_module =
492       "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
493     unless ( can_load( modules => { $linker_module => undef } ) ) {
494         $linker_module = 'C4::Linker::Default';
495         unless ( can_load( modules => { $linker_module => undef } ) ) {
496             return 0;
497         }
498     }
499
500     my $linker = $linker_module->new(
501         { 'options' => C4::Context->preference("LinkerOptions") } );
502     my ( $headings_changed, undef ) =
503       LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, C4::Context->preference("CatalogModuleRelink") || '' );
504     # By default we probably don't want to relink things when cataloging
505     return $headings_changed;
506 }
507
508 =head2 LinkBibHeadingsToAuthorities
509
510   my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink]);
511
512 Links bib headings to authority records by checking
513 each authority-controlled field in the C<MARC::Record>
514 object C<$marc>, looking for a matching authority record,
515 and setting the linking subfield $9 to the ID of that
516 authority record.  
517
518 If $allowrelink is false, existing authids will never be
519 replaced, regardless of the values of LinkerKeepStale and
520 LinkerRelink.
521
522 Returns the number of heading links changed in the
523 MARC record.
524
525 =cut
526
527 sub LinkBibHeadingsToAuthorities {
528     my $linker        = shift;
529     my $bib           = shift;
530     my $frameworkcode = shift;
531     my $allowrelink = shift;
532     my %results;
533     if (!$bib) {
534         carp 'LinkBibHeadingsToAuthorities called on undefined bib record';
535         return ( 0, {});
536     }
537     require C4::Heading;
538     require C4::AuthoritiesMarc;
539
540     $allowrelink = 1 unless defined $allowrelink;
541     my $num_headings_changed = 0;
542     foreach my $field ( $bib->fields() ) {
543         my $heading = C4::Heading->new_from_bib_field( $field, $frameworkcode );
544         next unless defined $heading;
545
546         # check existing $9
547         my $current_link = $field->subfield('9');
548
549         if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) )
550         {
551             $results{'linked'}->{ $heading->display_form() }++;
552             next;
553         }
554
555         my ( $authid, $fuzzy ) = $linker->get_link($heading);
556         if ($authid) {
557             $results{ $fuzzy ? 'fuzzy' : 'linked' }
558               ->{ $heading->display_form() }++;
559             next if defined $current_link and $current_link == $authid;
560
561             $field->delete_subfield( code => '9' ) if defined $current_link;
562             $field->add_subfields( '9', $authid );
563             $num_headings_changed++;
564         }
565         else {
566             if ( defined $current_link
567                 && (!$allowrelink || C4::Context->preference('LinkerKeepStale')) )
568             {
569                 $results{'fuzzy'}->{ $heading->display_form() }++;
570             }
571             elsif ( C4::Context->preference('AutoCreateAuthorities') ) {
572                 if ( _check_valid_auth_link( $current_link, $field ) ) {
573                     $results{'linked'}->{ $heading->display_form() }++;
574                 }
575                 else {
576                     my $authority_type = Koha::Authority::Types->find( $heading->auth_type() );
577                     my $marcrecordauth = MARC::Record->new();
578                     if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
579                         $marcrecordauth->leader('     nz  a22     o  4500');
580                         SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
581                     }
582                     $field->delete_subfield( code => '9' )
583                       if defined $current_link;
584                     my $authfield =
585                       MARC::Field->new( $authority_type->auth_tag_to_report,
586                         '', '', "a" => "" . $field->subfield('a') );
587                     map {
588                         $authfield->add_subfields( $_->[0] => $_->[1] )
589                           if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a" )
590                     } $field->subfields();
591                     $marcrecordauth->insert_fields_ordered($authfield);
592
593 # bug 2317: ensure new authority knows it's using UTF-8; currently
594 # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
595 # automatically for UNIMARC (by not transcoding)
596 # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
597 # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
598 # of change to a core API just before the 3.0 release.
599
600                     if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
601                         $marcrecordauth->insert_fields_ordered(
602                             MARC::Field->new(
603                                 '667', '', '',
604                                 'a' => "Machine generated authority record."
605                             )
606                         );
607                         my $cite =
608                             $bib->author() . ", "
609                           . $bib->title_proper() . ", "
610                           . $bib->publication_date() . " ";
611                         $cite =~ s/^[\s\,]*//;
612                         $cite =~ s/[\s\,]*$//;
613                         $cite =
614                             "Work cat.: ("
615                           . C4::Context->preference('MARCOrgCode') . ")"
616                           . $bib->subfield( '999', 'c' ) . ": "
617                           . $cite;
618                         $marcrecordauth->insert_fields_ordered(
619                             MARC::Field->new( '670', '', '', 'a' => $cite ) );
620                     }
621
622            #          warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
623
624                     $authid =
625                       C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '',
626                         $heading->auth_type() );
627                     $field->add_subfields( '9', $authid );
628                     $num_headings_changed++;
629                     $linker->update_cache($heading, $authid);
630                     $results{'added'}->{ $heading->display_form() }++;
631                 }
632             }
633             elsif ( defined $current_link ) {
634                 if ( _check_valid_auth_link( $current_link, $field ) ) {
635                     $results{'linked'}->{ $heading->display_form() }++;
636                 }
637                 else {
638                     $field->delete_subfield( code => '9' );
639                     $num_headings_changed++;
640                     $results{'unlinked'}->{ $heading->display_form() }++;
641                 }
642             }
643             else {
644                 $results{'unlinked'}->{ $heading->display_form() }++;
645             }
646         }
647
648     }
649     return $num_headings_changed, \%results;
650 }
651
652 =head2 _check_valid_auth_link
653
654     if ( _check_valid_auth_link($authid, $field) ) {
655         ...
656     }
657
658 Check whether the specified heading-auth link is valid without reference
659 to Zebra. Ideally this code would be in C4::Heading, but that won't be
660 possible until we have de-cycled C4::AuthoritiesMarc, so this is the
661 safest place.
662
663 =cut
664
665 sub _check_valid_auth_link {
666     my ( $authid, $field ) = @_;
667
668     require C4::AuthoritiesMarc;
669
670     my $authorized_heading =
671       C4::AuthoritiesMarc::GetAuthorizedHeading( { 'authid' => $authid } ) || '';
672
673    return ($field->as_string('abcdefghijklmnopqrstuvwxyz') eq $authorized_heading);
674 }
675
676 =head2 GetRecordValue
677
678   my $values = GetRecordValue($field, $record, $frameworkcode);
679
680 Get MARC fields from a keyword defined in fieldmapping table.
681
682 =cut
683
684 sub GetRecordValue {
685     my ( $field, $record, $frameworkcode ) = @_;
686
687     if (!$record) {
688         carp 'GetRecordValue called with undefined record';
689         return;
690     }
691     my $dbh = C4::Context->dbh;
692
693     my $sth = $dbh->prepare('SELECT fieldcode, subfieldcode FROM fieldmapping WHERE frameworkcode = ? AND field = ?');
694     $sth->execute( $frameworkcode, $field );
695
696     my @result = ();
697
698     while ( my $row = $sth->fetchrow_hashref ) {
699         foreach my $field ( $record->field( $row->{fieldcode} ) ) {
700             if ( ( $row->{subfieldcode} ne "" && $field->subfield( $row->{subfieldcode} ) ) ) {
701                 foreach my $subfield ( $field->subfield( $row->{subfieldcode} ) ) {
702                     push @result, { 'subfield' => $subfield };
703                 }
704
705             } elsif ( $row->{subfieldcode} eq "" ) {
706                 push @result, { 'subfield' => $field->as_string() };
707             }
708         }
709     }
710
711     return \@result;
712 }
713
714 =head2 SetFieldMapping
715
716   SetFieldMapping($framework, $field, $fieldcode, $subfieldcode);
717
718 Set a Field to MARC mapping value, if it already exists we don't add a new one.
719
720 =cut
721
722 sub SetFieldMapping {
723     my ( $framework, $field, $fieldcode, $subfieldcode ) = @_;
724     my $dbh = C4::Context->dbh;
725
726     my $sth = $dbh->prepare('SELECT * FROM fieldmapping WHERE fieldcode = ? AND subfieldcode = ? AND frameworkcode = ? AND field = ?');
727     $sth->execute( $fieldcode, $subfieldcode, $framework, $field );
728     if ( not $sth->fetchrow_hashref ) {
729         my @args;
730         $sth = $dbh->prepare('INSERT INTO fieldmapping (fieldcode, subfieldcode, frameworkcode, field) VALUES(?,?,?,?)');
731
732         $sth->execute( $fieldcode, $subfieldcode, $framework, $field );
733     }
734 }
735
736 =head2 DeleteFieldMapping
737
738   DeleteFieldMapping($id);
739
740 Delete a field mapping from an $id.
741
742 =cut
743
744 sub DeleteFieldMapping {
745     my ($id) = @_;
746     my $dbh = C4::Context->dbh;
747
748     my $sth = $dbh->prepare('DELETE FROM fieldmapping WHERE id = ?');
749     $sth->execute($id);
750 }
751
752 =head2 GetFieldMapping
753
754   GetFieldMapping($frameworkcode);
755
756 Get all field mappings for a specified frameworkcode
757
758 =cut
759
760 sub GetFieldMapping {
761     my ($framework) = @_;
762     my $dbh = C4::Context->dbh;
763
764     my $sth = $dbh->prepare('SELECT * FROM fieldmapping where frameworkcode = ?');
765     $sth->execute($framework);
766
767     my @return;
768     while ( my $row = $sth->fetchrow_hashref ) {
769         push @return, $row;
770     }
771     return \@return;
772 }
773
774 =head2 GetBiblioData
775
776   $data = &GetBiblioData($biblionumber);
777
778 Returns information about the book with the given biblionumber.
779 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
780 the C<biblio> and C<biblioitems> tables in the
781 Koha database.
782
783 In addition, C<$data-E<gt>{subject}> is the list of the book's
784 subjects, separated by C<" , "> (space, comma, space).
785 If there are multiple biblioitems with the given biblionumber, only
786 the first one is considered.
787
788 =cut
789
790 sub GetBiblioData {
791     my ($bibnum) = @_;
792     my $dbh = C4::Context->dbh;
793
794     my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
795             FROM biblio
796             LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
797             LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
798             WHERE biblio.biblionumber = ?";
799
800     my $sth = $dbh->prepare($query);
801     $sth->execute($bibnum);
802     my $data;
803     $data = $sth->fetchrow_hashref;
804     $sth->finish;
805
806     return ($data);
807 }    # sub GetBiblioData
808
809 =head2 &GetBiblioItemData
810
811   $itemdata = &GetBiblioItemData($biblioitemnumber);
812
813 Looks up the biblioitem with the given biblioitemnumber. Returns a
814 reference-to-hash. The keys are the fields from the C<biblio>,
815 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
816 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
817
818 =cut
819
820 #'
821 sub GetBiblioItemData {
822     my ($biblioitemnumber) = @_;
823     my $dbh                = C4::Context->dbh;
824     my $query              = "SELECT *,biblioitems.notes AS bnotes
825         FROM biblio LEFT JOIN biblioitems on biblio.biblionumber=biblioitems.biblionumber ";
826     unless ( C4::Context->preference('item-level_itypes') ) {
827         $query .= "LEFT JOIN itemtypes on biblioitems.itemtype=itemtypes.itemtype ";
828     }
829     $query .= " WHERE biblioitemnumber = ? ";
830     my $sth = $dbh->prepare($query);
831     my $data;
832     $sth->execute($biblioitemnumber);
833     $data = $sth->fetchrow_hashref;
834     $sth->finish;
835     return ($data);
836 }    # sub &GetBiblioItemData
837
838 =head2 GetBiblioItemByBiblioNumber
839
840 NOTE : This function has been copy/paste from C4/Biblio.pm from head before zebra integration.
841
842 =cut
843
844 sub GetBiblioItemByBiblioNumber {
845     my ($biblionumber) = @_;
846     my $dbh            = C4::Context->dbh;
847     my $sth            = $dbh->prepare("Select * FROM biblioitems WHERE biblionumber = ?");
848     my $count          = 0;
849     my @results;
850
851     $sth->execute($biblionumber);
852
853     while ( my $data = $sth->fetchrow_hashref ) {
854         push @results, $data;
855     }
856
857     $sth->finish;
858     return @results;
859 }
860
861 =head2 GetBiblionumberFromItemnumber
862
863
864 =cut
865
866 sub GetBiblionumberFromItemnumber {
867     my ($itemnumber) = @_;
868     my $dbh            = C4::Context->dbh;
869     my $sth            = $dbh->prepare("Select biblionumber FROM items WHERE itemnumber = ?");
870
871     $sth->execute($itemnumber);
872     my ($result) = $sth->fetchrow;
873     return ($result);
874 }
875
876 =head2 GetBiblioFromItemNumber
877
878   $item = &GetBiblioFromItemNumber($itemnumber,$barcode);
879
880 Looks up the item with the given itemnumber. if undef, try the barcode.
881
882 C<&itemnodata> returns a reference-to-hash whose keys are the fields
883 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
884 database.
885
886 =cut
887
888 #'
889 sub GetBiblioFromItemNumber {
890     my ( $itemnumber, $barcode ) = @_;
891     my $dbh = C4::Context->dbh;
892     my $sth;
893     if ($itemnumber) {
894         $sth = $dbh->prepare(
895             "SELECT * FROM items 
896             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
897             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
898              WHERE items.itemnumber = ?"
899         );
900         $sth->execute($itemnumber);
901     } else {
902         $sth = $dbh->prepare(
903             "SELECT * FROM items 
904             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
905             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
906              WHERE items.barcode = ?"
907         );
908         $sth->execute($barcode);
909     }
910     my $data = $sth->fetchrow_hashref;
911     $sth->finish;
912     return ($data);
913 }
914
915 =head2 GetISBDView 
916
917   $isbd = &GetISBDView($biblionumber);
918
919 Return the ISBD view which can be included in opac and intranet
920
921 =cut
922
923 sub GetISBDView {
924     my ( $biblionumber, $template ) = @_;
925     my $record   = GetMarcBiblio($biblionumber, 1);
926     return unless defined $record;
927     my $itemtype = &GetFrameworkCode($biblionumber);
928     my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField( "items.holdingbranch", $itemtype );
929     my $tagslib = &GetMarcStructure( 1, $itemtype );
930
931     my $ISBD = C4::Context->preference('isbd');
932     my $bloc = $ISBD;
933     my $res;
934     my $blocres;
935
936     foreach my $isbdfield ( split( /#/, $bloc ) ) {
937
938         #         $isbdfield= /(.?.?.?)/;
939         $isbdfield =~ /(\d\d\d)([^\|])?\|(.*)\|(.*)\|(.*)/;
940         my $fieldvalue = $1 || 0;
941         my $subfvalue  = $2 || "";
942         my $textbefore = $3;
943         my $analysestring = $4;
944         my $textafter     = $5;
945
946         #         warn "==> $1 / $2 / $3 / $4";
947         #         my $fieldvalue=substr($isbdfield,0,3);
948         if ( $fieldvalue > 0 ) {
949             my $hasputtextbefore = 0;
950             my @fieldslist       = $record->field($fieldvalue);
951             @fieldslist = sort { $a->subfield($holdingbrtagsubf) cmp $b->subfield($holdingbrtagsubf) } @fieldslist if ( $fieldvalue eq $holdingbrtagf );
952
953             #         warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
954             #             warn "FV : $fieldvalue";
955             if ( $subfvalue ne "" ) {
956                 # OPAC hidden subfield
957                 next
958                   if ( ( $template eq 'opac' )
959                     && ( $tagslib->{$fieldvalue}->{$subfvalue}->{'hidden'} || 0 ) > 0 );
960                 foreach my $field (@fieldslist) {
961                     foreach my $subfield ( $field->subfield($subfvalue) ) {
962                         my $calculated = $analysestring;
963                         my $tag        = $field->tag();
964                         if ( $tag < 10 ) {
965                         } else {
966                             my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subfvalue, $subfield, '', $tagslib );
967                             my $tagsubf = $tag . $subfvalue;
968                             $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
969                             if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
970
971                             # field builded, store the result
972                             if ( $calculated && !$hasputtextbefore ) {    # put textbefore if not done
973                                 $blocres .= $textbefore;
974                                 $hasputtextbefore = 1;
975                             }
976
977                             # remove punctuation at start
978                             $calculated =~ s/^( |;|:|\.|-)*//g;
979                             $blocres .= $calculated;
980
981                         }
982                     }
983                 }
984                 $blocres .= $textafter if $hasputtextbefore;
985             } else {
986                 foreach my $field (@fieldslist) {
987                     my $calculated = $analysestring;
988                     my $tag        = $field->tag();
989                     if ( $tag < 10 ) {
990                     } else {
991                         my @subf = $field->subfields;
992                         for my $i ( 0 .. $#subf ) {
993                             my $valuecode     = $subf[$i][1];
994                             my $subfieldcode  = $subf[$i][0];
995                             # OPAC hidden subfield
996                             next
997                               if ( ( $template eq 'opac' )
998                                 && ( $tagslib->{$fieldvalue}->{$subfieldcode}->{'hidden'} || 0 ) > 0 );
999                             my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subf[$i][0], $subf[$i][1], '', $tagslib );
1000                             my $tagsubf       = $tag . $subfieldcode;
1001
1002                             $calculated =~ s/                  # replace all {{}} codes by the value code.
1003                                   \{\{$tagsubf\}\} # catch the {{actualcode}}
1004                                 /
1005                                   $valuecode     # replace by the value code
1006                                /gx;
1007
1008                             $calculated =~ s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
1009                             if ( $template eq "opac" ) { $calculated =~ s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; }
1010                         }
1011
1012                         # field builded, store the result
1013                         if ( $calculated && !$hasputtextbefore ) {    # put textbefore if not done
1014                             $blocres .= $textbefore;
1015                             $hasputtextbefore = 1;
1016                         }
1017
1018                         # remove punctuation at start
1019                         $calculated =~ s/^( |;|:|\.|-)*//g;
1020                         $blocres .= $calculated;
1021                     }
1022                 }
1023                 $blocres .= $textafter if $hasputtextbefore;
1024             }
1025         } else {
1026             $blocres .= $isbdfield;
1027         }
1028     }
1029     $res .= $blocres;
1030
1031     $res =~ s/\{(.*?)\}//g;
1032     $res =~ s/\\n/\n/g;
1033     $res =~ s/\n/<br\/>/g;
1034
1035     # remove empty ()
1036     $res =~ s/\(\)//g;
1037
1038     return $res;
1039 }
1040
1041 =head2 GetBiblio
1042
1043   my $biblio = &GetBiblio($biblionumber);
1044
1045 =cut
1046
1047 sub GetBiblio {
1048     my ($biblionumber) = @_;
1049     my $dbh            = C4::Context->dbh;
1050     my $sth            = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber = ?");
1051     my $count          = 0;
1052     my @results;
1053     $sth->execute($biblionumber);
1054     if ( my $data = $sth->fetchrow_hashref ) {
1055         return $data;
1056     }
1057     return;
1058 }    # sub GetBiblio
1059
1060 =head2 GetBiblioItemInfosOf
1061
1062   GetBiblioItemInfosOf(@biblioitemnumbers);
1063
1064 =cut
1065
1066 sub GetBiblioItemInfosOf {
1067     my @biblioitemnumbers = @_;
1068
1069     my $biblioitemnumber_values = @biblioitemnumbers ? join( ',', @biblioitemnumbers ) : "''";
1070
1071     my $query = "
1072         SELECT biblioitemnumber,
1073             publicationyear,
1074             itemtype
1075         FROM biblioitems
1076         WHERE biblioitemnumber IN ($biblioitemnumber_values)
1077     ";
1078     return get_infos_of( $query, 'biblioitemnumber' );
1079 }
1080
1081 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
1082
1083 =head2 GetMarcStructure
1084
1085   $res = GetMarcStructure($forlibrarian,$frameworkcode);
1086
1087 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
1088 $forlibrarian  :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
1089 $frameworkcode : the framework code to read
1090
1091 =cut
1092
1093 sub GetMarcStructure {
1094     my ( $forlibrarian, $frameworkcode ) = @_;
1095     my $dbh = C4::Context->dbh;
1096     $frameworkcode = "" unless $frameworkcode;
1097
1098     $forlibrarian = $forlibrarian ? 1 : 0;
1099     my $cache = Koha::Cache->get_instance();
1100     my $cache_key = "MarcStructure-$forlibrarian-$frameworkcode";
1101     my $cached = $cache->get_from_cache($cache_key);
1102     return $cached if $cached;
1103
1104     my $sth = $dbh->prepare(
1105         "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable 
1106         FROM marc_tag_structure 
1107         WHERE frameworkcode=? 
1108         ORDER BY tagfield"
1109     );
1110     $sth->execute($frameworkcode);
1111     my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
1112
1113     while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
1114         $res->{$tag}->{lib}        = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1115         $res->{$tag}->{tab}        = "";
1116         $res->{$tag}->{mandatory}  = $mandatory;
1117         $res->{$tag}->{repeatable} = $repeatable;
1118     }
1119
1120     $sth = $dbh->prepare(
1121         "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue,maxlength
1122          FROM   marc_subfield_structure 
1123          WHERE  frameworkcode=? 
1124          ORDER BY tagfield,tagsubfield
1125         "
1126     );
1127
1128     $sth->execute($frameworkcode);
1129
1130     my $subfield;
1131     my $authorised_value;
1132     my $authtypecode;
1133     my $value_builder;
1134     my $kohafield;
1135     my $seealso;
1136     my $hidden;
1137     my $isurl;
1138     my $link;
1139     my $defaultvalue;
1140     my $maxlength;
1141
1142     while (
1143         (   $tag,          $subfield,      $liblibrarian, $libopac, $tab,    $mandatory, $repeatable, $authorised_value,
1144             $authtypecode, $value_builder, $kohafield,    $seealso, $hidden, $isurl,     $link,       $defaultvalue,
1145             $maxlength
1146         )
1147         = $sth->fetchrow
1148       ) {
1149         $res->{$tag}->{$subfield}->{lib}              = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1150         $res->{$tag}->{$subfield}->{tab}              = $tab;
1151         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
1152         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
1153         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
1154         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
1155         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
1156         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
1157         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
1158         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
1159         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
1160         $res->{$tag}->{$subfield}->{'link'}           = $link;
1161         $res->{$tag}->{$subfield}->{defaultvalue}     = $defaultvalue;
1162         $res->{$tag}->{$subfield}->{maxlength}        = $maxlength;
1163     }
1164
1165     $cache->set_in_cache($cache_key, $res);
1166     return $res;
1167 }
1168
1169 =head2 GetUsedMarcStructure
1170
1171 The same function as GetMarcStructure except it just takes field
1172 in tab 0-9. (used field)
1173
1174   my $results = GetUsedMarcStructure($frameworkcode);
1175
1176 C<$results> is a ref to an array which each case containts a ref
1177 to a hash which each keys is the columns from marc_subfield_structure
1178
1179 C<$frameworkcode> is the framework code. 
1180
1181 =cut
1182
1183 sub GetUsedMarcStructure {
1184     my $frameworkcode = shift || '';
1185     my $query = qq/
1186         SELECT *
1187         FROM   marc_subfield_structure
1188         WHERE   tab > -1 
1189             AND frameworkcode = ?
1190         ORDER BY tagfield, tagsubfield
1191     /;
1192     my $sth = C4::Context->dbh->prepare($query);
1193     $sth->execute($frameworkcode);
1194     return $sth->fetchall_arrayref( {} );
1195 }
1196
1197 =head2 GetMarcFromKohaField
1198
1199   ($MARCfield,$MARCsubfield)=GetMarcFromKohaField($kohafield,$frameworkcode);
1200
1201 Returns the MARC fields & subfields mapped to the koha field 
1202 for the given frameworkcode or default framework if $frameworkcode is missing
1203
1204 =cut
1205
1206 sub GetMarcFromKohaField {
1207     my $kohafield = shift;
1208     my $frameworkcode = shift || '';
1209     return (0, undef) unless $kohafield;
1210     my $relations = C4::Context->marcfromkohafield;
1211     if ( my $mf = $relations->{$frameworkcode}->{$kohafield} ) {
1212         return @$mf;
1213     }
1214     return (0, undef);
1215 }
1216
1217 =head2 GetMarcSubfieldStructureFromKohaField
1218
1219     my $subfield_structure = &GetMarcSubfieldStructureFromKohaField($kohafield, $frameworkcode);
1220
1221 Returns a hashref where keys are marc_subfield_structure column names for the
1222 row where kohafield=$kohafield for the given framework code.
1223
1224 $frameworkcode is optional. If not given, then the default framework is used.
1225
1226 =cut
1227
1228 sub GetMarcSubfieldStructureFromKohaField {
1229     my ($kohafield, $frameworkcode) = @_;
1230
1231     return undef unless $kohafield;
1232     $frameworkcode //= '';
1233
1234     my $dbh = C4::Context->dbh;
1235     my $query = qq{
1236         SELECT *
1237         FROM marc_subfield_structure
1238         WHERE kohafield = ?
1239           AND frameworkcode = ?
1240     };
1241     my $sth = $dbh->prepare($query);
1242     $sth->execute($kohafield, $frameworkcode);
1243     my $result = $sth->fetchrow_hashref;
1244     $sth->finish;
1245
1246     return $result;
1247 }
1248
1249 =head2 GetMarcBiblio
1250
1251   my $record = GetMarcBiblio($biblionumber, [$embeditems], [$opac]);
1252
1253 Returns MARC::Record representing a biblio record, or C<undef> if the
1254 biblionumber doesn't exist.
1255
1256 =over 4
1257
1258 =item C<$biblionumber>
1259
1260 the biblionumber
1261
1262 =item C<$embeditems>
1263
1264 set to true to include item information.
1265
1266 =item C<$opac>
1267
1268 set to true to make the result suited for OPAC view. This causes things like
1269 OpacHiddenItems to be applied.
1270
1271 =back
1272
1273 =cut
1274
1275 sub GetMarcBiblio {
1276     my $biblionumber = shift;
1277     my $embeditems   = shift || 0;
1278     my $opac         = shift || 0;
1279
1280     if (not defined $biblionumber) {
1281         carp 'GetMarcBiblio called with undefined biblionumber';
1282         return;
1283     }
1284
1285     my $dbh          = C4::Context->dbh;
1286     my $sth          = $dbh->prepare("SELECT biblioitemnumber, marcxml FROM biblioitems WHERE biblionumber=? ");
1287     $sth->execute($biblionumber);
1288     my $row     = $sth->fetchrow_hashref;
1289     my $biblioitemnumber = $row->{'biblioitemnumber'};
1290     my $marcxml = StripNonXmlChars( $row->{'marcxml'} );
1291     my $frameworkcode = GetFrameworkCode($biblionumber);
1292     MARC::File::XML->default_record_format( C4::Context->preference('marcflavour') );
1293     my $record = MARC::Record->new();
1294
1295     if ($marcxml) {
1296         $record = eval {
1297             MARC::Record::new_from_xml( $marcxml, "utf8",
1298                 C4::Context->preference('marcflavour') );
1299         };
1300         if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; }
1301         return unless $record;
1302
1303         C4::Biblio::_koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber,
1304             $biblioitemnumber );
1305         C4::Biblio::EmbedItemsInMarcBiblio( $record, $biblionumber, undef, $opac )
1306           if ($embeditems);
1307
1308         return $record;
1309     }
1310     else {
1311         return;
1312     }
1313 }
1314
1315 =head2 GetXmlBiblio
1316
1317   my $marcxml = GetXmlBiblio($biblionumber);
1318
1319 Returns biblioitems.marcxml of the biblionumber passed in parameter.
1320 The XML should only contain biblio information (item information is no longer stored in marcxml field)
1321
1322 =cut
1323
1324 sub GetXmlBiblio {
1325     my ($biblionumber) = @_;
1326     my $dbh            = C4::Context->dbh;
1327     my $sth            = $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1328     $sth->execute($biblionumber);
1329     my ($marcxml) = $sth->fetchrow;
1330     return $marcxml;
1331 }
1332
1333 =head2 GetCOinSBiblio
1334
1335   my $coins = GetCOinSBiblio($record);
1336
1337 Returns the COinS (a span) which can be included in a biblio record
1338
1339 =cut
1340
1341 sub GetCOinSBiblio {
1342     my $record = shift;
1343
1344     # get the coin format
1345     if ( ! $record ) {
1346         carp 'GetCOinSBiblio called with undefined record';
1347         return;
1348     }
1349     my $pos7 = substr $record->leader(), 7, 1;
1350     my $pos6 = substr $record->leader(), 6, 1;
1351     my $mtx;
1352     my $genre;
1353     my ( $aulast, $aufirst ) = ( '', '' );
1354     my $oauthors  = '';
1355     my $title     = '';
1356     my $subtitle  = '';
1357     my $pubyear   = '';
1358     my $isbn      = '';
1359     my $issn      = '';
1360     my $publisher = '';
1361     my $pages     = '';
1362     my $titletype = 'b';
1363
1364     # For the purposes of generating COinS metadata, LDR/06-07 can be
1365     # considered the same for UNIMARC and MARC21
1366     my $fmts6;
1367     my $fmts7;
1368     %$fmts6 = (
1369                 'a' => 'book',
1370                 'b' => 'manuscript',
1371                 'c' => 'book',
1372                 'd' => 'manuscript',
1373                 'e' => 'map',
1374                 'f' => 'map',
1375                 'g' => 'film',
1376                 'i' => 'audioRecording',
1377                 'j' => 'audioRecording',
1378                 'k' => 'artwork',
1379                 'l' => 'document',
1380                 'm' => 'computerProgram',
1381                 'o' => 'document',
1382                 'r' => 'document',
1383             );
1384     %$fmts7 = (
1385                     'a' => 'journalArticle',
1386                     's' => 'journal',
1387               );
1388
1389     $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
1390
1391     if ( $genre eq 'book' ) {
1392             $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
1393     }
1394
1395     ##### We must transform mtx to a valable mtx and document type ####
1396     if ( $genre eq 'book' ) {
1397             $mtx = 'book';
1398     } elsif ( $genre eq 'journal' ) {
1399             $mtx = 'journal';
1400             $titletype = 'j';
1401     } elsif ( $genre eq 'journalArticle' ) {
1402             $mtx   = 'journal';
1403             $genre = 'article';
1404             $titletype = 'a';
1405     } else {
1406             $mtx = 'dc';
1407     }
1408
1409     $genre = ( $mtx eq 'dc' ) ? "&amp;rft.type=$genre" : "&amp;rft.genre=$genre";
1410
1411     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
1412
1413         # Setting datas
1414         $aulast  = $record->subfield( '700', 'a' ) || '';
1415         $aufirst = $record->subfield( '700', 'b' ) || '';
1416         $oauthors = "&amp;rft.au=$aufirst $aulast";
1417
1418         # others authors
1419         if ( $record->field('200') ) {
1420             for my $au ( $record->field('200')->subfield('g') ) {
1421                 $oauthors .= "&amp;rft.au=$au";
1422             }
1423         }
1424         $title =
1425           ( $mtx eq 'dc' )
1426           ? "&amp;rft.title=" . $record->subfield( '200', 'a' )
1427           : "&amp;rft.title=" . $record->subfield( '200', 'a' ) . "&amp;rft.btitle=" . $record->subfield( '200', 'a' );
1428         $pubyear   = $record->subfield( '210', 'd' ) || '';
1429         $publisher = $record->subfield( '210', 'c' ) || '';
1430         $isbn      = $record->subfield( '010', 'a' ) || '';
1431         $issn      = $record->subfield( '011', 'a' ) || '';
1432     } else {
1433
1434         # MARC21 need some improve
1435
1436         # Setting datas
1437         if ( $record->field('100') ) {
1438             $oauthors .= "&amp;rft.au=" . $record->subfield( '100', 'a' );
1439         }
1440
1441         # others authors
1442         if ( $record->field('700') ) {
1443             for my $au ( $record->field('700')->subfield('a') ) {
1444                 $oauthors .= "&amp;rft.au=$au";
1445             }
1446         }
1447         $title = "&amp;rft." . $titletype . "title=" . $record->subfield( '245', 'a' );
1448         $subtitle = $record->subfield( '245', 'b' ) || '';
1449         $title .= $subtitle;
1450         if ($titletype eq 'a') {
1451             $pubyear   = $record->field('008') || '';
1452             $pubyear   = substr($pubyear->data(), 7, 4) if $pubyear;
1453             $isbn      = $record->subfield( '773', 'z' ) || '';
1454             $issn      = $record->subfield( '773', 'x' ) || '';
1455             if ($mtx eq 'journal') {
1456                 $title    .= "&amp;rft.title=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')));
1457             } else {
1458                 $title    .= "&amp;rft.btitle=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')) || '');
1459             }
1460             foreach my $rel ($record->subfield( '773', 'g' )) {
1461                 if ($pages) {
1462                     $pages .= ', ';
1463                 }
1464                 $pages .= $rel;
1465             }
1466         } else {
1467             $pubyear   = $record->subfield( '260', 'c' ) || '';
1468             $publisher = $record->subfield( '260', 'b' ) || '';
1469             $isbn      = $record->subfield( '020', 'a' ) || '';
1470             $issn      = $record->subfield( '022', 'a' ) || '';
1471         }
1472
1473     }
1474     my $coins_value =
1475 "ctx_ver=Z39.88-2004&amp;rft_val_fmt=info%3Aofi%2Ffmt%3Akev%3Amtx%3A$mtx$genre$title&amp;rft.isbn=$isbn&amp;rft.issn=$issn&amp;rft.aulast=$aulast&amp;rft.aufirst=$aufirst$oauthors&amp;rft.pub=$publisher&amp;rft.date=$pubyear&amp;rft.pages=$pages";
1476     $coins_value =~ s/(\ |&[^a])/\+/g;
1477     $coins_value =~ s/\"/\&quot\;/g;
1478
1479 #<!-- TMPL_VAR NAME="ocoins_format" -->&amp;rft.au=<!-- TMPL_VAR NAME="author" -->&amp;rft.btitle=<!-- TMPL_VAR NAME="title" -->&amp;rft.date=<!-- TMPL_VAR NAME="publicationyear" -->&amp;rft.pages=<!-- TMPL_VAR NAME="pages" -->&amp;rft.isbn=<!-- TMPL_VAR NAME=amazonisbn -->&amp;rft.aucorp=&amp;rft.place=<!-- TMPL_VAR NAME="place" -->&amp;rft.pub=<!-- TMPL_VAR NAME="publishercode" -->&amp;rft.edition=<!-- TMPL_VAR NAME="edition" -->&amp;rft.series=<!-- TMPL_VAR NAME="series" -->&amp;rft.genre="
1480
1481     return $coins_value;
1482 }
1483
1484
1485 =head2 GetMarcPrice
1486
1487 return the prices in accordance with the Marc format.
1488
1489 returns 0 if no price found
1490 returns undef if called without a marc record or with
1491 an unrecognized marc format
1492
1493 =cut
1494
1495 sub GetMarcPrice {
1496     my ( $record, $marcflavour ) = @_;
1497     if (!$record) {
1498         carp 'GetMarcPrice called on undefined record';
1499         return;
1500     }
1501
1502     my @listtags;
1503     my $subfield;
1504     
1505     if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1506         @listtags = ('345', '020');
1507         $subfield="c";
1508     } elsif ( $marcflavour eq "UNIMARC" ) {
1509         @listtags = ('345', '010');
1510         $subfield="d";
1511     } else {
1512         return;
1513     }
1514     
1515     for my $field ( $record->field(@listtags) ) {
1516         for my $subfield_value  ($field->subfield($subfield)){
1517             #check value
1518             $subfield_value = MungeMarcPrice( $subfield_value );
1519             return $subfield_value if ($subfield_value);
1520         }
1521     }
1522     return 0; # no price found
1523 }
1524
1525 =head2 MungeMarcPrice
1526
1527 Return the best guess at what the actual price is from a price field.
1528 =cut
1529
1530 sub MungeMarcPrice {
1531     my ( $price ) = @_;
1532     return unless ( $price =~ m/\d/ ); ## No digits means no price.
1533     # Look for the currency symbol and the normalized code of the active currency, if it's there,
1534     my $active_currency = C4::Budgets->GetCurrency();
1535     my $symbol = $active_currency->{'symbol'};
1536     my $isocode = $active_currency->{'isocode'};
1537     $isocode = $active_currency->{'currency'} unless defined $isocode;
1538     my $localprice;
1539     if ( $symbol ) {
1540         my @matches =($price=~ /
1541             \s?
1542             (                          # start of capturing parenthesis
1543             (?:
1544             (?:[\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'
1545             |(?:\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'
1546             )
1547             \s?\p{Sc}?\s?              # followed or not by a whitespace. \p{Sc}?\s? are for cases like '25$ USD'
1548             (?:
1549             (?:[\p{Sc}\p{L}\/.]){1,4}  # followed by same block as symbol block
1550             |(?:\d+[\p{P}\s]?){1,4}    # or by same block as digits block
1551             )
1552             \s?\p{L}{0,4}\s?           # followed or not by a whitespace. \p{L}{0,4}\s? are for cases like '$9.50 USD'
1553             )                          # end of capturing parenthesis
1554             (?:\p{P}|\z)               # followed by a punctuation sign or by the end of the string
1555             /gx);
1556
1557         if ( @matches ) {
1558             foreach ( @matches ) {
1559                 $localprice = $_ and last if index($_, $isocode)>=0;
1560             }
1561             if ( !$localprice ) {
1562                 foreach ( @matches ) {
1563                     $localprice = $_ and last if $_=~ /(^|[^\p{Sc}\p{L}\/])\Q$symbol\E([^\p{Sc}\p{L}\/]+\z|\z)/;
1564                 }
1565             }
1566         }
1567     }
1568     if ( $localprice ) {
1569         $price = $localprice;
1570     } else {
1571         ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
1572         ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
1573     }
1574     # eliminate symbol/isocode, space and any final dot from the string
1575     $price =~ s/[\p{Sc}\p{L}\/ ]|\.$//g;
1576     # remove comma,dot when used as separators from hundreds
1577     $price =~s/[\,\.](\d{3})/$1/g;
1578     # convert comma to dot to ensure correct display of decimals if existing
1579     $price =~s/,/./;
1580     return $price;
1581 }
1582
1583
1584 =head2 GetMarcQuantity
1585
1586 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
1587 Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
1588
1589 returns 0 if no quantity found
1590 returns undef if called without a marc record or with
1591 an unrecognized marc format
1592
1593 =cut
1594
1595 sub GetMarcQuantity {
1596     my ( $record, $marcflavour ) = @_;
1597     if (!$record) {
1598         carp 'GetMarcQuantity called on undefined record';
1599         return;
1600     }
1601
1602     my @listtags;
1603     my $subfield;
1604     
1605     if ( $marcflavour eq "MARC21" ) {
1606         return 0
1607     } elsif ( $marcflavour eq "UNIMARC" ) {
1608         @listtags = ('969');
1609         $subfield="a";
1610     } else {
1611         return;
1612     }
1613     
1614     for my $field ( $record->field(@listtags) ) {
1615         for my $subfield_value  ($field->subfield($subfield)){
1616             #check value
1617             if ($subfield_value) {
1618                  # in France, the cents separator is the , but sometimes, ppl use a .
1619                  # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1620                 $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
1621                 return $subfield_value;
1622             }
1623         }
1624     }
1625     return 0; # no price found
1626 }
1627
1628
1629 =head2 GetAuthorisedValueDesc
1630
1631   my $subfieldvalue =get_authorised_value_desc(
1632     $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1633
1634 Retrieve the complete description for a given authorised value.
1635
1636 Now takes $category and $value pair too.
1637
1638   my $auth_value_desc =GetAuthorisedValueDesc(
1639     '','', 'DVD' ,'','','CCODE');
1640
1641 If the optional $opac parameter is set to a true value, displays OPAC 
1642 descriptions rather than normal ones when they exist.
1643
1644 =cut
1645
1646 sub GetAuthorisedValueDesc {
1647     my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1648     my $dbh = C4::Context->dbh;
1649
1650     if ( !$category ) {
1651
1652         return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1653
1654         #---- branch
1655         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1656             return C4::Branch::GetBranchName($value);
1657         }
1658
1659         #---- itemtypes
1660         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1661             return getitemtypeinfo($value)->{translated_description};
1662         }
1663
1664         #---- "true" authorized value
1665         $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1666     }
1667
1668     if ( $category ne "" ) {
1669         my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1670         $sth->execute( $category, $value );
1671         my $data = $sth->fetchrow_hashref;
1672         return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
1673     } else {
1674         return $value;    # if nothing is found return the original value
1675     }
1676 }
1677
1678 =head2 GetMarcControlnumber
1679
1680   $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1681
1682 Get the control number / record Identifier from the MARC record and return it.
1683
1684 =cut
1685
1686 sub GetMarcControlnumber {
1687     my ( $record, $marcflavour ) = @_;
1688     if (!$record) {
1689         carp 'GetMarcControlnumber called on undefined record';
1690         return;
1691     }
1692     my $controlnumber = "";
1693     # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
1694     # Keep $marcflavour for possible later use
1695     if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" || $marcflavour eq "NORMARC") {
1696         my $controlnumberField = $record->field('001');
1697         if ($controlnumberField) {
1698             $controlnumber = $controlnumberField->data();
1699         }
1700     }
1701     return $controlnumber;
1702 }
1703
1704 =head2 GetMarcISBN
1705
1706   $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1707
1708 Get all ISBNs from the MARC record and returns them in an array.
1709 ISBNs stored in different fields depending on MARC flavour
1710
1711 =cut
1712
1713 sub GetMarcISBN {
1714     my ( $record, $marcflavour ) = @_;
1715     if (!$record) {
1716         carp 'GetMarcISBN called on undefined record';
1717         return;
1718     }
1719     my $scope;
1720     if ( $marcflavour eq "UNIMARC" ) {
1721         $scope = '010';
1722     } else {    # assume marc21 if not unimarc
1723         $scope = '020';
1724     }
1725
1726     my @marcisbns;
1727     foreach my $field ( $record->field($scope) ) {
1728         my $isbn = $field->subfield( 'a' );
1729         if ( $isbn ne "" ) {
1730             push @marcisbns, $isbn;
1731         }
1732     }
1733
1734     return \@marcisbns;
1735 }    # end GetMarcISBN
1736
1737
1738 =head2 GetMarcISSN
1739
1740   $marcissnsarray = GetMarcISSN( $record, $marcflavour );
1741
1742 Get all valid ISSNs from the MARC record and returns them in an array.
1743 ISSNs are stored in different fields depending on MARC flavour
1744
1745 =cut
1746
1747 sub GetMarcISSN {
1748     my ( $record, $marcflavour ) = @_;
1749     if (!$record) {
1750         carp 'GetMarcISSN called on undefined record';
1751         return;
1752     }
1753     my $scope;
1754     if ( $marcflavour eq "UNIMARC" ) {
1755         $scope = '011';
1756     }
1757     else {    # assume MARC21 or NORMARC
1758         $scope = '022';
1759     }
1760     my @marcissns;
1761     foreach my $field ( $record->field($scope) ) {
1762         push @marcissns, $field->subfield( 'a' )
1763             if ( $field->subfield( 'a' ) ne "" );
1764     }
1765     return \@marcissns;
1766 }    # end GetMarcISSN
1767
1768 =head2 GetMarcNotes
1769
1770   $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1771
1772 Get all notes from the MARC record and returns them in an array.
1773 The note are stored in different fields depending on MARC flavour
1774
1775 =cut
1776
1777 sub GetMarcNotes {
1778     my ( $record, $marcflavour ) = @_;
1779     if (!$record) {
1780         carp 'GetMarcNotes called on undefined record';
1781         return;
1782     }
1783     my $scope;
1784     if ( $marcflavour eq "UNIMARC" ) {
1785         $scope = '3..';
1786     } else {    # assume marc21 if not unimarc
1787         $scope = '5..';
1788     }
1789     my @marcnotes;
1790     my $note = "";
1791     my $tag  = "";
1792     my $marcnote;
1793     my %blacklist = map { $_ => 1 } split(/,/,C4::Context->preference('NotesBlacklist'));
1794     foreach my $field ( $record->field($scope) ) {
1795         my $tag = $field->tag();
1796         if (!$blacklist{$tag}) {
1797             my $value = $field->as_string();
1798             if ( $note ne "" ) {
1799                 $marcnote = { marcnote => $note, };
1800                 push @marcnotes, $marcnote;
1801                 $note = $value;
1802             }
1803             if ( $note ne $value ) {
1804                 $note = $note . " " . $value;
1805             }
1806         }
1807     }
1808
1809     if ($note) {
1810         $marcnote = { marcnote => $note };
1811         push @marcnotes, $marcnote;    #load last tag into array
1812     }
1813     return \@marcnotes;
1814 }    # end GetMarcNotes
1815
1816 =head2 GetMarcSubjects
1817
1818   $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1819
1820 Get all subjects from the MARC record and returns them in an array.
1821 The subjects are stored in different fields depending on MARC flavour
1822
1823 =cut
1824
1825 sub GetMarcSubjects {
1826     my ( $record, $marcflavour ) = @_;
1827     if (!$record) {
1828         carp 'GetMarcSubjects called on undefined record';
1829         return;
1830     }
1831     my ( $mintag, $maxtag, $fields_filter );
1832     if ( $marcflavour eq "UNIMARC" ) {
1833         $mintag = "600";
1834         $maxtag = "611";
1835         $fields_filter = '6..';
1836     } else { # marc21/normarc
1837         $mintag = "600";
1838         $maxtag = "699";
1839         $fields_filter = '6..';
1840     }
1841
1842     my @marcsubjects;
1843
1844     my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1845     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1846
1847     foreach my $field ( $record->field($fields_filter) ) {
1848         next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
1849         my @subfields_loop;
1850         my @subfields = $field->subfields();
1851         my @link_loop;
1852
1853         # if there is an authority link, build the links with an= subfield9
1854         my $subfield9 = $field->subfield('9');
1855         my $authoritylink;
1856         if ($subfield9) {
1857             my $linkvalue = $subfield9;
1858             $linkvalue =~ s/(\(|\))//g;
1859             @link_loop = ( { limit => 'an', 'link' => $linkvalue } );
1860             $authoritylink = $linkvalue
1861         }
1862
1863         # other subfields
1864         for my $subject_subfield (@subfields) {
1865             next if ( $subject_subfield->[0] eq '9' );
1866
1867             # don't load unimarc subfields 3,4,5
1868             next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1869             # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1870             next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1871
1872             my $code      = $subject_subfield->[0];
1873             my $value     = $subject_subfield->[1];
1874             my $linkvalue = $value;
1875             $linkvalue =~ s/(\(|\))//g;
1876             # if no authority link, build a search query
1877             unless ($subfield9) {
1878                 push @link_loop, {
1879                     limit    => $subject_limit,
1880                     'link'   => $linkvalue,
1881                     operator => (scalar @link_loop) ? ' and ' : undef
1882                 };
1883             }
1884             my @this_link_loop = @link_loop;
1885             # do not display $0
1886             unless ( $code eq '0' ) {
1887                 push @subfields_loop, {
1888                     code      => $code,
1889                     value     => $value,
1890                     link_loop => \@this_link_loop,
1891                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1892                 };
1893             }
1894         }
1895
1896         push @marcsubjects, {
1897             MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop,
1898             authoritylink => $authoritylink,
1899         };
1900
1901     }
1902     return \@marcsubjects;
1903 }    #end getMARCsubjects
1904
1905 =head2 GetMarcAuthors
1906
1907   authors = GetMarcAuthors($record,$marcflavour);
1908
1909 Get all authors from the MARC record and returns them in an array.
1910 The authors are stored in different fields depending on MARC flavour
1911
1912 =cut
1913
1914 sub GetMarcAuthors {
1915     my ( $record, $marcflavour ) = @_;
1916     if (!$record) {
1917         carp 'GetMarcAuthors called on undefined record';
1918         return;
1919     }
1920     my ( $mintag, $maxtag, $fields_filter );
1921
1922     # tagslib useful for UNIMARC author reponsabilities
1923     my $tagslib =
1924       &GetMarcStructure( 1, '' );    # FIXME : we don't have the framework available, we take the default framework. May be buggy on some setups, will be usually correct.
1925     if ( $marcflavour eq "UNIMARC" ) {
1926         $mintag = "700";
1927         $maxtag = "712";
1928         $fields_filter = '7..';
1929     } else { # marc21/normarc
1930         $mintag = "700";
1931         $maxtag = "720";
1932         $fields_filter = '7..';
1933     }
1934
1935     my @marcauthors;
1936     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1937
1938     foreach my $field ( $record->field($fields_filter) ) {
1939         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1940         my @subfields_loop;
1941         my @link_loop;
1942         my @subfields  = $field->subfields();
1943         my $count_auth = 0;
1944
1945         # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1946         my $subfield9 = $field->subfield('9');
1947         if ($subfield9) {
1948             my $linkvalue = $subfield9;
1949             $linkvalue =~ s/(\(|\))//g;
1950             @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1951         }
1952
1953         # other subfields
1954         my $unimarc3;
1955         for my $authors_subfield (@subfields) {
1956             next if ( $authors_subfield->[0] eq '9' );
1957
1958             # unimarc3 contains the $3 of the author for UNIMARC.
1959             # For french academic libraries, it's the "ppn", and it's required for idref webservice
1960             $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1961
1962             # don't load unimarc subfields 3, 5
1963             next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1964
1965             my $code = $authors_subfield->[0];
1966             my $value        = $authors_subfield->[1];
1967             my $linkvalue    = $value;
1968             $linkvalue =~ s/(\(|\))//g;
1969             # UNIMARC author responsibility
1970             if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1971                 $value = GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1972                 $linkvalue = "($value)";
1973             }
1974             # if no authority link, build a search query
1975             unless ($subfield9) {
1976                 push @link_loop, {
1977                     limit    => 'au',
1978                     'link'   => $linkvalue,
1979                     operator => (scalar @link_loop) ? ' and ' : undef
1980                 };
1981             }
1982             my @this_link_loop = @link_loop;
1983             # do not display $0
1984             unless ( $code eq '0') {
1985                 push @subfields_loop, {
1986                     tag       => $field->tag(),
1987                     code      => $code,
1988                     value     => $value,
1989                     link_loop => \@this_link_loop,
1990                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1991                 };
1992             }
1993         }
1994         push @marcauthors, {
1995             MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
1996             authoritylink => $subfield9,
1997             unimarc3 => $unimarc3
1998         };
1999     }
2000     return \@marcauthors;
2001 }
2002
2003 =head2 GetMarcUrls
2004
2005   $marcurls = GetMarcUrls($record,$marcflavour);
2006
2007 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
2008 Assumes web resources (not uncommon in MARC21 to omit resource type ind) 
2009
2010 =cut
2011
2012 sub GetMarcUrls {
2013     my ( $record, $marcflavour ) = @_;
2014     if (!$record) {
2015         carp 'GetMarcUrls called on undefined record';
2016         return;
2017     }
2018
2019     my @marcurls;
2020     for my $field ( $record->field('856') ) {
2021         my @notes;
2022         for my $note ( $field->subfield('z') ) {
2023             push @notes, { note => $note };
2024         }
2025         my @urls = $field->subfield('u');
2026         foreach my $url (@urls) {
2027             my $marcurl;
2028             if ( $marcflavour eq 'MARC21' ) {
2029                 my $s3   = $field->subfield('3');
2030                 my $link = $field->subfield('y');
2031                 unless ( $url =~ /^\w+:/ ) {
2032                     if ( $field->indicator(1) eq '7' ) {
2033                         $url = $field->subfield('2') . "://" . $url;
2034                     } elsif ( $field->indicator(1) eq '1' ) {
2035                         $url = 'ftp://' . $url;
2036                     } else {
2037
2038                         #  properly, this should be if ind1=4,
2039                         #  however we will assume http protocol since we're building a link.
2040                         $url = 'http://' . $url;
2041                     }
2042                 }
2043
2044                 # TODO handle ind 2 (relationship)
2045                 $marcurl = {
2046                     MARCURL => $url,
2047                     notes   => \@notes,
2048                 };
2049                 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
2050                 $marcurl->{'part'} = $s3 if ($link);
2051                 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
2052             } else {
2053                 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
2054                 $marcurl->{'MARCURL'} = $url;
2055             }
2056             push @marcurls, $marcurl;
2057         }
2058     }
2059     return \@marcurls;
2060 }
2061
2062 =head2 GetMarcSeries
2063
2064   $marcseriesarray = GetMarcSeries($record,$marcflavour);
2065
2066 Get all series from the MARC record and returns them in an array.
2067 The series are stored in different fields depending on MARC flavour
2068
2069 =cut
2070
2071 sub GetMarcSeries {
2072     my ( $record, $marcflavour ) = @_;
2073     if (!$record) {
2074         carp 'GetMarcSeries called on undefined record';
2075         return;
2076     }
2077
2078     my ( $mintag, $maxtag, $fields_filter );
2079     if ( $marcflavour eq "UNIMARC" ) {
2080         $mintag = "225";
2081         $maxtag = "225";
2082         $fields_filter = '2..';
2083     } else {    # marc21/normarc
2084         $mintag = "440";
2085         $maxtag = "490";
2086         $fields_filter = '4..';
2087     }
2088
2089     my @marcseries;
2090     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
2091
2092     foreach my $field ( $record->field($fields_filter) ) {
2093         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
2094         my @subfields_loop;
2095         my @subfields = $field->subfields();
2096         my @link_loop;
2097
2098         for my $series_subfield (@subfields) {
2099
2100             # ignore $9, used for authority link
2101             next if ( $series_subfield->[0] eq '9' );
2102
2103             my $volume_number;
2104             my $code      = $series_subfield->[0];
2105             my $value     = $series_subfield->[1];
2106             my $linkvalue = $value;
2107             $linkvalue =~ s/(\(|\))//g;
2108
2109             # see if this is an instance of a volume
2110             if ( $code eq 'v' ) {
2111                 $volume_number = 1;
2112             }
2113
2114             push @link_loop, {
2115                 'link' => $linkvalue,
2116                 operator => (scalar @link_loop) ? ' and ' : undef
2117             };
2118
2119             if ($volume_number) {
2120                 push @subfields_loop, { volumenum => $value };
2121             } else {
2122                 push @subfields_loop, {
2123                     code      => $code,
2124                     value     => $value,
2125                     link_loop => \@link_loop,
2126                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : '',
2127                     volumenum => $volume_number,
2128                 }
2129             }
2130         }
2131         push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
2132
2133     }
2134     return \@marcseries;
2135 }    #end getMARCseriess
2136
2137 =head2 GetMarcHosts
2138
2139   $marchostsarray = GetMarcHosts($record,$marcflavour);
2140
2141 Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns them in an array.
2142
2143 =cut
2144
2145 sub GetMarcHosts {
2146     my ( $record, $marcflavour ) = @_;
2147     if (!$record) {
2148         carp 'GetMarcHosts called on undefined record';
2149         return;
2150     }
2151
2152     my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
2153     $marcflavour ||="MARC21";
2154     if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2155         $tag = "773";
2156         $title_subf = "t";
2157         $bibnumber_subf ="0";
2158         $itemnumber_subf='9';
2159     }
2160     elsif ($marcflavour eq "UNIMARC") {
2161         $tag = "461";
2162         $title_subf = "t";
2163         $bibnumber_subf ="0";
2164         $itemnumber_subf='9';
2165     };
2166
2167     my @marchosts;
2168
2169     foreach my $field ( $record->field($tag)) {
2170
2171         my @fields_loop;
2172
2173         my $hostbiblionumber = $field->subfield("$bibnumber_subf");
2174         my $hosttitle = $field->subfield($title_subf);
2175         my $hostitemnumber=$field->subfield($itemnumber_subf);
2176         push @fields_loop, { hostbiblionumber => $hostbiblionumber, hosttitle => $hosttitle, hostitemnumber => $hostitemnumber};
2177         push @marchosts, { MARCHOSTS_FIELDS_LOOP => \@fields_loop };
2178
2179         }
2180     my $marchostsarray = \@marchosts;
2181     return $marchostsarray;
2182 }
2183
2184 =head2 GetFrameworkCode
2185
2186   $frameworkcode = GetFrameworkCode( $biblionumber )
2187
2188 =cut
2189
2190 sub GetFrameworkCode {
2191     my ($biblionumber) = @_;
2192     my $dbh            = C4::Context->dbh;
2193     my $sth            = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
2194     $sth->execute($biblionumber);
2195     my ($frameworkcode) = $sth->fetchrow;
2196     return $frameworkcode;
2197 }
2198
2199 =head2 TransformKohaToMarc
2200
2201     $record = TransformKohaToMarc( $hash )
2202
2203 This function builds partial MARC::Record from a hash
2204 Hash entries can be from biblio or biblioitems.
2205
2206 This function is called in acquisition module, to create a basic catalogue
2207 entry from user entry
2208
2209 =cut
2210
2211
2212 sub TransformKohaToMarc {
2213     my $hash = shift;
2214     my $record = MARC::Record->new();
2215     SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
2216     my $db_to_marc = C4::Context->marcfromkohafield;
2217     my $tag_hr = {};
2218     while ( my ($name, $value) = each %$hash ) {
2219         next unless my $dtm = $db_to_marc->{''}->{$name};
2220         next unless ( scalar( @$dtm ) );
2221         my ($tag, $letter) = @$dtm;
2222         $tag .= '';
2223         foreach my $value ( split(/\s?\|\s?/, $value, -1) ) {
2224             next if $value eq '';
2225             $tag_hr->{$tag} //= [];
2226             push @{$tag_hr->{$tag}}, [($letter, $value)];
2227         }
2228     }
2229     foreach my $tag (sort keys %$tag_hr) {
2230         my @sfl = @{$tag_hr->{$tag}};
2231         @sfl = sort { $a->[0] cmp $b->[0]; } @sfl;
2232         @sfl = map { @{$_}; } @sfl;
2233         $record->insert_fields_ordered(
2234             MARC::Field->new($tag, " ", " ", @sfl)
2235         );
2236     }
2237     return $record;
2238 }
2239
2240 =head2 PrepHostMarcField
2241
2242     $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
2243
2244 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
2245
2246 =cut
2247
2248 sub PrepHostMarcField {
2249     my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
2250     $marcflavour ||="MARC21";
2251     
2252     require C4::Items;
2253     my $hostrecord = GetMarcBiblio($hostbiblionumber);
2254         my $item = C4::Items::GetItem($hostitemnumber);
2255         
2256         my $hostmarcfield;
2257     if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2258         
2259         #main entry
2260         my $mainentry;
2261         if ($hostrecord->subfield('100','a')){
2262             $mainentry = $hostrecord->subfield('100','a');
2263         } elsif ($hostrecord->subfield('110','a')){
2264             $mainentry = $hostrecord->subfield('110','a');
2265         } else {
2266             $mainentry = $hostrecord->subfield('111','a');
2267         }
2268         
2269         # qualification info
2270         my $qualinfo;
2271         if (my $field260 = $hostrecord->field('260')){
2272             $qualinfo =  $field260->as_string( 'abc' );
2273         }
2274         
2275
2276         #other fields
2277         my $ed = $hostrecord->subfield('250','a');
2278         my $barcode = $item->{'barcode'};
2279         my $title = $hostrecord->subfield('245','a');
2280
2281         # record control number, 001 with 003 and prefix
2282         my $recctrlno;
2283         if ($hostrecord->field('001')){
2284             $recctrlno = $hostrecord->field('001')->data();
2285             if ($hostrecord->field('003')){
2286                 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
2287             }
2288         }
2289
2290         # issn/isbn
2291         my $issn = $hostrecord->subfield('022','a');
2292         my $isbn = $hostrecord->subfield('020','a');
2293
2294
2295         $hostmarcfield = MARC::Field->new(
2296                 773, '0', '',
2297                 '0' => $hostbiblionumber,
2298                 '9' => $hostitemnumber,
2299                 'a' => $mainentry,
2300                 'b' => $ed,
2301                 'd' => $qualinfo,
2302                 'o' => $barcode,
2303                 't' => $title,
2304                 'w' => $recctrlno,
2305                 'x' => $issn,
2306                 'z' => $isbn
2307                 );
2308     } elsif ($marcflavour eq "UNIMARC") {
2309         $hostmarcfield = MARC::Field->new(
2310             461, '', '',
2311             '0' => $hostbiblionumber,
2312             't' => $hostrecord->subfield('200','a'), 
2313             '9' => $hostitemnumber
2314         );      
2315     };
2316
2317     return $hostmarcfield;
2318 }
2319
2320 =head2 TransformHtmlToXml
2321
2322   $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator, 
2323                              $ind_tag, $auth_type )
2324
2325 $auth_type contains :
2326
2327 =over
2328
2329 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
2330
2331 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2332
2333 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2334
2335 =back
2336
2337 =cut
2338
2339 sub TransformHtmlToXml {
2340     my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2341     # NOTE: The parameter $ind_tag is NOT USED -- BZ 11247
2342
2343     my $xml = MARC::File::XML::header('UTF-8');
2344     $xml .= "<record>\n";
2345     $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2346     MARC::File::XML->default_record_format($auth_type);
2347
2348     # in UNIMARC, field 100 contains the encoding
2349     # check that there is one, otherwise the
2350     # MARC::Record->new_from_xml will fail (and Koha will die)
2351     my $unimarc_and_100_exist = 0;
2352     $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM';    # if we rebuild an item, no need of a 100 field
2353     my $prevvalue;
2354     my $prevtag = -1;
2355     my $first   = 1;
2356     my $j       = -1;
2357     for ( my $i = 0 ; $i < @$tags ; $i++ ) {
2358
2359         if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
2360
2361             # if we have a 100 field and it's values are not correct, skip them.
2362             # if we don't have any valid 100 field, we will create a default one at the end
2363             my $enc = substr( @$values[$i], 26, 2 );
2364             if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2365                 $unimarc_and_100_exist = 1;
2366             } else {
2367                 next;
2368             }
2369         }
2370         @$values[$i] =~ s/&/&amp;/g;
2371         @$values[$i] =~ s/</&lt;/g;
2372         @$values[$i] =~ s/>/&gt;/g;
2373         @$values[$i] =~ s/"/&quot;/g;
2374         @$values[$i] =~ s/'/&apos;/g;
2375
2376         if ( ( @$tags[$i] ne $prevtag ) ) {
2377             $j++ unless ( @$tags[$i] eq "" );
2378             my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2379             my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2380             my $ind1       = _default_ind_to_space($indicator1);
2381             my $ind2;
2382             if ( @$indicator[$j] ) {
2383                 $ind2 = _default_ind_to_space($indicator2);
2384             } else {
2385                 warn "Indicator in @$tags[$i] is empty";
2386                 $ind2 = " ";
2387             }
2388             if ( !$first ) {
2389                 $xml .= "</datafield>\n";
2390                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
2391                     && ( @$values[$i] ne "" ) ) {
2392                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2393                     $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2394                     $first = 0;
2395                 } else {
2396                     $first = 1;
2397                 }
2398             } else {
2399                 if ( @$values[$i] ne "" ) {
2400
2401                     # leader
2402                     if ( @$tags[$i] eq "000" ) {
2403                         $xml .= "<leader>@$values[$i]</leader>\n";
2404                         $first = 1;
2405
2406                         # rest of the fixed fields
2407                     } elsif ( @$tags[$i] < 10 ) {
2408                         $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2409                         $first = 1;
2410                     } else {
2411                         $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2412                         $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2413                         $first = 0;
2414                     }
2415                 }
2416             }
2417         } else {    # @$tags[$i] eq $prevtag
2418             my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2419             my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2420             my $ind1       = _default_ind_to_space($indicator1);
2421             my $ind2;
2422             if ( @$indicator[$j] ) {
2423                 $ind2 = _default_ind_to_space($indicator2);
2424             } else {
2425                 warn "Indicator in @$tags[$i] is empty";
2426                 $ind2 = " ";
2427             }
2428             if ( @$values[$i] eq "" ) {
2429             } else {
2430                 if ($first) {
2431                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2432                     $first = 0;
2433                 }
2434                 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2435             }
2436         }
2437         $prevtag = @$tags[$i];
2438     }
2439     $xml .= "</datafield>\n" if $xml =~ m/<datafield/;
2440     if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2441
2442         #     warn "SETTING 100 for $auth_type";
2443         my $string = strftime( "%Y%m%d", localtime(time) );
2444
2445         # set 50 to position 26 is biblios, 13 if authorities
2446         my $pos = 26;
2447         $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2448         $string = sprintf( "%-*s", 35, $string );
2449         substr( $string, $pos, 6, "50" );
2450         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2451         $xml .= "<subfield code=\"a\">$string</subfield>\n";
2452         $xml .= "</datafield>\n";
2453     }
2454     $xml .= "</record>\n";
2455     $xml .= MARC::File::XML::footer();
2456     return $xml;
2457 }
2458
2459 =head2 _default_ind_to_space
2460
2461 Passed what should be an indicator returns a space
2462 if its undefined or zero length
2463
2464 =cut
2465
2466 sub _default_ind_to_space {
2467     my $s = shift;
2468     if ( !defined $s || $s eq q{} ) {
2469         return ' ';
2470     }
2471     return $s;
2472 }
2473
2474 =head2 TransformHtmlToMarc
2475
2476     L<$record> = TransformHtmlToMarc(L<$cgi>)
2477     L<$cgi> is the CGI object which containts the values for subfields
2478     {
2479         'tag_010_indicator1_531951' ,
2480         'tag_010_indicator2_531951' ,
2481         'tag_010_code_a_531951_145735' ,
2482         'tag_010_subfield_a_531951_145735' ,
2483         'tag_200_indicator1_873510' ,
2484         'tag_200_indicator2_873510' ,
2485         'tag_200_code_a_873510_673465' ,
2486         'tag_200_subfield_a_873510_673465' ,
2487         'tag_200_code_b_873510_704318' ,
2488         'tag_200_subfield_b_873510_704318' ,
2489         'tag_200_code_e_873510_280822' ,
2490         'tag_200_subfield_e_873510_280822' ,
2491         'tag_200_code_f_873510_110730' ,
2492         'tag_200_subfield_f_873510_110730' ,
2493     }
2494     L<$record> is the MARC::Record object.
2495
2496 =cut
2497
2498 sub TransformHtmlToMarc {
2499     my ($cgi, $isbiblio) = @_;
2500
2501     my @params = $cgi->param();
2502
2503     # explicitly turn on the UTF-8 flag for all
2504     # 'tag_' parameters to avoid incorrect character
2505     # conversion later on
2506     my $cgi_params = $cgi->Vars;
2507     foreach my $param_name ( keys %$cgi_params ) {
2508         if ( $param_name =~ /^tag_/ ) {
2509             my $param_value = $cgi_params->{$param_name};
2510             unless ( Encode::is_utf8( $param_value ) ) {
2511                 $cgi_params->{$param_name} = Encode::decode('UTF-8', $param_value );
2512             }
2513         }
2514     }
2515
2516     # creating a new record
2517     my $record = MARC::Record->new();
2518     my @fields;
2519     my ($biblionumbertagfield, $biblionumbertagsubfield) = (-1, -1);
2520     ($biblionumbertagfield, $biblionumbertagsubfield) =
2521         &GetMarcFromKohaField( "biblio.biblionumber", '' ) if $isbiblio;
2522 #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!
2523     for (my $i = 0; $params[$i]; $i++ ) {    # browse all CGI params
2524         my $param    = $params[$i];
2525         my $newfield = 0;
2526
2527         # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2528         if ( $param eq 'biblionumber' ) {
2529             if ( $biblionumbertagfield < 10 ) {
2530                 $newfield = MARC::Field->new( $biblionumbertagfield, $cgi->param($param), );
2531             } else {
2532                 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => $cgi->param($param), );
2533             }
2534             push @fields, $newfield if ($newfield);
2535         } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) {    # new field start when having 'input name="..._indicator1_..."
2536             my $tag = $1;
2537
2538             my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2539             my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2540             $newfield = 0;
2541             my $j = $i + 2;
2542
2543             if ( $tag < 10 ) {                              # no code for theses fields
2544                                                             # in MARC editor, 000 contains the leader.
2545                 if ( $tag == $biblionumbertagfield ) {
2546                     # We do nothing and let $i be incremented
2547                 }
2548                 elsif ( $tag eq '000' ) {
2549                     # Force a fake leader even if not provided to avoid crashing
2550                     # during decoding MARC record containing UTF-8 characters
2551                     $record->leader(
2552                         length( $cgi->param($params[$j+1]) ) == 24
2553                         ? $cgi->param( $params[ $j + 1 ] )
2554                         : '     nam a22        4500'
2555                         )
2556                     ;
2557                     # between 001 and 009 (included)
2558                 } elsif ( $cgi->param( $params[ $j + 1 ] ) ne '' ) {
2559                     $newfield = MARC::Field->new( $tag, $cgi->param( $params[ $j + 1 ] ), );
2560                 }
2561
2562                 # > 009, deal with subfields
2563             } else {
2564                 # browse subfields for this tag (reason for _code_ match)
2565                 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2566                     last unless defined $params[$j+1];
2567                     $j += 2 and next
2568                         if $tag == $biblionumbertagfield and
2569                            $cgi->param($params[$j]) eq $biblionumbertagsubfield;
2570                     #if next param ne subfield, then it was probably empty
2571                     #try next param by incrementing j
2572                     if($params[$j+1]!~/_subfield_/) {$j++; next; }
2573                     my $fval= $cgi->param($params[$j+1]);
2574                     #check if subfield value not empty and field exists
2575                     if($fval ne '' && $newfield) {
2576                         $newfield->add_subfields( $cgi->param($params[$j]) => $fval);
2577                     }
2578                     elsif($fval ne '') {
2579                         $newfield = MARC::Field->new( $tag, $ind1, $ind2, $cgi->param($params[$j]) => $fval );
2580                     }
2581                     $j += 2;
2582                 } #end-of-while
2583                 $i= $j-1; #update i for outer loop accordingly
2584             }
2585             push @fields, $newfield if ($newfield);
2586         }
2587     }
2588
2589     $record->append_fields(@fields);
2590     return $record;
2591 }
2592
2593 # cache inverted MARC field map
2594 our $inverted_field_map;
2595
2596 =head2 TransformMarcToKoha
2597
2598   $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
2599
2600 Extract data from a MARC bib record into a hashref representing
2601 Koha biblio, biblioitems, and items fields. 
2602
2603 If passed an undefined record will log the error and return an empty
2604 hash_ref
2605
2606 =cut
2607
2608 sub TransformMarcToKoha {
2609     my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
2610
2611     my $result = {};
2612     if (!defined $record) {
2613         carp('TransformMarcToKoha called with undefined record');
2614         return $result;
2615     }
2616     $limit_table = $limit_table || 0;
2617     $frameworkcode = '' unless defined $frameworkcode;
2618
2619     unless ( defined $inverted_field_map ) {
2620         $inverted_field_map = _get_inverted_marc_field_map();
2621     }
2622
2623     my %tables = ();
2624     if ( defined $limit_table && $limit_table eq 'items' ) {
2625         $tables{'items'} = 1;
2626     } else {
2627         $tables{'items'}       = 1;
2628         $tables{'biblio'}      = 1;
2629         $tables{'biblioitems'} = 1;
2630     }
2631
2632     # traverse through record
2633   MARCFIELD: foreach my $field ( $record->fields() ) {
2634         my $tag = $field->tag();
2635         next MARCFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag};
2636         if ( $field->is_control_field() ) {
2637             my $kohafields = $inverted_field_map->{$frameworkcode}->{$tag}->{list};
2638           ENTRY: foreach my $entry ( @{$kohafields} ) {
2639                 my ( $subfield, $table, $column ) = @{$entry};
2640                 next ENTRY unless exists $tables{$table};
2641                 my $key = _disambiguate( $table, $column );
2642                 if ( $result->{$key} ) {
2643                     unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $field->data() eq "" ) ) {
2644                         $result->{$key} .= " | " . $field->data();
2645                     }
2646                 } else {
2647                     $result->{$key} = $field->data();
2648                 }
2649             }
2650         } else {
2651
2652             # deal with subfields
2653           MARCSUBFIELD: foreach my $sf ( $field->subfields() ) {
2654                 my $code = $sf->[0];
2655                 next MARCSUBFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code};
2656                 my $value = $sf->[1];
2657               SFENTRY: foreach my $entry ( @{ $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code} } ) {
2658                     my ( $table, $column ) = @{$entry};
2659                     next SFENTRY unless exists $tables{$table};
2660                     my $key = _disambiguate( $table, $column );
2661                     if ( $result->{$key} ) {
2662                         unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $value eq "" ) ) {
2663                             $result->{$key} .= " | " . $value;
2664                         }
2665                     } else {
2666                         $result->{$key} = $value;
2667                     }
2668                 }
2669             }
2670         }
2671     }
2672
2673     # modify copyrightdate to keep only the 1st year found
2674     if ( exists $result->{'copyrightdate'} ) {
2675         my $temp = $result->{'copyrightdate'};
2676         $temp =~ m/c(\d\d\d\d)/;
2677         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) {    # search cYYYY first
2678             $result->{'copyrightdate'} = $1;
2679         } else {                                       # if no cYYYY, get the 1st date.
2680             $temp =~ m/(\d\d\d\d)/;
2681             $result->{'copyrightdate'} = $1;
2682         }
2683     }
2684
2685     # modify publicationyear to keep only the 1st year found
2686     if ( exists $result->{'publicationyear'} ) {
2687         my $temp = $result->{'publicationyear'};
2688         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) {    # search cYYYY first
2689             $result->{'publicationyear'} = $1;
2690         } else {                                       # if no cYYYY, get the 1st date.
2691             $temp =~ m/(\d\d\d\d)/;
2692             $result->{'publicationyear'} = $1;
2693         }
2694     }
2695
2696     return $result;
2697 }
2698
2699 sub _get_inverted_marc_field_map {
2700     my $field_map = {};
2701     my $relations = C4::Context->marcfromkohafield;
2702
2703     foreach my $frameworkcode ( keys %{$relations} ) {
2704         foreach my $kohafield ( keys %{ $relations->{$frameworkcode} } ) {
2705             next unless @{ $relations->{$frameworkcode}->{$kohafield} };    # not all columns are mapped to MARC tag & subfield
2706             my $tag      = $relations->{$frameworkcode}->{$kohafield}->[0];
2707             my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1];
2708             my ( $table, $column ) = split /[.]/, $kohafield, 2;
2709             push @{ $field_map->{$frameworkcode}->{$tag}->{list} }, [ $subfield, $table, $column ];
2710             push @{ $field_map->{$frameworkcode}->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2711         }
2712     }
2713     return $field_map;
2714 }
2715
2716 =head2 _disambiguate
2717
2718   $newkey = _disambiguate($table, $field);
2719
2720 This is a temporary hack to distinguish between the
2721 following sets of columns when using TransformMarcToKoha.
2722
2723   items.cn_source & biblioitems.cn_source
2724   items.cn_sort & biblioitems.cn_sort
2725
2726 Columns that are currently NOT distinguished (FIXME
2727 due to lack of time to fully test) are:
2728
2729   biblio.notes and biblioitems.notes
2730   biblionumber
2731   timestamp
2732   biblioitemnumber
2733
2734 FIXME - this is necessary because prefixing each column
2735 name with the table name would require changing lots
2736 of code and templates, and exposing more of the DB
2737 structure than is good to the UI templates, particularly
2738 since biblio and bibloitems may well merge in a future
2739 version.  In the future, it would also be good to 
2740 separate DB access and UI presentation field names
2741 more.
2742
2743 =cut
2744
2745 sub CountItemsIssued {
2746     my ($biblionumber) = @_;
2747     my $dbh            = C4::Context->dbh;
2748     my $sth            = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2749     $sth->execute($biblionumber);
2750     my $row = $sth->fetchrow_hashref();
2751     return $row->{'issuedCount'};
2752 }
2753
2754 sub _disambiguate {
2755     my ( $table, $column ) = @_;
2756     if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2757         return $table . '.' . $column;
2758     } else {
2759         return $column;
2760     }
2761
2762 }
2763
2764 =head2 get_koha_field_from_marc
2765
2766   $result->{_disambiguate($table, $field)} = 
2767      get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2768
2769 Internal function to map data from the MARC record to a specific non-MARC field.
2770 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2771
2772 =cut
2773
2774 sub get_koha_field_from_marc {
2775     my ( $koha_table, $koha_column, $record, $frameworkcode ) = @_;
2776     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table . '.' . $koha_column, $frameworkcode );
2777     my $kohafield;
2778     foreach my $field ( $record->field($tagfield) ) {
2779         if ( $field->tag() < 10 ) {
2780             if ($kohafield) {
2781                 $kohafield .= " | " . $field->data();
2782             } else {
2783                 $kohafield = $field->data();
2784             }
2785         } else {
2786             if ( $field->subfields ) {
2787                 my @subfields = $field->subfields();
2788                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2789                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2790                         if ($kohafield) {
2791                             $kohafield .= " | " . $subfields[$subfieldcount][1];
2792                         } else {
2793                             $kohafield = $subfields[$subfieldcount][1];
2794                         }
2795                     }
2796                 }
2797             }
2798         }
2799     }
2800     return $kohafield;
2801 }
2802
2803 =head2 TransformMarcToKohaOneField
2804
2805   $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2806
2807 =cut
2808
2809 sub TransformMarcToKohaOneField {
2810
2811     # FIXME ? if a field has a repeatable subfield that is used in old-db,
2812     # only the 1st will be retrieved...
2813     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2814     my $res = "";
2815     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $kohatable . "." . $kohafield, $frameworkcode );
2816     foreach my $field ( $record->field($tagfield) ) {
2817         if ( $field->tag() < 10 ) {
2818             if ( $result->{$kohafield} ) {
2819                 $result->{$kohafield} .= " | " . $field->data();
2820             } else {
2821                 $result->{$kohafield} = $field->data();
2822             }
2823         } else {
2824             if ( $field->subfields ) {
2825                 my @subfields = $field->subfields();
2826                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2827                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2828                         if ( $result->{$kohafield} ) {
2829                             $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
2830                         } else {
2831                             $result->{$kohafield} = $subfields[$subfieldcount][1];
2832                         }
2833                     }
2834                 }
2835             }
2836         }
2837     }
2838     return $result;
2839 }
2840
2841
2842 #"
2843
2844 #
2845 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2846 # at the same time
2847 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2848 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2849 # =head2 ModZebrafiles
2850 #
2851 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2852 #
2853 # =cut
2854 #
2855 # sub ModZebrafiles {
2856 #
2857 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2858 #
2859 #     my $op;
2860 #     my $zebradir =
2861 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2862 #     unless ( opendir( DIR, "$zebradir" ) ) {
2863 #         warn "$zebradir not found";
2864 #         return;
2865 #     }
2866 #     closedir DIR;
2867 #     my $filename = $zebradir . $biblionumber;
2868 #
2869 #     if ($record) {
2870 #         open( OUTPUT, ">", $filename . ".xml" );
2871 #         print OUTPUT $record;
2872 #         close OUTPUT;
2873 #     }
2874 # }
2875
2876 =head2 ModZebra
2877
2878   ModZebra( $biblionumber, $op, $server );
2879
2880 $biblionumber is the biblionumber we want to index
2881
2882 $op is specialUpdate or delete, and is used to know what we want to do
2883
2884 $server is the server that we want to update
2885
2886 =cut
2887
2888 sub ModZebra {
2889 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2890     my ( $biblionumber, $op, $server ) = @_;
2891     my $dbh = C4::Context->dbh;
2892
2893     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2894     # at the same time
2895     # replaced by a zebraqueue table, that is filled with ModZebra to run.
2896     # the table is emptied by rebuild_zebra.pl script (using the -z switch)
2897
2898     my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2899                      WHERE server = ?
2900                      AND   biblio_auth_number = ?
2901                      AND   operation = ?
2902                      AND   done = 0";
2903     my $check_sth = $dbh->prepare_cached($check_sql);
2904     $check_sth->execute( $server, $biblionumber, $op );
2905     my ($count) = $check_sth->fetchrow_array;
2906     $check_sth->finish();
2907     if ( $count == 0 ) {
2908         my $sth = $dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
2909         $sth->execute( $biblionumber, $server, $op );
2910         $sth->finish;
2911     }
2912 }
2913
2914
2915 =head2 EmbedItemsInMarcBiblio
2916
2917     EmbedItemsInMarcBiblio($marc, $biblionumber, $itemnumbers, $opac);
2918
2919 Given a MARC::Record object containing a bib record,
2920 modify it to include the items attached to it as 9XX
2921 per the bib's MARC framework.
2922 if $itemnumbers is defined, only specified itemnumbers are embedded.
2923
2924 If $opac is true, then opac-relevant suppressions are included.
2925
2926 =cut
2927
2928 sub EmbedItemsInMarcBiblio {
2929     my ($marc, $biblionumber, $itemnumbers, $opac) = @_;
2930     if ( !$marc ) {
2931         carp 'EmbedItemsInMarcBiblio: No MARC record passed';
2932         return;
2933     }
2934
2935     $itemnumbers = [] unless defined $itemnumbers;
2936
2937     my $frameworkcode = GetFrameworkCode($biblionumber);
2938     _strip_item_fields($marc, $frameworkcode);
2939
2940     # ... and embed the current items
2941     my $dbh = C4::Context->dbh;
2942     my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2943     $sth->execute($biblionumber);
2944     my @item_fields;
2945     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2946     my @items;
2947     my $opachiddenitems = $opac
2948       && ( C4::Context->preference('OpacHiddenItems') !~ /^\s*$/ );
2949     require C4::Items;
2950     while ( my ($itemnumber) = $sth->fetchrow_array ) {
2951         next if @$itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers;
2952         my $i = $opachiddenitems ? C4::Items::GetItem($itemnumber) : undef;
2953         push @items, { itemnumber => $itemnumber, item => $i };
2954     }
2955     my @hiddenitems =
2956       $opachiddenitems
2957       ? C4::Items::GetHiddenItemnumbers( map { $_->{item} } @items )
2958       : ();
2959     # Convert to a hash for quick searching
2960     my %hiddenitems = map { $_ => 1 } @hiddenitems;
2961     foreach my $itemnumber ( map { $_->{itemnumber} } @items ) {
2962         next if $hiddenitems{$itemnumber};
2963         my $item_marc = C4::Items::GetMarcItem( $biblionumber, $itemnumber );
2964         push @item_fields, $item_marc->field($itemtag);
2965     }
2966     $marc->append_fields(@item_fields);
2967 }
2968
2969 =head1 INTERNAL FUNCTIONS
2970
2971 =head2 _koha_marc_update_bib_ids
2972
2973
2974   _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2975
2976 Internal function to add or update biblionumber and biblioitemnumber to
2977 the MARC XML.
2978
2979 =cut
2980
2981 sub _koha_marc_update_bib_ids {
2982     my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
2983
2984     # we must add bibnum and bibitemnum in MARC::Record...
2985     # we build the new field with biblionumber and biblioitemnumber
2986     # we drop the original field
2987     # we add the new builded field.
2988     my ( $biblio_tag,     $biblio_subfield )     = GetMarcFromKohaField( "biblio.biblionumber",          $frameworkcode );
2989     die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
2990     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
2991     die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
2992
2993     if ( $biblio_tag == $biblioitem_tag ) {
2994
2995         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
2996         my $new_field = MARC::Field->new(
2997             $biblio_tag, '', '',
2998             "$biblio_subfield"     => $biblionumber,
2999             "$biblioitem_subfield" => $biblioitemnumber
3000         );
3001
3002         # drop old field and create new one...
3003         my $old_field = $record->field($biblio_tag);
3004         $record->delete_field($old_field) if $old_field;
3005         $record->insert_fields_ordered($new_field);
3006     } else {
3007
3008         # biblionumber & biblioitemnumber are in different fields
3009
3010         # deal with biblionumber
3011         my ( $new_field, $old_field );
3012         if ( $biblio_tag < 10 ) {
3013             $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
3014         } else {
3015             $new_field = MARC::Field->new( $biblio_tag, '', '', "$biblio_subfield" => $biblionumber );
3016         }
3017
3018         # drop old field and create new one...
3019         $old_field = $record->field($biblio_tag);
3020         $record->delete_field($old_field) if $old_field;
3021         $record->insert_fields_ordered($new_field);
3022
3023         # deal with biblioitemnumber
3024         if ( $biblioitem_tag < 10 ) {
3025             $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
3026         } else {
3027             $new_field = MARC::Field->new( $biblioitem_tag, '', '', "$biblioitem_subfield" => $biblioitemnumber, );
3028         }
3029
3030         # drop old field and create new one...
3031         $old_field = $record->field($biblioitem_tag);
3032         $record->delete_field($old_field) if $old_field;
3033         $record->insert_fields_ordered($new_field);
3034     }
3035 }
3036
3037 =head2 _koha_marc_update_biblioitem_cn_sort
3038
3039   _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
3040
3041 Given a MARC bib record and the biblioitem hash, update the
3042 subfield that contains a copy of the value of biblioitems.cn_sort.
3043
3044 =cut
3045
3046 sub _koha_marc_update_biblioitem_cn_sort {
3047     my $marc          = shift;
3048     my $biblioitem    = shift;
3049     my $frameworkcode = shift;
3050
3051     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort", $frameworkcode );
3052     return unless $biblioitem_tag;
3053
3054     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3055
3056     if ( my $field = $marc->field($biblioitem_tag) ) {
3057         $field->delete_subfield( code => $biblioitem_subfield );
3058         if ( $cn_sort ne '' ) {
3059             $field->add_subfields( $biblioitem_subfield => $cn_sort );
3060         }
3061     } else {
3062
3063         # if we get here, no biblioitem tag is present in the MARC record, so
3064         # we'll create it if $cn_sort is not empty -- this would be
3065         # an odd combination of events, however
3066         if ($cn_sort) {
3067             $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
3068         }
3069     }
3070 }
3071
3072 =head2 _koha_add_biblio
3073
3074   my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3075
3076 Internal function to add a biblio ($biblio is a hash with the values)
3077
3078 =cut
3079
3080 sub _koha_add_biblio {
3081     my ( $dbh, $biblio, $frameworkcode ) = @_;
3082
3083     my $error;
3084
3085     # set the series flag
3086     unless (defined $biblio->{'serial'}){
3087         $biblio->{'serial'} = 0;
3088         if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
3089     }
3090
3091     my $query = "INSERT INTO biblio
3092         SET frameworkcode = ?,
3093             author = ?,
3094             title = ?,
3095             unititle =?,
3096             notes = ?,
3097             serial = ?,
3098             seriestitle = ?,
3099             copyrightdate = ?,
3100             datecreated=NOW(),
3101             abstract = ?
3102         ";
3103     my $sth = $dbh->prepare($query);
3104     $sth->execute(
3105         $frameworkcode, $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
3106         $biblio->{'serial'},        $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
3107     );
3108
3109     my $biblionumber = $dbh->{'mysql_insertid'};
3110     if ( $dbh->errstr ) {
3111         $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
3112         warn $error;
3113     }
3114
3115     $sth->finish();
3116
3117     #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3118     return ( $biblionumber, $error );
3119 }
3120
3121 =head2 _koha_modify_biblio
3122
3123   my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3124
3125 Internal function for updating the biblio table
3126
3127 =cut
3128
3129 sub _koha_modify_biblio {
3130     my ( $dbh, $biblio, $frameworkcode ) = @_;
3131     my $error;
3132
3133     my $query = "
3134         UPDATE biblio
3135         SET    frameworkcode = ?,
3136                author = ?,
3137                title = ?,
3138                unititle = ?,
3139                notes = ?,
3140                serial = ?,
3141                seriestitle = ?,
3142                copyrightdate = ?,
3143                abstract = ?
3144         WHERE  biblionumber = ?
3145         "
3146       ;
3147     my $sth = $dbh->prepare($query);
3148
3149     $sth->execute(
3150         $frameworkcode,      $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
3151         $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}, $biblio->{'biblionumber'}
3152     ) if $biblio->{'biblionumber'};
3153
3154     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3155         $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
3156         warn $error;
3157     }
3158     return ( $biblio->{'biblionumber'}, $error );
3159 }
3160
3161 =head2 _koha_modify_biblioitem_nonmarc
3162
3163   my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3164
3165 Updates biblioitems row except for marc and marcxml, which should be changed
3166 via ModBiblioMarc
3167
3168 =cut
3169
3170 sub _koha_modify_biblioitem_nonmarc {
3171     my ( $dbh, $biblioitem ) = @_;
3172     my $error;
3173
3174     # re-calculate the cn_sort, it may have changed
3175     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3176
3177     my $query = "UPDATE biblioitems 
3178     SET biblionumber    = ?,
3179         volume          = ?,
3180         number          = ?,
3181         itemtype        = ?,
3182         isbn            = ?,
3183         issn            = ?,
3184         publicationyear = ?,
3185         publishercode   = ?,
3186         volumedate      = ?,
3187         volumedesc      = ?,
3188         collectiontitle = ?,
3189         collectionissn  = ?,
3190         collectionvolume= ?,
3191         editionstatement= ?,
3192         editionresponsibility = ?,
3193         illus           = ?,
3194         pages           = ?,
3195         notes           = ?,
3196         size            = ?,
3197         place           = ?,
3198         lccn            = ?,
3199         url             = ?,
3200         cn_source       = ?,
3201         cn_class        = ?,
3202         cn_item         = ?,
3203         cn_suffix       = ?,
3204         cn_sort         = ?,
3205         totalissues     = ?,
3206         ean             = ?,
3207         agerestriction  = ?
3208         where biblioitemnumber = ?
3209         ";
3210     my $sth = $dbh->prepare($query);
3211     $sth->execute(
3212         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
3213         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
3214         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
3215         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3216         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
3217         $biblioitem->{'lccn'},             $biblioitem->{'url'},              $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
3218         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},        $cn_sort,                               $biblioitem->{'totalissues'},
3219         $biblioitem->{'ean'},              $biblioitem->{'agerestriction'},   $biblioitem->{'biblioitemnumber'}
3220     );
3221     if ( $dbh->errstr ) {
3222         $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
3223         warn $error;
3224     }
3225     return ( $biblioitem->{'biblioitemnumber'}, $error );
3226 }
3227
3228 =head2 _koha_add_biblioitem
3229
3230   my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3231
3232 Internal function to add a biblioitem
3233
3234 =cut
3235
3236 sub _koha_add_biblioitem {
3237     my ( $dbh, $biblioitem ) = @_;
3238     my $error;
3239
3240     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3241     my $query = "INSERT INTO biblioitems SET
3242         biblionumber    = ?,
3243         volume          = ?,
3244         number          = ?,
3245         itemtype        = ?,
3246         isbn            = ?,
3247         issn            = ?,
3248         publicationyear = ?,
3249         publishercode   = ?,
3250         volumedate      = ?,
3251         volumedesc      = ?,
3252         collectiontitle = ?,
3253         collectionissn  = ?,
3254         collectionvolume= ?,
3255         editionstatement= ?,
3256         editionresponsibility = ?,
3257         illus           = ?,
3258         pages           = ?,
3259         notes           = ?,
3260         size            = ?,
3261         place           = ?,
3262         lccn            = ?,
3263         marc            = ?,
3264         url             = ?,
3265         cn_source       = ?,
3266         cn_class        = ?,
3267         cn_item         = ?,
3268         cn_suffix       = ?,
3269         cn_sort         = ?,
3270         totalissues     = ?,
3271         ean             = ?,
3272         agerestriction  = ?
3273         ";
3274     my $sth = $dbh->prepare($query);
3275     $sth->execute(
3276         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
3277         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
3278         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
3279         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3280         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
3281         $biblioitem->{'lccn'},             $biblioitem->{'marc'},             $biblioitem->{'url'},                   $biblioitem->{'biblioitems.cn_source'},
3282         $biblioitem->{'cn_class'},         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},             $cn_sort,
3283         $biblioitem->{'totalissues'},      $biblioitem->{'ean'},              $biblioitem->{'agerestriction'}
3284     );
3285     my $bibitemnum = $dbh->{'mysql_insertid'};
3286
3287     if ( $dbh->errstr ) {
3288         $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
3289         warn $error;
3290     }
3291     $sth->finish();
3292     return ( $bibitemnum, $error );
3293 }
3294
3295 =head2 _koha_delete_biblio
3296
3297   $error = _koha_delete_biblio($dbh,$biblionumber);
3298
3299 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3300
3301 C<$dbh> - the database handle
3302
3303 C<$biblionumber> - the biblionumber of the biblio to be deleted
3304
3305 =cut
3306
3307 # FIXME: add error handling
3308
3309 sub _koha_delete_biblio {
3310     my ( $dbh, $biblionumber ) = @_;
3311
3312     # get all the data for this biblio
3313     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3314     $sth->execute($biblionumber);
3315
3316     if ( my $data = $sth->fetchrow_hashref ) {
3317
3318         # save the record in deletedbiblio
3319         # find the fields to save
3320         my $query = "INSERT INTO deletedbiblio SET ";
3321         my @bind  = ();
3322         foreach my $temp ( keys %$data ) {
3323             $query .= "$temp = ?,";
3324             push( @bind, $data->{$temp} );
3325         }
3326
3327         # replace the last , by ",?)"
3328         $query =~ s/\,$//;
3329         my $bkup_sth = $dbh->prepare($query);
3330         $bkup_sth->execute(@bind);
3331         $bkup_sth->finish;
3332
3333         # delete the biblio
3334         my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3335         $sth2->execute($biblionumber);
3336         # update the timestamp (Bugzilla 7146)
3337         $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
3338         $sth2->execute($biblionumber);
3339         $sth2->finish;
3340     }
3341     $sth->finish;
3342     return;
3343 }
3344
3345 =head2 _koha_delete_biblioitems
3346
3347   $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3348
3349 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3350
3351 C<$dbh> - the database handle
3352 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3353
3354 =cut
3355
3356 # FIXME: add error handling
3357
3358 sub _koha_delete_biblioitems {
3359     my ( $dbh, $biblioitemnumber ) = @_;
3360
3361     # get all the data for this biblioitem
3362     my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3363     $sth->execute($biblioitemnumber);
3364
3365     if ( my $data = $sth->fetchrow_hashref ) {
3366
3367         # save the record in deletedbiblioitems
3368         # find the fields to save
3369         my $query = "INSERT INTO deletedbiblioitems SET ";
3370         my @bind  = ();
3371         foreach my $temp ( keys %$data ) {
3372             $query .= "$temp = ?,";
3373             push( @bind, $data->{$temp} );
3374         }
3375
3376         # replace the last , by ",?)"
3377         $query =~ s/\,$//;
3378         my $bkup_sth = $dbh->prepare($query);
3379         $bkup_sth->execute(@bind);
3380         $bkup_sth->finish;
3381
3382         # delete the biblioitem
3383         my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3384         $sth2->execute($biblioitemnumber);
3385         # update the timestamp (Bugzilla 7146)
3386         $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
3387         $sth2->execute($biblioitemnumber);
3388         $sth2->finish;
3389     }
3390     $sth->finish;
3391     return;
3392 }
3393
3394 =head1 UNEXPORTED FUNCTIONS
3395
3396 =head2 ModBiblioMarc
3397
3398   &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3399
3400 Add MARC data for a biblio to koha 
3401
3402 Function exported, but should NOT be used, unless you really know what you're doing
3403
3404 =cut
3405
3406 sub ModBiblioMarc {
3407     # pass the MARC::Record to this function, and it will create the records in
3408     # the marc field
3409     my ( $record, $biblionumber, $frameworkcode ) = @_;
3410     if ( !$record ) {
3411         carp 'ModBiblioMarc passed an undefined record';
3412         return;
3413     }
3414
3415     # Clone record as it gets modified
3416     $record = $record->clone();
3417     my $dbh    = C4::Context->dbh;
3418     my @fields = $record->fields();
3419     if ( !$frameworkcode ) {
3420         $frameworkcode = "";
3421     }
3422     my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3423     $sth->execute( $frameworkcode, $biblionumber );
3424     $sth->finish;
3425     my $encoding = C4::Context->preference("marcflavour");
3426
3427     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3428     if ( $encoding eq "UNIMARC" ) {
3429         my $defaultlanguage = C4::Context->preference("UNIMARCField100Language");
3430         $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
3431         my $string = $record->subfield( 100, "a" );
3432         if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3433             my $f100 = $record->field(100);
3434             $record->delete_field($f100);
3435         } else {
3436             $string = POSIX::strftime( "%Y%m%d", localtime );
3437             $string =~ s/\-//g;
3438             $string = sprintf( "%-*s", 35, $string );
3439             substr ( $string, 22, 3, $defaultlanguage);
3440         }
3441         substr( $string, 25, 3, "y50" );
3442         unless ( $record->subfield( 100, "a" ) ) {
3443             $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
3444         }
3445     }
3446
3447     #enhancement 5374: update transaction date (005) for marc21/unimarc
3448     if($encoding =~ /MARC21|UNIMARC/) {
3449       my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3450         # YY MM DD HH MM SS (update year and month)
3451       my $f005= $record->field('005');
3452       $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3453     }
3454
3455     $sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
3456     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding), $biblionumber );
3457     $sth->finish;
3458     ModZebra( $biblionumber, "specialUpdate", "biblioserver" );
3459     return $biblionumber;
3460 }
3461
3462 =head2 get_biblio_authorised_values
3463
3464 find the types and values for all authorised values assigned to this biblio.
3465
3466 parameters:
3467     biblionumber
3468     MARC::Record of the bib
3469
3470 returns: a hashref mapping the authorised value to the value set for this biblionumber
3471
3472   $authorised_values = {
3473                        'Scent'     => 'flowery',
3474                        'Audience'  => 'Young Adult',
3475                        'itemtypes' => 'SER',
3476                         };
3477
3478 Notes: forlibrarian should probably be passed in, and called something different.
3479
3480 =cut
3481
3482 sub get_biblio_authorised_values {
3483     my $biblionumber = shift;
3484     my $record       = shift;
3485
3486     my $forlibrarian  = 1;                                 # are we in staff or opac?
3487     my $frameworkcode = GetFrameworkCode($biblionumber);
3488
3489     my $authorised_values;
3490
3491     my $tagslib = GetMarcStructure( $forlibrarian, $frameworkcode )
3492       or return $authorised_values;
3493
3494     # assume that these entries in the authorised_value table are bibliolevel.
3495     # ones that start with 'item%' are item level.
3496     my $query = q(SELECT distinct authorised_value, kohafield
3497                     FROM marc_subfield_structure
3498                     WHERE authorised_value !=''
3499                       AND (kohafield like 'biblio%'
3500                        OR  kohafield like '') );
3501     my $bibliolevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
3502
3503     foreach my $tag ( keys(%$tagslib) ) {
3504         foreach my $subfield ( keys( %{ $tagslib->{$tag} } ) ) {
3505
3506             # warn "checking $subfield. type is: " . ref $tagslib->{ $tag }{ $subfield };
3507             if ( 'HASH' eq ref $tagslib->{$tag}{$subfield} ) {
3508                 if ( defined $tagslib->{$tag}{$subfield}{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } ) {
3509                     if ( defined $record->field($tag) ) {
3510                         my $this_subfield_value = $record->field($tag)->subfield($subfield);
3511                         if ( defined $this_subfield_value ) {
3512                             $authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } = $this_subfield_value;
3513                         }
3514                     }
3515                 }
3516             }
3517         }
3518     }
3519
3520     # warn ( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) );
3521     return $authorised_values;
3522 }
3523
3524 =head2 CountBiblioInOrders
3525
3526     $count = &CountBiblioInOrders( $biblionumber);
3527
3528 This function return count of biblios in orders with $biblionumber 
3529
3530 =cut
3531
3532 sub CountBiblioInOrders {
3533  my ($biblionumber) = @_;
3534     my $dbh            = C4::Context->dbh;
3535     my $query          = "SELECT count(*)
3536           FROM  aqorders 
3537           WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')";
3538     my $sth = $dbh->prepare($query);
3539     $sth->execute($biblionumber);
3540     my $count = $sth->fetchrow;
3541     return ($count);
3542 }
3543
3544 =head2 GetSubscriptionsId
3545
3546     $subscriptions = &GetSubscriptionsId($biblionumber);
3547
3548 This function return an array of subscriptionid with $biblionumber
3549
3550 =cut
3551
3552 sub GetSubscriptionsId {
3553  my ($biblionumber) = @_;
3554     my $dbh            = C4::Context->dbh;
3555     my $query          = "SELECT subscriptionid
3556           FROM  subscription
3557           WHERE biblionumber=?";
3558     my $sth = $dbh->prepare($query);
3559     $sth->execute($biblionumber);
3560     my @subscriptions = $sth->fetchrow_array;
3561     return (@subscriptions);
3562 }
3563
3564 =head2 GetHolds
3565
3566     $holds = &GetHolds($biblionumber);
3567
3568 This function return the count of holds with $biblionumber
3569
3570 =cut
3571
3572 sub GetHolds {
3573  my ($biblionumber) = @_;
3574     my $dbh            = C4::Context->dbh;
3575     my $query          = "SELECT count(*)
3576           FROM  reserves
3577           WHERE biblionumber=?";
3578     my $sth = $dbh->prepare($query);
3579     $sth->execute($biblionumber);
3580     my $holds = $sth->fetchrow;
3581     return ($holds);
3582 }
3583
3584 =head2 prepare_host_field
3585
3586 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
3587 Generate the host item entry for an analytic child entry
3588
3589 =cut
3590
3591 sub prepare_host_field {
3592     my ( $hostbiblio, $marcflavour ) = @_;
3593     $marcflavour ||= C4::Context->preference('marcflavour');
3594     my $host = GetMarcBiblio($hostbiblio);
3595     # unfortunately as_string does not 'do the right thing'
3596     # if field returns undef
3597     my %sfd;
3598     my $field;
3599     my $host_field;
3600     if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
3601         if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
3602             my $s = $field->as_string('ab');
3603             if ($s) {
3604                 $sfd{a} = $s;
3605             }
3606         }
3607         if ( $field = $host->field('245') ) {
3608             my $s = $field->as_string('a');
3609             if ($s) {
3610                 $sfd{t} = $s;
3611             }
3612         }
3613         if ( $field = $host->field('260') ) {
3614             my $s = $field->as_string('abc');
3615             if ($s) {
3616                 $sfd{d} = $s;
3617             }
3618         }
3619         if ( $field = $host->field('240') ) {
3620             my $s = $field->as_string();
3621             if ($s) {
3622                 $sfd{b} = $s;
3623             }
3624         }
3625         if ( $field = $host->field('022') ) {
3626             my $s = $field->as_string('a');
3627             if ($s) {
3628                 $sfd{x} = $s;
3629             }
3630         }
3631         if ( $field = $host->field('020') ) {
3632             my $s = $field->as_string('a');
3633             if ($s) {
3634                 $sfd{z} = $s;
3635             }
3636         }
3637         if ( $field = $host->field('001') ) {
3638             $sfd{w} = $field->data(),;
3639         }
3640         $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
3641         return $host_field;
3642     }
3643     elsif ( $marcflavour eq 'UNIMARC' ) {
3644         #author
3645         if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3646             my $s = $field->as_string('ab');
3647             if ($s) {
3648                 $sfd{a} = $s;
3649             }
3650         }
3651         #title
3652         if ( $field = $host->field('200') ) {