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