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