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