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