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