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