Playing with the zebra...
[koha-ffzg.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 require Exporter;
22 use C4::Context;
23 use C4::Database;
24 use MARC::Record;
25 use MARC::File::USMARC;
26 use MARC::File::XML;
27
28 use vars qw($VERSION @ISA @EXPORT);
29
30 # set the version for version checking
31 $VERSION = 0.01;
32
33 @ISA = qw(Exporter);
34
35 #
36 # don't forget MARCxxx subs are exported only for testing purposes. Should not be used
37 # as the old-style API and the NEW one are the only public functions.
38 #
39 @EXPORT = qw(
40   &updateBiblio &updateBiblioItem &updateItem
41   &itemcount &newbiblio &newbiblioitem
42   &newsubject &newsubtitle
43   &modbiblio &checkitems
44   &newitems &modbibitem
45   &modsubtitle &modsubject &modaddauthor &moditem
46   &delitem &deletebiblioitem &delbiblio
47   &getbiblio
48   &getbiblioitembybiblionumber
49   &getbiblioitem &getitemsbybiblioitem
50   &skip
51   &newcompletebiblioitem
52
53   &MARCfind_marc_from_kohafield
54   &MARCfind_frameworkcode
55   &find_biblioitemnumber
56   &MARCgettagslib
57
58   &NEWnewbiblio &NEWnewitem
59   &NEWmodbiblio &NEWmoditem
60   &NEWdelbiblio &NEWdelitem
61   &NEWmodbiblioframework
62
63   &MARCkoha2marcBiblio &MARCmarc2koha
64   &MARCkoha2marcItem &MARChtml2marc
65   &MARCgetbiblio &MARCgetitem
66   &char_decode
67   
68   &FindDuplicate
69   &DisplayISBN
70 );
71
72 =head1 NAME
73
74 C4::Biblio - acquisition, catalog  management functions
75
76 =head1 SYNOPSIS
77
78 ( lot of changes for Koha 3.0)
79
80 Koha 1.2 and previous version used a specific API to manage biblios. This API uses old-DB style parameters.
81 They are based on a hash, and store data in biblio/biblioitems/items tables (plus additionalauthors, bibliosubject and bibliosubtitle where applicable)
82
83 In Koha 2.0, we introduced a MARC-DB.
84
85 In Koha 3.0 we removed this MARC-DB for search as we wanted to use Zebra as search system.
86
87 So in Koha 3.0, saving a record means :
88  - storing the raw marc record (iso2709) in biblioitems.marc field. It contains both biblio & items informations.
89  - storing the "decoded information" in biblio/biblioitems/items as previously.
90  - using zebra to manage search & indexing on the MARC datas.
91  
92  In Koha, there is a systempreference saying "MARC=ON" or "MARC=OFF"
93  
94  * MARC=ON : when MARC=ON, koha uses a MARC::Record object (in sub parameters). Saving informations in the DB means : 
95  - transform the MARC record into a hash
96  - add the raw marc record into the hash
97  - store them & update zebra
98  
99  * MARC=OFF : when MARC=OFF, koha uses a hash object (in sub parameters). Saving informations in the DB means :
100  - transform the hash into a MARC record
101  - add the raw marc record into the hash
102  - store them and update zebra
103  
104  
105 That's why we need 3 types of subs :
106
107 =head2 REALxxx subs
108
109 all I<subs beginning by REAL> does effective storage of information (with a hash, one field of the hash being the raw marc record). Those subs also update the record in zebra. REAL subs should be only for internal use (called by NEW or "something else" subs
110
111 =head2 NEWxxx related subs
112
113 =over 4
114
115 all I<subs beginning by NEW> use MARC::Record as parameters. it's the API that MUST be used in MARC acquisition system. They just create the hash, add it the raw marc record. Then, they call REALxxx sub.
116
117 all subs requires/use $dbh as 1st parameter and a MARC::Record object as 2nd parameter. they sometimes requires another parameter.
118
119 =back
120
121 =head2 something_elsexxx related subs
122
123 =over 4
124
125 all I<subs beginning by seomething else> are the old-style API. They use a hash as parameter, transform the hash into a -small- marc record, and calls REAL subs.
126
127 all subs requires/use $dbh as 1st parameter and a hash as 2nd parameter.
128
129 =back
130
131 =head1 API
132
133 =cut
134
135 sub zebra_create {
136         my ($biblionumber,$record) = @_;
137         # create the iso2709 file for zebra
138         my $cgidir = C4::Context->intranetdir ."/cgi-bin";
139         unless (opendir(DIR, "$cgidir")) {
140                         $cgidir = C4::Context->intranetdir."/";
141         } 
142
143         my $filename = $cgidir."/zebra/biblios/BIBLIO".$biblionumber."iso2709";
144         open F,"> $filename";
145         print F $record->as_usmarc();
146         close F;
147         my $res = system("cd $cgidir/zebra;/usr/local/bin/zebraidx update biblios");
148         unlink($filename);
149         warn "$biblionumber : $res";
150 }
151
152 =head2 @tagslib = &MARCgettagslib($dbh,1|0,$frameworkcode);
153
154 =over 4
155
156 2nd param is 1 for liblibrarian and 0 for libopac
157 $frameworkcode contains the framework reference. If empty or does not exist, the default one is used
158
159 returns a hash with all values for all fields and subfields for a given MARC framework :
160         $res->{$tag}->{lib}        = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
161                     ->{tab}        = "";            # XXX
162                     ->{mandatory}  = $mandatory;
163                     ->{repeatable} = $repeatable;
164                     ->{$subfield}->{lib}              = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
165                                  ->{tab}              = $tab;
166                                  ->{mandatory}        = $mandatory;
167                                  ->{repeatable}       = $repeatable;
168                                  ->{authorised_value} = $authorised_value;
169                                  ->{authtypecode}     = $authtypecode;
170                                  ->{value_builder}    = $value_builder;
171                                  ->{kohafield}        = $kohafield;
172                                  ->{seealso}          = $seealso;
173                                  ->{hidden}           = $hidden;
174                                  ->{isurl}            = $isurl;
175                                  ->{link}            = $link;
176
177 =back
178
179 =cut
180
181 sub MARCgettagslib {
182     my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
183     $frameworkcode = "" unless $frameworkcode;
184     my $sth;
185     my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
186
187     # check that framework exists
188     $sth =
189       $dbh->prepare(
190         "select count(*) from marc_tag_structure where frameworkcode=?");
191     $sth->execute($frameworkcode);
192     my ($total) = $sth->fetchrow;
193     $frameworkcode = "" unless ( $total > 0 );
194     $sth =
195       $dbh->prepare(
196 "select tagfield,liblibrarian,libopac,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield"
197     );
198     $sth->execute($frameworkcode);
199     my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
200
201     while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
202         $res->{$tag}->{lib}        = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
203         $res->{$tab}->{tab}        = "";            # XXX
204         $res->{$tag}->{mandatory}  = $mandatory;
205         $res->{$tag}->{repeatable} = $repeatable;
206     }
207
208     $sth =
209       $dbh->prepare(
210 "select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link from marc_subfield_structure where frameworkcode=? order by tagfield,tagsubfield"
211     );
212     $sth->execute($frameworkcode);
213
214     my $subfield;
215     my $authorised_value;
216     my $authtypecode;
217     my $value_builder;
218     my $kohafield;
219     my $seealso;
220     my $hidden;
221     my $isurl;
222         my $link;
223
224     while (
225         ( $tag,         $subfield,   $liblibrarian,   , $libopac,      $tab,
226         $mandatory,     $repeatable, $authorised_value, $authtypecode,
227         $value_builder, $kohafield,  $seealso,          $hidden,
228         $isurl,                 $link )
229         = $sth->fetchrow
230       )
231     {
232         $res->{$tag}->{$subfield}->{lib}              = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
233         $res->{$tag}->{$subfield}->{tab}              = $tab;
234         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
235         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
236         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
237         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
238         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
239         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
240         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
241         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
242         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
243         $res->{$tag}->{$subfield}->{link}            = $link;
244     }
245     return $res;
246 }
247
248 =head2 ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
249
250 =over 4
251
252 finds MARC tag and subfield for a given kohafield
253 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
254
255 =back
256
257 =cut
258
259 sub MARCfind_marc_from_kohafield {
260     my ( $dbh, $kohafield,$frameworkcode ) = @_;
261     return 0, 0 unless $kohafield;
262         my $relations = C4::Context->marcfromkohafield;
263         return ($relations->{$frameworkcode}->{$kohafield}->[0],$relations->{$frameworkcode}->{$kohafield}->[1]);
264 }
265
266 =head2 $MARCRecord = &MARCgetbiblio($dbh,$biblionumber);
267
268 =over 4
269
270 Returns a MARC::Record for the biblio $biblionumber.
271
272 =cut
273
274 sub MARCgetbiblio {
275
276     # Returns MARC::Record of the biblio passed in parameter.
277     my ( $dbh, $biblionumber ) = @_;
278         my $sth = $dbh->prepare('select marc from biblioitems where biblionumber=?');
279         $sth->execute($biblionumber);
280         my ($marc) = $sth->fetchrow;
281         my $record = MARC::File::USMARC::decode($marc);
282     return $record;
283 }
284
285 =head2 $MARCrecord = &MARCgetitem($dbh,$biblionumber);
286
287 =over 4
288
289 Returns a MARC::Record with all items of biblio # $biblionumber
290
291 =back
292
293 =cut
294
295 sub MARCgetitem {
296
297     my ( $dbh, $biblionumber, $itemnumber ) = @_;
298         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
299         # get the complete MARC record
300         my $sth = $dbh->prepare("select marc from biblioitems where biblionumber=?");
301         $sth->execute($biblionumber);
302         my ($rawmarc) = $sth->fetchrow;
303         my $record = MARC::File::USMARC::decode($rawmarc);
304         # now, find the relevant itemnumber
305         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
306         # prepare the new item record
307         my $itemrecord = MARC::Record->new();
308         # parse all fields fields from the complete record
309         foreach ($record->field($itemnumberfield)) {
310                 # when the item field is found, save it
311                 if ($_->subfield($itemnumbersubfield) == $itemnumber) {
312                         $itemrecord->append_fields($_);
313                 }
314         }
315
316     return $itemrecord;
317 }
318
319 =head2 sub find_biblioitemnumber($dbh,$biblionumber);
320
321 =over 4
322
323 Returns the 1st biblioitemnumber related to $biblionumber. When MARC=ON we should have 1 biblionumber = 1 and only 1 biblioitemnumber
324 This sub is useless when MARC=OFF
325
326 =back
327
328 =cut
329 sub find_biblioitemnumber {
330         my ( $dbh, $biblionumber ) = @_;
331         my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
332         $sth->execute($biblionumber);
333         my ($biblioitemnumber) = $sth->fetchrow;
334         return $biblioitemnumber;
335 }
336
337 =head2 $frameworkcode = MARCfind_frameworkcode($dbh,$biblionumber);
338
339 =over 4
340
341 returns the framework of a given biblio
342
343 =back
344
345 =cut
346
347 sub MARCfind_frameworkcode {
348         my ( $dbh, $biblionumber ) = @_;
349         my $sth = $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
350         $sth->execute($biblionumber);
351         my ($frameworkcode) = $sth->fetchrow;
352         return $frameworkcode;
353 }
354
355 =head2 $MARCRecord = &MARCkoha2marcBiblio($dbh,$biblionumber,biblioitemnumber);
356
357 =over 4
358
359 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem :
360 all entries of the hash are transformed into their matching MARC field/subfield.
361
362 =back
363
364 =cut
365
366 sub MARCkoha2marcBiblio {
367
368     # this function builds partial MARC::Record from the old koha-DB fields
369     my ( $dbh, $biblionumber, $biblioitemnumber ) = @_;
370     my $sth =
371       $dbh->prepare(
372 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
373     );
374     my $record = MARC::Record->new();
375
376     #--- if bibid, then retrieve old-style koha data
377     if ( $biblionumber > 0 ) {
378         my $sth2 =
379           $dbh->prepare(
380 "select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp
381                 from biblio where biblionumber=?"
382         );
383         $sth2->execute($biblionumber);
384         my $row = $sth2->fetchrow_hashref;
385         my $code;
386         foreach $code ( keys %$row ) {
387             if ( $row->{$code} ) {
388                 &MARCkoha2marcOnefield( $sth, $record, "biblio." . $code,
389                     $row->{$code}, '');
390             }
391         }
392     }
393
394     #--- if biblioitem, then retrieve old-style koha data
395     if ( $biblioitemnumber > 0 ) {
396         my $sth2 =
397           $dbh->prepare(
398             " SELECT biblioitemnumber,biblionumber,volume,number,classification,
399                                                 itemtype,url,isbn,issn,dewey,subclass,publicationyear,publishercode,
400                                                 volumedate,volumeddesc,timestamp,illus,pages,notes AS bnotes,size,place
401                                         FROM biblioitems
402                                         WHERE biblioitemnumber=?
403                                         "
404         );
405         $sth2->execute($biblioitemnumber);
406         my $row = $sth2->fetchrow_hashref;
407         my $code;
408         foreach $code ( keys %$row ) {
409             if ( $row->{$code} ) {
410                 &MARCkoha2marcOnefield( $sth, $record, "biblioitems." . $code,
411                     $row->{$code},'' );
412             }
413         }
414     }
415
416     # other fields => additional authors, subjects, subtitles
417     my $sth2 =
418       $dbh->prepare(
419         " SELECT author FROM additionalauthors WHERE biblionumber=?");
420     $sth2->execute($biblionumber);
421     while ( my $row = $sth2->fetchrow_hashref ) {
422         &MARCkoha2marcOnefield( $sth, $record, "additionalauthors.author",
423             $row->{'author'},'' );
424     }
425     $sth2 =
426       $dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?");
427     $sth2->execute($biblionumber);
428     while ( my $row = $sth2->fetchrow_hashref ) {
429         &MARCkoha2marcOnefield( $sth, $record, "bibliosubject.subject",
430             $row->{'subject'},'' );
431     }
432     $sth2 =
433       $dbh->prepare(
434         " SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?");
435     $sth2->execute($biblionumber);
436     while ( my $row = $sth2->fetchrow_hashref ) {
437         &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle",
438             $row->{'subtitle'},'' );
439     }
440     return $record;
441 }
442
443 =head2 $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);
444
445 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB items :
446 all entries of the hash are transformed into their matching MARC field/subfield.
447
448 =over 4
449
450 =back
451
452 =cut
453
454 sub MARCkoha2marcItem {
455
456     # this function builds partial MARC::Record from the old koha-DB fields
457     my ( $dbh, $biblionumber, $itemnumber ) = @_;
458
459     #    my $dbh=&C4Connect;
460     my $sth =
461       $dbh->prepare(
462 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
463     );
464     my $record = MARC::Record->new();
465
466     #--- if item, then retrieve old-style koha data
467     if ( $itemnumber > 0 ) {
468
469         #       print STDERR "prepare $biblionumber,$itemnumber\n";
470         my $sth2 =
471           $dbh->prepare(
472 "SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned,
473                                                 booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
474                                                 datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,itemcallnumber,issues,renewals,
475                                         reserves,restricted,binding,itemnotes,holdingbranch,timestamp
476                                         FROM items
477                                         WHERE itemnumber=?"
478         );
479         $sth2->execute($itemnumber);
480         my $row = $sth2->fetchrow_hashref;
481         my $code;
482         foreach $code ( keys %$row ) {
483             if ( $row->{$code} ) {
484                 &MARCkoha2marcOnefield( $sth, $record, "items." . $code,
485                     $row->{$code},'' );
486             }
487         }
488     }
489     return $record;
490 }
491
492 =head2 MARCkoha2marcOnefield
493
494 =over 4
495
496 This sub is for internal use only, used by koha2marcBiblio & koha2marcItem
497
498 =back
499
500 =cut
501
502 sub MARCkoha2marcOnefield {
503     my ( $sth, $record, $kohafieldname, $value,$frameworkcode ) = @_;
504     my $tagfield;
505     my $tagsubfield;
506     $sth->execute($frameworkcode,$kohafieldname);
507     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
508         if ( $record->field($tagfield) ) {
509             my $tag = $record->field($tagfield);
510             if ($tag) {
511                 $tag->add_subfields( $tagsubfield, $value );
512                 $record->delete_field($tag);
513                 $record->add_fields($tag);
514             }
515         }
516         else {
517             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
518         }
519     }
520     return $record;
521 }
522
523 =head2 $MARCrecord = MARChtml2marc($dbh,$rtags,$rsubfields,$rvalues,%indicators);
524
525 =over 4
526
527 transforms the parameters (coming from HTML form) into a MARC::Record
528 parameters with r are references to arrays.
529
530 FIXME : should be improved for 3.0, to avoid having 4 differents arrays
531
532 =back
533
534 =cut
535
536 sub MARChtml2marc {
537         my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
538         my $prevtag = -1;
539         my $record = MARC::Record->new();
540 #       my %subfieldlist=();
541         my $prevvalue; # if tag <10
542         my $field; # if tag >=10
543         for (my $i=0; $i< @$rtags; $i++) {
544                 next unless @$rvalues[$i];
545                 # rebuild MARC::Record
546 #                       warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
547                 if (@$rtags[$i] ne $prevtag) {
548                         if ($prevtag < 10) {
549                                 if ($prevvalue) {
550                                         if ($prevtag ne '000') {
551                                                 $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
552                                         } else {
553                                                 $record->leader($prevvalue);
554                                         }
555                                 }
556                         } else {
557                                 if ($field) {
558                                         $record->add_fields($field);
559                                 }
560                         }
561                         $indicators{@$rtags[$i]}.='  ';
562                         if (@$rtags[$i] <10) {
563                                 $prevvalue= @$rvalues[$i];
564                                 undef $field;
565                         } else {
566                                 undef $prevvalue;
567                                 $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
568 #                       warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
569                         }
570                         $prevtag = @$rtags[$i];
571                 } else {
572                         if (@$rtags[$i] <10) {
573                                 $prevvalue=@$rvalues[$i];
574                         } else {
575                                 if (length(@$rvalues[$i])>0) {
576                                         $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
577 #                       warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
578                                 }
579                         }
580                         $prevtag= @$rtags[$i];
581                 }
582         }
583         # the last has not been included inside the loop... do it now !
584         $record->add_fields($field) if $field;
585 #       warn "HTML2MARC=".$record->as_formatted;
586         return $record;
587 }
588
589
590 =head2 $hash = &MARCmarc2koha($dbh,$MARCRecord);
591
592 =over 4
593
594 builds a hash with old-db datas from a MARC::Record
595
596 =back
597
598 =cut
599
600 sub MARCmarc2koha {
601         my ($dbh,$record,$frameworkcode) = @_;
602         my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
603         my $result;
604         my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
605         $sth2->execute;
606         my $field;
607         while (($field)=$sth2->fetchrow) {
608                 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result,$frameworkcode);
609         }
610         $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
611         $sth2->execute;
612         while (($field)=$sth2->fetchrow) {
613                 if ($field eq 'notes') { $field = 'bnotes'; }
614                 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result,$frameworkcode);
615         }
616         $sth2=$dbh->prepare("SHOW COLUMNS from items");
617         $sth2->execute;
618         while (($field)=$sth2->fetchrow) {
619                 $result=&MARCmarc2kohaOneField($sth,"items",$field,$record,$result,$frameworkcode);
620         }
621         # additional authors : specific
622         $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result,$frameworkcode);
623         $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result,$frameworkcode);
624 # modify copyrightdate to keep only the 1st year found
625         my $temp = $result->{'copyrightdate'};
626         $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
627         if ($1>0) {
628                 $result->{'copyrightdate'} = $1;
629         } else { # if no cYYYY, get the 1st date.
630                 $temp =~ m/(\d\d\d\d)/;
631                 $result->{'copyrightdate'} = $1;
632         }
633 # modify publicationyear to keep only the 1st year found
634         $temp = $result->{'publicationyear'};
635         $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
636         if ($1>0) {
637                 $result->{'publicationyear'} = $1;
638         } else { # if no cYYYY, get the 1st date.
639                 $temp =~ m/(\d\d\d\d)/;
640                 $result->{'publicationyear'} = $1;
641         }
642         return $result;
643 }
644
645 sub MARCmarc2kohaOneField {
646
647 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
648     my ( $sth, $kohatable, $kohafield, $record, $result,$frameworkcode ) = @_;
649     #    warn "kohatable / $kohafield / $result / ";
650     my $res = "";
651     my $tagfield;
652     my $subfield;
653     ( $tagfield, $subfield ) = MARCfind_marc_from_kohafield("",$kohatable.".".$kohafield,$frameworkcode);
654     foreach my $field ( $record->field($tagfield) ) {
655                 if ($field->tag()<10) {
656                         if ($result->{$kohafield}) {
657                                 $result->{$kohafield} .= " | ".$field->data();
658                         } else {
659                                 $result->{$kohafield} = $field->data();
660                         }
661                 } else {
662                         if ( $field->subfields ) {
663                                 my @subfields = $field->subfields();
664                                 foreach my $subfieldcount ( 0 .. $#subfields ) {
665                                         if ($subfields[$subfieldcount][0] eq $subfield) {
666                                                 if ( $result->{$kohafield} ) {
667                                                         $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
668                                                 }
669                                                 else {
670                                                         $result->{$kohafield} = $subfields[$subfieldcount][1];
671                                                 }
672                                         }
673                                 }
674                         }
675                 }
676     }
677 #       warn "OneField for $kohatable.$kohafield and $frameworkcode=> $tagfield, $subfield";
678     return $result;
679 }
680
681 =head2 ($biblionumber,$biblioitemnumber) = NEWnewbibilio($dbh,$MARCRecord,$frameworkcode);
682
683 =over 4
684
685 creates a biblio from a MARC::Record.
686
687 =back
688
689 =cut
690
691 sub NEWnewbiblio {
692     my ( $dbh, $record, $frameworkcode ) = @_;
693     my $biblionumber;
694     my $biblioitemnumber;
695     my $olddata = MARCmarc2koha( $dbh, $record,$frameworkcode );
696         $olddata->{frameworkcode} = $frameworkcode;
697     $biblionumber = REALnewbiblio( $dbh, $olddata );
698         $olddata->{biblionumber} = $biblionumber;
699         # add biblionumber into the MARC record (it's the ID for zebra)
700         my ( $tagfield, $tagsubfield ) =
701                                         MARCfind_marc_from_kohafield( $dbh, "biblio.biblionumber",$frameworkcode );
702         # create the field
703         my $newfield;
704         if ($tagfield<10) {
705                 $newfield = MARC::Field->new(
706                         $tagfield, $biblionumber,
707                 );
708         } else {
709                 $newfield = MARC::Field->new(
710                         $tagfield, '', '', "$tagsubfield" => $biblionumber,
711                 );
712         }
713         # drop old field (just in case it already exist and create new one...
714         my $old_field = $record->field($tagfield);
715         $record->delete_field($old_field);
716         $record->add_fields($newfield);
717
718         #create the marc entry, that stores the rax marc record in Koha 3.0
719         $olddata->{marc} = $record->as_usmarc();
720         $olddata->{marcxml} = $record->as_xml();
721         # and create biblioitem, that's all folks !
722     $biblioitemnumber = REALnewbiblioitem( $dbh, $olddata );
723
724     # search subtiles, addiauthors and subjects
725     ( $tagfield, $tagsubfield ) =
726       MARCfind_marc_from_kohafield( $dbh, "additionalauthors.author",$frameworkcode );
727     my @addiauthfields = $record->field($tagfield);
728     foreach my $addiauthfield (@addiauthfields) {
729         my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
730         foreach my $subfieldcount ( 0 .. $#addiauthsubfields ) {
731             REALmodaddauthor( $dbh, $biblionumber,
732                 $addiauthsubfields[$subfieldcount] );
733         }
734     }
735     ( $tagfield, $tagsubfield ) =
736       MARCfind_marc_from_kohafield( $dbh, "bibliosubtitle.subtitle",$frameworkcode );
737     my @subtitlefields = $record->field($tagfield);
738     foreach my $subtitlefield (@subtitlefields) {
739         my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
740         foreach my $subfieldcount ( 0 .. $#subtitlesubfields ) {
741             REALnewsubtitle( $dbh, $biblionumber,
742                 $subtitlesubfields[$subfieldcount] );
743         }
744     }
745     ( $tagfield, $tagsubfield ) =
746       MARCfind_marc_from_kohafield( $dbh, "bibliosubject.subject",$frameworkcode );
747     my @subj = $record->field($tagfield);
748     my @subjects;
749     foreach my $subject (@subj) {
750         my @subjsubfield = $subject->subfield($tagsubfield);
751         foreach my $subfieldcount ( 0 .. $#subjsubfield ) {
752             push @subjects, $subjsubfield[$subfieldcount];
753         }
754     }
755     REALmodsubject( $dbh, $biblionumber, 1, @subjects );
756     return ( $biblionumber, $biblioitemnumber );
757 }
758
759 =head2 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
760
761 =over 4
762
763 modify the framework of a biblio
764
765 =back
766
767 =cut
768
769 sub NEWmodbiblioframework {
770         my ($dbh,$biblionumber,$frameworkcode) =@_;
771         my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE biblionumber=?");
772         $sth->execute($frameworkcode,$biblionumber);
773         return 1;
774 }
775
776 =head2 NEWmodbiblio($dbh,$MARCrecord,$biblionumber,$frameworkcode);
777
778 =over 4
779
780 modify a biblio (MARC=ON)
781
782 =back
783
784 =cut
785
786 sub NEWmodbiblio {
787         my ($dbh,$record,$biblionumber,$frameworkcode) =@_;
788         $frameworkcode="" unless $frameworkcode;
789 #       &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,0);
790         my $oldbiblio = MARCmarc2koha($dbh,$record,$frameworkcode);
791         
792         $oldbiblio->{frameworkcode} = $frameworkcode;
793         #create the marc entry, that stores the rax marc record in Koha 3.0
794         $oldbiblio->{marc} = $record->as_usmarc();
795         $oldbiblio->{marcxml} = $record->as_xml();
796         
797         REALmodbiblio($dbh,$oldbiblio);
798         REALmodbiblioitem($dbh,$oldbiblio);
799         # now, modify addi authors, subject, addititles.
800         my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author",$frameworkcode);
801         my @addiauthfields = $record->field($tagfield);
802         foreach my $addiauthfield (@addiauthfields) {
803                 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
804                 foreach my $subfieldcount (0..$#addiauthsubfields) {
805                         REALmodaddauthor($dbh,$biblionumber,$addiauthsubfields[$subfieldcount]);
806                 }
807         }
808         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle",$frameworkcode);
809         my @subtitlefields = $record->field($tagfield);
810         foreach my $subtitlefield (@subtitlefields) {
811                 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
812                 # delete & create subtitle again because REALmodsubtitle can't handle new subtitles
813                 # between 2 modifs
814                 $dbh->do("delete from bibliosubtitle where biblionumber=$biblionumber");
815                 foreach my $subfieldcount (0..$#subtitlesubfields) {
816                         foreach my $subtit(split /\||#/,$subtitlesubfields[$subfieldcount]) {
817                                 REALnewsubtitle($dbh,$biblionumber,$subtit);
818                         }
819                 }
820         }
821         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject",$frameworkcode);
822         my @subj = $record->field($tagfield);
823         my @subjects;
824         foreach my $subject (@subj) {
825                 my @subjsubfield = $subject->subfield($tagsubfield);
826                 foreach my $subfieldcount (0..$#subjsubfield) {
827                         push @subjects,$subjsubfield[$subfieldcount];
828                 }
829         }
830         REALmodsubject($dbh,$biblionumber,1,@subjects);
831         return 1;
832 }
833
834 =head2 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
835
836 =over 4
837
838 delete a biblio
839
840 =back
841
842 =cut
843
844 sub NEWdelbiblio {
845     my ( $dbh, $bibid ) = @_;
846     my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
847     &REALdelbiblio( $dbh, $biblio );
848     my $sth =
849       $dbh->prepare(
850         "select biblioitemnumber from biblioitems where biblionumber=?");
851     $sth->execute($biblio);
852     while ( my ($biblioitemnumber) = $sth->fetchrow ) {
853         REALdelbiblioitem( $dbh, $biblioitemnumber );
854     }
855     &MARCdelbiblio( $dbh, $bibid, 0 );
856 }
857
858 =head2 $itemnumber = NEWnewitem($dbh, $record, $biblionumber, $biblioitemnumber);
859
860 =over 4
861
862 creates an item from a MARC::Record
863
864 =back
865
866 =cut
867
868 sub NEWnewitem {
869     my ( $dbh, $record, $biblionumber, $biblioitemnumber ) = @_;
870
871     # add item in old-DB
872         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
873     my $item = &MARCmarc2koha( $dbh, $record,$frameworkcode );
874     # needs old biblionumber and biblioitemnumber
875     $item->{'biblionumber'} = $biblionumber;
876     $item->{'biblioitemnumber'}=$biblioitemnumber;
877         $item->{marc} = $record->as_usmarc();
878     my ( $itemnumber, $error ) = &REALnewitems( $dbh, $item, $item->{barcode} );
879         return $itemnumber;
880 }
881
882
883 =head2 $itemnumber = NEWmoditem($dbh, $record, $biblionumber, $biblioitemnumber,$itemnumber);
884
885 =over 4
886
887 Modify an item
888
889 =back
890
891 =cut
892
893 sub NEWmoditem {
894     my ( $dbh, $record, $biblionumber, $biblioitemnumber, $itemnumber) = @_;
895     
896         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
897     my $olditem = MARCmarc2koha( $dbh, $record,$frameworkcode );
898         # add MARC record
899         $olditem->{marc} = $record->as_usmarc();
900         $olditem->{biblionumber} = $biblionumber;
901         $olditem->{biblioitemnumber} = $biblioitemnumber;
902         # and modify item
903     REALmoditem( $dbh, $olditem );
904 }
905
906
907 =head2 $itemnumber = NEWdelitem($dbh, $biblionumber, $biblioitemnumber, $itemnumber);
908
909 =over 4
910
911 delete an item
912
913 =back
914
915 =cut
916
917 sub NEWdelitem {
918     my ( $dbh, $bibid, $itemnumber ) = @_;
919     my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
920     &REALdelitem( $dbh, $itemnumber );
921     &MARCdelitem( $dbh, $bibid, $itemnumber );
922 }
923
924
925 =head2 $biblionumber = REALnewbiblio($dbh,$biblio);
926
927 =over 4
928
929 adds a record in biblio table. Datas are in the hash $biblio.
930
931 =back
932
933 =cut
934
935 sub REALnewbiblio {
936     my ( $dbh, $biblio ) = @_;
937
938         $dbh->do('lock tables biblio WRITE');
939     my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
940     $sth->execute;
941     my $data   = $sth->fetchrow_arrayref;
942     my $bibnum = $$data[0] + 1;
943     my $series = 0;
944
945     if ( $biblio->{'seriestitle'} ) { $series = 1 }
946     $sth->finish;
947     $sth =
948       $dbh->prepare("insert into biblio set     biblionumber=?, title=?,                author=?,       copyrightdate=?,
949                                                                                         serial=?,               seriestitle=?,  notes=?,        abstract=?,
950                                                                                         unititle=?"
951     );
952     $sth->execute(
953         $bibnum,             $biblio->{'title'},
954         $biblio->{'author'}, $biblio->{'copyrightdate'},
955         $biblio->{'serial'},             $biblio->{'seriestitle'},
956         $biblio->{'notes'},  $biblio->{'abstract'},
957                 $biblio->{'unititle'}
958     );
959
960     $sth->finish;
961         $dbh->do('unlock tables');
962     return ($bibnum);
963 }
964
965 =head2 $biblionumber = REALmodbiblio($dbh,$biblio);
966
967 =over 4
968
969 modify a record in biblio table. Datas are in the hash $biblio.
970
971 =back
972
973 =cut
974
975 sub REALmodbiblio {
976     my ( $dbh, $biblio ) = @_;
977     my $sth = $dbh->prepare("Update biblio set  title=?,                author=?,       abstract=?,     copyrightdate=?,
978                                                                                                 seriestitle=?,  serial=?,       unititle=?,     notes=?,        frameworkcode=? 
979                                                                                         where biblionumber = ?"
980     );
981     $sth->execute(
982                 $biblio->{'title'},       $biblio->{'author'},
983                 $biblio->{'abstract'},    $biblio->{'copyrightdate'},
984                 $biblio->{'seriestitle'}, $biblio->{'serial'},
985                 $biblio->{'unititle'},    $biblio->{'notes'},
986                 $biblio->{frameworkcode},
987                 $biblio->{'biblionumber'}
988     );
989         $sth->finish;
990         return ( $biblio->{'biblionumber'} );
991 }    # sub modbiblio
992
993 =head2 REALmodsubtitle($dbh,$bibnum,$subtitle);
994
995 =over 4
996
997 modify subtitles in bibliosubtitle table.
998
999 =back
1000
1001 =cut
1002
1003 sub REALmodsubtitle {
1004     my ( $dbh, $bibnum, $subtitle ) = @_;
1005     my $sth =
1006       $dbh->prepare(
1007         "update bibliosubtitle set subtitle = ? where biblionumber = ?");
1008     $sth->execute( $subtitle, $bibnum );
1009     $sth->finish;
1010 }    # sub modsubtitle
1011
1012 =head2 REALmodaddauthor($dbh,$bibnum,$author);
1013
1014 =over 4
1015
1016 adds or modify additional authors
1017 NOTE :  Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
1018
1019 =back
1020
1021 =cut
1022
1023 sub REALmodaddauthor {
1024     my ( $dbh, $bibnum, @authors ) = @_;
1025
1026     #    my $dbh   = C4Connect;
1027     my $sth =
1028       $dbh->prepare("Delete from additionalauthors where biblionumber = ?");
1029
1030     $sth->execute($bibnum);
1031     $sth->finish;
1032     foreach my $author (@authors) {
1033         if ( $author ne '' ) {
1034             $sth =
1035               $dbh->prepare(
1036                 "Insert into additionalauthors set author = ?, biblionumber = ?"
1037             );
1038
1039             $sth->execute( $author, $bibnum );
1040
1041             $sth->finish;
1042         }    # if
1043     }
1044 }    # sub modaddauthor
1045
1046 =head2 $errors = REALmodsubject($dbh,$bibnum, $force, @subject);
1047
1048 =over 4
1049
1050 modify/adds subjects
1051
1052 =back
1053
1054 =cut
1055 sub REALmodsubject {
1056     my ( $dbh, $bibnum, $force, @subject ) = @_;
1057
1058     #  my $dbh   = C4Connect;
1059     my $count = @subject;
1060     my $error;
1061     for ( my $i = 0 ; $i < $count ; $i++ ) {
1062         $subject[$i] =~ s/^ //g;
1063         $subject[$i] =~ s/ $//g;
1064         my $sth =
1065           $dbh->prepare(
1066 "select * from catalogueentry where entrytype = 's' and catalogueentry = ?"
1067         );
1068         $sth->execute( $subject[$i] );
1069
1070         if ( my $data = $sth->fetchrow_hashref ) {
1071         }
1072         else {
1073             if ( $force eq $subject[$i] || $force == 1 ) {
1074
1075                 # subject not in aut, chosen to force anway
1076                 # so insert into cataloguentry so its in auth file
1077                 my $sth2 =
1078                   $dbh->prepare(
1079 "Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)"
1080                 );
1081
1082                 $sth2->execute( $subject[$i] ) if ( $subject[$i] );
1083                 $sth2->finish;
1084             }
1085             else {
1086                 $error =
1087                   "$subject[$i]\n does not exist in the subject authority file";
1088                 my $sth2 =
1089                   $dbh->prepare(
1090 "Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)"
1091                 );
1092                 $sth2->execute( "$subject[$i] %", "% $subject[$i] %",
1093                     "% $subject[$i]" );
1094                 while ( my $data = $sth2->fetchrow_hashref ) {
1095                     $error .= "<br>$data->{'catalogueentry'}";
1096                 }    # while
1097                 $sth2->finish;
1098             }    # else
1099         }    # else
1100         $sth->finish;
1101     }    # else
1102     if ( $error eq '' ) {
1103         my $sth =
1104           $dbh->prepare("Delete from bibliosubject where biblionumber = ?");
1105         $sth->execute($bibnum);
1106         $sth->finish;
1107         $sth =
1108           $dbh->prepare(
1109             "Insert into bibliosubject (subject,biblionumber) values (?,?)");
1110         my $query;
1111         foreach $query (@subject) {
1112             $sth->execute( $query, $bibnum ) if ( $query && $bibnum );
1113         }    # foreach
1114         $sth->finish;
1115     }    # if
1116
1117     #  $dbh->disconnect;
1118     return ($error);
1119 }    # sub modsubject
1120
1121 =head2 REALmodbiblioitem($dbh, $biblioitem);
1122
1123 =over 4
1124
1125 modify a biblioitem
1126
1127 =back
1128
1129 =cut
1130 sub REALmodbiblioitem {
1131     my ( $dbh, $biblioitem ) = @_;
1132     my $query;
1133
1134     my $sth = $dbh->prepare("update biblioitems set     itemtype=?,                     url=?,                          isbn=?, issn=?,
1135                                                                                 publishercode=?,        publicationyear=?,      classification=?,       dewey=?,
1136                                                                                 subclass=?,                     illus=?,                        pages=?,                        volumeddesc=?,
1137                                                                                 notes=?,                        size=?,                         place=?,                        marc=?,
1138                                                                                 marcxml=?
1139                                                         where biblioitemnumber=?");
1140         $sth->execute(  $biblioitem->{itemtype},                $biblioitem->{url},             $biblioitem->{isbn},    $biblioitem->{issn},
1141                                 $biblioitem->{publishercode},   $biblioitem->{publicationyear}, $biblioitem->{classification},  $biblioitem->{dewey},
1142                                 $biblioitem->{subclass},                $biblioitem->{illus},           $biblioitem->{pages},   $biblioitem->{volumeddesc},
1143                                 $biblioitem->{bnotes},                  $biblioitem->{size},            $biblioitem->{place},   $biblioitem->{marc},
1144                                         $biblioitem->{marcxml},                 $biblioitem->{biblioitemnumber});
1145         my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1146         zebra_create($biblioitem->{biblionumber}, $record);
1147 #       warn "MOD : $biblioitem->{biblioitemnumber} = ".$biblioitem->{marc};
1148 }    # sub modbibitem
1149
1150 =head2 REALnewbiblioitem($dbh,$biblioitem);
1151
1152 =over 4
1153
1154 adds a biblioitem ($biblioitem is a hash with the values)
1155
1156 =back
1157
1158 =cut
1159
1160 sub REALnewbiblioitem {
1161         my ( $dbh, $biblioitem ) = @_;
1162
1163         $dbh->do("lock tables biblioitems WRITE, biblio WRITE");
1164         my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems");
1165         my $data;
1166         my $biblioitemnumber;
1167
1168         $sth->execute;
1169         $data       = $sth->fetchrow_arrayref;
1170         $biblioitemnumber = $$data[0] + 1;
1171         
1172         # Insert biblioitemnumber in MARC record, we need it to manage items later...
1173         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblioitem->{biblionumber});
1174         my ($biblioitemnumberfield,$biblioitemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'biblioitems.biblioitemnumber',$frameworkcode);
1175         my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1176         my $field=$record->field($biblioitemnumberfield);
1177         $field->update($biblioitemnumbersubfield => "$biblioitemnumber");
1178         $biblioitem->{marc} = $record->as_usmarc();
1179         $biblioitem->{marcxml} = $record->as_xml();
1180
1181         $sth = $dbh->prepare( "insert into biblioitems set
1182                                                                         biblioitemnumber = ?,           biblionumber     = ?,
1183                                                                         volume           = ?,                   number           = ?,
1184                                                                         classification  = ?,                    itemtype         = ?,
1185                                                                         url              = ?,                           isbn             = ?,
1186                                                                         issn             = ?,                           dewey            = ?,
1187                                                                         subclass         = ?,                           publicationyear  = ?,
1188                                                                         publishercode    = ?,           volumedate       = ?,
1189                                                                         volumeddesc      = ?,           illus            = ?,
1190                                                                         pages            = ?,                           notes            = ?,
1191                                                                         size             = ?,                           lccn             = ?,
1192                                                                         marc             = ?,                           place            = ?,
1193                                                                         marcxml          = ?"
1194         );
1195         $sth->execute(
1196                 $biblioitemnumber,               $biblioitem->{'biblionumber'},
1197                 $biblioitem->{'volume'},         $biblioitem->{'number'},
1198                 $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
1199                 $biblioitem->{'url'},            $biblioitem->{'isbn'},
1200                 $biblioitem->{'issn'},           $biblioitem->{'dewey'},
1201                 $biblioitem->{'subclass'},       $biblioitem->{'publicationyear'},
1202                 $biblioitem->{'publishercode'},  $biblioitem->{'volumedate'},
1203                 $biblioitem->{'volumeddesc'},    $biblioitem->{'illus'},
1204                 $biblioitem->{'pages'},          $biblioitem->{'bnotes'},
1205                 $biblioitem->{'size'},           $biblioitem->{'lccn'},
1206                 $biblioitem->{'marc'},           $biblioitem->{'place'},
1207                 $biblioitem->{marcxml},
1208         );
1209         $dbh->do("unlock tables");
1210         zebra_create($biblioitem->{biblionumber}, $record);
1211         return ($biblioitemnumber);
1212 }
1213
1214 =head2 REALnewsubtitle($dbh,$bibnum,$subtitle);
1215
1216 =over 4
1217
1218 create a new subtitle
1219
1220 =back
1221
1222 =cut
1223 sub REALnewsubtitle {
1224     my ( $dbh, $bibnum, $subtitle ) = @_;
1225     my $sth =
1226       $dbh->prepare(
1227         "insert into bibliosubtitle set biblionumber = ?, subtitle = ?");
1228     $sth->execute( $bibnum, $subtitle ) if $subtitle;
1229     $sth->finish;
1230 }
1231
1232 =head2 ($itemnumber,$errors)= REALnewitems($dbh,$item,$barcode);
1233
1234 =over 4
1235
1236 create a item. $item is a hash and $barcode the barcode.
1237
1238 =back
1239
1240 =cut
1241
1242 sub REALnewitems {
1243     my ( $dbh, $item, $barcode ) = @_;
1244
1245 #       warn "OLDNEWITEMS";
1246         
1247         $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE');
1248     my $sth = $dbh->prepare("Select max(itemnumber) from items");
1249     my $data;
1250     my $itemnumber;
1251     my $error = "";
1252     $sth->execute;
1253     $data       = $sth->fetchrow_hashref;
1254     $itemnumber = $data->{'max(itemnumber)'} + 1;
1255
1256 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
1257     if ( $item->{'loan'} ) {
1258         $item->{'notforloan'} = $item->{'loan'};
1259     }
1260
1261     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1262     if ( $item->{'dateaccessioned'} ) {
1263         $sth = $dbh->prepare( "Insert into items set
1264                                                         itemnumber           = ?,                       biblionumber         = ?,
1265                                                         multivolumepart      = ?,
1266                                                         biblioitemnumber     = ?,                       barcode              = ?,
1267                                                         booksellerid         = ?,                       dateaccessioned      = ?,
1268                                                         homebranch           = ?,                       holdingbranch        = ?,
1269                                                         price                = ?,                       replacementprice     = ?,
1270                                                         replacementpricedate = NOW(),           datelastseen            = NOW(),
1271                                                         multivolume                     = ?,                    stack                           = ?,
1272                                                         itemlost                        = ?,                    wthdrawn                        = ?,
1273                                                         paidfor                         = ?,                    itemnotes            = ?,
1274                                                         itemcallnumber  =?,                                                     notforloan = ?,
1275                                                         location = ?
1276                                                         "
1277         );
1278         $sth->execute(
1279                         $itemnumber,                            $item->{'biblionumber'},
1280                         $item->{'multivolumepart'},
1281                         $item->{'biblioitemnumber'},$barcode,
1282                         $item->{'booksellerid'},        $item->{'dateaccessioned'},
1283                         $item->{'homebranch'},          $item->{'holdingbranch'},
1284                         $item->{'price'},                       $item->{'replacementprice'},
1285                         $item->{multivolume},           $item->{stack},
1286                         $item->{itemlost},                      $item->{wthdrawn},
1287                         $item->{paidfor},                       $item->{'itemnotes'},
1288                         $item->{'itemcallnumber'},      $item->{'notforloan'},
1289                         $item->{'location'}
1290         );
1291                 if ( defined $sth->errstr ) {
1292                         $error .= $sth->errstr;
1293                 }
1294     }
1295     else {
1296         $sth = $dbh->prepare( "Insert into items set
1297                                                         itemnumber           = ?,                       biblionumber         = ?,
1298                                                         multivolumepart      = ?,
1299                                                         biblioitemnumber     = ?,                       barcode              = ?,
1300                                                         booksellerid         = ?,                       dateaccessioned      = NOW(),
1301                                                         homebranch           = ?,                       holdingbranch        = ?,
1302                                                         price                = ?,                       replacementprice     = ?,
1303                                                         replacementpricedate = NOW(),           datelastseen            = NOW(),
1304                                                         multivolume                     = ?,                    stack                           = ?,
1305                                                         itemlost                        = ?,                    wthdrawn                        = ?,
1306                                                         paidfor                         = ?,                    itemnotes            = ?,
1307                                                         itemcallnumber  =?,                                                     notforloan = ?,
1308                                                         location = ?
1309                                                         "
1310         );
1311         $sth->execute(
1312                         $itemnumber,                            $item->{'biblionumber'},
1313                         $item->{'multivolumepart'},
1314                         $item->{'biblioitemnumber'},$barcode,
1315                         $item->{'booksellerid'},
1316                         $item->{'homebranch'},          $item->{'holdingbranch'},
1317                         $item->{'price'},                       $item->{'replacementprice'},
1318                         $item->{multivolume},           $item->{stack},
1319                         $item->{itemlost},                      $item->{wthdrawn},
1320                         $item->{paidfor},                       $item->{'itemnotes'},
1321                         $item->{'itemcallnumber'},      $item->{'notforloan'},
1322                         $item->{'location'}
1323         );
1324                 if ( defined $sth->errstr ) {
1325                         $error .= $sth->errstr;
1326                 }
1327     }
1328         # item stored, now, deal with the marc part...
1329         $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio 
1330                                                         where   biblio.biblionumber=biblioitems.biblionumber and 
1331                                                                         biblio.biblionumber=?");
1332         $sth->execute($item->{biblionumber});
1333     if ( defined $sth->errstr ) {
1334         $error .= $sth->errstr;
1335     }
1336         my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1337         warn "ERROR IN OLDnewitem, MARC record not found FOR $item->{biblionumber} => $rawmarc <=" unless $rawmarc;
1338         my $record = MARC::File::USMARC::decode($rawmarc);
1339         # ok, we have the marc record, add item number to the item field (in {marc}, and add the field to the record)
1340         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1341         my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1342         my $itemfield = $itemrecord->field($itemnumberfield);
1343         $itemfield->add_subfields($itemnumbersubfield => "$itemnumber");
1344         $record->insert_grouped_field($itemfield);
1345         # save the record into biblioitem
1346         $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=?");
1347         $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber});
1348     if ( defined $sth->errstr ) {
1349         $error .= $sth->errstr;
1350     }
1351         zebra_create($item->{biblionumber},$record);
1352         $dbh->do('unlock tables');
1353     return ( $itemnumber, $error );
1354 }
1355
1356 =head2 REALmoditem($dbh,$item);
1357
1358 =over 4
1359
1360 modify item
1361
1362 =back
1363
1364 =cut
1365
1366 sub REALmoditem {
1367     my ( $dbh, $item ) = @_;
1368         my $error;
1369         $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE');
1370     $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
1371     my $query = "update items set  barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1372     my @bind = (
1373         $item->{'barcode'},                     $item->{'notes'},
1374         $item->{'itemcallnumber'},      $item->{'notforloan'},
1375         $item->{'location'},            $item->{multivolumepart},
1376                 $item->{multivolume},           $item->{stack},
1377                 $item->{wthdrawn},
1378     );
1379     if ( $item->{'lost'} ne '' ) {
1380         $query = "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
1381                                                         itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
1382                                                         location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1383         @bind = (
1384             $item->{'bibitemnum'},     $item->{'barcode'},
1385             $item->{'notes'},          $item->{'homebranch'},
1386             $item->{'lost'},           $item->{'wthdrawn'},
1387             $item->{'itemcallnumber'}, $item->{'notforloan'},
1388             $item->{'location'},                $item->{multivolumepart},
1389                         $item->{multivolume},           $item->{stack},
1390                         $item->{wthdrawn},
1391         );
1392                 if ($item->{homebranch}) {
1393                         $query.=",homebranch=?";
1394                         push @bind, $item->{homebranch};
1395                 }
1396                 if ($item->{holdingbranch}) {
1397                         $query.=",holdingbranch=?";
1398                         push @bind, $item->{holdingbranch};
1399                 }
1400     }
1401         $query.=" where itemnumber=?";
1402         push @bind,$item->{'itemnum'};
1403    if ( $item->{'replacement'} ne '' ) {
1404         $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1405     }
1406     my $sth = $dbh->prepare($query);
1407     $sth->execute(@bind);
1408         
1409         # item stored, now, deal with the marc part...
1410         $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio 
1411                                                         where   biblio.biblionumber=biblioitems.biblionumber and 
1412                                                                         biblio.biblionumber=? and 
1413                                                                         biblioitems.biblioitemnumber=?");
1414         $sth->execute($item->{biblionumber},$item->{biblioitemnumber});
1415     if ( defined $sth->errstr ) {
1416         $error .= $sth->errstr;
1417     }
1418         my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1419         warn "ERROR IN REALmoditem, MARC record not found" unless $rawmarc;
1420         my $record = MARC::File::USMARC::decode($rawmarc);
1421         # ok, we have the marc record, find the previous item record for this itemnumber and delete it
1422         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1423         # prepare the new item record
1424         my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1425         my $itemfield = $itemrecord->field($itemnumberfield);
1426         $itemfield->add_subfields($itemnumbersubfield => '$itemnumber');
1427         # parse all fields fields from the complete record
1428         foreach ($record->field($itemnumberfield)) {
1429                 # when the previous field is found, replace by the new one
1430                 if ($_->subfield($itemnumbersubfield) == $item->{itemnum}) {
1431                         $_->replace_with($itemfield);
1432                 }
1433         }
1434 #       $record->insert_grouped_field($itemfield);
1435         # save the record into biblioitem
1436         $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=? and biblioitemnumber=?");
1437         $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber},$item->{biblioitemnumber});
1438         zebra_create($item->biblionumber,$record);
1439     if ( defined $sth->errstr ) {
1440         $error .= $sth->errstr;
1441     }
1442         $dbh->do('unlock tables');
1443
1444     #  $dbh->disconnect;
1445 }
1446
1447 =head2 REALdelitem($dbh,$itemnum);
1448
1449 =over 4
1450
1451 delete item
1452
1453 =back
1454
1455 =cut
1456
1457 sub REALdelitem {
1458     my ( $dbh, $itemnum ) = @_;
1459
1460     #  my $dbh=C4Connect;
1461     my $sth = $dbh->prepare("select * from items where itemnumber=?");
1462     $sth->execute($itemnum);
1463     my $data = $sth->fetchrow_hashref;
1464     $sth->finish;
1465     my $query = "Insert into deleteditems set ";
1466     my @bind  = ();
1467     foreach my $temp ( keys %$data ) {
1468         $query .= "$temp = ?,";
1469         push ( @bind, $data->{$temp} );
1470     }
1471     $query =~ s/\,$//;
1472
1473     #  print $query;
1474     $sth = $dbh->prepare($query);
1475     $sth->execute(@bind);
1476     $sth->finish;
1477     $sth = $dbh->prepare("Delete from items where itemnumber=?");
1478     $sth->execute($itemnum);
1479     $sth->finish;
1480
1481     #  $dbh->disconnect;
1482 }
1483
1484 =head2 REALdelbiblioitem($dbh,$biblioitemnumber);
1485
1486 =over 4
1487
1488 deletes a biblioitem
1489 NOTE : not standard sub name. Should be REALdelbiblioitem()
1490
1491 =back
1492
1493 =cut
1494
1495 sub REALdelbiblioitem {
1496     my ( $dbh, $biblioitemnumber ) = @_;
1497
1498     #    my $dbh   = C4Connect;
1499     my $sth = $dbh->prepare( "Select * from biblioitems
1500 where biblioitemnumber = ?"
1501     );
1502     my $results;
1503
1504     $sth->execute($biblioitemnumber);
1505
1506     if ( $results = $sth->fetchrow_hashref ) {
1507         $sth->finish;
1508         $sth =
1509           $dbh->prepare(
1510 "Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
1511                                         isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
1512                                         pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
1513         );
1514
1515         $sth->execute(
1516             $results->{biblioitemnumber}, $results->{biblionumber},
1517             $results->{volume},           $results->{number},
1518             $results->{classification},   $results->{itemtype},
1519             $results->{isbn},             $results->{issn},
1520             $results->{dewey},            $results->{subclass},
1521             $results->{publicationyear},  $results->{publishercode},
1522             $results->{volumedate},       $results->{volumeddesc},
1523             $results->{timestamp},        $results->{illus},
1524             $results->{pages},            $results->{notes},
1525             $results->{size},             $results->{url},
1526             $results->{lccn}
1527         );
1528         my $sth2 =
1529           $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?");
1530         $sth2->execute($biblioitemnumber);
1531         $sth2->finish();
1532     }    # if
1533     $sth->finish;
1534
1535     # Now delete all the items attached to the biblioitem
1536     $sth = $dbh->prepare("Select * from items where biblioitemnumber = ?");
1537     $sth->execute($biblioitemnumber);
1538     my @results;
1539     while ( my $data = $sth->fetchrow_hashref ) {
1540         my $query = "Insert into deleteditems set ";
1541         my @bind  = ();
1542         foreach my $temp ( keys %$data ) {
1543             $query .= "$temp = ?,";
1544             push ( @bind, $data->{$temp} );
1545         }
1546         $query =~ s/\,$//;
1547         my $sth2 = $dbh->prepare($query);
1548         $sth2->execute(@bind);
1549     }    # while
1550     $sth->finish;
1551     $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
1552     $sth->execute($biblioitemnumber);
1553     $sth->finish();
1554
1555     #    $dbh->disconnect;
1556 }    # sub deletebiblioitem
1557
1558 =head2 REALdelbiblio($dbh,$biblio);
1559
1560 =over 4
1561
1562 delete a biblio
1563
1564 =back
1565
1566 =cut
1567
1568 sub REALdelbiblio {
1569     my ( $dbh, $biblio ) = @_;
1570     my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
1571     $sth->execute($biblio);
1572     if ( my $data = $sth->fetchrow_hashref ) {
1573         $sth->finish;
1574         my $query = "Insert into deletedbiblio set ";
1575         my @bind  = ();
1576         foreach my $temp ( keys %$data ) {
1577             $query .= "$temp = ?,";
1578             push ( @bind, $data->{$temp} );
1579         }
1580
1581         #replacing the last , by ",?)"
1582         $query =~ s/\,$//;
1583         $sth = $dbh->prepare($query);
1584         $sth->execute(@bind);
1585         $sth->finish;
1586         $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
1587         $sth->execute($biblio);
1588         $sth->finish;
1589     }
1590     $sth->finish;
1591 }
1592
1593 =head2 $number = itemcount($biblio);
1594
1595 =over 4
1596
1597 returns the number of items attached to a biblio
1598
1599 =back
1600
1601 =cut
1602
1603 sub itemcount {
1604     my ($biblio) = @_;
1605     my $dbh = C4::Context->dbh;
1606
1607     #  print $query;
1608     my $sth = $dbh->prepare("Select count(*) from items where biblionumber=?");
1609     $sth->execute($biblio);
1610     my $data = $sth->fetchrow_hashref;
1611     $sth->finish;
1612     return ( $data->{'count(*)'} );
1613 }
1614
1615 =head2 $biblionumber = newbiblio($biblio);
1616
1617 =over 4
1618
1619 create a biblio. The parameter is a hash
1620
1621 =back
1622
1623 =cut
1624
1625 sub newbiblio {
1626     my ($biblio) = @_;
1627     my $dbh    = C4::Context->dbh;
1628     my $bibnum = REALnewbiblio( $dbh, $biblio );
1629     # finds new (MARC bibid
1630     #   my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1631     my $record = &MARCkoha2marcBiblio( $dbh, $bibnum );
1632     MARCaddbiblio( $dbh, $record, $bibnum,'' );
1633     return ($bibnum);
1634 }
1635
1636 =head2   $biblionumber = &modbiblio($biblio);
1637
1638 =over 4
1639
1640 Update a biblio record.
1641
1642 C<$biblio> is a reference-to-hash whose keys are the fields in the
1643 biblio table in the Koha database. All fields must be present, not
1644 just the ones you wish to change.
1645
1646 C<&modbiblio> updates the record defined by
1647 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1648
1649 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1650 successful or not.
1651
1652 =back
1653
1654 =cut
1655
1656 sub modbiblio {
1657         my ($biblio) = @_;
1658         my $dbh  = C4::Context->dbh;
1659         my $biblionumber=REALmodbiblio($dbh,$biblio);
1660         my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
1661         # finds new (MARC bibid
1662         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
1663         MARCmodbiblio($dbh,$bibid,$record,"",0);
1664         return($biblionumber);
1665 } # sub modbiblio
1666
1667 =head2   &modsubtitle($biblionumber, $subtitle);
1668
1669 =over 4
1670
1671 Sets the subtitle of a book.
1672
1673 C<$biblionumber> is the biblionumber of the book to modify.
1674
1675 C<$subtitle> is the new subtitle.
1676
1677 =back
1678
1679 =cut
1680
1681 sub modsubtitle {
1682     my ( $bibnum, $subtitle ) = @_;
1683     my $dbh = C4::Context->dbh;
1684     &REALmodsubtitle( $dbh, $bibnum, $subtitle );
1685 }    # sub modsubtitle
1686
1687 =head2 &modaddauthor($biblionumber, $author);
1688
1689 =over 4
1690
1691 Replaces all additional authors for the book with biblio number
1692 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1693 C<&modaddauthor> deletes all additional authors.
1694
1695 =back
1696
1697 =cut
1698
1699 sub modaddauthor {
1700     my ( $bibnum, @authors ) = @_;
1701     my $dbh = C4::Context->dbh;
1702     &REALmodaddauthor( $dbh, $bibnum, @authors );
1703 }    # sub modaddauthor
1704
1705 =head2 $error = &modsubject($biblionumber, $force, @subjects);
1706
1707 =over 4
1708
1709 $force - a subject to force
1710 $error - Error message, or undef if successful.
1711
1712 =back
1713
1714 =cut
1715
1716 sub modsubject {
1717     my ( $bibnum, $force, @subject ) = @_;
1718     my $dbh = C4::Context->dbh;
1719     my $error = &REALmodsubject( $dbh, $bibnum, $force, @subject );
1720     if ($error eq ''){
1721                 # When MARC is off, ensures that the MARC biblio table gets updated with new
1722                 # subjects, of course, it deletes the biblio in marc, and then recreates.
1723                 # This check is to ensure that no MARC data exists to lose.
1724                 if (C4::Context->preference("MARC") eq '0'){
1725                         my $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibnum);
1726                         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1727                         &MARCmodbiblio($dbh,$bibid, $MARCRecord);
1728                 }
1729         }
1730         return ($error);
1731 }    # sub modsubject
1732
1733 =head2 modbibitem($biblioitem);
1734
1735 =over 4
1736
1737 modify a biblioitem. The parameter is a hash
1738
1739 =back
1740
1741 =cut
1742
1743 sub modbibitem {
1744     my ($biblioitem) = @_;
1745     my $dbh = C4::Context->dbh;
1746     &REALmodbiblioitem( $dbh, $biblioitem );
1747 }    # sub modbibitem
1748
1749 =head2 $biblioitemnumber = newbiblioitem($biblioitem)
1750
1751 =over 4
1752
1753 create a biblioitem, the parameter is a hash
1754
1755 =back
1756
1757 =cut
1758
1759 sub newbiblioitem {
1760     my ($biblioitem) = @_;
1761     my $dbh        = C4::Context->dbh;
1762     my $bibitemnum = &REALnewbiblioitem( $dbh, $biblioitem );
1763
1764     my $MARCbiblio =
1765       MARCkoha2marcBiblio( $dbh, 0, $bibitemnum )
1766       ; # the 0 means "do NOT retrieve biblio, only biblioitem, in the MARC record
1767     my $bibid =
1768       &MARCfind_MARCbibid_from_oldbiblionumber( $dbh,
1769         $biblioitem->{biblionumber} );
1770     &MARCaddbiblio( $dbh, $MARCbiblio, $biblioitem->{biblionumber}, '',$bibid );
1771     return ($bibitemnum);
1772 }
1773
1774 =head2 newsubtitle($biblionumber,$subtitle);
1775
1776 =over 4
1777
1778 insert a subtitle for $biblionumber biblio
1779
1780 =back
1781
1782 =cut
1783
1784
1785 sub newsubtitle {
1786     my ( $bibnum, $subtitle ) = @_;
1787     my $dbh = C4::Context->dbh;
1788     &REALnewsubtitle( $dbh, $bibnum, $subtitle );
1789 }
1790
1791 =head2 $errors = newitems($item, @barcodes);
1792
1793 =over 4
1794
1795 insert items ($item is a hash)
1796
1797 =back
1798
1799 =cut
1800
1801
1802 sub newitems {
1803     my ( $item, @barcodes ) = @_;
1804     my $dbh = C4::Context->dbh;
1805     my $errors;
1806     my $itemnumber;
1807     my $error;
1808     foreach my $barcode (@barcodes) {
1809         ( $itemnumber, $error ) = &REALnewitems( $dbh, $item, uc($barcode) );
1810         $errors .= $error;
1811         my $MARCitem =
1812           &MARCkoha2marcItem( $dbh, $item->{biblionumber}, $itemnumber );
1813         &MARCadditem( $dbh, $MARCitem, $item->{biblionumber} );
1814     }
1815     return ($errors);
1816 }
1817
1818 =head2 moditem($item);
1819
1820 =over 4
1821
1822 modify an item ($item is a hash with all item informations)
1823
1824 =back
1825
1826 =cut
1827
1828
1829 sub moditem {
1830     my ($item) = @_;
1831     my $dbh = C4::Context->dbh;
1832     &REALmoditem( $dbh, $item );
1833     my $MARCitem =
1834       &MARCkoha2marcItem( $dbh, $item->{'biblionumber'}, $item->{'itemnum'} );
1835     my $bibid =
1836       &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $item->{biblionumber} );
1837     &MARCmoditem( $dbh, $MARCitem, $bibid, $item->{itemnum}, 0 );
1838 }
1839
1840 =head2 $error = checkitems($count,@barcodes);
1841
1842 =over 4
1843
1844 check for each @barcode entry that the barcode is not a duplicate
1845
1846 =back
1847
1848 =cut
1849
1850 sub checkitems {
1851     my ( $count, @barcodes ) = @_;
1852     my $dbh = C4::Context->dbh;
1853     my $error;
1854     my $sth = $dbh->prepare("Select * from items where barcode=?");
1855     for ( my $i = 0 ; $i < $count ; $i++ ) {
1856         $barcodes[$i] = uc $barcodes[$i];
1857         $sth->execute( $barcodes[$i] );
1858         if ( my $data = $sth->fetchrow_hashref ) {
1859             $error .= " Duplicate Barcode: $barcodes[$i]";
1860         }
1861     }
1862     $sth->finish;
1863     return ($error);
1864 }
1865
1866 =head2 $delitem($itemnum);
1867
1868 =over 4
1869
1870 delete item $itemnum being the item number to delete
1871
1872 =back
1873
1874 =cut
1875
1876 sub delitem {
1877     my ($itemnum) = @_;
1878     my $dbh = C4::Context->dbh;
1879     &REALdelitem( $dbh, $itemnum );
1880 }
1881
1882 =head2 deletebiblioitem($biblioitemnumber);
1883
1884 =over 4
1885
1886 delete the biblioitem $biblioitemnumber
1887
1888 =back
1889
1890 =cut
1891
1892 sub deletebiblioitem {
1893     my ($biblioitemnumber) = @_;
1894     my $dbh = C4::Context->dbh;
1895     &REALdelbiblioitem( $dbh, $biblioitemnumber );
1896 }    # sub deletebiblioitem
1897
1898 =head2 delbiblio($biblionumber)
1899
1900 =over 4
1901
1902 delete biblio $biblionumber
1903
1904 =back
1905
1906 =cut
1907
1908 sub delbiblio {
1909     my ($biblio) = @_;
1910     my $dbh = C4::Context->dbh;
1911     &REALdelbiblio( $dbh, $biblio );
1912     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio );
1913     &MARCdelbiblio( $dbh, $bibid, 0 );
1914 }
1915
1916 =head2 ($count,@results) = getbiblio($biblionumber);
1917
1918 =over 4
1919
1920 return an array with hash of biblios.
1921
1922 FIXME : biblionumber being the primary key, this sub will always return only 1 result, API should be modified...
1923
1924 =back
1925
1926 =cut
1927
1928 sub getbiblio {
1929     my ($biblionumber) = @_;
1930     my $dbh = C4::Context->dbh;
1931     my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
1932
1933     # || die "Cannot prepare $query\n" . $dbh->errstr;
1934     my $count = 0;
1935     my @results;
1936
1937     $sth->execute($biblionumber);
1938
1939     # || die "Cannot execute $query\n" . $sth->errstr;
1940     while ( my $data = $sth->fetchrow_hashref ) {
1941         $results[$count] = $data;
1942         $count++;
1943     }    # while
1944
1945     $sth->finish;
1946     return ( $count, @results );
1947 }    # sub getbiblio
1948
1949 =head2 ($count,@results) = getbiblioitem($biblioitemnumber);
1950
1951 =over 4
1952
1953 return an array with hash of biblioitemss.
1954
1955 FIXME : biblioitemnumber being unique, this sub will always return only 1 result, API should be modified...
1956
1957 =back
1958
1959 =cut
1960
1961 sub getbiblioitem {
1962     my ($biblioitemnum) = @_;
1963     my $dbh = C4::Context->dbh;
1964     my $sth = $dbh->prepare( "Select * from biblioitems where
1965 biblioitemnumber = ?"
1966     );
1967     my $count = 0;
1968     my @results;
1969
1970     $sth->execute($biblioitemnum);
1971
1972     while ( my $data = $sth->fetchrow_hashref ) {
1973         $results[$count] = $data;
1974         $count++;
1975     }    # while
1976
1977     $sth->finish;
1978     return ( $count, @results );
1979 }    # sub getbiblioitem
1980
1981 =head2 ($count,@results) = getbiblioitembybiblionumber($biblionumber);
1982
1983 =over 4
1984
1985 return an array with hash of biblioitems for the given biblionumber.
1986
1987 =back
1988
1989 =cut
1990
1991 sub getbiblioitembybiblionumber {
1992     my ($biblionumber) = @_;
1993     my $dbh = C4::Context->dbh;
1994     my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
1995     my $count = 0;
1996     my @results;
1997
1998     $sth->execute($biblionumber);
1999
2000     while ( my $data = $sth->fetchrow_hashref ) {
2001         $results[$count] = $data;
2002         $count++;
2003     }    # while
2004
2005     $sth->finish;
2006     return ( $count, @results );
2007 }    # sub
2008
2009 =head2 ($count,@results) = getitemsbybiblioitem($biblionumber);
2010
2011 =over 4
2012
2013 returns an array with hash of items
2014
2015 =back
2016
2017 =cut
2018
2019 sub getitemsbybiblioitem {
2020     my ($biblioitemnum) = @_;
2021     my $dbh = C4::Context->dbh;
2022     my $sth = $dbh->prepare( "Select * from items, biblio where
2023 biblio.biblionumber = items.biblionumber and biblioitemnumber
2024 = ?"
2025     );
2026
2027     # || die "Cannot prepare $query\n" . $dbh->errstr;
2028     my $count = 0;
2029     my @results;
2030
2031     $sth->execute($biblioitemnum);
2032
2033     # || die "Cannot execute $query\n" . $sth->errstr;
2034     while ( my $data = $sth->fetchrow_hashref ) {
2035         $results[$count] = $data;
2036         $count++;
2037     }    # while
2038
2039     $sth->finish;
2040     return ( $count, @results );
2041 }    # sub getitemsbybiblioitem
2042
2043 sub char_decode {
2044
2045     # converts ISO 5426 coded string to ISO 8859-1
2046     # sloppy code : should be improved in next issue
2047     my ( $string, $encoding ) = @_;
2048     $_ = $string;
2049
2050     #   $encoding = C4::Context->preference("marcflavour") unless $encoding;
2051     if ( $encoding eq "UNIMARC" ) {
2052 #         s/\xe1/Æ/gm;
2053         s/\xe2/Ð/gm;
2054         s/\xe9/Ø/gm;
2055         s/\xec/þ/gm;
2056         s/\xf1/æ/gm;
2057         s/\xf3/ð/gm;
2058         s/\xf9/ø/gm;
2059         s/\xfb/ß/gm;
2060         s/\xc1\x61/à/gm;
2061         s/\xc1\x65/è/gm;
2062         s/\xc1\x69/ì/gm;
2063         s/\xc1\x6f/ò/gm;
2064         s/\xc1\x75/ù/gm;
2065         s/\xc1\x41/À/gm;
2066         s/\xc1\x45/È/gm;
2067         s/\xc1\x49/Ì/gm;
2068         s/\xc1\x4f/Ò/gm;
2069         s/\xc1\x55/Ù/gm;
2070         s/\xc2\x41/Á/gm;
2071         s/\xc2\x45/É/gm;
2072         s/\xc2\x49/Í/gm;
2073         s/\xc2\x4f/Ó/gm;
2074         s/\xc2\x55/Ú/gm;
2075         s/\xc2\x59/Ý/gm;
2076         s/\xc2\x61/á/gm;
2077         s/\xc2\x65/é/gm;
2078         s/\xc2\x69/í/gm;
2079         s/\xc2\x6f/ó/gm;
2080         s/\xc2\x75/ú/gm;
2081         s/\xc2\x79/ý/gm;
2082         s/\xc3\x41/Â/gm;
2083         s/\xc3\x45/Ê/gm;
2084         s/\xc3\x49/Î/gm;
2085         s/\xc3\x4f/Ô/gm;
2086         s/\xc3\x55/Û/gm;
2087         s/\xc3\x61/â/gm;
2088         s/\xc3\x65/ê/gm;
2089         s/\xc3\x69/î/gm;
2090         s/\xc3\x6f/ô/gm;
2091         s/\xc3\x75/û/gm;
2092         s/\xc4\x41/Ã/gm;
2093         s/\xc4\x4e/Ñ/gm;
2094         s/\xc4\x4f/Õ/gm;
2095         s/\xc4\x61/ã/gm;
2096         s/\xc4\x6e/ñ/gm;
2097         s/\xc4\x6f/õ/gm;
2098         s/\xc8\x41/Ä/gm;
2099         s/\xc8\x45/Ë/gm;
2100         s/\xc8\x49/Ï/gm;
2101         s/\xc8\x61/ä/gm;
2102         s/\xc8\x65/ë/gm;
2103         s/\xc8\x69/ï/gm;
2104         s/\xc8\x6F/ö/gm;
2105         s/\xc8\x75/ü/gm;
2106         s/\xc8\x76/ÿ/gm;
2107         s/\xc9\x41/Ä/gm;
2108         s/\xc9\x45/Ë/gm;
2109         s/\xc9\x49/Ï/gm;
2110         s/\xc9\x4f/Ö/gm;
2111         s/\xc9\x55/Ü/gm;
2112         s/\xc9\x61/ä/gm;
2113         s/\xc9\x6f/ö/gm;
2114         s/\xc9\x75/ü/gm;
2115         s/\xca\x41/Å/gm;
2116         s/\xca\x61/å/gm;
2117         s/\xd0\x43/Ç/gm;
2118         s/\xd0\x63/ç/gm;
2119
2120         # this handles non-sorting blocks (if implementation requires this)
2121         $string = nsb_clean($_);
2122     }
2123     elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2124         if (/[\xc1-\xff]/) {
2125             s/\xe1\x61/à/gm;
2126             s/\xe1\x65/è/gm;
2127             s/\xe1\x69/ì/gm;
2128             s/\xe1\x6f/ò/gm;
2129             s/\xe1\x75/ù/gm;
2130             s/\xe1\x41/À/gm;
2131             s/\xe1\x45/È/gm;
2132             s/\xe1\x49/Ì/gm;
2133             s/\xe1\x4f/Ò/gm;
2134             s/\xe1\x55/Ù/gm;
2135             s/\xe2\x41/Á/gm;
2136             s/\xe2\x45/É/gm;
2137             s/\xe2\x49/Í/gm;
2138             s/\xe2\x4f/Ó/gm;
2139             s/\xe2\x55/Ú/gm;
2140             s/\xe2\x59/Ý/gm;
2141             s/\xe2\x61/á/gm;
2142             s/\xe2\x65/é/gm;
2143             s/\xe2\x69/í/gm;
2144             s/\xe2\x6f/ó/gm;
2145             s/\xe2\x75/ú/gm;
2146             s/\xe2\x79/ý/gm;
2147             s/\xe3\x41/Â/gm;
2148             s/\xe3\x45/Ê/gm;
2149             s/\xe3\x49/Î/gm;
2150             s/\xe3\x4f/Ô/gm;
2151             s/\xe3\x55/Û/gm;
2152             s/\xe3\x61/â/gm;
2153             s/\xe3\x65/ê/gm;
2154             s/\xe3\x69/î/gm;
2155             s/\xe3\x6f/ô/gm;
2156             s/\xe3\x75/û/gm;
2157             s/\xe4\x41/Ã/gm;
2158             s/\xe4\x4e/Ñ/gm;
2159             s/\xe4\x4f/Õ/gm;
2160             s/\xe4\x61/ã/gm;
2161             s/\xe4\x6e/ñ/gm;
2162             s/\xe4\x6f/õ/gm;
2163             s/\xe8\x45/Ë/gm;
2164             s/\xe8\x49/Ï/gm;
2165             s/\xe8\x65/ë/gm;
2166             s/\xe8\x69/ï/gm;
2167             s/\xe8\x76/ÿ/gm;
2168             s/\xe9\x41/Ä/gm;
2169             s/\xe9\x4f/Ö/gm;
2170             s/\xe9\x55/Ü/gm;
2171             s/\xe9\x61/ä/gm;
2172             s/\xe9\x6f/ö/gm;
2173             s/\xe9\x75/ü/gm;
2174             s/\xea\x41/Å/gm;
2175             s/\xea\x61/å/gm;
2176
2177             # this handles non-sorting blocks (if implementation requires this)
2178             $string = nsb_clean($_);
2179         }
2180     }
2181     return ($string);
2182 }
2183
2184 sub nsb_clean {
2185     my $NSB = '\x88';    # NSB : begin Non Sorting Block
2186     my $NSE = '\x89';    # NSE : Non Sorting Block end
2187                          # handles non sorting blocks
2188     my ($string) = @_;
2189     $_ = $string;
2190     s/$NSB/(/gm;
2191     s/[ ]{0,1}$NSE/) /gm;
2192     $string = $_;
2193     return ($string);
2194 }
2195
2196 sub FindDuplicate {
2197         my ($record)=@_;
2198         my $dbh = C4::Context->dbh;
2199         my $result = MARCmarc2koha($dbh,$record,'');
2200         my $sth;
2201         my ($biblionumber,$bibid,$title);
2202         # search duplicate on ISBN, easy and fast...
2203         if ($result->{isbn}) {
2204                 $sth = $dbh->prepare("select biblio.biblionumber,bibid,title from biblio,biblioitems,marc_biblio where biblio.biblionumber=biblioitems.biblionumber and marc_biblio.biblionumber=biblioitems.biblionumber and isbn=?");
2205                 $sth->execute($result->{'isbn'});
2206                 ($biblionumber,$bibid,$title) = $sth->fetchrow;
2207                 return $biblionumber,$bibid,$title if ($biblionumber);
2208         }
2209         # a more complex search : build a request for SearchMarc::catalogsearch()
2210         my (@tags, @and_or, @excluding, @operator, @value, $offset,$length);
2211         # search on biblio.title
2212         my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.title","");
2213         if ($record->field($tag)) {
2214                 if ($record->field($tag)->subfields($subfield)) {
2215                         push @tags, "'".$tag.$subfield."'";
2216                         push @and_or, "and";
2217                         push @excluding, "";
2218                         push @operator, "contains";
2219                         push @value, $record->field($tag)->subfield($subfield);
2220 #                       warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2221                 }
2222         }
2223         # ... and on biblio.author
2224         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.author","");
2225         if ($record->field($tag)) {
2226                 if ($record->field($tag)->subfields($subfield)) {
2227                         push @tags, "'".$tag.$subfield."'";
2228                         push @and_or, "and";
2229                         push @excluding, "";
2230                         push @operator, "contains";
2231                         push @value, $record->field($tag)->subfield($subfield);
2232 #                       warn "for author, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2233                 }
2234         }
2235         # ... and on publicationyear.
2236         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publicationyear","");
2237         if ($record->field($tag)) {
2238                 if ($record->field($tag)->subfields($subfield)) {
2239                         push @tags, "'".$tag.$subfield."'";
2240                         push @and_or, "and";
2241                         push @excluding, "";
2242                         push @operator, "=";
2243                         push @value, $record->field($tag)->subfield($subfield);
2244 #                       warn "for publicationyear, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2245                 }
2246         }
2247         # ... and on size.
2248         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.size","");
2249         if ($record->field($tag)) {
2250                 if ($record->field($tag)->subfields($subfield)) {
2251                         push @tags, "'".$tag.$subfield."'";
2252                         push @and_or, "and";
2253                         push @excluding, "";
2254                         push @operator, "=";
2255                         push @value, $record->field($tag)->subfield($subfield);
2256 #                       warn "for size, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2257                 }
2258         }
2259         # ... and on publisher.
2260         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publishercode","");
2261         if ($record->field($tag)) {
2262                 if ($record->field($tag)->subfields($subfield)) {
2263                         push @tags, "'".$tag.$subfield."'";
2264                         push @and_or, "and";
2265                         push @excluding, "";
2266                         push @operator, "=";
2267                         push @value, $record->field($tag)->subfield($subfield);
2268 #                       warn "for publishercode, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2269                 }
2270         }
2271         # ... and on volume.
2272         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.volume","");
2273         if ($record->field($tag)) {
2274                 if ($record->field($tag)->subfields($subfield)) {
2275                         push @tags, "'".$tag.$subfield."'";
2276                         push @and_or, "and";
2277                         push @excluding, "";
2278                         push @operator, "=";
2279                         push @value, $record->field($tag)->subfield($subfield);
2280 #                       warn "for volume, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2281                 }
2282         }
2283
2284         my ($finalresult,$nbresult) = C4::SearchMarc::catalogsearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10);
2285         # there is at least 1 result => return the 1st one
2286         if ($nbresult) {
2287 #               warn "$nbresult => ".@$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2288                 return @$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2289         }
2290         # no result, returns nothing
2291         return;
2292 }
2293
2294 sub DisplayISBN {
2295         my ($isbn)=@_;
2296         my $seg1;
2297         if(substr($isbn, 0, 1) <=7) {
2298                 $seg1 = substr($isbn, 0, 1);
2299         } elsif(substr($isbn, 0, 2) <= 94) {
2300                 $seg1 = substr($isbn, 0, 2);
2301         } elsif(substr($isbn, 0, 3) <= 995) {
2302                 $seg1 = substr($isbn, 0, 3);
2303         } elsif(substr($isbn, 0, 4) <= 9989) {
2304                 $seg1 = substr($isbn, 0, 4);
2305         } else {
2306                 $seg1 = substr($isbn, 0, 5);
2307         }
2308         my $x = substr($isbn, length($seg1));
2309         my $seg2;
2310         if(substr($x, 0, 2) <= 19) {
2311 #               if(sTmp2 < 10) sTmp2 = "0" sTmp2;
2312                 $seg2 = substr($x, 0, 2);
2313         } elsif(substr($x, 0, 3) <= 699) {
2314                 $seg2 = substr($x, 0, 3);
2315         } elsif(substr($x, 0, 4) <= 8399) {
2316                 $seg2 = substr($x, 0, 4);
2317         } elsif(substr($x, 0, 5) <= 89999) {
2318                 $seg2 = substr($x, 0, 5);
2319         } elsif(substr($x, 0, 6) <= 9499999) {
2320                 $seg2 = substr($x, 0, 6);
2321         } else {
2322                 $seg2 = substr($x, 0, 7);
2323         }
2324         my $seg3=substr($x,length($seg2));
2325         $seg3=substr($seg3,0,length($seg3)-1) ;
2326         my $seg4 = substr($x, -1, 1);
2327         return "$seg1-$seg2-$seg3-$seg4";
2328 }
2329
2330
2331 END { }    # module clean-up code here (global destructor)
2332
2333 =back
2334
2335 =head1 AUTHOR
2336
2337 Koha Developement team <info@koha.org>
2338
2339 Paul POULAIN paul.poulain@free.fr
2340
2341 =cut
2342
2343 # $Id$
2344 # $Log$
2345 # Revision 1.128  2005/08/11 16:12:47  tipaul
2346 # Playing with the zebra...
2347 #
2348 # * go to koha cvs home directory
2349 # * in misc/zebra there is a unimarc directory. I suggest that marc21 libraries create a marc21 directory
2350 # * put your zebra.cfg files here & create your database.
2351 # * from koha cvs home directory, ln -s misc/zebra/marc21 zebra (I mean create a symbolic link to YOUR zebra directory)
2352 # * now, everytime you add/modify a biblio/item your zebra DB is updated correctly.
2353 #
2354 # NOTE :
2355 # * this uses a system call in perl. CPU consumming, but we are waiting for indexdata Perl/zoom
2356 # * deletion still not work
2357 # * UNIMARC zebra config files are provided in misc/zebra/unimarc directory. The most important line being :
2358 # in zebra.cfg :
2359 # recordId: (bib1,Local-number)
2360 # storeKeys:1
2361 #
2362 # in .abs file :
2363 # elm 090            Local-number            -
2364 # elm 090/?          Local-number            -
2365 # elm 090/?/9        Local-number            !:w
2366 #
2367 # (090$9 being the field mapped to biblio.biblionumber in Koha)
2368 #
2369 # Revision 1.127  2005/08/11 14:37:32  tipaul
2370 # * POD documenting
2371 # * removing useless subs
2372 # * removing some subs that are also elsewhere
2373 # * renaming all OLDxxx subs to REALxxx subs (should not change anything, as OLDxxx, as well as REAL, are supposed to be for Biblio.pm internal use only)
2374 #
2375 # Revision 1.126  2005/08/11 09:13:28  tipaul
2376 # just removing useless subs (a lot !!!) for code cleaning
2377 #
2378 # Revision 1.125  2005/08/11 09:00:07  tipaul
2379 # Ok guys, this time, it seems that item add and modif begin working as expected...
2380 # Still a lot of bugs to fix, of course
2381 #
2382 # Revision 1.124  2005/08/10 10:21:15  tipaul
2383 # continuing the road to zebra :
2384 # - the biblio add begins to work.
2385 # - the biblio modif begins to work.
2386 #
2387 # (still without doing anything on zebra)
2388 # (no new change in updatedatabase)
2389 #
2390 # Revision 1.123  2005/08/09 14:10:28  tipaul
2391 # 1st commit to go to zebra.
2392 # don't update your cvs if you want to have a working head...
2393 #
2394 # this commit contains :
2395 # * updater/updatedatabase : get rid with marc_* tables, but DON'T remove them. As a lot of things uses them, it would not be a good idea for instance to drop them. If you really want to play, you can rename them to test head without them but being still able to reintroduce them...
2396 # * Biblio.pm : modify MARCgetbiblio to find the raw marc record in biblioitems.marc field, not from marc_subfield_table, modify MARCfindframeworkcode to find frameworkcode in biblio.frameworkcode, modify some other subs to use biblio.biblionumber & get rid of bibid.
2397 # * other files : get rid of bibid and use biblionumber instead.
2398 #
2399 # What is broken :
2400 # * does not do anything on zebra yet.
2401 # * if you rename marc_subfield_table, you can't search anymore.
2402 # * you can view a biblio & bibliodetails, go to MARC editor, but NOT save any modif.
2403 # * don't try to add a biblio, it would add data poorly... (don't try to delete either, it may work, but that would be a surprise ;-) )
2404 #
2405 # IMPORTANT NOTE : you need MARC::XML package (http://search.cpan.org/~esummers/MARC-XML-0.7/lib/MARC/File/XML.pm), that requires a recent version of MARC::Record
2406 # Updatedatabase stores the iso2709 data in biblioitems.marc field & an xml version in biblioitems.marcxml Not sure we will keep it when releasing the stable version, but I think it's a good idea to have something readable in sql, at least for development stage.
2407
2408 # tipaul cutted previous commit notes