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