NoZebra SQL index management :
[koha.git] / C4 / Biblio.pm
1 package C4::Biblio;
2
3 # Copyright 2000-2002 Katipo Communications
4 #
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
10 # version.
11 #
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA  02111-1307 USA
19
20 use strict;
21
22 require Exporter;
23 use C4::Context;
24 use MARC::Record;
25 use MARC::File::USMARC;
26 use MARC::File::XML;
27 use ZOOM;
28 use C4::Koha;
29 use C4::Date;
30 use utf8;
31 use C4::Log; # logaction
32
33 use vars qw($VERSION @ISA @EXPORT);
34
35 # set the version for version checking
36 $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v).".".join( "_", map { sprintf "%03d", $_ } @v ); };
37
38 @ISA = qw( Exporter );
39
40 # EXPORTED FUNCTIONS.
41
42 # to add biblios or items
43 push @EXPORT, qw( &AddBiblio &AddItem );
44
45 # to get something
46 push @EXPORT, qw(
47   &GetBiblio
48   &GetBiblioData
49   &GetBiblioItemData
50   &GetBiblioItemInfosOf
51   &GetBiblioItemByBiblioNumber
52   &GetBiblioFromItemNumber
53   
54   &GetMarcItem
55   &GetItem
56   &GetItemInfosOf
57   &GetItemStatus
58   &GetItemLocation
59   &GetLostItems
60   &GetItemsForInventory
61
62   &GetMarcNotes
63   &GetMarcSubjects
64   &GetMarcBiblio
65   &GetMarcAuthors
66   &GetMarcSeries
67
68   &GetItemsInfo
69   &GetItemnumberFromBarcode
70   &get_itemnumbers_of
71   &GetXmlBiblio
72
73   &GetAuthorisedValueDesc
74   &GetMarcStructure
75   &GetMarcFromKohaField
76   &GetFrameworkCode
77   &TransformKohaToMarc
78 );
79
80 # To modify something
81 push @EXPORT, qw(
82   &ModBiblio
83   &ModItem
84   &ModItemTransfer
85   &ModBiblioframework
86   &ModZebra
87   &ModItemInMarc
88   &ModItemInMarconefield
89   &ModDateLastSeen
90 );
91
92 # To delete something
93 push @EXPORT, qw(
94   &DelBiblio
95   &DelItem
96 );
97
98 # Internal functions
99 # those functions are exported but should not be used
100 # they are usefull is few circumstances, so are exported.
101 # but don't use them unless you're a core developer ;-)
102 push @EXPORT, qw(
103   &ModBiblioMarc
104   &AddItemInMarc
105   &calculatelc
106   &itemcalculator
107 );
108
109 # Others functions
110 push @EXPORT, qw(
111   &TransformMarcToKoha
112   &TransformHtmlToMarc
113   &TransformHtmlToXml
114   &PrepareItemrecordDisplay
115   &char_decode
116   &GetNoZebraIndexes
117 );
118
119 =head1 NAME
120
121 C4::Biblio - cataloging management functions
122
123 =head1 DESCRIPTION
124
125 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:
126
127 =over 4
128
129 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
130
131 =item 2. as raw MARC in the Zebra index and storage engine
132
133 =item 3. as raw MARC the biblioitems.marc and biblioitems.marcxml
134
135 =back
136
137 In the 3.0 version of Koha, the authoritative record-level information is in biblioitems.marcxml
138
139 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.
140
141 =over 4
142
143 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
144
145 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
146
147 =back
148
149 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:
150
151 =over 4
152
153 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
154
155 =item 2. _koha_* - low-level internal functions for managing the koha tables
156
157 =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.
158
159 =item 4. Zebra functions used to update the Zebra index
160
161 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
162
163 =back
164
165 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 :
166
167 =over 4
168
169 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
170
171 =item 2. add the biblionumber and biblioitemnumber into the MARC records
172
173 =item 3. save the marc record
174
175 =back
176
177 When dealing with items, we must :
178
179 =over 4
180
181 =item 1. save the item in items table, that gives us an itemnumber
182
183 =item 2. add the itemnumber to the item MARC field
184
185 =item 3. overwrite the MARC record (with the added item) into biblioitems.marc(xml)
186
187 When modifying a biblio or an item, the behaviour is quite similar.
188
189 =back
190
191 =head1 EXPORTED FUNCTIONS
192
193 =head2 AddBiblio
194
195 =over 4
196
197 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
198 Exported function (core API) for adding a new biblio to koha.
199
200 =back
201
202 =cut
203
204 sub AddBiblio {
205     my ( $record, $frameworkcode ) = @_;
206     my $biblionumber;
207     my $biblioitemnumber;
208     my $dbh = C4::Context->dbh;
209     # transform the data into koha-table style data
210     my $olddata = TransformMarcToKoha( $dbh, $record, $frameworkcode );
211     $biblionumber = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
212     $olddata->{'biblionumber'} = $biblionumber;
213     $biblioitemnumber = _koha_add_biblioitem( $dbh, $olddata );
214
215     # we must add bibnum and bibitemnum in MARC::Record...
216     # we build the new field with biblionumber and biblioitemnumber
217     # we drop the original field
218     # we add the new builded field.
219     ( my $biblio_tag, my $biblio_subfield ) = GetMarcFromKohaField("biblio.biblionumber",$frameworkcode);
220     ( my $biblioitem_tag, my $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.biblioitemnumber",$frameworkcode);
221
222     my $newfield;
223
224     # biblionumber & biblioitemnumber are in different fields
225     if ( $biblio_tag != $biblioitem_tag ) {
226
227         # deal with biblionumber
228         if ( $biblio_tag < 10 ) {
229             $newfield = MARC::Field->new( $biblio_tag, $biblionumber );
230         }
231         else {
232             $newfield =
233               MARC::Field->new( $biblio_tag, '', '',
234                 "$biblio_subfield" => $biblionumber );
235         }
236
237         # drop old field and create new one...
238         my $old_field = $record->field($biblio_tag);
239         $record->delete_field($old_field);
240         $record->append_fields($newfield);
241
242         # deal with biblioitemnumber
243         if ( $biblioitem_tag < 10 ) {
244             $newfield = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
245         }
246         else {
247             $newfield =
248               MARC::Field->new( $biblioitem_tag, '', '',
249                 "$biblioitem_subfield" => $biblioitemnumber, );
250         }
251         # drop old field and create new one...
252         $old_field = $record->field($biblioitem_tag);
253         $record->delete_field($old_field);
254         $record->insert_fields_ordered($newfield);
255
256 # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
257     }
258     else {
259         my $newfield = MARC::Field->new(
260             $biblio_tag, '', '',
261             "$biblio_subfield" => $biblionumber,
262             "$biblioitem_subfield" => $biblioitemnumber
263         );
264
265         # drop old field and create new one...
266         my $old_field = $record->field($biblio_tag);
267         $record->delete_field($old_field);
268         $record->insert_fields_ordered($newfield);
269     }
270
271     # now add the record
272     my $biblionumber =
273       ModBiblioMarc( $record, $biblionumber, $frameworkcode );
274       
275     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$biblionumber,"biblio") 
276         if C4::Context->preference("CataloguingLog");
277       
278     return ( $biblionumber, $biblioitemnumber );
279 }
280
281 =head2 AddItem
282
283 =over
284
285 $biblionumber = AddItem( $record, $biblionumber)
286 Exported function (core API) for adding a new item to Koha
287
288 =back
289
290 =cut
291
292 sub AddItem {
293     my ( $record, $biblionumber ) = @_;
294     my $dbh = C4::Context->dbh;
295     
296     # add item in old-DB
297     my $frameworkcode = GetFrameworkCode( $biblionumber );
298     my $item = &TransformMarcToKoha( $dbh, $record, $frameworkcode );
299
300     # needs old biblionumber and biblioitemnumber
301     $item->{'biblionumber'} = $biblionumber;
302     my $sth =
303       $dbh->prepare(
304         "select biblioitemnumber,itemtype from biblioitems where biblionumber=?"
305       );
306     $sth->execute( $item->{'biblionumber'} );
307     my $itemtype;
308     ( $item->{'biblioitemnumber'}, $itemtype ) = $sth->fetchrow;
309     $sth =
310       $dbh->prepare(
311         "select notforloan from itemtypes where itemtype='$itemtype'");
312     $sth->execute();
313     my $notforloan = $sth->fetchrow;
314     ##Change the notforloan field if $notforloan found
315     if ( $notforloan > 0 ) {
316         $item->{'notforloan'} = $notforloan;
317         &MARCitemchange( $record, "items.notforloan", $notforloan );
318     }
319     if ( !$item->{'dateaccessioned'} || $item->{'dateaccessioned'} eq '' ) {
320
321         # find today's date
322         my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
323           localtime(time);
324         $year += 1900;
325         $mon  += 1;
326         my $date =
327           "$year-" . sprintf( "%0.2d", $mon ) . "-" . sprintf( "%0.2d", $mday );
328         $item->{'dateaccessioned'} = $date;
329         &MARCitemchange( $record, "items.dateaccessioned", $date );
330     }
331     my ( $itemnumber, $error ) =
332       &_koha_new_items( $dbh, $item, $item->{barcode} );
333
334     # add itemnumber to MARC::Record before adding the item.
335     $sth =
336       $dbh->prepare(
337 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
338       );
339     &TransformKohaToMarcOneField( $sth, $record, "items.itemnumber", $itemnumber,
340         $frameworkcode );
341
342     # add the item
343     &AddItemInMarc( $record, $item->{'biblionumber'},$frameworkcode );
344     
345     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$itemnumber,"item") 
346         if C4::Context->preference("CataloguingLog");
347     
348     return ($item->{biblionumber}, $item->{biblioitemnumber},$itemnumber);
349 }
350
351 =head2 ModBiblio
352
353 =over
354
355 ModBiblio( $record,$biblionumber,$frameworkcode);
356 Exported function (core API) to modify a biblio
357
358 =back
359
360 =cut
361
362 sub ModBiblio {
363     my ( $record, $biblionumber, $frameworkcode ) = @_;
364     
365     if (C4::Context->preference("CataloguingLog")) {    
366         my $newrecord = GetMarcBiblio($biblionumber);
367         &logaction(C4::Context->userenv->{'number'},"CATALOGUING","MODIFY",$biblionumber,$newrecord->as_formatted) 
368     }
369     
370     my $dbh = C4::Context->dbh;
371     
372     $frameworkcode = "" unless $frameworkcode;
373
374     # update the MARC record with the new record data
375     &ModBiblioMarc($record, $biblionumber, $frameworkcode );
376
377     # load the koha-table data object
378     my $oldbiblio = TransformMarcToKoha( $dbh, $record, $frameworkcode );
379
380     # modify the other koha tables
381     my $biblionumber = _koha_modify_biblio( $dbh, $oldbiblio );
382     _koha_modify_biblioitem( $dbh, $oldbiblio );
383
384     return 1;
385 }
386
387 =head2 ModItem
388
389 =over
390
391 Exported function (core API) for modifying an item in Koha.
392
393 =back
394
395 =cut
396
397 sub ModItem {
398     my ( $record, $biblionumber, $itemnumber, $delete, $new_item_hashref )
399       = @_;
400     
401     #logging
402     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","MODIFY",$itemnumber,$record->as_formatted) 
403         if C4::Context->preference("CataloguingLog");
404       
405     my $dbh = C4::Context->dbh;
406     
407     # if we have a MARC record, we're coming from cataloging and so
408     # we do the whole routine: update the MARC and zebra, then update the koha
409     # tables
410     if ($record) {
411         my $frameworkcode = GetFrameworkCode( $biblionumber );
412         ModItemInMarc( $record, $biblionumber, $itemnumber, $frameworkcode );
413         my $olditem       = TransformMarcToKoha( $dbh, $record, $frameworkcode );
414         _koha_modify_item( $dbh, $olditem );
415         return $biblionumber;
416     }
417
418     # otherwise, we're just looking to modify something quickly
419     # (like a status) so we just update the koha tables
420     elsif ($new_item_hashref) {
421         _koha_modify_item( $dbh, $new_item_hashref );
422     }
423 }
424
425 sub ModItemTransfer {
426     my ( $itemnumber, $frombranch, $tobranch ) = @_;
427     
428     my $dbh = C4::Context->dbh;
429     
430     #new entry in branchtransfers....
431     my $sth = $dbh->prepare(
432         "INSERT INTO branchtransfers (itemnumber, frombranch, datesent, tobranch)
433         VALUES (?, ?, now(), $?)");
434     $sth->execute($itemnumber, $frombranch, $tobranch);
435     #update holdingbranch in items .....
436      $sth= $dbh->prepare(
437           "UPDATE items set holdingbranch = ? WHERE items.itemnumber = ?");
438     $sth->execute($tobranch,$itemnumber);
439     &ModDateLastSeen($itemnumber);
440     $sth = $dbh->prepare(
441         "SELECT biblionumber FROM items WHERE itemnumber=?"
442       );
443     $sth->execute($itemnumber);
444     while ( my ( $biblionumber ) = $sth->fetchrow ) {
445         &ModItemInMarconefield( $biblionumber, $itemnumber,
446             'items.holdingbranch', $tobranch );
447     }
448     return;
449 }
450
451 ##New sub to dotransfer in marc tables as well. Not exported -TG 10/04/2006
452 # sub domarctransfer {
453 #     my ( $dbh, $itemnumber ) = @_;
454 #     $itemnumber =~ s /\'//g;    ##itemnumber seems to come with quotes-TG
455 #     my $sth =
456 #       $dbh->prepare(
457 #         "select biblionumber,holdingbranch from items where itemnumber=$itemnumber"
458 #       );
459 #     $sth->execute();
460 #     while ( my ( $biblionumber, $holdingbranch ) = $sth->fetchrow ) {
461 #         &ModItemInMarconefield( $biblionumber, $itemnumber,
462 #             'items.holdingbranch', $holdingbranch );
463 #     }
464 #     return;
465 # }
466 =head2 ModBiblioframework
467
468 =over
469
470 ModBiblioframework($biblionumber,$frameworkcode);
471 Exported function to modify a biblio framework
472
473 =back
474
475 =cut
476
477 sub ModBiblioframework {
478     my ( $biblionumber, $frameworkcode ) = @_;
479     my $dbh = C4::Context->dbh;
480     my $sth =
481       $dbh->prepare(
482         "UPDATE biblio SET frameworkcode=? WHERE biblionumber=$biblionumber");
483     $sth->execute($frameworkcode);
484     return 1;
485 }
486
487 =head2 ModItemInMarconefield
488
489 =over
490
491 modify only 1 field in a MARC item (mainly used for holdingbranch, but could also be used for status modif - moving a book to "lost" on a long overdu for example)
492 &ModItemInMarconefield( $biblionumber, $itemnumber, $itemfield, $newvalue )
493
494 =back
495
496 =cut
497
498 sub ModItemInMarconefield {
499     my ( $biblionumber, $itemnumber, $itemfield, $newvalue ) = @_;
500     my $dbh = C4::Context->dbh;
501     if ( !defined $newvalue ) {
502         $newvalue = "";
503     }
504
505     my $record = GetMarcItem( $biblionumber, $itemnumber );
506     my ($tagfield, $tagsubfield) = GetMarcFromKohaField( $itemfield,'');
507     if ($tagfield && $tagsubfield) {
508         my $tag = $record->field($tagfield);
509         if ($tag) {
510 #             my $tagsubs = $record->field($tagfield)->subfield($tagsubfield);
511             $tag->update( $tagsubfield => $newvalue );
512             $record->delete_field($tag);
513             $record->insert_fields_ordered($tag);
514             &ModItemInMarc( $record, $biblionumber, $itemnumber, 0 );
515         }
516     }
517 }
518
519 =head2 ModItemInMarc
520
521 =over
522
523 &ModItemInMarc( $record, $biblionumber, $itemnumber )
524
525 =back
526
527 =cut
528
529 sub ModItemInMarc {
530     my ( $ItemRecord, $biblionumber, $itemnumber, $frameworkcode) = @_;
531     my $dbh = C4::Context->dbh;
532     
533     # get complete MARC record & replace the item field by the new one
534     my $completeRecord = GetMarcBiblio($biblionumber);
535     my ($itemtag,$itemsubfield) = GetMarcFromKohaField("items.itemnumber",$frameworkcode);
536     my $itemField = $ItemRecord->field($itemtag);
537     my @items = $completeRecord->field($itemtag);
538     foreach (@items) {
539         if ($_->subfield($itemsubfield) eq $itemnumber) {
540 #             $completeRecord->delete_field($_);
541             $_->replace_with($itemField);
542         }
543     }
544     # save the record
545     my $sth = $dbh->prepare("update biblioitems set marc=?,marcxml=?  where biblionumber=?");
546     $sth->execute( $completeRecord->as_usmarc(), $completeRecord->as_xml_record(),$biblionumber );
547     $sth->finish;
548     ModZebra($biblionumber,"specialUpdate","biblioserver");
549 }
550
551 =head2 ModDateLastSeen
552
553 &ModDateLastSeen($itemnum)
554 Mark item as seen. Is called when an item is issued, returned or manually marked during inventory/stocktaking
555 C<$itemnum> is the item number
556
557 =cut
558
559 sub ModDateLastSeen {
560     my ($itemnum) = @_;
561     my $dbh       = C4::Context->dbh;
562     my $sth       =
563       $dbh->prepare(
564           "update items set itemlost=0, datelastseen  = now() where items.itemnumber = ?"
565       );
566     $sth->execute($itemnum);
567     return;
568 }
569 =head2 DelBiblio
570
571 =over
572
573 my $error = &DelBiblio($dbh,$biblionumber);
574 Exported function (core API) for deleting a biblio in koha.
575 Deletes biblio record from Zebra and Koha tables (biblio,biblioitems,items)
576 Also backs it up to deleted* tables
577 Checks to make sure there are not issues on any of the items
578 return:
579 C<$error> : undef unless an error occurs
580
581 =back
582
583 =cut
584
585 sub DelBiblio {
586     my ( $biblionumber ) = @_;
587     my $dbh = C4::Context->dbh;
588     my $error;    # for error handling
589
590     # First make sure there are no items with issues are still attached
591     my $sth =
592       $dbh->prepare(
593         "SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
594     $sth->execute($biblionumber);
595     while ( my $biblioitemnumber = $sth->fetchrow ) {
596         my @issues = C4::Circulation::Circ2::itemissues($biblioitemnumber);
597         foreach my $issue (@issues) {
598             if (   ( $issue->{date_due} )
599                 && ( $issue->{date_due} ne "Available" ) )
600             {
601
602 #FIXME: we need a status system in Biblio like in Circ to return standard codes and messages
603 # instead of hard-coded strings
604                 $error .=
605 "Item is checked out to a patron -- you must return it before deleting the Biblio";
606             }
607         }
608     }
609     return $error if $error;
610
611     # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
612     # for at least 2 reasons :
613     # - we need to read the biblio if NoZebra is set (to remove it from the indexes
614     # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
615     #   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)
616     ModZebra($biblionumber,"delete_record","biblioserver");
617
618     # delete biblio from Koha tables and save in deletedbiblio
619     $error = &_koha_delete_biblio( $dbh, $biblionumber );
620
621     # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
622     $sth =
623       $dbh->prepare(
624         "SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
625     $sth->execute($biblionumber);
626     while ( my $biblioitemnumber = $sth->fetchrow ) {
627
628         # delete this biblioitem
629         $error = &_koha_delete_biblioitems( $dbh, $biblioitemnumber );
630         return $error if $error;
631
632         # delete items
633         my $items_sth =
634           $dbh->prepare(
635             "SELECT itemnumber FROM items WHERE biblioitemnumber=?");
636         $items_sth->execute($biblioitemnumber);
637         while ( my $itemnumber = $items_sth->fetchrow ) {
638             $error = &_koha_delete_item( $dbh, $itemnumber );
639             return $error if $error;
640         }
641     }
642     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","DELETE",$biblionumber,"") 
643         if C4::Context->preference("CataloguingLog");
644     return;
645 }
646
647 =head2 DelItem
648
649 =over
650
651 DelItem( $biblionumber, $itemnumber );
652 Exported function (core API) for deleting an item record in Koha.
653
654 =back
655
656 =cut
657
658 sub DelItem {
659     my ( $biblionumber, $itemnumber ) = @_;
660     my $dbh = C4::Context->dbh;
661     &_koha_delete_item( $dbh, $itemnumber );
662     # get the MARC record
663     my $record = GetMarcBiblio($biblionumber);
664     my $frameworkcode = GetFrameworkCode($biblionumber);
665
666     # backup the record
667     my $copy2deleted =
668       $dbh->prepare("UPDATE deleteditems SET marc=? WHERE itemnumber=?");
669     $copy2deleted->execute( $record->as_usmarc(), $itemnumber );
670
671     #search item field code
672     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField("items.itemnumber",$frameworkcode);
673     my @fields = $record->field($itemtag);
674     # delete the item specified
675     foreach my $field (@fields) {
676         if ( $field->subfield($itemsubfield) eq $itemnumber ) {
677             $record->delete_field($field);
678         }
679     }
680     &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
681     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","DELETE",$itemnumber,"item") 
682         if C4::Context->preference("CataloguingLog");
683 }
684
685 =head2 GetBiblioData
686
687 =over 4
688
689 $data = &GetBiblioData($biblionumber);
690 Returns information about the book with the given biblionumber.
691 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
692 the C<biblio> and C<biblioitems> tables in the
693 Koha database.
694 In addition, C<$data-E<gt>{subject}> is the list of the book's
695 subjects, separated by C<" , "> (space, comma, space).
696 If there are multiple biblioitems with the given biblionumber, only
697 the first one is considered.
698
699 =back
700
701 =cut
702
703 sub GetBiblioData {
704     my ( $bibnum ) = @_;
705     my $dbh = C4::Context->dbh;
706
707     my $query = "
708         SELECT * , biblioitems.notes AS bnotes, biblio.notes
709         FROM biblio
710             LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
711             LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
712         WHERE biblio.biblionumber = ?
713             AND biblioitems.biblionumber = biblio.biblionumber
714     ";
715     my $sth = $dbh->prepare($query);
716     $sth->execute($bibnum);
717     my $data;
718     $data = $sth->fetchrow_hashref;
719     $sth->finish;
720
721     return ($data);
722 }    # sub GetBiblioData
723
724
725 =head2 GetItemsInfo
726
727 =over 4
728
729   @results = &GetItemsInfo($biblionumber, $type);
730
731 Returns information about books with the given biblionumber.
732
733 C<$type> may be either C<intra> or anything else. If it is not set to
734 C<intra>, then the search will exclude lost, very overdue, and
735 withdrawn items.
736
737 C<&GetItemsInfo> returns a list of references-to-hash. Each element
738 contains a number of keys. Most of them are table items from the
739 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
740 Koha database. Other keys include:
741
742 =over 4
743
744 =item C<$data-E<gt>{branchname}>
745
746 The name (not the code) of the branch to which the book belongs.
747
748 =item C<$data-E<gt>{datelastseen}>
749
750 This is simply C<items.datelastseen>, except that while the date is
751 stored in YYYY-MM-DD format in the database, here it is converted to
752 DD/MM/YYYY format. A NULL date is returned as C<//>.
753
754 =item C<$data-E<gt>{datedue}>
755
756 =item C<$data-E<gt>{class}>
757
758 This is the concatenation of C<biblioitems.classification>, the book's
759 Dewey code, and C<biblioitems.subclass>.
760
761 =item C<$data-E<gt>{ocount}>
762
763 I think this is the number of copies of the book available.
764
765 =item C<$data-E<gt>{order}>
766
767 If this is set, it is set to C<One Order>.
768
769 =back
770
771 =back
772
773 =cut
774
775 sub GetItemsInfo {
776     my ( $biblionumber, $type ) = @_;
777     my $dbh   = C4::Context->dbh;
778     my $query = "SELECT *,items.notforloan as itemnotforloan
779                  FROM items, biblio, biblioitems
780                  LEFT JOIN itemtypes on biblioitems.itemtype = itemtypes.itemtype
781                 WHERE items.biblionumber = ?
782                     AND biblioitems.biblioitemnumber = items.biblioitemnumber
783                     AND biblio.biblionumber = items.biblionumber
784                 ORDER BY items.dateaccessioned desc
785                  ";
786     my $sth = $dbh->prepare($query);
787     $sth->execute($biblionumber);
788     my $i = 0;
789     my @results;
790     my ( $date_due, $count_reserves );
791
792     while ( my $data = $sth->fetchrow_hashref ) {
793         my $datedue = '';
794         my $isth    = $dbh->prepare(
795             "SELECT issues.*,borrowers.cardnumber
796             FROM   issues, borrowers
797             WHERE  itemnumber = ?
798                 AND returndate IS NULL
799                 AND issues.borrowernumber=borrowers.borrowernumber"
800         );
801         $isth->execute( $data->{'itemnumber'} );
802         if ( my $idata = $isth->fetchrow_hashref ) {
803             $data->{borrowernumber} = $idata->{borrowernumber};
804             $data->{cardnumber}     = $idata->{cardnumber};
805             $datedue                = format_date( $idata->{'date_due'} );
806         }
807         if ( $datedue eq '' ) {
808             #$datedue="Available";
809             my ( $restype, $reserves ) =
810               C4::Reserves::CheckReserves( $data->{'itemnumber'} );
811             if ($restype) {
812
813                 #$datedue=$restype;
814                 $count_reserves = $restype;
815             }
816         }
817         $isth->finish;
818
819         #get branch information.....
820         my $bsth = $dbh->prepare(
821             "SELECT * FROM branches WHERE branchcode = ?
822         "
823         );
824         $bsth->execute( $data->{'holdingbranch'} );
825         if ( my $bdata = $bsth->fetchrow_hashref ) {
826             $data->{'branchname'} = $bdata->{'branchname'};
827         }
828         my $date = format_date( $data->{'datelastseen'} );
829         $data->{'datelastseen'}   = $date;
830         $data->{'datedue'}        = $datedue;
831         $data->{'count_reserves'} = $count_reserves;
832
833         # get notforloan complete status if applicable
834         my $sthnflstatus = $dbh->prepare(
835             'SELECT authorised_value
836             FROM   marc_subfield_structure
837             WHERE  kohafield="items.notforloan"
838         '
839         );
840
841         $sthnflstatus->execute;
842         my ($authorised_valuecode) = $sthnflstatus->fetchrow;
843         if ($authorised_valuecode) {
844             $sthnflstatus = $dbh->prepare(
845                 "SELECT lib FROM authorised_values
846                  WHERE  category=?
847                  AND authorised_value=?"
848             );
849             $sthnflstatus->execute( $authorised_valuecode,
850                 $data->{itemnotforloan} );
851             my ($lib) = $sthnflstatus->fetchrow;
852             $data->{notforloan} = $lib;
853         }
854
855         # my stack procedures
856         my $stackstatus = $dbh->prepare(
857             'SELECT authorised_value
858              FROM   marc_subfield_structure
859              WHERE  kohafield="items.stack"
860         '
861         );
862         $stackstatus->execute;
863
864         ($authorised_valuecode) = $stackstatus->fetchrow;
865         if ($authorised_valuecode) {
866             $stackstatus = $dbh->prepare(
867                 "SELECT lib
868                  FROM   authorised_values
869                  WHERE  category=?
870                  AND    authorised_value=?
871             "
872             );
873             $stackstatus->execute( $authorised_valuecode, $data->{stack} );
874             my ($lib) = $stackstatus->fetchrow;
875             $data->{stack} = $lib;
876         }
877         $results[$i] = $data;
878         $i++;
879     }
880     $sth->finish;
881
882     return (@results);
883 }
884
885 =head2 getitemstatus
886
887 =over 4
888
889 $itemstatushash = &getitemstatus($fwkcode);
890 returns information about status.
891 Can be MARC dependant.
892 fwkcode is optional.
893 But basically could be can be loan or not
894 Create a status selector with the following code
895
896 =head3 in PERL SCRIPT
897
898 my $itemstatushash = getitemstatus;
899 my @itemstatusloop;
900 foreach my $thisstatus (keys %$itemstatushash) {
901     my %row =(value => $thisstatus,
902                 statusname => $itemstatushash->{$thisstatus}->{'statusname'},
903             );
904     push @itemstatusloop, \%row;
905 }
906 $template->param(statusloop=>\@itemstatusloop);
907
908
909 =head3 in TEMPLATE
910
911             <select name="statusloop">
912                 <option value="">Default</option>
913             <!-- TMPL_LOOP name="statusloop" -->
914                 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="statusname" --></option>
915             <!-- /TMPL_LOOP -->
916             </select>
917
918 =cut
919
920 sub GetItemStatus {
921
922     # returns a reference to a hash of references to status...
923     my ($fwk) = @_;
924     my %itemstatus;
925     my $dbh = C4::Context->dbh;
926     my $sth;
927     $fwk = '' unless ($fwk);
928     my ( $tag, $subfield ) =
929       GetMarcFromKohaField( "items.notforloan", $fwk );
930     if ( $tag and $subfield ) {
931         my $sth =
932           $dbh->prepare(
933 "select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?"
934           );
935         $sth->execute( $tag, $subfield, $fwk );
936         if ( my ($authorisedvaluecat) = $sth->fetchrow ) {
937             my $authvalsth =
938               $dbh->prepare(
939 "select authorised_value, lib from authorised_values where category=? order by lib"
940               );
941             $authvalsth->execute($authorisedvaluecat);
942             while ( my ( $authorisedvalue, $lib ) = $authvalsth->fetchrow ) {
943                 $itemstatus{$authorisedvalue} = $lib;
944             }
945             $authvalsth->finish;
946             return \%itemstatus;
947             exit 1;
948         }
949         else {
950
951             #No authvalue list
952             # build default
953         }
954         $sth->finish;
955     }
956
957     #No authvalue list
958     #build default
959     $itemstatus{"1"} = "Not For Loan";
960     return \%itemstatus;
961 }
962
963 =head2 getitemlocation
964
965 =over 4
966
967 $itemlochash = &getitemlocation($fwk);
968 returns informations about location.
969 where fwk stands for an optional framework code.
970 Create a location selector with the following code
971
972 =head3 in PERL SCRIPT
973
974 my $itemlochash = getitemlocation;
975 my @itemlocloop;
976 foreach my $thisloc (keys %$itemlochash) {
977     my $selected = 1 if $thisbranch eq $branch;
978     my %row =(locval => $thisloc,
979                 selected => $selected,
980                 locname => $itemlochash->{$thisloc},
981             );
982     push @itemlocloop, \%row;
983 }
984 $template->param(itemlocationloop => \@itemlocloop);
985
986 =head3 in TEMPLATE
987
988 <select name="location">
989     <option value="">Default</option>
990 <!-- TMPL_LOOP name="itemlocationloop" -->
991     <option value="<!-- TMPL_VAR name="locval" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="locname" --></option>
992 <!-- /TMPL_LOOP -->
993 </select>
994
995 =back
996
997 =cut
998
999 sub GetItemLocation {
1000
1001     # returns a reference to a hash of references to location...
1002     my ($fwk) = @_;
1003     my %itemlocation;
1004     my $dbh = C4::Context->dbh;
1005     my $sth;
1006     $fwk = '' unless ($fwk);
1007     my ( $tag, $subfield ) =
1008       GetMarcFromKohaField( "items.location", $fwk );
1009     if ( $tag and $subfield ) {
1010         my $sth =
1011           $dbh->prepare(
1012 "select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?"
1013           );
1014         $sth->execute( $tag, $subfield, $fwk );
1015         if ( my ($authorisedvaluecat) = $sth->fetchrow ) {
1016             my $authvalsth =
1017               $dbh->prepare(
1018 "select authorised_value, lib from authorised_values where category=? order by lib"
1019               );
1020             $authvalsth->execute($authorisedvaluecat);
1021             while ( my ( $authorisedvalue, $lib ) = $authvalsth->fetchrow ) {
1022                 $itemlocation{$authorisedvalue} = $lib;
1023             }
1024             $authvalsth->finish;
1025             return \%itemlocation;
1026             exit 1;
1027         }
1028         else {
1029
1030             #No authvalue list
1031             # build default
1032         }
1033         $sth->finish;
1034     }
1035
1036     #No authvalue list
1037     #build default
1038     $itemlocation{"1"} = "Not For Loan";
1039     return \%itemlocation;
1040 }
1041
1042 =head2 GetLostItems
1043
1044 $items = GetLostItems($where,$orderby);
1045
1046 This function get the items lost into C<$items>.
1047
1048 =over 2
1049
1050 =item input:
1051 C<$where> is a hashref. it containts a field of the items table as key
1052 and the value to match as value.
1053 C<$orderby> is a field of the items table.
1054
1055 =item return:
1056 C<$items> is a reference to an array full of hasref which keys are items' table column.
1057
1058 =item usage in the perl script:
1059
1060 my %where;
1061 $where{barcode} = 0001548;
1062 my $items = GetLostItems( \%where, "homebranch" );
1063 $template->param(itemsloop => $items);
1064
1065 =back
1066
1067 =cut
1068
1069 sub GetLostItems {
1070     # Getting input args.
1071     my $where   = shift;
1072     my $orderby = shift;
1073     my $dbh     = C4::Context->dbh;
1074
1075     my $query   = "
1076         SELECT *
1077         FROM   items
1078         WHERE  itemlost IS NOT NULL
1079           AND  itemlost <> 0
1080     ";
1081     foreach my $key (keys %$where) {
1082         $query .= " AND " . $key . " LIKE '%" . $where->{$key} . "%'";
1083     }
1084     $query .= " ORDER BY ".$orderby if defined $orderby;
1085
1086     my $sth = $dbh->prepare($query);
1087     $sth->execute;
1088     my @items;
1089     while ( my $row = $sth->fetchrow_hashref ){
1090         push @items, $row;
1091     }
1092     return \@items;
1093 }
1094
1095 =head2 GetItemsForInventory
1096
1097 $itemlist = GetItemsForInventory($minlocation,$maxlocation,$datelastseen,$offset,$size)
1098
1099 Retrieve a list of title/authors/barcode/callnumber, for biblio inventory.
1100
1101 The sub returns a list of hashes, containing itemnumber, author, title, barcode & item callnumber.
1102 It is ordered by callnumber,title.
1103
1104 The minlocation & maxlocation parameters are used to specify a range of item callnumbers
1105 the datelastseen can be used to specify that you want to see items not seen since a past date only.
1106 offset & size can be used to retrieve only a part of the whole listing (defaut behaviour)
1107
1108 =cut
1109
1110 sub GetItemsForInventory {
1111     my ( $minlocation, $maxlocation, $datelastseen, $branch, $offset, $size ) = @_;
1112     my $dbh = C4::Context->dbh;
1113     my $sth;
1114     if ($datelastseen) {
1115         my $query =
1116                 "SELECT itemnumber,barcode,itemcallnumber,title,author,datelastseen
1117                  FROM items
1118                    LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber 
1119                  WHERE itemcallnumber>= ?
1120                    AND itemcallnumber <=?
1121                    AND (datelastseen< ? OR datelastseen IS NULL)";
1122         $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch;
1123         $query .= " ORDER BY itemcallnumber,title";
1124         $sth = $dbh->prepare($query);
1125         $sth->execute( $minlocation, $maxlocation, $datelastseen );
1126     }
1127     else {
1128         my $query ="
1129                 SELECT itemnumber,barcode,itemcallnumber,title,author,datelastseen
1130                 FROM items 
1131                   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber 
1132                 WHERE itemcallnumber>= ?
1133                   AND itemcallnumber <=?";
1134         $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch;
1135         $query .= " ORDER BY itemcallnumber,title";
1136         $sth = $dbh->prepare($query);
1137         $sth->execute( $minlocation, $maxlocation );
1138     }
1139     my @results;
1140     while ( my $row = $sth->fetchrow_hashref ) {
1141         $offset-- if ($offset);
1142         if ( ( !$offset ) && $size ) {
1143             push @results, $row;
1144             $size--;
1145         }
1146     }
1147     return \@results;
1148 }
1149
1150 =head2 &GetBiblioItemData
1151
1152 =over 4
1153
1154 $itemdata = &GetBiblioItemData($biblioitemnumber);
1155
1156 Looks up the biblioitem with the given biblioitemnumber. Returns a
1157 reference-to-hash. The keys are the fields from the C<biblio>,
1158 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
1159 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
1160
1161 =back
1162
1163 =cut
1164
1165 #'
1166 sub GetBiblioItemData {
1167     my ($bibitem) = @_;
1168     my $dbh       = C4::Context->dbh;
1169     my $sth       =
1170       $dbh->prepare(
1171 "Select *,biblioitems.notes as bnotes from biblioitems, biblio,itemtypes where biblio.biblionumber = biblioitems.biblionumber and biblioitemnumber = ? and biblioitems.itemtype = itemtypes.itemtype"
1172       );
1173     my $data;
1174
1175     $sth->execute($bibitem);
1176
1177     $data = $sth->fetchrow_hashref;
1178
1179     $sth->finish;
1180     return ($data);
1181 }    # sub &GetBiblioItemData
1182
1183 =head2 GetItemnumberFromBarcode
1184
1185 =over 4
1186
1187 $result = GetItemnumberFromBarcode($barcode);
1188
1189 =back
1190
1191 =cut
1192
1193 sub GetItemnumberFromBarcode {
1194     my ($barcode) = @_;
1195     my $dbh = C4::Context->dbh;
1196
1197     my $rq =
1198       $dbh->prepare("SELECT itemnumber from items where items.barcode=?");
1199     $rq->execute($barcode);
1200     my ($result) = $rq->fetchrow;
1201     return ($result);
1202 }
1203
1204 =head2 GetBiblioItemByBiblioNumber
1205
1206 =over 4
1207
1208 NOTE : This function has been copy/paste from C4/Biblio.pm from head before zebra integration.
1209
1210 =back
1211
1212 =cut
1213
1214 sub GetBiblioItemByBiblioNumber {
1215     my ($biblionumber) = @_;
1216     my $dbh = C4::Context->dbh;
1217     my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
1218     my $count = 0;
1219     my @results;
1220
1221     $sth->execute($biblionumber);
1222
1223     while ( my $data = $sth->fetchrow_hashref ) {
1224         push @results, $data;
1225     }
1226
1227     $sth->finish;
1228     return @results;
1229 }
1230
1231 =head2 GetBiblioFromItemNumber
1232
1233 =over 4
1234
1235 $item = &GetBiblioFromItemNumber($itemnumber);
1236
1237 Looks up the item with the given itemnumber.
1238
1239 C<&itemnodata> returns a reference-to-hash whose keys are the fields
1240 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
1241 database.
1242
1243 =back
1244
1245 =cut
1246
1247 #'
1248 sub GetBiblioFromItemNumber {
1249     my ( $itemnumber ) = @_;
1250     my $dbh = C4::Context->dbh;
1251     my $sth = $dbh->prepare(
1252         "SELECT * FROM biblio,items,biblioitems
1253          WHERE items.itemnumber = ?
1254            AND biblio.biblionumber = items.biblionumber
1255            AND biblioitems.biblioitemnumber = items.biblioitemnumber"
1256     );
1257
1258     $sth->execute($itemnumber);
1259     my $data = $sth->fetchrow_hashref;
1260     $sth->finish;
1261     return ($data);
1262 }
1263
1264 =head2 GetBiblio
1265
1266 =over 4
1267
1268 ( $count, @results ) = &GetBiblio($biblionumber);
1269
1270 =back
1271
1272 =cut
1273
1274 sub GetBiblio {
1275     my ($biblionumber) = @_;
1276     my $dbh = C4::Context->dbh;
1277     my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
1278     my $count = 0;
1279     my @results;
1280     $sth->execute($biblionumber);
1281     while ( my $data = $sth->fetchrow_hashref ) {
1282         $results[$count] = $data;
1283         $count++;
1284     }    # while
1285     $sth->finish;
1286     return ( $count, @results );
1287 }    # sub GetBiblio
1288
1289 =head2 GetItem
1290
1291 =over 4
1292
1293 $data = &GetItem($itemnumber,$barcode);
1294
1295 return Item information, for a given itemnumber or barcode
1296
1297 =back
1298
1299 =cut
1300
1301 sub GetItem {
1302     my ($itemnumber,$barcode) = @_;
1303     my $dbh = C4::Context->dbh;
1304     if ($itemnumber) {
1305         my $sth = $dbh->prepare("
1306             SELECT * FROM items 
1307             WHERE itemnumber = ?");
1308         $sth->execute($itemnumber);
1309         my $data = $sth->fetchrow_hashref;
1310         return $data;
1311     } else {
1312         my $sth = $dbh->prepare("
1313             SELECT * FROM items 
1314             WHERE barcode = ?"
1315             );
1316         $sth->execute($barcode);
1317         my $data = $sth->fetchrow_hashref;
1318         return $data;
1319     }
1320 }    # sub GetItem
1321
1322 =head2 get_itemnumbers_of
1323
1324 =over 4
1325
1326 my @itemnumbers_of = get_itemnumbers_of(@biblionumbers);
1327
1328 Given a list of biblionumbers, return the list of corresponding itemnumbers
1329 for each biblionumber.
1330
1331 Return a reference on a hash where keys are biblionumbers and values are
1332 references on array of itemnumbers.
1333
1334 =back
1335
1336 =cut
1337
1338 sub get_itemnumbers_of {
1339     my @biblionumbers = @_;
1340
1341     my $dbh = C4::Context->dbh;
1342
1343     my $query = '
1344         SELECT itemnumber,
1345             biblionumber
1346         FROM items
1347         WHERE biblionumber IN (?' . ( ',?' x scalar @biblionumbers - 1 ) . ')
1348     ';
1349     my $sth = $dbh->prepare($query);
1350     $sth->execute(@biblionumbers);
1351
1352     my %itemnumbers_of;
1353
1354     while ( my ( $itemnumber, $biblionumber ) = $sth->fetchrow_array ) {
1355         push @{ $itemnumbers_of{$biblionumber} }, $itemnumber;
1356     }
1357
1358     return \%itemnumbers_of;
1359 }
1360
1361 =head2 GetItemInfosOf
1362
1363 =over 4
1364
1365 GetItemInfosOf(@itemnumbers);
1366
1367 =back
1368
1369 =cut
1370
1371 sub GetItemInfosOf {
1372     my @itemnumbers = @_;
1373
1374     my $query = '
1375         SELECT *
1376         FROM items
1377         WHERE itemnumber IN (' . join( ',', @itemnumbers ) . ')
1378     ';
1379     return get_infos_of( $query, 'itemnumber' );
1380 }
1381
1382 =head2 GetBiblioItemInfosOf
1383
1384 =over 4
1385
1386 GetBiblioItemInfosOf(@biblioitemnumbers);
1387
1388 =back
1389
1390 =cut
1391
1392 sub GetBiblioItemInfosOf {
1393     my @biblioitemnumbers = @_;
1394
1395     my $query = '
1396         SELECT biblioitemnumber,
1397             publicationyear,
1398             itemtype
1399         FROM biblioitems
1400         WHERE biblioitemnumber IN (' . join( ',', @biblioitemnumbers ) . ')
1401     ';
1402     return get_infos_of( $query, 'biblioitemnumber' );
1403 }
1404
1405 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
1406
1407 =head2 GetMarcStructure
1408
1409 =over 4
1410
1411 $res = GetMarcStructure($dbh,$forlibrarian,$frameworkcode);
1412
1413 Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
1414 $dbh : DB handler
1415 $forlibrarian  :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
1416 $frameworkcode : the framework code to read
1417
1418 =back
1419
1420 =back
1421
1422 =cut
1423
1424 sub GetMarcStructure {
1425     my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
1426     $frameworkcode = "" unless $frameworkcode;
1427     my $sth;
1428     my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
1429
1430     # check that framework exists
1431     $sth =
1432       $dbh->prepare(
1433         "select count(*) from marc_tag_structure where frameworkcode=?");
1434     $sth->execute($frameworkcode);
1435     my ($total) = $sth->fetchrow;
1436     $frameworkcode = "" unless ( $total > 0 );
1437     $sth =
1438       $dbh->prepare(
1439 "select tagfield,liblibrarian,libopac,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield"
1440       );
1441     $sth->execute($frameworkcode);
1442     my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
1443
1444     while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) =
1445         $sth->fetchrow )
1446     {
1447         $res->{$tag}->{lib} =
1448           ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1449           # why the hell do we need to explicitly decode utf8 ? 
1450           # that's a good question, but we must do it...
1451           use utf8;
1452           utf8::decode($res->{$tag}->{lib});
1453 #           warn "$liblibrarian";
1454         $res->{$tab}->{tab}        = "";            # XXX
1455         $res->{$tag}->{mandatory}  = $mandatory;
1456         $res->{$tag}->{repeatable} = $repeatable;
1457     }
1458
1459     $sth =
1460       $dbh->prepare(
1461 "select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue from marc_subfield_structure where frameworkcode=? order by tagfield,tagsubfield"
1462       );
1463     $sth->execute($frameworkcode);
1464
1465     my $subfield;
1466     my $authorised_value;
1467     my $authtypecode;
1468     my $value_builder;
1469     my $kohafield;
1470     my $seealso;
1471     my $hidden;
1472     my $isurl;
1473     my $link;
1474     my $defaultvalue;
1475
1476     while (
1477         (
1478             $tag,          $subfield,      $liblibrarian,
1479             ,              $libopac,       $tab,
1480             $mandatory,    $repeatable,    $authorised_value,
1481             $authtypecode, $value_builder, $kohafield,
1482             $seealso,      $hidden,        $isurl,
1483             $link,$defaultvalue
1484         )
1485         = $sth->fetchrow
1486       )
1487     {
1488         $res->{$tag}->{$subfield}->{lib} =
1489           ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1490         $res->{$tag}->{$subfield}->{tab}              = $tab;
1491         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
1492         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
1493         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
1494         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
1495         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
1496         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
1497         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
1498         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
1499         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
1500         $res->{$tag}->{$subfield}->{link}             = $link;
1501         $res->{$tag}->{$subfield}->{defaultvalue}     = $defaultvalue;
1502     }
1503     return $res;
1504 }
1505
1506 =head2 GetMarcFromKohaField
1507
1508 =over 4
1509
1510 ($MARCfield,$MARCsubfield)=GetMarcFromKohaField($kohafield,$frameworkcode);
1511 Returns the MARC fields & subfields mapped to the koha field 
1512 for the given frameworkcode
1513
1514 =back
1515
1516 =cut
1517
1518 sub GetMarcFromKohaField {
1519     my ( $kohafield, $frameworkcode ) = @_;
1520     return 0, 0 unless $kohafield;
1521     my $relations = C4::Context->marcfromkohafield;
1522     return (
1523         $relations->{$frameworkcode}->{$kohafield}->[0],
1524         $relations->{$frameworkcode}->{$kohafield}->[1]
1525     );
1526 }
1527
1528 =head2 GetMarcBiblio
1529
1530 =over 4
1531
1532 Returns MARC::Record of the biblionumber passed in parameter.
1533 the marc record contains both biblio & item datas
1534
1535 =back
1536
1537 =cut
1538
1539 sub GetMarcBiblio {
1540     my $biblionumber = shift;
1541     my $dbh          = C4::Context->dbh;
1542     my $sth          =
1543       $dbh->prepare("select marcxml from biblioitems where biblionumber=? ");
1544     $sth->execute($biblionumber);
1545     my ($marcxml) = $sth->fetchrow;
1546     MARC::File::XML->default_record_format(C4::Context->preference('marcflavour'));
1547     $marcxml =~ s/\x1e//g;
1548     $marcxml =~ s/\x1f//g;
1549     $marcxml =~ s/\x1d//g;
1550     $marcxml =~ s/\x0f//g;
1551     $marcxml =~ s/\x0c//g;
1552     my $record = MARC::Record->new();
1553     $record = MARC::Record::new_from_xml( $marcxml, "utf8",C4::Context->preference('marcflavour')) if $marcxml;
1554     return $record;
1555 }
1556
1557 =head2 GetXmlBiblio
1558
1559 =over 4
1560
1561 my $marcxml = GetXmlBiblio($biblionumber);
1562
1563 Returns biblioitems.marcxml of the biblionumber passed in parameter.
1564 The XML contains both biblio & item datas
1565
1566 =back
1567
1568 =cut
1569
1570 sub GetXmlBiblio {
1571     my ( $biblionumber ) = @_;
1572     my $dbh = C4::Context->dbh;
1573     my $sth =
1574       $dbh->prepare("select marcxml from biblioitems where biblionumber=? ");
1575     $sth->execute($biblionumber);
1576     my ($marcxml) = $sth->fetchrow;
1577     return $marcxml;
1578 }
1579
1580 =head2 GetAuthorisedValueDesc
1581
1582 =over 4
1583
1584 my $subfieldvalue =get_authorised_value_desc(
1585     $tag, $subf[$i][0],$subf[$i][1], '', $taglib);
1586 Retrieve the complete description for a given authorised value.
1587
1588 =back
1589
1590 =cut
1591
1592 sub GetAuthorisedValueDesc {
1593     my ( $tag, $subfield, $value, $framework, $tagslib ) = @_;
1594     my $dbh = C4::Context->dbh;
1595     
1596     #---- branch
1597     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1598         return C4::Branch::GetBranchName($value);
1599     }
1600
1601     #---- itemtypes
1602     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1603         return getitemtypeinfo($value);
1604     }
1605
1606     #---- "true" authorized value
1607     my $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1608
1609     if ( $category ne "" ) {
1610         my $sth =
1611           $dbh->prepare(
1612             "select lib from authorised_values where category = ? and authorised_value = ?"
1613           );
1614         $sth->execute( $category, $value );
1615         my $data = $sth->fetchrow_hashref;
1616         return $data->{'lib'};
1617     }
1618     else {
1619         return $value;    # if nothing is found return the original value
1620     }
1621 }
1622
1623 =head2 GetMarcItem
1624
1625 =over 4
1626
1627 Returns MARC::Record of the item passed in parameter.
1628
1629 =back
1630
1631 =cut
1632
1633 sub GetMarcItem {
1634     my ( $biblionumber, $itemnumber ) = @_;
1635     my $dbh = C4::Context->dbh;
1636     my $newrecord = MARC::Record->new();
1637     my $marcflavour = C4::Context->preference('marcflavour');
1638     
1639     my $marcxml = GetXmlBiblio($biblionumber);
1640     my $record = MARC::Record->new();
1641     $record = MARC::Record::new_from_xml( $marcxml, "utf8", $marcflavour );
1642     # now, find where the itemnumber is stored & extract only the item
1643     my ( $itemnumberfield, $itemnumbersubfield ) =
1644       GetMarcFromKohaField( 'items.itemnumber', '' );
1645     my @fields = $record->field($itemnumberfield);
1646     foreach my $field (@fields) {
1647         if ( $field->subfield($itemnumbersubfield) eq $itemnumber ) {
1648             $newrecord->insert_fields_ordered($field);
1649         }
1650     }
1651     return $newrecord;
1652 }
1653
1654
1655
1656 =head2 GetMarcNotes
1657
1658 =over 4
1659
1660 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1661 Get all notes from the MARC record and returns them in an array.
1662 The note are stored in differents places depending on MARC flavour
1663
1664 =back
1665
1666 =cut
1667
1668 sub GetMarcNotes {
1669     my ( $record, $marcflavour ) = @_;
1670     my $scope;
1671     if ( $marcflavour eq "MARC21" ) {
1672         $scope = '5..';
1673     }
1674     else {    # assume unimarc if not marc21
1675         $scope = '3..';
1676     }
1677     my @marcnotes;
1678     my $note = "";
1679     my $tag  = "";
1680     my $marcnote;
1681     foreach my $field ( $record->field($scope) ) {
1682         my $value = $field->as_string();
1683         if ( $note ne "" ) {
1684             $marcnote = { marcnote => $note, };
1685             push @marcnotes, $marcnote;
1686             $note = $value;
1687         }
1688         if ( $note ne $value ) {
1689             $note = $note . " " . $value;
1690         }
1691     }
1692
1693     if ( $note ) {
1694         $marcnote = { marcnote => $note };
1695         push @marcnotes, $marcnote;    #load last tag into array
1696     }
1697     return \@marcnotes;
1698 }    # end GetMarcNotes
1699
1700 =head2 GetMarcSubjects
1701
1702 =over 4
1703
1704 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1705 Get all subjects from the MARC record and returns them in an array.
1706 The subjects are stored in differents places depending on MARC flavour
1707
1708 =back
1709
1710 =cut
1711
1712 sub GetMarcSubjects {
1713     my ( $record, $marcflavour ) = @_;
1714     my ( $mintag, $maxtag );
1715     if ( $marcflavour eq "MARC21" ) {
1716         $mintag = "600";
1717         $maxtag = "699";
1718     }
1719     else {    # assume unimarc if not marc21
1720         $mintag = "600";
1721         $maxtag = "611";
1722     }
1723
1724     my @marcsubjcts;
1725
1726     foreach my $field ( $record->fields ) {
1727         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1728         my @subfields = $field->subfields();
1729         my $link;
1730         my $label = "su:";
1731         my $flag = 0;
1732         for my $subject_subfield ( @subfields ) {
1733             my $code = $subject_subfield->[0];
1734             $label .= $subject_subfield->[1] . " and su-to:" unless ( $code == 9 );
1735             if ( $code == 9 ) {
1736                 $link = "Koha-Auth-Number:".$subject_subfield->[1];
1737                 $flag = 1;
1738             }
1739             elsif ( ! $flag ) {
1740                 $link = $label;
1741                 $link =~ s/ and\ssu-to:$//;
1742             }
1743         }
1744         $label =~ s/su/ /g;
1745         $label =~ s/://g;
1746         $label =~ s/-to//g;
1747         $label =~ s/and//g;
1748         push @marcsubjcts,
1749           {
1750             label => $label,
1751             link  => $link
1752           }
1753     }
1754     return \@marcsubjcts;
1755 }    #end GetMarcSubjects
1756
1757 =head2 GetMarcAuthors
1758
1759 =over 4
1760
1761 authors = GetMarcAuthors($record,$marcflavour);
1762 Get all authors from the MARC record and returns them in an array.
1763 The authors are stored in differents places depending on MARC flavour
1764
1765 =back
1766
1767 =cut
1768
1769 sub GetMarcAuthors {
1770     my ( $record, $marcflavour ) = @_;
1771     my ( $mintag, $maxtag );
1772     if ( $marcflavour eq "MARC21" ) {
1773         $mintag = "100";
1774         $maxtag = "111"; 
1775     }
1776     else {    # assume unimarc if not marc21
1777         $mintag = "701";
1778         $maxtag = "712";
1779     }
1780
1781     my @marcauthors;
1782
1783     foreach my $field ( $record->fields ) {
1784         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1785         my %hash;
1786         my @subfields = $field->subfields();
1787         my $count_auth = 0;
1788         my $and ;
1789         for my $authors_subfield (@subfields) {
1790                 if ($count_auth ne '0'){
1791                 $and = " and au:";
1792                 }
1793             $count_auth++;
1794             my $subfieldcode     = $authors_subfield->[0];
1795             my $value            = $authors_subfield->[1];
1796             $hash{'tag'}         = $field->tag;
1797             $hash{value}        .= $value . " " if ($subfieldcode != 9) ;
1798             $hash{link}        .= $value if ($subfieldcode eq 9);
1799         }
1800         push @marcauthors, \%hash;
1801     }
1802     return \@marcauthors;
1803 }
1804
1805 =head2 GetMarcSeries
1806
1807 =over 4
1808
1809 $marcseriessarray = GetMarcSeries($record,$marcflavour);
1810 Get all series from the MARC record and returns them in an array.
1811 The series are stored in differents places depending on MARC flavour
1812
1813 =back
1814
1815 =cut
1816
1817 sub GetMarcSeries {
1818     my ($record, $marcflavour) = @_;
1819     my ($mintag, $maxtag);
1820     if ($marcflavour eq "MARC21") {
1821         $mintag = "440";
1822         $maxtag = "490";
1823     } else {           # assume unimarc if not marc21
1824         $mintag = "600";
1825         $maxtag = "619";
1826     }
1827
1828     my @marcseries;
1829     my $subjct = "";
1830     my $subfield = "";
1831     my $marcsubjct;
1832
1833     foreach my $field ($record->field('440'), $record->field('490')) {
1834         my @subfields_loop;
1835         #my $value = $field->subfield('a');
1836         #$marcsubjct = {MARCSUBJCT => $value,};
1837         my @subfields = $field->subfields();
1838         #warn "subfields:".join " ", @$subfields;
1839         my $counter = 0;
1840         my @link_loop;
1841         for my $series_subfield (@subfields) {
1842                         my $volume_number;
1843                         undef $volume_number;
1844                         # see if this is an instance of a volume
1845                         if ($series_subfield->[0] eq 'v') {
1846                                 $volume_number=1;
1847                         }
1848
1849             my $code = $series_subfield->[0];
1850             my $value = $series_subfield->[1];
1851             my $linkvalue = $value;
1852             $linkvalue =~ s/(\(|\))//g;
1853             my $operator = " and " unless $counter==0;
1854             push @link_loop, {link => $linkvalue, operator => $operator };
1855             my $separator = C4::Context->preference("authoritysep") unless $counter==0;
1856                         if ($volume_number) {
1857                         push @subfields_loop, {volumenum => $value};
1858                         }
1859                         else {
1860             push @subfields_loop, {code => $code, value => $value, link_loop => \@link_loop, separator => $separator, volumenum => $volume_number};
1861                         }
1862             $counter++;
1863         }
1864         push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1865         #$marcsubjct = {MARCSUBJCT => $field->as_string(),};
1866         #push @marcsubjcts, $marcsubjct;
1867         #$subjct = $value;
1868
1869     }
1870     my $marcseriessarray=\@marcseries;
1871     return $marcseriessarray;
1872 }  #end getMARCseriess
1873
1874 =head2 GetFrameworkCode
1875
1876 =over 4
1877
1878 $frameworkcode = GetFrameworkCode( $biblionumber )
1879
1880 =back
1881
1882 =cut
1883
1884 sub GetFrameworkCode {
1885     my ( $biblionumber ) = @_;
1886     my $dbh = C4::Context->dbh;
1887     my $sth =
1888       $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
1889     $sth->execute($biblionumber);
1890     my ($frameworkcode) = $sth->fetchrow;
1891     return $frameworkcode;
1892 }
1893
1894 =head2 TransformKohaToMarc
1895
1896 =over 4
1897
1898 $record = TransformKohaToMarc( $hash )
1899 This function builds partial MARC::Record from a hash
1900 Hash entries can be from biblio or biblioitems.
1901 This function is called in acquisition module, to create a basic catalogue entry from user entry
1902
1903 =back
1904
1905 =cut
1906
1907 sub TransformKohaToMarc {
1908
1909     my ( $hash ) = @_;
1910     my $dbh = C4::Context->dbh;
1911     my $sth =
1912     $dbh->prepare(
1913         "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
1914     );
1915     my $record = MARC::Record->new();
1916     foreach (keys %{$hash}) {
1917         &TransformKohaToMarcOneField( $sth, $record, $_,
1918             $hash->{$_}, '' );
1919         }
1920     return $record;
1921 }
1922
1923 =head2 TransformKohaToMarcOneField
1924
1925 =over 4
1926
1927 $record = TransformKohaToMarcOneField( $sth, $record, $kohafieldname, $value, $frameworkcode );
1928
1929 =back
1930
1931 =cut
1932
1933 sub TransformKohaToMarcOneField {
1934     my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_;
1935     $frameworkcode='' unless $frameworkcode;
1936     my $tagfield;
1937     my $tagsubfield;
1938
1939     if ( !defined $sth ) {
1940         my $dbh = C4::Context->dbh;
1941         $sth =
1942           $dbh->prepare(
1943 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
1944           );
1945     }
1946     $sth->execute( $frameworkcode, $kohafieldname );
1947     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
1948         my $tag = $record->field($tagfield);
1949         if ($tag) {
1950             $tag->update( $tagsubfield => $value );
1951             $record->delete_field($tag);
1952             $record->insert_fields_ordered($tag);
1953         }
1954         else {
1955             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
1956         }
1957     }
1958     return $record;
1959 }
1960
1961 =head2 TransformHtmlToXml
1962
1963 =over 4
1964
1965 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator, $ind_tag )
1966
1967 =back
1968
1969 =cut
1970
1971 sub TransformHtmlToXml {
1972     my ( $tags, $subfields, $values, $indicator, $ind_tag ) = @_;
1973     my $xml = MARC::File::XML::header('UTF-8');
1974     if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1975         MARC::File::XML->default_record_format('UNIMARC');
1976         use POSIX qw(strftime);
1977         my $string = strftime( "%Y%m%d", localtime(time) );
1978         $string = sprintf( "%-*s", 35, $string );
1979         substr( $string, 22, 6, "frey50" );
1980         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
1981         $xml .= "<subfield code=\"a\">$string</subfield>\n";
1982         $xml .= "</datafield>\n";
1983     }
1984     my $prevvalue;
1985     my $prevtag = -1;
1986     my $first   = 1;
1987     my $j       = -1;
1988     for ( my $i = 0 ; $i <= @$tags ; $i++ ) {
1989         @$values[$i] =~ s/&/&amp;/g;
1990         @$values[$i] =~ s/</&lt;/g;
1991         @$values[$i] =~ s/>/&gt;/g;
1992         @$values[$i] =~ s/"/&quot;/g;
1993         @$values[$i] =~ s/'/&apos;/g;
1994         if ( !utf8::is_utf8( @$values[$i] ) ) {
1995             utf8::decode( @$values[$i] );
1996         }
1997         if ( ( @$tags[$i] ne $prevtag ) ) {
1998             $j++ unless ( @$tags[$i] eq "" );
1999             if ( !$first ) {
2000                 $xml .= "</datafield>\n";
2001                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
2002                     && ( @$values[$i] ne "" ) )
2003                 {
2004                     my $ind1 = substr( @$indicator[$j], 0, 1 );
2005                     my $ind2;
2006                     if ( @$indicator[$j] ) {
2007                         $ind2 = substr( @$indicator[$j], 1, 1 );
2008                     }
2009                     else {
2010                         warn "Indicator in @$tags[$i] is empty";
2011                         $ind2 = " ";
2012                     }
2013                     $xml .=
2014 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2015                     $xml .=
2016 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2017                     $first = 0;
2018                 }
2019                 else {
2020                     $first = 1;
2021                 }
2022             }
2023             else {
2024                 if ( @$values[$i] ne "" ) {
2025
2026                     # leader
2027                     if ( @$tags[$i] eq "000" ) {
2028                         $xml .= "<leader>@$values[$i]</leader>\n";
2029                         $first = 1;
2030
2031                         # rest of the fixed fields
2032                     }
2033                     elsif ( @$tags[$i] < 10 ) {
2034                         $xml .=
2035 "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2036                         $first = 1;
2037                     }
2038                     else {
2039                         my $ind1 = substr( @$indicator[$j], 0, 1 );
2040                         my $ind2 = substr( @$indicator[$j], 1, 1 );
2041                         $xml .=
2042 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2043                         $xml .=
2044 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2045                         $first = 0;
2046                     }
2047                 }
2048             }
2049         }
2050         else {    # @$tags[$i] eq $prevtag
2051             if ( @$values[$i] eq "" ) {
2052             }
2053             else {
2054                 if ($first) {
2055                     my $ind1 = substr( @$indicator[$j], 0, 1 );
2056                     my $ind2 = substr( @$indicator[$j], 1, 1 );
2057                     $xml .=
2058 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2059                     $first = 0;
2060                 }
2061                 $xml .=
2062 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2063             }
2064         }
2065         $prevtag = @$tags[$i];
2066     }
2067     $xml .= MARC::File::XML::footer();
2068
2069     return $xml;
2070 }
2071
2072 =head2 TransformHtmlToMarc
2073
2074 =over 4
2075
2076 $record = TransformHtmlToMarc( $dbh, $rtags, $rsubfields, $rvalues, %indicators )
2077
2078 =back
2079
2080 =cut
2081
2082 sub TransformHtmlToMarc {
2083     my ( $dbh, $rtags, $rsubfields, $rvalues, %indicators ) = @_;
2084     my $prevtag = -1;
2085     my $record  = MARC::Record->new();
2086
2087     #     my %subfieldlist=();
2088     my $prevvalue;    # if tag <10
2089     my $field;        # if tag >=10
2090     for ( my $i = 0 ; $i < @$rtags ; $i++ ) {
2091         next unless @$rvalues[$i];
2092
2093  # rebuild MARC::Record
2094  #             warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
2095         if ( @$rtags[$i] ne $prevtag ) {
2096             if ( $prevtag < 10 ) {
2097                 if ($prevvalue) {
2098
2099                     if ( $prevtag ne '000' ) {
2100                         $record->insert_fields_ordered(
2101                             ( sprintf "%03s", $prevtag ), $prevvalue );
2102                     }
2103                     else {
2104
2105                         $record->leader($prevvalue);
2106
2107                     }
2108                 }
2109             }
2110             else {
2111                 if ($field) {
2112                     $record->insert_fields_ordered($field);
2113                 }
2114             }
2115             $indicators{ @$rtags[$i] } .= '  ';
2116             if ( @$rtags[$i] < 10 ) {
2117                 $prevvalue = @$rvalues[$i];
2118                 undef $field;
2119             }
2120             else {
2121                 undef $prevvalue;
2122                 $field = MARC::Field->new(
2123                     ( sprintf "%03s", @$rtags[$i] ),
2124                     substr( $indicators{ @$rtags[$i] }, 0, 1 ),
2125                     substr( $indicators{ @$rtags[$i] }, 1, 1 ),
2126                     @$rsubfields[$i] => @$rvalues[$i]
2127                 );
2128             }
2129             $prevtag = @$rtags[$i];
2130         }
2131         else {
2132             if ( @$rtags[$i] < 10 ) {
2133                 $prevvalue = @$rvalues[$i];
2134             }
2135             else {
2136                 if ( length( @$rvalues[$i] ) > 0 ) {
2137                     $field->add_subfields( @$rsubfields[$i] => @$rvalues[$i] );
2138                 }
2139             }
2140             $prevtag = @$rtags[$i];
2141         }
2142     }
2143
2144     # the last has not been included inside the loop... do it now !
2145     $record->insert_fields_ordered($field) if $field;
2146
2147     $record->encoding('UTF-8');
2148
2149     #    $record->MARC::File::USMARC::update_leader();
2150     return $record;
2151 }
2152
2153 =head2 TransformMarcToKoha
2154
2155 =over 4
2156
2157 $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
2158
2159 =back
2160
2161 =cut
2162
2163 sub TransformMarcToKoha {
2164     my ( $dbh, $record, $frameworkcode ) = @_;
2165     my $sth =
2166       $dbh->prepare(
2167 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
2168       );
2169     my $result;
2170     my $sth2 = $dbh->prepare("SHOW COLUMNS from biblio");
2171     $sth2->execute;
2172     my $field;
2173     while ( ($field) = $sth2->fetchrow ) {
2174         $result =
2175           &TransformMarcToKohaOneField( "biblio", $field, $record, $result,
2176             $frameworkcode );
2177     }
2178     $sth2 = $dbh->prepare("SHOW COLUMNS from biblioitems");
2179     $sth2->execute;
2180     while ( ($field) = $sth2->fetchrow ) {
2181         if ( $field eq 'notes' ) { $field = 'bnotes'; }
2182         $result =
2183           &TransformMarcToKohaOneField( "biblioitems", $field, $record, $result,
2184             $frameworkcode );
2185     }
2186     $sth2 = $dbh->prepare("SHOW COLUMNS from items");
2187     $sth2->execute;
2188     while ( ($field) = $sth2->fetchrow ) {
2189         $result =
2190           &TransformMarcToKohaOneField( "items", $field, $record, $result,
2191             $frameworkcode );
2192     }
2193
2194     #
2195     # modify copyrightdate to keep only the 1st year found
2196     my $temp = $result->{'copyrightdate'};
2197     $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2198     if ( $1 > 0 ) {
2199         $result->{'copyrightdate'} = $1;
2200     }
2201     else {                      # if no cYYYY, get the 1st date.
2202         $temp =~ m/(\d\d\d\d)/;
2203         $result->{'copyrightdate'} = $1;
2204     }
2205
2206     # modify publicationyear to keep only the 1st year found
2207     $temp = $result->{'publicationyear'};
2208     $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2209     if ( $1 > 0 ) {
2210         $result->{'publicationyear'} = $1;
2211     }
2212     else {                      # if no cYYYY, get the 1st date.
2213         $temp =~ m/(\d\d\d\d)/;
2214         $result->{'publicationyear'} = $1;
2215     }
2216     return $result;
2217 }
2218
2219 =head2 TransformMarcToKohaOneField
2220
2221 =over 4
2222
2223 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2224
2225 =back
2226
2227 =cut
2228
2229 sub TransformMarcToKohaOneField {
2230
2231 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
2232     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2233
2234     my $res = "";
2235     my ( $tagfield, $subfield ) =
2236       GetMarcFromKohaField( $kohatable . "." . $kohafield,
2237         $frameworkcode );
2238     foreach my $field ( $record->field($tagfield) ) {
2239         if ( $field->tag() < 10 ) {
2240             if ( $result->{$kohafield} ) {
2241                 $result->{$kohafield} .= " | " . $field->data();
2242             }
2243             else {
2244                 $result->{$kohafield} = $field->data();
2245             }
2246         }
2247         else {
2248             if ( $field->subfields ) {
2249                 my @subfields = $field->subfields();
2250                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2251                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2252                         if ( $result->{$kohafield} ) {
2253                             $result->{$kohafield} .=
2254                               " | " . $subfields[$subfieldcount][1];
2255                         }
2256                         else {
2257                             $result->{$kohafield} =
2258                               $subfields[$subfieldcount][1];
2259                         }
2260                     }
2261                 }
2262             }
2263         }
2264     }
2265     return $result;
2266 }
2267 =head1  OTHER FUNCTIONS
2268
2269 =head2 char_decode
2270
2271 =over 4
2272
2273 my $string = char_decode( $string, $encoding );
2274
2275 converts ISO 5426 coded string to UTF-8
2276 sloppy code : should be improved in next issue
2277
2278 =back
2279
2280 =cut
2281
2282 sub char_decode {
2283     my ( $string, $encoding ) = @_;
2284     $_ = $string;
2285
2286     $encoding = C4::Context->preference("marcflavour") unless $encoding;
2287     if ( $encoding eq "UNIMARC" ) {
2288
2289         #         s/\xe1/Æ/gm;
2290         s/\xe2/Ğ/gm;
2291         s/\xe9/Ø/gm;
2292         s/\xec/ş/gm;
2293         s/\xf1/æ/gm;
2294         s/\xf3/ğ/gm;
2295         s/\xf9/ø/gm;
2296         s/\xfb/ß/gm;
2297         s/\xc1\x61/à/gm;
2298         s/\xc1\x65/è/gm;
2299         s/\xc1\x69/ì/gm;
2300         s/\xc1\x6f/ò/gm;
2301         s/\xc1\x75/ù/gm;
2302         s/\xc1\x41/À/gm;
2303         s/\xc1\x45/È/gm;
2304         s/\xc1\x49/Ì/gm;
2305         s/\xc1\x4f/Ò/gm;
2306         s/\xc1\x55/Ù/gm;
2307         s/\xc2\x41/Á/gm;
2308         s/\xc2\x45/É/gm;
2309         s/\xc2\x49/Í/gm;
2310         s/\xc2\x4f/Ó/gm;
2311         s/\xc2\x55/Ú/gm;
2312         s/\xc2\x59/İ/gm;
2313         s/\xc2\x61/á/gm;
2314         s/\xc2\x65/é/gm;
2315         s/\xc2\x69/í/gm;
2316         s/\xc2\x6f/ó/gm;
2317         s/\xc2\x75/ú/gm;
2318         s/\xc2\x79/ı/gm;
2319         s/\xc3\x41/Â/gm;
2320         s/\xc3\x45/Ê/gm;
2321         s/\xc3\x49/Î/gm;
2322         s/\xc3\x4f/Ô/gm;
2323         s/\xc3\x55/Û/gm;
2324         s/\xc3\x61/â/gm;
2325         s/\xc3\x65/ê/gm;
2326         s/\xc3\x69/î/gm;
2327         s/\xc3\x6f/ô/gm;
2328         s/\xc3\x75/û/gm;
2329         s/\xc4\x41/Ã/gm;
2330         s/\xc4\x4e/Ñ/gm;
2331         s/\xc4\x4f/Õ/gm;
2332         s/\xc4\x61/ã/gm;
2333         s/\xc4\x6e/ñ/gm;
2334         s/\xc4\x6f/õ/gm;
2335         s/\xc8\x41/Ä/gm;
2336         s/\xc8\x45/Ë/gm;
2337         s/\xc8\x49/Ï/gm;
2338         s/\xc8\x61/ä/gm;
2339         s/\xc8\x65/ë/gm;
2340         s/\xc8\x69/ï/gm;
2341         s/\xc8\x6F/ö/gm;
2342         s/\xc8\x75/ü/gm;
2343         s/\xc8\x76/ÿ/gm;
2344         s/\xc9\x41/Ä/gm;
2345         s/\xc9\x45/Ë/gm;
2346         s/\xc9\x49/Ï/gm;
2347         s/\xc9\x4f/Ö/gm;
2348         s/\xc9\x55/Ü/gm;
2349         s/\xc9\x61/ä/gm;
2350         s/\xc9\x6f/ö/gm;
2351         s/\xc9\x75/ü/gm;
2352         s/\xca\x41/Å/gm;
2353         s/\xca\x61/å/gm;
2354         s/\xd0\x43/Ç/gm;
2355         s/\xd0\x63/ç/gm;
2356
2357         # this handles non-sorting blocks (if implementation requires this)
2358         $string = nsb_clean($_);
2359     }
2360     elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2361         ##MARC-8 to UTF-8
2362
2363         s/\xe1\x61/à/gm;
2364         s/\xe1\x65/è/gm;
2365         s/\xe1\x69/ì/gm;
2366         s/\xe1\x6f/ò/gm;
2367         s/\xe1\x75/ù/gm;
2368         s/\xe1\x41/À/gm;
2369         s/\xe1\x45/È/gm;
2370         s/\xe1\x49/Ì/gm;
2371         s/\xe1\x4f/Ò/gm;
2372         s/\xe1\x55/Ù/gm;
2373         s/\xe2\x41/Á/gm;
2374         s/\xe2\x45/É/gm;
2375         s/\xe2\x49/Í/gm;
2376         s/\xe2\x4f/Ó/gm;
2377         s/\xe2\x55/Ú/gm;
2378         s/\xe2\x59/İ/gm;
2379         s/\xe2\x61/á/gm;
2380         s/\xe2\x65/é/gm;
2381         s/\xe2\x69/í/gm;
2382         s/\xe2\x6f/ó/gm;
2383         s/\xe2\x75/ú/gm;
2384         s/\xe2\x79/ı/gm;
2385         s/\xe3\x41/Â/gm;
2386         s/\xe3\x45/Ê/gm;
2387         s/\xe3\x49/Î/gm;
2388         s/\xe3\x4f/Ô/gm;
2389         s/\xe3\x55/Û/gm;
2390         s/\xe3\x61/â/gm;
2391         s/\xe3\x65/ê/gm;
2392         s/\xe3\x69/î/gm;
2393         s/\xe3\x6f/ô/gm;
2394         s/\xe3\x75/û/gm;
2395         s/\xe4\x41/Ã/gm;
2396         s/\xe4\x4e/Ñ/gm;
2397         s/\xe4\x4f/Õ/gm;
2398         s/\xe4\x61/ã/gm;
2399         s/\xe4\x6e/ñ/gm;
2400         s/\xe4\x6f/õ/gm;
2401         s/\xe6\x41/Ă/gm;
2402         s/\xe6\x45/Ĕ/gm;
2403         s/\xe6\x65/ĕ/gm;
2404         s/\xe6\x61/ă/gm;
2405         s/\xe8\x45/Ë/gm;
2406         s/\xe8\x49/Ï/gm;
2407         s/\xe8\x65/ë/gm;
2408         s/\xe8\x69/ï/gm;
2409         s/\xe8\x76/ÿ/gm;
2410         s/\xe9\x41/A/gm;
2411         s/\xe9\x4f/O/gm;
2412         s/\xe9\x55/U/gm;
2413         s/\xe9\x61/a/gm;
2414         s/\xe9\x6f/o/gm;
2415         s/\xe9\x75/u/gm;
2416         s/\xea\x41/A/gm;
2417         s/\xea\x61/a/gm;
2418
2419         #Additional Turkish characters
2420         s/\x1b//gm;
2421         s/\x1e//gm;
2422         s/(\xf0)s/\xc5\x9f/gm;
2423         s/(\xf0)S/\xc5\x9e/gm;
2424         s/(\xf0)c/ç/gm;
2425         s/(\xf0)C/Ç/gm;
2426         s/\xe7\x49/\\xc4\xb0/gm;
2427         s/(\xe6)G/\xc4\x9e/gm;
2428         s/(\xe6)g/ğ\xc4\x9f/gm;
2429         s/\xB8/ı/gm;
2430         s/\xB9/£/gm;
2431         s/(\xe8|\xc8)o/ö/gm;
2432         s/(\xe8|\xc8)O/Ö/gm;
2433         s/(\xe8|\xc8)u/ü/gm;
2434         s/(\xe8|\xc8)U/Ü/gm;
2435         s/\xc2\xb8/\xc4\xb1/gm;
2436         s/¸/\xc4\xb1/gm;
2437
2438         # this handles non-sorting blocks (if implementation requires this)
2439         $string = nsb_clean($_);
2440     }
2441     return ($string);
2442 }
2443
2444 =head2 nsb_clean
2445
2446 =over 4
2447
2448 my $string = nsb_clean( $string, $encoding );
2449
2450 =back
2451
2452 =cut
2453
2454 sub nsb_clean {
2455     my $NSB      = '\x88';    # NSB : begin Non Sorting Block
2456     my $NSE      = '\x89';    # NSE : Non Sorting Block end
2457                               # handles non sorting blocks
2458     my ($string) = @_;
2459     $_ = $string;
2460     s/$NSB/(/gm;
2461     s/[ ]{0,1}$NSE/) /gm;
2462     $string = $_;
2463     return ($string);
2464 }
2465
2466 =head2 PrepareItemrecordDisplay
2467
2468 =over 4
2469
2470 PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber);
2471
2472 Returns a hash with all the fields for Display a given item data in a template
2473
2474 =back
2475
2476 =cut
2477
2478 sub PrepareItemrecordDisplay {
2479
2480     my ( $bibnum, $itemnum ) = @_;
2481
2482     my $dbh = C4::Context->dbh;
2483     my $frameworkcode = &GetFrameworkCode( $bibnum );
2484     my ( $itemtagfield, $itemtagsubfield ) =
2485       &GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2486     my $tagslib = &GetMarcStructure( $dbh, 1, $frameworkcode );
2487     my $itemrecord = GetMarcItem( $bibnum, $itemnum) if ($itemnum);
2488     my @loop_data;
2489     my $authorised_values_sth =
2490       $dbh->prepare(
2491 "select authorised_value,lib from authorised_values where category=? order by lib"
2492       );
2493     foreach my $tag ( sort keys %{$tagslib} ) {
2494         my $previous_tag = '';
2495         if ( $tag ne '' ) {
2496             # loop through each subfield
2497             my $cntsubf;
2498             foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
2499                 next if ( subfield_is_koha_internal_p($subfield) );
2500                 next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
2501                 my %subfield_data;
2502                 $subfield_data{tag}           = $tag;
2503                 $subfield_data{subfield}      = $subfield;
2504                 $subfield_data{countsubfield} = $cntsubf++;
2505                 $subfield_data{kohafield}     =
2506                   $tagslib->{$tag}->{$subfield}->{'kohafield'};
2507
2508          #        $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
2509                 $subfield_data{marc_lib} =
2510                     "<span id=\"error\" title=\""
2511                   . $tagslib->{$tag}->{$subfield}->{lib} . "\">"
2512                   . substr( $tagslib->{$tag}->{$subfield}->{lib}, 0, 12 )
2513                   . "</span>";
2514                 $subfield_data{mandatory} =
2515                   $tagslib->{$tag}->{$subfield}->{mandatory};
2516                 $subfield_data{repeatable} =
2517                   $tagslib->{$tag}->{$subfield}->{repeatable};
2518                 $subfield_data{hidden} = "display:none"
2519                   if $tagslib->{$tag}->{$subfield}->{hidden};
2520                 my ( $x, $value );
2521                 ( $x, $value ) = _find_value( $tag, $subfield, $itemrecord )
2522                   if ($itemrecord);
2523                 $value =~ s/"/&quot;/g;
2524
2525                 # search for itemcallnumber if applicable
2526                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
2527                     'items.itemcallnumber'
2528                     && C4::Context->preference('itemcallnumber') )
2529                 {
2530                     my $CNtag =
2531                       substr( C4::Context->preference('itemcallnumber'), 0, 3 );
2532                     my $CNsubfield =
2533                       substr( C4::Context->preference('itemcallnumber'), 3, 1 );
2534                     my $temp = $itemrecord->field($CNtag) if ($itemrecord);
2535                     if ($temp) {
2536                         $value = $temp->subfield($CNsubfield);
2537                     }
2538                 }
2539                 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
2540                     my @authorised_values;
2541                     my %authorised_lib;
2542
2543                     # builds list, depending on authorised value...
2544                     #---- branch
2545                     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq
2546                         "branches" )
2547                     {
2548                         if ( ( C4::Context->preference("IndependantBranches") )
2549                             && ( C4::Context->userenv->{flags} != 1 ) )
2550                         {
2551                             my $sth =
2552                               $dbh->prepare(
2553 "select branchcode,branchname from branches where branchcode = ? order by branchname"
2554                               );
2555                             $sth->execute( C4::Context->userenv->{branch} );
2556                             push @authorised_values, ""
2557                               unless (
2558                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
2559                             while ( my ( $branchcode, $branchname ) =
2560                                 $sth->fetchrow_array )
2561                             {
2562                                 push @authorised_values, $branchcode;
2563                                 $authorised_lib{$branchcode} = $branchname;
2564                             }
2565                         }
2566                         else {
2567                             my $sth =
2568                               $dbh->prepare(
2569 "select branchcode,branchname from branches order by branchname"
2570                               );
2571                             $sth->execute;
2572                             push @authorised_values, ""
2573                               unless (
2574                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
2575                             while ( my ( $branchcode, $branchname ) =
2576                                 $sth->fetchrow_array )
2577                             {
2578                                 push @authorised_values, $branchcode;
2579                                 $authorised_lib{$branchcode} = $branchname;
2580                             }
2581                         }
2582
2583                         #----- itemtypes
2584                     }
2585                     elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq
2586                         "itemtypes" )
2587                     {
2588                         my $sth =
2589                           $dbh->prepare(
2590 "select itemtype,description from itemtypes order by description"
2591                           );
2592                         $sth->execute;
2593                         push @authorised_values, ""
2594                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2595                         while ( my ( $itemtype, $description ) =
2596                             $sth->fetchrow_array )
2597                         {
2598                             push @authorised_values, $itemtype;
2599                             $authorised_lib{$itemtype} = $description;
2600                         }
2601
2602                         #---- "true" authorised value
2603                     }
2604                     else {
2605                         $authorised_values_sth->execute(
2606                             $tagslib->{$tag}->{$subfield}->{authorised_value} );
2607                         push @authorised_values, ""
2608                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2609                         while ( my ( $value, $lib ) =
2610                             $authorised_values_sth->fetchrow_array )
2611                         {
2612                             push @authorised_values, $value;
2613                             $authorised_lib{$value} = $lib;
2614                         }
2615                     }
2616                     $subfield_data{marc_value} = CGI::scrolling_list(
2617                         -name     => 'field_value',
2618                         -values   => \@authorised_values,
2619                         -default  => "$value",
2620                         -labels   => \%authorised_lib,
2621                         -size     => 1,
2622                         -tabindex => '',
2623                         -multiple => 0,
2624                     );
2625                 }
2626                 elsif ( $tagslib->{$tag}->{$subfield}->{thesaurus_category} ) {
2627                     $subfield_data{marc_value} =
2628 "<input type=\"text\" name=\"field_value\"  size=47 maxlength=255> <a href=\"javascript:Dopop('cataloguing/thesaurus_popup.pl?category=$tagslib->{$tag}->{$subfield}->{thesaurus_category}&index=',)\">...</a>";
2629
2630 #"
2631 # COMMENTED OUT because No $i is provided with this API.
2632 # And thus, no value_builder can be activated.
2633 # BUT could be thought over.
2634 #         } elsif ($tagslib->{$tag}->{$subfield}->{'value_builder'}) {
2635 #             my $plugin="value_builder/".$tagslib->{$tag}->{$subfield}->{'value_builder'};
2636 #             require $plugin;
2637 #             my $extended_param = plugin_parameters($dbh,$itemrecord,$tagslib,$i,0);
2638 #             my ($function_name,$javascript) = plugin_javascript($dbh,$record,$tagslib,$i,0);
2639 #             $subfield_data{marc_value}="<input type=\"text\" value=\"$value\" name=\"field_value\"  size=47 maxlength=255 DISABLE READONLY OnFocus=\"javascript:Focus$function_name()\" OnBlur=\"javascript:Blur$function_name()\"> <a href=\"javascript:Clic$function_name()\">...</a> $javascript";
2640                 }
2641                 else {
2642                     $subfield_data{marc_value} =
2643 "<input type=\"text\" name=\"field_value\" value=\"$value\" size=50 maxlength=255>";
2644                 }
2645                 push( @loop_data, \%subfield_data );
2646             }
2647         }
2648     }
2649     my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
2650       if ( $itemrecord && $itemrecord->field($itemtagfield) );
2651     return {
2652         'itemtagfield'    => $itemtagfield,
2653         'itemtagsubfield' => $itemtagsubfield,
2654         'itemnumber'      => $itemnumber,
2655         'iteminformation' => \@loop_data
2656     };
2657 }
2658 #"
2659
2660 #
2661 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2662 # at the same time
2663 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2664 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2665 # =head2 ModZebrafiles
2666
2667 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2668
2669 # =cut
2670
2671 # sub ModZebrafiles {
2672
2673 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2674
2675 #     my $op;
2676 #     my $zebradir =
2677 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2678 #     unless ( opendir( DIR, "$zebradir" ) ) {
2679 #         warn "$zebradir not found";
2680 #         return;
2681 #     }
2682 #     closedir DIR;
2683 #     my $filename = $zebradir . $biblionumber;
2684
2685 #     if ($record) {
2686 #         open( OUTPUT, ">", $filename . ".xml" );
2687 #         print OUTPUT $record;
2688 #         close OUTPUT;
2689 #     }
2690 # }
2691
2692 =head2 ModZebra
2693
2694 =over 4
2695
2696 ModZebra( $dbh, $biblionumber, $op, $server );
2697
2698 =back
2699
2700 =cut
2701
2702 sub ModZebra {
2703 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2704     my ( $biblionumber, $op, $server ) = @_;
2705     my $dbh=C4::Context->dbh;
2706     #warn "SERVER:".$server;
2707 #
2708 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2709 # at the same time
2710 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2711 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2712
2713     if (C4::Context->preference("NoZebra")) {
2714         # lock the nozebra table : we will read index lines, update them in Perl process
2715         # and write everything in 1 transaction.
2716         # lock the table to avoid someone else overwriting what we are doing
2717         $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE');
2718         my %result; # the result hash that will be builded by deletion / add, and written on mySQL at the end, to improve speed
2719         my $record= GetMarcBiblio($biblionumber);
2720         if ($op eq 'specialUpdate') {
2721             # OK, we have to add or update the record
2722             # 1st delete (virtually, in indexes) ...
2723             %result = _DelBiblioNoZebra($biblionumber,$record);
2724             # ... add the record
2725             %result=_AddBiblioNoZebra($biblionumber,$record, %result);
2726         } else {
2727             # it's a deletion, delete the record...
2728             %result=_DelBiblioNoZebra($biblionumber,$record);
2729         }
2730         # ok, now update the database...
2731         my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE indexname=? AND value=?");
2732         foreach my $key (keys %result) {
2733             foreach my $index (keys %{$result{$key}}) {
2734                 $sth->execute($result{$key}->{$index},$key,$index);
2735             }
2736         }
2737     $dbh->do('UNLOCK TABLES');
2738
2739     } else {
2740     #
2741     # we use zebra, just fill zebraqueue table
2742     #
2743     my $sth=$dbh->prepare("insert into zebraqueue  (biblio_auth_number ,server,operation) values(?,?,?)");
2744     $sth->execute($biblionumber,$server,$op);
2745     $sth->finish;
2746     }
2747 }
2748
2749 =head2 GetNoZebraIndexes
2750
2751 =cut
2752
2753 sub GetNoZebraIndexes {
2754     my $index = C4::Context->preference('NoZebraIndexes');
2755     my %indexes;
2756     foreach my $line (split /('|"),/,$index) {
2757         $line =~ /(.*)=>(.*)/;
2758         my $index = substr($1,1); # get the index, don't forget to remove initial ' or "
2759         my $fields = $2;
2760         $index =~ s/'|"| //g;
2761         $fields =~ s/'|"| //g;
2762         $indexes{$index}=$fields;
2763     }
2764     return %indexes;
2765 }
2766
2767 =head1 INTERNAL FUNCTIONS
2768
2769 =head2 _DelBiblioNoZebra($biblionumber,$record);
2770
2771     function to delete a biblio in NoZebra indexes
2772     This function does NOT delete anything in database : it reads all the indexes entries
2773     that have to be deleted & delete them in the hash
2774     The SQL part is done either :
2775     - after the Add if we are modifying a biblio (delete + add again)
2776     - immediatly after this sub if we are doing a true deletion.
2777
2778 =cut
2779
2780
2781 sub _DelBiblioNoZebra {
2782     my ($biblionumber,$record)=@_;
2783     # Get the indexes
2784     my $dbh = C4::Context->dbh;
2785     # Get the indexes
2786     my %index=GetNoZebraIndexes;
2787     # get title of the record (to store the 10 first letters with the index)
2788     my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
2789     my $title = lc($record->subfield($titletag,$titlesubfield));
2790     
2791     my %result;
2792     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2793     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2794     # limit to 10 char, should be enough, and limit the DB size
2795     $title = substr($title,0,10);
2796     #parse each field
2797     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE indexname=? AND value=?');
2798     foreach my $field ($record->fields()) {
2799         #parse each subfield
2800         next if $field->tag <10;
2801         foreach my $subfield ($field->subfields()) {
2802             my $tag = $field->tag();
2803             my $subfieldcode = $subfield->[0];
2804             my $indexed=0;
2805             # check each index to see if the subfield is stored somewhere
2806             # otherwise, store it in __RAW__ index
2807             foreach my $key (keys %index) {
2808 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2809                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
2810                     $indexed=1;
2811                     my $line= lc $subfield->[1];
2812                     # remove meaningless value in the field...
2813                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=/ /g;
2814                     # ... and split in words
2815                     foreach (split / /,$line) {
2816                         next unless $_; # skip  empty values (multiple spaces)
2817                         # if the entry is already here, do nothing, the biblionumber has already be removed
2818                         unless ($result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) {
2819                             # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2820                             $sth2->execute($key,$_);
2821                             my $existing_biblionumbers = $sth2->fetchrow;
2822                             # it exists
2823                             if ($existing_biblionumbers) {
2824                                 warn " existing for $key $_: $existing_biblionumbers";
2825                                 $result{$key}->{$_} =$existing_biblionumbers;
2826                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2827                             }
2828                         }
2829                     }
2830                 }
2831             }
2832             # the subfield is not indexed, store it in __RAW__ index anyway
2833             unless ($indexed) {
2834                 my $line= lc $subfield->[1];
2835                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=/ /g;
2836                 # ... and split in words
2837                 foreach (split / /,$line) {
2838                     next unless $_; # skip  empty values (multiple spaces)
2839                     # if the entry is already here, do nothing, the biblionumber has already be removed
2840                     unless ($result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/) {
2841                         # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2842                         $sth2->execute('__RAW__',$_);
2843                         my $existing_biblionumbers = $sth2->fetchrow;
2844                         # it exists
2845                         if ($existing_biblionumbers) {
2846                             warn " existing for __RAW__ $_ : $existing_biblionumbers";
2847                             $result{'__RAW__'}->{$_} =$existing_biblionumbers;
2848                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2849                         }
2850                     }
2851                 }
2852             }
2853         }
2854     }
2855     return %result;
2856 }
2857
2858 =head2 _DelBiblioNoZebra($biblionumber,$record);
2859
2860     function to delete a biblio in NoZebra indexes
2861
2862 =cut
2863
2864
2865 sub _AddBiblioNoZebra {
2866     my ($biblionumber,$record,%result)=@_;
2867     my $dbh = C4::Context->dbh;
2868     # Get the indexes
2869     my %index=GetNoZebraIndexes;
2870     # get title of the record (to store the 10 first letters with the index)
2871     my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
2872     my $title = lc($record->subfield($titletag,$titlesubfield));
2873
2874     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2875     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2876     # limit to 10 char, should be enough, and limit the DB size
2877     $title = substr($title,0,10);
2878     #parse each field
2879     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE indexname=? AND value=?');
2880     foreach my $field ($record->fields()) {
2881         #parse each subfield
2882         next if $field->tag <10;
2883         foreach my $subfield ($field->subfields()) {
2884             my $tag = $field->tag();
2885             my $subfieldcode = $subfield->[0];
2886             my $indexed=0;
2887             # check each index to see if the subfield is stored somewhere
2888             # otherwise, store it in __RAW__ index
2889             foreach my $key (keys %index) {
2890 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2891                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
2892                     $indexed=1;
2893                     my $line= lc $subfield->[1];
2894                     # remove meaningless value in the field...
2895                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=/ /g;
2896                     # ... and split in words
2897                     foreach (split / /,$line) {
2898                         next unless $_; # skip  empty values (multiple spaces)
2899                         # if the entry is already here, improve weight
2900 #                         warn "managing $_";
2901                         if ($result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) {
2902                             my $weight=$1+1;
2903                             $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2904                             $result{$key}->{$_} .= "$biblionumber,$title-$weight;";
2905                         } else {
2906                             # get the value if it exist in the nozebra table, otherwise, create it
2907                             $sth2->execute($key,$_);
2908                             my $existing_biblionumbers = $sth2->fetchrow;
2909                             # it exists
2910                             if ($existing_biblionumbers) {
2911                                 warn" existing : $existing_biblionumbers";
2912                                 $result{$key}->{$_} =$existing_biblionumbers;
2913                                 my $weight=$1+1;
2914                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2915                                 $result{$key}->{$_} .= "$biblionumber,$title-$weight;";
2916                             # create a new ligne for this entry
2917                             } else {
2918                                 $dbh->do('INSERT INTO nozebra SET indexname='.$dbh->quote($key).',value='.$dbh->quote($_));
2919                                 $result{$key}->{$_}.="$biblionumber,$title-1;";
2920                             }
2921                         }
2922                     }
2923                 }
2924             }
2925             # the subfield is not indexed, store it in __RAW__ index anyway
2926             unless ($indexed) {
2927                 my $line= lc $subfield->[1];
2928                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=/ /g;
2929                 # ... and split in words
2930                 foreach (split / /,$line) {
2931                     next unless $_; # skip  empty values (multiple spaces)
2932                     # if the entry is already here, improve weight
2933                     if ($result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/) {
2934                         my $weight=$1+1;
2935                         $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2936                         $result{'__RAW__'}->{$_} .= "$biblionumber,$title-$weight;";
2937                     } else {
2938                         # get the value if it exist in the nozebra table, otherwise, create it
2939                         $sth2->execute('__RAW__',$_);
2940                         my $existing_biblionumbers = $sth2->fetchrow;
2941                         # it exists
2942                         if ($existing_biblionumbers) {
2943                             $result{'__RAW__'}->{$_} =$existing_biblionumbers;
2944                             my $weight=$1+1;
2945                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2946                             $result{'__RAW__'}->{$_} .= "$biblionumber,$title-$weight;";
2947                         # create a new ligne for this entry
2948                         } else {
2949                             $dbh->do('INSERT INTO nozebra SET indexname="__RAW__",value='.$dbh->quote($_));
2950                             $result{'__RAW__'}->{$_}.="$biblionumber,$title-1;";
2951                         }
2952                     }
2953                 }
2954             }
2955         }
2956     }
2957     return %result;
2958 }
2959
2960
2961 =head2 MARCitemchange
2962
2963 =over 4
2964
2965 &MARCitemchange( $record, $itemfield, $newvalue )
2966
2967 Function to update a single value in an item field.
2968 Used twice, could probably be replaced by something else, but works well...
2969
2970 =back
2971
2972 =back
2973
2974 =cut
2975
2976 sub MARCitemchange {
2977     my ( $record, $itemfield, $newvalue ) = @_;
2978     my $dbh = C4::Context->dbh;
2979     
2980     my ( $tagfield, $tagsubfield ) =
2981       GetMarcFromKohaField( $itemfield, "" );
2982     if ( ($tagfield) && ($tagsubfield) ) {
2983         my $tag = $record->field($tagfield);
2984         if ($tag) {
2985             $tag->update( $tagsubfield => $newvalue );
2986             $record->delete_field($tag);
2987             $record->insert_fields_ordered($tag);
2988         }
2989     }
2990 }
2991
2992 =head2 _koha_add_biblio
2993
2994 =over 4
2995
2996 _koha_add_biblio($dbh,$biblioitem);
2997
2998 Internal function to add a biblio ($biblio is a hash with the values)
2999
3000 =back
3001
3002 =cut
3003
3004 sub _koha_add_biblio {
3005     my ( $dbh, $biblio, $frameworkcode ) = @_;
3006     my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
3007     $sth->execute;
3008     my $data         = $sth->fetchrow_arrayref;
3009     my $biblionumber = $$data[0] + 1;
3010     my $series       = 0;
3011
3012     if ( $biblio->{'seriestitle'} ) { $series = 1 }
3013     $sth->finish;
3014     $sth = $dbh->prepare(
3015         "INSERT INTO biblio
3016     SET biblionumber  = ?, title = ?, author = ?, copyrightdate = ?, serial = ?, seriestitle = ?, notes = ?, abstract = ?, unititle = ?, frameworkcode = ? "
3017     );
3018     $sth->execute(
3019         $biblionumber,         $biblio->{'title'},
3020         $biblio->{'author'},   $biblio->{'copyrightdate'},
3021         $biblio->{'serial'},   $biblio->{'seriestitle'},
3022         $biblio->{'notes'},    $biblio->{'abstract'},
3023         $biblio->{'unititle'}, $frameworkcode
3024     );
3025
3026     $sth->finish;
3027     return ($biblionumber);
3028 }
3029
3030 =head2 _find_value
3031
3032 =over 4
3033
3034 ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
3035
3036 Find the given $subfield in the given $tag in the given
3037 MARC::Record $record.  If the subfield is found, returns
3038 the (indicators, value) pair; otherwise, (undef, undef) is
3039 returned.
3040
3041 PROPOSITION :
3042 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
3043 I suggest we export it from this module.
3044
3045 =back
3046
3047 =cut
3048
3049 sub _find_value {
3050     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
3051     my @result;
3052     my $indicator;
3053     if ( $tagfield < 10 ) {
3054         if ( $record->field($tagfield) ) {
3055             push @result, $record->field($tagfield)->data();
3056         }
3057         else {
3058             push @result, "";
3059         }
3060     }
3061     else {
3062         foreach my $field ( $record->field($tagfield) ) {
3063             my @subfields = $field->subfields();
3064             foreach my $subfield (@subfields) {
3065                 if ( @$subfield[0] eq $insubfield ) {
3066                     push @result, @$subfield[1];
3067                     $indicator = $field->indicator(1) . $field->indicator(2);
3068                 }
3069             }
3070         }
3071     }
3072     return ( $indicator, @result );
3073 }
3074
3075 =head2 _koha_modify_biblio
3076
3077 =over 4
3078
3079 Internal function for updating the biblio table
3080
3081 =back
3082
3083 =cut
3084
3085 sub _koha_modify_biblio {
3086     my ( $dbh, $biblio ) = @_;
3087
3088 # FIXME: this code could be made more portable by not hard-coding the values that are supposed to be in biblio table
3089     my $sth =
3090       $dbh->prepare(
3091 "Update biblio set title = ?, author = ?, abstract = ?, copyrightdate = ?, seriestitle = ?, serial = ?, unititle = ?, notes = ? where biblionumber = ?"
3092       );
3093     $sth->execute(
3094         $biblio->{'title'},       $biblio->{'author'},
3095         $biblio->{'abstract'},    $biblio->{'copyrightdate'},
3096         $biblio->{'seriestitle'}, $biblio->{'serial'},
3097         $biblio->{'unititle'},    $biblio->{'notes'},
3098         $biblio->{'biblionumber'}
3099     );
3100     $sth->finish;
3101     return ( $biblio->{'biblionumber'} );
3102 }
3103
3104 =head2 _koha_modify_biblioitem
3105
3106 =over 4
3107
3108 _koha_modify_biblioitem( $dbh, $biblioitem );
3109
3110 =back
3111
3112 =cut
3113
3114 sub _koha_modify_biblioitem {
3115     my ( $dbh, $biblioitem ) = @_;
3116     my $query;
3117 ##Recalculate LC in case it changed --TG
3118
3119     $biblioitem->{'itemtype'}      = $dbh->quote( $biblioitem->{'itemtype'} );
3120     $biblioitem->{'url'}           = $dbh->quote( $biblioitem->{'url'} );
3121     $biblioitem->{'isbn'}          = $dbh->quote( $biblioitem->{'isbn'} );
3122     $biblioitem->{'issn'}          = $dbh->quote( $biblioitem->{'issn'} );
3123     $biblioitem->{'publishercode'} =
3124       $dbh->quote( $biblioitem->{'publishercode'} );
3125     $biblioitem->{'publicationyear'} =
3126       $dbh->quote( $biblioitem->{'publicationyear'} );
3127     $biblioitem->{'classification'} =
3128       $dbh->quote( $biblioitem->{'classification'} );
3129     $biblioitem->{'dewey'}        = $dbh->quote( $biblioitem->{'dewey'} );
3130     $biblioitem->{'subclass'}     = $dbh->quote( $biblioitem->{'subclass'} );
3131     $biblioitem->{'illus'}        = $dbh->quote( $biblioitem->{'illus'} );
3132     $biblioitem->{'pages'}        = $dbh->quote( $biblioitem->{'pages'} );
3133     $biblioitem->{'volumeddesc'}  = $dbh->quote( $biblioitem->{'volumeddesc'} );
3134     $biblioitem->{'bnotes'}       = $dbh->quote( $biblioitem->{'bnotes'} );
3135     $biblioitem->{'size'}         = $dbh->quote( $biblioitem->{'size'} );
3136     $biblioitem->{'place'}        = $dbh->quote( $biblioitem->{'place'} );
3137     $biblioitem->{'ccode'}        = $dbh->quote( $biblioitem->{'ccode'} );
3138     $biblioitem->{'biblionumber'} =
3139       $dbh->quote( $biblioitem->{'biblionumber'} );
3140
3141     $query = "Update biblioitems set
3142         itemtype        = $biblioitem->{'itemtype'},
3143         url             = $biblioitem->{'url'},
3144         isbn            = $biblioitem->{'isbn'},
3145         issn            = $biblioitem->{'issn'},
3146         publishercode   = $biblioitem->{'publishercode'},
3147         publicationyear = $biblioitem->{'publicationyear'},
3148         classification  = $biblioitem->{'classification'},
3149         dewey           = $biblioitem->{'dewey'},
3150         subclass        = $biblioitem->{'subclass'},
3151         illus           = $biblioitem->{'illus'},
3152         pages           = $biblioitem->{'pages'},
3153         volumeddesc     = $biblioitem->{'volumeddesc'},
3154         notes           = $biblioitem->{'bnotes'},
3155         size            = $biblioitem->{'size'},
3156         place           = $biblioitem->{'place'},
3157         ccode           = $biblioitem->{'ccode'}
3158         where biblionumber = $biblioitem->{'biblionumber'}";
3159
3160     $dbh->do($query);
3161     if ( $dbh->errstr ) {
3162         warn "$query";
3163     }
3164 }
3165
3166 =head2 _koha_add_biblioitem
3167
3168 =over 4
3169
3170 _koha_add_biblioitem( $dbh, $biblioitem );
3171
3172 Internal function to add a biblioitem
3173
3174 =back
3175
3176 =cut
3177
3178 sub _koha_add_biblioitem {
3179     my ( $dbh, $biblioitem ) = @_;
3180
3181     #  my $dbh   = C4Connect;
3182     my $sth = $dbh->prepare("SELECT max(biblioitemnumber) FROM biblioitems");
3183     my $data;
3184     my $bibitemnum;
3185
3186     $sth->execute;
3187     $data       = $sth->fetchrow_arrayref;
3188     $bibitemnum = $$data[0] + 1;
3189
3190     $sth->finish;
3191
3192     $sth = $dbh->prepare(
3193         "INSERT INTO biblioitems SET
3194             biblioitemnumber = ?, biblionumber    = ?,
3195             volume           = ?, number          = ?,
3196             classification   = ?, itemtype        = ?,
3197             url              = ?, isbn            = ?,
3198             issn             = ?, dewey           = ?,
3199             subclass         = ?, publicationyear = ?,
3200             publishercode    = ?, volumedate      = ?,
3201             volumeddesc      = ?, illus           = ?,
3202             pages            = ?, notes           = ?,
3203             size             = ?, lccn            = ?,
3204             marc             = ?, lcsort          =?,
3205             place            = ?, ccode           = ?
3206           "
3207     );
3208     my ($lcsort) =
3209       calculatelc( $biblioitem->{'classification'} )
3210       . $biblioitem->{'subclass'};
3211     $sth->execute(
3212         $bibitemnum,                     $biblioitem->{'biblionumber'},
3213         $biblioitem->{'volume'},         $biblioitem->{'number'},
3214         $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
3215         $biblioitem->{'url'},            $biblioitem->{'isbn'},
3216         $biblioitem->{'issn'},           $biblioitem->{'dewey'},
3217         $biblioitem->{'subclass'},       $biblioitem->{'publicationyear'},
3218         $biblioitem->{'publishercode'},  $biblioitem->{'volumedate'},
3219         $biblioitem->{'volumeddesc'},    $biblioitem->{'illus'},
3220         $biblioitem->{'pages'},          $biblioitem->{'bnotes'},
3221         $biblioitem->{'size'},           $biblioitem->{'lccn'},
3222         $biblioitem->{'marc'},           $biblioitem->{'place'},
3223         $lcsort,                         $biblioitem->{'ccode'}
3224     );
3225     $sth->finish;
3226     return ($bibitemnum);
3227 }
3228
3229 =head2 _koha_new_items
3230
3231 =over 4
3232
3233 _koha_new_items( $dbh, $item, $barcode );
3234
3235 =back
3236
3237 =cut
3238
3239 sub _koha_new_items {
3240     my ( $dbh, $item, $barcode ) = @_;
3241
3242     #  my $dbh   = C4Connect;
3243     my $sth = $dbh->prepare("Select max(itemnumber) from items");
3244     my $data;
3245     my $itemnumber;
3246     my $error = "";
3247
3248     $sth->execute;
3249     $data       = $sth->fetchrow_hashref;
3250     $itemnumber = $data->{'max(itemnumber)'} + 1;
3251     $sth->finish;
3252 ## Now calculate lccalnumber
3253     my ($cutterextra) = itemcalculator(
3254         $dbh,
3255         $item->{'biblioitemnumber'},
3256         $item->{'itemcallnumber'}
3257     );
3258
3259 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
3260     if ( $item->{'loan'} ) {
3261         $item->{'notforloan'} = $item->{'loan'};
3262     }
3263
3264     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
3265     if ( $item->{'dateaccessioned'} eq '' || !$item->{'dateaccessioned'} ) {
3266
3267         $sth = $dbh->prepare(
3268             "Insert into items set
3269             itemnumber           = ?,     biblionumber     = ?,
3270             multivolumepart      = ?,
3271             biblioitemnumber     = ?,     barcode          = ?,
3272             booksellerid         = ?,     dateaccessioned  = NOW(),
3273             homebranch           = ?,     holdingbranch    = ?,
3274             price                = ?,     replacementprice = ?,
3275             replacementpricedate = NOW(), datelastseen     = NOW(),
3276             multivolume          = ?,     stack            = ?,
3277             itemlost             = ?,     wthdrawn         = ?,
3278             paidfor              = ?,     itemnotes        = ?,
3279             itemcallnumber       =?,      notforloan       = ?,
3280             location             = ?,     Cutterextra      = ?
3281           "
3282         );
3283         $sth->execute(
3284             $itemnumber,                $item->{'biblionumber'},
3285             $item->{'multivolumepart'}, $item->{'biblioitemnumber'},
3286             $barcode,                   $item->{'booksellerid'},
3287             $item->{'homebranch'},      $item->{'holdingbranch'},
3288             $item->{'price'},           $item->{'replacementprice'},
3289             $item->{multivolume},       $item->{stack},
3290             $item->{itemlost},          $item->{wthdrawn},
3291             $item->{paidfor},           $item->{'itemnotes'},
3292             $item->{'itemcallnumber'},  $item->{'notforloan'},
3293             $item->{'location'},        $cutterextra
3294         );
3295     }
3296     else {
3297         $sth = $dbh->prepare(
3298             "INSERT INTO items SET
3299             itemnumber           = ?,     biblionumber     = ?,
3300             multivolumepart      = ?,
3301             biblioitemnumber     = ?,     barcode          = ?,
3302             booksellerid         = ?,     dateaccessioned  = ?,
3303             homebranch           = ?,     holdingbranch    = ?,
3304             price                = ?,     replacementprice = ?,
3305             replacementpricedate = NOW(), datelastseen     = NOW(),
3306             multivolume          = ?,     stack            = ?,
3307             itemlost             = ?,     wthdrawn         = ?,
3308             paidfor              = ?,     itemnotes        = ?,
3309             itemcallnumber       = ?,     notforloan       = ?,
3310             location             = ?,
3311             Cutterextra          = ?
3312                             "
3313         );
3314         $sth->execute(
3315             $itemnumber,                 $item->{'biblionumber'},
3316             $item->{'multivolumepart'},  $item->{'biblioitemnumber'},
3317             $barcode,                    $item->{'booksellerid'},
3318             $item->{'dateaccessioned'},  $item->{'homebranch'},
3319             $item->{'holdingbranch'},    $item->{'price'},
3320             $item->{'replacementprice'}, $item->{multivolume},
3321             $item->{stack},              $item->{itemlost},
3322             $item->{wthdrawn},           $item->{paidfor},
3323             $item->{'itemnotes'},        $item->{'itemcallnumber'},
3324             $item->{'notforloan'},       $item->{'location'},
3325             $cutterextra
3326         );
3327     }
3328     if ( defined $sth->errstr ) {
3329         $error .= $sth->errstr;
3330     }
3331     return ( $itemnumber, $error );
3332 }
3333
3334 =head2 _koha_modify_item
3335
3336 =over 4
3337
3338 _koha_modify_item( $dbh, $item, $op );
3339
3340 =back
3341
3342 =cut
3343
3344 sub _koha_modify_item {
3345     my ( $dbh, $item, $op ) = @_;
3346     $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
3347
3348     # if all we're doing is setting statuses, just update those and get out
3349     if ( $op eq "setstatus" ) {
3350         my $query =
3351           "UPDATE items SET itemlost=?,wthdrawn=?,binding=? WHERE itemnumber=?";
3352         my @bind = (
3353             $item->{'itemlost'}, $item->{'wthdrawn'},
3354             $item->{'binding'},  $item->{'itemnumber'}
3355         );
3356         my $sth = $dbh->prepare($query);
3357         $sth->execute(@bind);
3358         $sth->finish;
3359         return undef;
3360     }
3361 ## Now calculate lccalnumber
3362     my ($cutterextra) =
3363       itemcalculator( $dbh, $item->{'bibitemnum'}, $item->{'itemcallnumber'} );
3364
3365     my $query = "UPDATE items SET
3366 barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,homebranch=?,cutterextra=?, onloan=?, binding=?";
3367
3368     my @bind = (
3369         $item->{'barcode'},        $item->{'notes'},
3370         $item->{'itemcallnumber'}, $item->{'notforloan'},
3371         $item->{'location'},       $item->{multivolumepart},
3372         $item->{multivolume},      $item->{stack},
3373         $item->{wthdrawn},         $item->{holdingbranch},
3374         $item->{homebranch},       $cutterextra,
3375         $item->{onloan},           $item->{binding}
3376     );
3377     if ( $item->{'lost'} ne '' ) {
3378         $query =
3379 "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
3380                             itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
3381                              location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,cutterextra=?,onloan=?, binding=?";
3382         @bind = (
3383             $item->{'bibitemnum'},     $item->{'barcode'},
3384             $item->{'notes'},          $item->{'homebranch'},
3385             $item->{'lost'},           $item->{'wthdrawn'},
3386             $item->{'itemcallnumber'}, $item->{'notforloan'},
3387             $item->{'location'},       $item->{multivolumepart},
3388             $item->{multivolume},      $item->{stack},
3389             $item->{wthdrawn},         $item->{holdingbranch},
3390             $cutterextra,              $item->{onloan},
3391             $item->{binding}
3392         );
3393         if ( $item->{homebranch} ) {
3394             $query .= ",homebranch=?";
3395             push @bind, $item->{homebranch};
3396         }
3397         if ( $item->{holdingbranch} ) {
3398             $query .= ",holdingbranch=?";
3399             push @bind, $item->{holdingbranch};
3400         }
3401     }
3402     $query .= " where itemnumber=?";
3403     push @bind, $item->{'itemnum'};
3404     if ( $item->{'replacement'} ne '' ) {
3405         $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
3406     }
3407     my $sth = $dbh->prepare($query);
3408     $sth->execute(@bind);
3409     $sth->finish;
3410 }
3411
3412 =head2 _koha_delete_biblio
3413
3414 =over 4
3415
3416 $error = _koha_delete_biblio($dbh,$biblionumber);
3417
3418 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3419
3420 C<$dbh> - the database handle
3421 C<$biblionumber> - the biblionumber of the biblio to be deleted
3422
3423 =back
3424
3425 =cut
3426
3427 # FIXME: add error handling
3428
3429 sub _koha_delete_biblio {
3430     my ( $dbh, $biblionumber ) = @_;
3431
3432     # get all the data for this biblio
3433     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3434     $sth->execute($biblionumber);
3435
3436     if ( my $data = $sth->fetchrow_hashref ) {
3437
3438         # save the record in deletedbiblio
3439         # find the fields to save
3440         my $query = "INSERT INTO deletedbiblio SET ";
3441         my @bind  = ();
3442         foreach my $temp ( keys %$data ) {
3443             $query .= "$temp = ?,";
3444             push( @bind, $data->{$temp} );
3445         }
3446
3447         # replace the last , by ",?)"
3448         $query =~ s/\,$//;
3449         my $bkup_sth = $dbh->prepare($query);
3450         $bkup_sth->execute(@bind);
3451         $bkup_sth->finish;
3452
3453         # delete the biblio
3454         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3455         $del_sth->execute($biblionumber);
3456         $del_sth->finish;
3457     }
3458     $sth->finish;
3459     return undef;
3460 }
3461
3462 =head2 _koha_delete_biblioitems
3463
3464 =over 4
3465
3466 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3467
3468 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3469
3470 C<$dbh> - the database handle
3471 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3472
3473 =back
3474
3475 =cut
3476
3477 # FIXME: add error handling
3478
3479 sub _koha_delete_biblioitems {
3480     my ( $dbh, $biblioitemnumber ) = @_;
3481
3482     # get all the data for this biblioitem
3483     my $sth =
3484       $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3485     $sth->execute($biblioitemnumber);
3486
3487     if ( my $data = $sth->fetchrow_hashref ) {
3488
3489         # save the record in deletedbiblioitems
3490         # find the fields to save
3491         my $query = "INSERT INTO deletedbiblioitems SET ";
3492         my @bind  = ();
3493         foreach my $temp ( keys %$data ) {
3494             $query .= "$temp = ?,";
3495             push( @bind, $data->{$temp} );
3496         }
3497
3498         # replace the last , by ",?)"
3499         $query =~ s/\,$//;
3500         my $bkup_sth = $dbh->prepare($query);
3501         $bkup_sth->execute(@bind);
3502         $bkup_sth->finish;
3503
3504         # delete the biblioitem
3505         my $del_sth =
3506           $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3507         $del_sth->execute($biblioitemnumber);
3508         $del_sth->finish;
3509     }
3510     $sth->finish;
3511     return undef;
3512 }
3513
3514 =head2 _koha_delete_item
3515
3516 =over 4
3517
3518 _koha_delete_item( $dbh, $itemnum );
3519
3520 Internal function to delete an item record from the koha tables
3521
3522 =back
3523
3524 =cut
3525
3526 sub _koha_delete_item {
3527     my ( $dbh, $itemnum ) = @_;
3528
3529     my $sth = $dbh->prepare("select * from items where itemnumber=?");
3530     $sth->execute($itemnum);
3531     my $data = $sth->fetchrow_hashref;
3532     $sth->finish;
3533     my $query = "Insert into deleteditems set ";
3534     my @bind  = ();
3535     foreach my $temp ( keys %$data ) {
3536         $query .= "$temp = ?,";
3537         push( @bind, $data->{$temp} );
3538     }
3539     $query =~ s/\,$//;
3540
3541     #  print $query;
3542     $sth = $dbh->prepare($query);
3543     $sth->execute(@bind);
3544     $sth->finish;
3545     $sth = $dbh->prepare("Delete from items where itemnumber=?");
3546     $sth->execute($itemnum);
3547     $sth->finish;
3548 }
3549
3550 =head1 UNEXPORTED FUNCTIONS
3551
3552 =over 4
3553
3554 =head2 calculatelc
3555
3556 $lc = calculatelc($classification);
3557
3558 =back
3559
3560 =cut
3561
3562 sub calculatelc {
3563     my ($classification) = @_;
3564     $classification =~ s/^\s+|\s+$//g;
3565     my $i = 0;
3566     my $lc2;
3567     my $lc1;
3568
3569     for ( $i = 0 ; $i < length($classification) ; $i++ ) {
3570         my $c = ( substr( $classification, $i, 1 ) );
3571         if ( $c ge '0' && $c le '9' ) {
3572
3573             $lc2 = substr( $classification, $i );
3574             last;
3575         }
3576         else {
3577             $lc1 .= substr( $classification, $i, 1 );
3578
3579         }
3580     }    #while
3581
3582     my $other = length($lc1);
3583     if ( !$lc1 ) {
3584         $other = 0;
3585     }
3586
3587     my $extras;
3588     if ( $other < 4 ) {
3589         for ( 1 .. ( 4 - $other ) ) {
3590             $extras .= "0";
3591         }
3592     }
3593     $lc1 .= $extras;
3594     $lc2 =~ s/^ //g;
3595
3596     $lc2 =~ s/ //g;
3597     $extras = "";
3598     ##Find the decimal part of $lc2
3599     my $pos = index( $lc2, "." );
3600     if ( $pos < 0 ) { $pos = length($lc2); }
3601     if ( $pos >= 0 && $pos < 5 ) {
3602         ##Pad lc2 with zeros to create a 5digit decimal needed in marc record to sort as numeric
3603
3604         for ( 1 .. ( 5 - $pos ) ) {
3605             $extras .= "0";
3606         }
3607     }
3608     $lc2 = $extras . $lc2;
3609     return ( $lc1 . $lc2 );
3610 }
3611
3612 =head2 itemcalculator
3613
3614 =over 4
3615
3616 $cutterextra = itemcalculator( $dbh, $biblioitem, $callnumber );
3617
3618 =back
3619
3620 =cut
3621
3622 sub itemcalculator {
3623     my ( $dbh, $biblioitem, $callnumber ) = @_;
3624     my $sth =
3625       $dbh->prepare(
3626 "select classification, subclass from biblioitems where biblioitemnumber=?"
3627       );
3628
3629     $sth->execute($biblioitem);
3630     my ( $classification, $subclass ) = $sth->fetchrow;
3631     my $all         = $classification . " " . $subclass;
3632     my $total       = length($all);
3633     my $cutterextra = substr( $callnumber, $total - 1 );
3634
3635     return $cutterextra;
3636 }
3637
3638 =head2 ModBiblioMarc
3639
3640 =over 4
3641
3642 &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3643
3644 Add MARC data for a biblio to koha 
3645
3646 Function exported, but should NOT be used, unless you really know what you're doing
3647
3648 =back
3649
3650 =cut
3651
3652 sub ModBiblioMarc {
3653
3654 # pass the MARC::Record to this function, and it will create the records in the marc tables
3655     my ( $record, $biblionumber, $frameworkcode ) = @_;
3656     my $dbh = C4::Context->dbh;
3657     my @fields = $record->fields();
3658     if ( !$frameworkcode ) {
3659         $frameworkcode = "";
3660     }
3661     my $sth =
3662       $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3663     $sth->execute( $frameworkcode, $biblionumber );
3664     $sth->finish;
3665     my $encoding = C4::Context->preference("marcflavour");
3666
3667 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3668     if ( $encoding eq "UNIMARC" ) {
3669         my $string;
3670         if ( length($record->subfield( 100, "a" )) == 35 ) {
3671             $string = $record->subfield( 100, "a" );
3672             my $f100 = $record->field(100);
3673             $record->delete_field($f100);
3674         }
3675         else {
3676             $string = POSIX::strftime( "%Y%m%d", localtime );
3677             $string =~ s/\-//g;
3678             $string = sprintf( "%-*s", 35, $string );
3679         }
3680         substr( $string, 22, 6, "frey50" );
3681         unless ( $record->subfield( 100, "a" ) ) {
3682             $record->insert_grouped_field(
3683                 MARC::Field->new( 100, "", "", "a" => $string ) );
3684         }
3685     }
3686 #     warn "biblionumber : ".$biblionumber;
3687     $sth =
3688       $dbh->prepare(
3689         "update biblioitems set marc=?,marcxml=?  where biblionumber=?");
3690     $sth->execute( $record->as_usmarc(), $record->as_xml_record(),
3691         $biblionumber );
3692 #     warn $record->as_xml_record();
3693     $sth->finish;
3694     ModZebra($biblionumber,"specialUpdate","biblioserver");
3695     return $biblionumber;
3696 }
3697
3698 =head2 AddItemInMarc
3699
3700 =over 4
3701
3702 $newbiblionumber = AddItemInMarc( $record, $biblionumber, $frameworkcode );
3703
3704 Add an item in a MARC record and save the MARC record
3705
3706 Function exported, but should NOT be used, unless you really know what you're doing
3707
3708 =back
3709
3710 =cut
3711
3712 sub AddItemInMarc {
3713
3714 # pass the MARC::Record to this function, and it will create the records in the marc tables
3715     my ( $record, $biblionumber, $frameworkcode ) = @_;
3716     my $newrec = &GetMarcBiblio($biblionumber);
3717
3718     # create it
3719     my @fields = $record->fields();
3720     foreach my $field (@fields) {
3721         $newrec->append_fields($field);
3722     }
3723
3724     # FIXME: should we be making sure the biblionumbers are the same?
3725     my $newbiblionumber =
3726       &ModBiblioMarc( $newrec, $biblionumber, $frameworkcode );
3727     return $newbiblionumber;
3728 }
3729
3730 =head2 z3950_extended_services
3731
3732 z3950_extended_services($serviceType,$serviceOptions,$record);
3733
3734     z3950_extended_services is used to handle all interactions with Zebra's extended serices package, which is employed to perform all management of the MARC data stored in Zebra.
3735
3736 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
3737
3738 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
3739
3740     action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
3741
3742 and maybe
3743