adding a XMLgetbiblio in Biblio.pm (1st draft, to use with zebra)
[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 C4::Date;
25 use MARC::Record;
26 use MARC::File::USMARC;
27 use MARC::File::XML;
28
29 use vars qw($VERSION @ISA @EXPORT);
30
31 # set the version for version checking
32 $VERSION = 0.01;
33
34 @ISA = qw(Exporter);
35
36 #
37 # don't forget MARCxxx subs are exported only for testing purposes. Should not be used
38 # as the old-style API and the NEW one are the only public functions.
39 #
40 @EXPORT = qw(
41   &newbiblio &newbiblioitem
42   &newsubject &newsubtitle &newitems 
43   
44   &modbiblio &checkitems &modbibitem
45   &modsubtitle &modsubject &modaddauthor &moditem
46   
47   &delitem &deletebiblioitem &delbiblio
48   
49   &getbiblio &bibdata &bibitems &bibitemdata 
50   &barcodes &ItemInfo &itemdata &itemissues &itemcount 
51   &getsubject &getaddauthor &getsubtitle
52   &getwebbiblioitems &getwebsites
53   &getbiblioitembybiblionumber
54   &getbiblioitem &getitemsbybiblioitem
55
56   &MARCfind_marc_from_kohafield
57   &MARCfind_frameworkcode
58   &find_biblioitemnumber
59   &MARCgettagslib
60
61   &NEWnewbiblio &NEWnewitem
62   &NEWmodbiblio &NEWmoditem
63   &NEWdelbiblio &NEWdelitem
64   &NEWmodbiblioframework
65
66   &MARCkoha2marcBiblio &MARCmarc2koha
67   &MARCkoha2marcItem &MARChtml2marc
68   &MARCgetbiblio &MARCgetitem
69   &XMLgetbiblio
70   &char_decode
71   
72   &FindDuplicate
73   &DisplayISBN
74 );
75
76 =head1 NAME
77
78 C4::Biblio - acquisition, catalog  management functions
79
80 =head1 SYNOPSIS
81
82 ( lot of changes for Koha 3.0)
83
84 Koha 1.2 and previous version used a specific API to manage biblios. This API uses old-DB style parameters.
85 They are based on a hash, and store data in biblio/biblioitems/items tables (plus additionalauthors, bibliosubject and bibliosubtitle where applicable)
86
87 In Koha 2.0, we introduced a MARC-DB.
88
89 In Koha 3.0 we removed this MARC-DB for search as we wanted to use Zebra as search system.
90
91 So in Koha 3.0, saving a record means :
92  - storing the raw marc record (iso2709) in biblioitems.marc field. It contains both biblio & items informations.
93  - storing the "decoded information" in biblio/biblioitems/items as previously.
94  - using zebra to manage search & indexing on the MARC datas.
95  
96  In Koha, there is a systempreference saying "MARC=ON" or "MARC=OFF"
97  
98  * MARC=ON : when MARC=ON, koha uses a MARC::Record object (in sub parameters). Saving informations in the DB means : 
99  - transform the MARC record into a hash
100  - add the raw marc record into the hash
101  - store them & update zebra
102  
103  * MARC=OFF : when MARC=OFF, koha uses a hash object (in sub parameters). Saving informations in the DB means :
104  - transform the hash into a MARC record
105  - add the raw marc record into the hash
106  - store them and update zebra
107  
108  
109 That's why we need 3 types of subs :
110
111 =head2 REALxxx subs
112
113 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
114
115 =head2 NEWxxx related subs
116
117 =over 4
118
119 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.
120
121 all subs requires/use $dbh as 1st parameter and a MARC::Record object as 2nd parameter. they sometimes requires another parameter.
122
123 =back
124
125 =head2 something_elsexxx related subs
126
127 =over 4
128
129 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.
130
131 all subs requires/use $dbh as 1st parameter and a hash as 2nd parameter.
132
133 =back
134
135 =head1 API
136
137 =cut
138
139 sub zebra_create {
140         my ($biblionumber,$record) = @_;
141         # create the iso2709 file for zebra
142         my $cgidir = C4::Context->intranetdir ."/cgi-bin";
143         unless (opendir(DIR, "$cgidir")) {
144                         $cgidir = C4::Context->intranetdir."/";
145         } 
146         closedir DIR;
147         my $filename = $cgidir."/zebra/biblios/BIBLIO".$biblionumber."iso2709";
148         open F,"> $filename";
149         print F $record->as_usmarc();
150         close F;
151         my $res = system("cd $cgidir/zebra;/usr/local/bin/zebraidx update biblios");
152         unlink($filename);
153 }
154
155 =head2 @tagslib = &MARCgettagslib($dbh,1|0,$frameworkcode);
156
157 =over 4
158
159 2nd param is 1 for liblibrarian and 0 for libopac
160 $frameworkcode contains the framework reference. If empty or does not exist, the default one is used
161
162 returns a hash with all values for all fields and subfields for a given MARC framework :
163         $res->{$tag}->{lib}        = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
164                     ->{tab}        = "";            # XXX
165                     ->{mandatory}  = $mandatory;
166                     ->{repeatable} = $repeatable;
167                     ->{$subfield}->{lib}              = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
168                                  ->{tab}              = $tab;
169                                  ->{mandatory}        = $mandatory;
170                                  ->{repeatable}       = $repeatable;
171                                  ->{authorised_value} = $authorised_value;
172                                  ->{authtypecode}     = $authtypecode;
173                                  ->{value_builder}    = $value_builder;
174                                  ->{kohafield}        = $kohafield;
175                                  ->{seealso}          = $seealso;
176                                  ->{hidden}           = $hidden;
177                                  ->{isurl}            = $isurl;
178                                  ->{link}            = $link;
179
180 =back
181
182 =cut
183
184 sub MARCgettagslib {
185     my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
186     $frameworkcode = "" unless $frameworkcode;
187     my $sth;
188     my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
189
190     # check that framework exists
191     $sth =
192       $dbh->prepare(
193         "select count(*) from marc_tag_structure where frameworkcode=?");
194     $sth->execute($frameworkcode);
195     my ($total) = $sth->fetchrow;
196     $frameworkcode = "" unless ( $total > 0 );
197     $sth =
198       $dbh->prepare(
199 "select tagfield,liblibrarian,libopac,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield"
200     );
201     $sth->execute($frameworkcode);
202     my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
203
204     while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
205         $res->{$tag}->{lib}        = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
206         $res->{$tag}->{tab}        = "";            # XXX
207         $res->{$tag}->{mandatory}  = $mandatory;
208         $res->{$tag}->{repeatable} = $repeatable;
209     }
210
211     $sth =
212       $dbh->prepare(
213 "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"
214     );
215     $sth->execute($frameworkcode);
216
217     my $subfield;
218     my $authorised_value;
219     my $authtypecode;
220     my $value_builder;
221     my $kohafield;
222     my $seealso;
223     my $hidden;
224     my $isurl;
225         my $link;
226
227     while (
228         ( $tag,         $subfield,   $liblibrarian,   , $libopac,      $tab,
229         $mandatory,     $repeatable, $authorised_value, $authtypecode,
230         $value_builder, $kohafield,  $seealso,          $hidden,
231         $isurl,                 $link )
232         = $sth->fetchrow
233       )
234     {
235         $res->{$tag}->{$subfield}->{lib}              = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
236         $res->{$tag}->{$subfield}->{tab}              = $tab;
237         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
238         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
239         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
240         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
241         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
242         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
243         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
244         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
245         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
246         $res->{$tag}->{$subfield}->{link}            = $link;
247     }
248     return $res;
249 }
250
251 =head2 ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
252
253 =over 4
254
255 finds MARC tag and subfield for a given kohafield
256 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
257
258 =back
259
260 =cut
261
262 sub MARCfind_marc_from_kohafield {
263     my ( $dbh, $kohafield,$frameworkcode ) = @_;
264     return 0, 0 unless $kohafield;
265         my $relations = C4::Context->marcfromkohafield;
266         return ($relations->{$frameworkcode}->{$kohafield}->[0],$relations->{$frameworkcode}->{$kohafield}->[1]);
267 }
268
269 =head2 $MARCRecord = &MARCgetbiblio($dbh,$biblionumber);
270
271 =over 4
272
273 Returns a MARC::Record for the biblio $biblionumber.
274
275 =cut
276
277 sub MARCgetbiblio {
278
279     # Returns MARC::Record of the biblio passed in parameter.
280     my ( $dbh, $biblionumber ) = @_;
281         my $sth = $dbh->prepare('select marcxml from biblioitems where biblionumber=?');
282         $sth->execute($biblionumber);
283         my ($marc) = $sth->fetchrow;
284         my $record = MARC::Record::new_from_xml($marc);
285     return $record;
286 }
287
288 =head2 $XML = &XMLgetbiblio($dbh,$biblionumber);
289
290 =over 4
291
292 Returns a raw XML for the biblio $biblionumber.
293
294 =cut
295
296 sub XMLgetbiblio {
297
298     # Returns MARC::Record of the biblio passed in parameter.
299     my ( $dbh, $biblionumber ) = @_;
300         my $sth = $dbh->prepare('select marcxml,marc from biblioitems where biblionumber=?');
301         $sth->execute($biblionumber);
302         my ($XML,$marc) = $sth->fetchrow;
303 #       my $record =MARC::Record::new_from_usmarc($marc);
304 #       warn "MARC : \n*-************************\n".$record->as_xml."\n*-************************\n";
305     return $XML;
306 }
307
308 =head2 $MARCrecord = &MARCgetitem($dbh,$biblionumber);
309
310 =over 4
311
312 Returns a MARC::Record with all items of biblio # $biblionumber
313
314 =back
315
316 =cut
317
318 sub MARCgetitem {
319
320     my ( $dbh, $biblionumber, $itemnumber ) = @_;
321         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
322         # get the complete MARC record
323         my $sth = $dbh->prepare("select marc from biblioitems where biblionumber=?");
324         $sth->execute($biblionumber);
325         my ($rawmarc) = $sth->fetchrow;
326         my $record = MARC::File::USMARC::decode($rawmarc);
327         # now, find the relevant itemnumber
328         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
329         # prepare the new item record
330         my $itemrecord = MARC::Record->new();
331         # parse all fields fields from the complete record
332         foreach ($record->field($itemnumberfield)) {
333                 # when the item field is found, save it
334                 if ($_->subfield($itemnumbersubfield) == $itemnumber) {
335                         $itemrecord->append_fields($_);
336                 }
337         }
338
339     return $itemrecord;
340 }
341
342 =head2 sub find_biblioitemnumber($dbh,$biblionumber);
343
344 =over 4
345
346 Returns the 1st biblioitemnumber related to $biblionumber. When MARC=ON we should have 1 biblionumber = 1 and only 1 biblioitemnumber
347 This sub is useless when MARC=OFF
348
349 =back
350
351 =cut
352 sub find_biblioitemnumber {
353         my ( $dbh, $biblionumber ) = @_;
354         my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
355         $sth->execute($biblionumber);
356         my ($biblioitemnumber) = $sth->fetchrow;
357         return $biblioitemnumber;
358 }
359
360 =head2 $frameworkcode = MARCfind_frameworkcode($dbh,$biblionumber);
361
362 =over 4
363
364 returns the framework of a given biblio
365
366 =back
367
368 =cut
369
370 sub MARCfind_frameworkcode {
371         my ( $dbh, $biblionumber ) = @_;
372         my $sth = $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
373         $sth->execute($biblionumber);
374         my ($frameworkcode) = $sth->fetchrow;
375         return $frameworkcode;
376 }
377
378 =head2 $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibliohash);
379
380 =over 4
381
382 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem :
383 all entries of the hash are transformed into their matching MARC field/subfield.
384
385 =back
386
387 =cut
388
389 sub MARCkoha2marcBiblio {
390
391         # this function builds partial MARC::Record from the old koha-DB fields
392         my ( $dbh, $bibliohash ) = @_;
393         # we don't have biblio entries in the hash, so we add them first
394         my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
395         $sth->execute($bibliohash->{biblionumber});
396         my $biblio = $sth->fetchrow_hashref;
397         foreach (keys %$biblio) {
398                 $bibliohash->{$_}=$biblio->{$_};
399         }
400         $sth = $dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
401         my $record = MARC::Record->new();
402         foreach ( keys %$bibliohash ) {
403                 &MARCkoha2marcOnefield( $sth, $record, "biblio." . $_, $bibliohash->{$_}, '') if $bibliohash->{$_};
404                 &MARCkoha2marcOnefield( $sth, $record, "biblioitems." . $_, $bibliohash->{$_}, '') if $bibliohash->{$_};
405         }
406
407         # other fields => additional authors, subjects, subtitles
408         my $sth2 = $dbh->prepare(" SELECT author FROM additionalauthors WHERE biblionumber=?");
409         $sth2->execute($bibliohash->{biblionumber});
410         while ( my $row = $sth2->fetchrow_hashref ) {
411                 &MARCkoha2marcOnefield( $sth, $record, "additionalauthors.author", $bibliohash->{'author'},'' );
412         }
413         $sth2 = $dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?");
414         $sth2->execute($bibliohash->{biblionumber});
415         while ( my $row = $sth2->fetchrow_hashref ) {
416                 &MARCkoha2marcOnefield( $sth, $record, "bibliosubject.subject", $row->{'subject'},'' );
417         }
418         $sth2 = $dbh->prepare(" SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?");
419         $sth2->execute($bibliohash->{biblionumber});
420         while ( my $row = $sth2->fetchrow_hashref ) {
421                 &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle", $row->{'subtitle'},'' );
422         }
423         
424         return $record;
425 }
426
427 =head2 $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);
428
429 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB items :
430 all entries of the hash are transformed into their matching MARC field/subfield.
431
432 =over 4
433
434 =back
435
436 =cut
437
438 sub MARCkoha2marcItem {
439
440     # this function builds partial MARC::Record from the old koha-DB fields
441     my ( $dbh, $item ) = @_;
442
443     #    my $dbh=&C4Connect;
444     my $sth = $dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
445     my $record = MARC::Record->new();
446
447         foreach( keys %$item ) {
448                 if ( $item->{$_} ) {
449                         &MARCkoha2marcOnefield( $sth, $record, "items." . $_,
450                                 $item->{$_},'' );
451                 }
452         }
453     return $record;
454 }
455
456 =head2 MARCkoha2marcOnefield
457
458 =over 4
459
460 This sub is for internal use only, used by koha2marcBiblio & koha2marcItem
461
462 =back
463
464 =cut
465
466 sub MARCkoha2marcOnefield {
467     my ( $sth, $record, $kohafieldname, $value,$frameworkcode ) = @_;
468     my $tagfield;
469     my $tagsubfield;
470     $sth->execute($frameworkcode,$kohafieldname);
471     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
472         if ( $record->field($tagfield) ) {
473             my $tag = $record->field($tagfield);
474             if ($tag) {
475                 $tag->add_subfields( $tagsubfield, $value );
476                 $record->delete_field($tag);
477                 $record->add_fields($tag);
478             }
479         }
480         else {
481             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
482         }
483     }
484     return $record;
485 }
486
487 =head2 $MARCrecord = MARChtml2marc($dbh,$rtags,$rsubfields,$rvalues,%indicators);
488
489 =over 4
490
491 transforms the parameters (coming from HTML form) into a MARC::Record
492 parameters with r are references to arrays.
493
494 FIXME : should be improved for 3.0, to avoid having 4 differents arrays
495
496 =back
497
498 =cut
499
500 sub MARChtml2marc {
501         my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
502         my $prevtag = -1;
503         my $record = MARC::Record->new();
504 #       my %subfieldlist=();
505         my $prevvalue; # if tag <10
506         my $field; # if tag >=10
507         for (my $i=0; $i< @$rtags; $i++) {
508                 next unless @$rvalues[$i];
509                 # rebuild MARC::Record
510 #                       warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
511                 if (@$rtags[$i] ne $prevtag) {
512                         if ($prevtag < 10) {
513                                 if ($prevvalue) {
514                                         if ($prevtag ne '000') {
515                                                 $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
516                                         } else {
517                                                 $record->leader($prevvalue);
518                                         }
519                                 }
520                         } else {
521                                 if ($field) {
522                                         $record->add_fields($field);
523                                 }
524                         }
525                         $indicators{@$rtags[$i]}.='  ';
526                         if (@$rtags[$i] <10) {
527                                 $prevvalue= @$rvalues[$i];
528                                 undef $field;
529                         } else {
530                                 undef $prevvalue;
531                                 $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
532 #                       warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
533                         }
534                         $prevtag = @$rtags[$i];
535                 } else {
536                         if (@$rtags[$i] <10) {
537                                 $prevvalue=@$rvalues[$i];
538                         } else {
539                                 if (length(@$rvalues[$i])>0) {
540                                         $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
541 #                       warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
542                                 }
543                         }
544                         $prevtag= @$rtags[$i];
545                 }
546         }
547         # the last has not been included inside the loop... do it now !
548         $record->add_fields($field) if $field;
549 #       warn "HTML2MARC=".$record->as_formatted;
550         return $record;
551 }
552
553
554 =head2 $hash = &MARCmarc2koha($dbh,$MARCRecord);
555
556 =over 4
557
558 builds a hash with old-db datas from a MARC::Record
559
560 =back
561
562 =cut
563
564 sub MARCmarc2koha {
565         my ($dbh,$record,$frameworkcode) = @_;
566         my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
567         my $result;
568         my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
569         $sth2->execute;
570         my $field;
571         while (($field)=$sth2->fetchrow) {
572 #               warn "biblio.".$field;
573                 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result,$frameworkcode);
574         }
575         $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
576         $sth2->execute;
577         while (($field)=$sth2->fetchrow) {
578                 if ($field eq 'notes') { $field = 'bnotes'; }
579 #               warn "biblioitems".$field;
580                 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result,$frameworkcode);
581         }
582         $sth2=$dbh->prepare("SHOW COLUMNS from items");
583         $sth2->execute;
584         while (($field)=$sth2->fetchrow) {
585 #               warn "items".$field;
586                 $result=&MARCmarc2kohaOneField($sth,"items",$field,$record,$result,$frameworkcode);
587         }
588         # additional authors : specific
589         $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result,$frameworkcode);
590         $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result,$frameworkcode);
591 # modify copyrightdate to keep only the 1st year found
592         my $temp = $result->{'copyrightdate'};
593         if ($temp){
594                 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
595                 if ($1>0) {
596                         $result->{'copyrightdate'} = $1;
597                 } else { # if no cYYYY, get the 1st date.
598                         $temp =~ m/(\d\d\d\d)/;
599                         $result->{'copyrightdate'} = $1;
600                 }
601         }
602 # modify publicationyear to keep only the 1st year found
603         $temp = $result->{'publicationyear'};
604         $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
605         if ($1>0) {
606                 $result->{'publicationyear'} = $1;
607         } else { # if no cYYYY, get the 1st date.
608                 $temp =~ m/(\d\d\d\d)/;
609                 $result->{'publicationyear'} = $1;
610         }
611         return $result;
612 }
613
614 sub MARCmarc2kohaOneField {
615
616 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
617     my ( $sth, $kohatable, $kohafield, $record, $result,$frameworkcode ) = @_;
618     #    warn "kohatable / $kohafield / $result / ";
619     my $res = "";
620     my $tagfield;
621     my $subfield;
622     ( $tagfield, $subfield ) = MARCfind_marc_from_kohafield("",$kohatable.".".$kohafield,$frameworkcode);
623     foreach my $field ( $record->field($tagfield) ) {
624                 if ($field->tag()<10) {
625                         if ($result->{$kohafield}) {
626                                 # Reverse array filled with elements from repeated subfields 
627                                 # from first to last to avoid last to first concatenation of 
628                                 # elements in Koha DB.  -- thd.
629                                 $result->{$kohafield} .= " | ".reverse($field->data());
630                         } else {
631                                 $result->{$kohafield} = $field->data();
632                         }
633                 } else {
634                         if ( $field->subfields ) {
635                                 my @subfields = $field->subfields();
636                                 foreach my $subfieldcount ( 0 .. $#subfields ) {
637                                         if ($subfields[$subfieldcount][0] eq $subfield) {
638                                                 if ( $result->{$kohafield} ) {
639                                                         $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
640                                                 }
641                                                 else {
642                                                         $result->{$kohafield} = $subfields[$subfieldcount][1];
643                                                 }
644                                         }
645                                 }
646                         }
647                 }
648     }
649 #       warn "OneField for $kohatable.$kohafield and $frameworkcode=> $tagfield, $subfield";
650     return $result;
651 }
652
653 =head2 ($biblionumber,$biblioitemnumber) = NEWnewbibilio($dbh,$MARCRecord,$frameworkcode);
654
655 =over 4
656
657 creates a biblio from a MARC::Record.
658
659 =back
660
661 =cut
662
663 sub NEWnewbiblio {
664     my ( $dbh, $record, $frameworkcode ) = @_;
665     my $biblionumber;
666     my $biblioitemnumber;
667     my $olddata = MARCmarc2koha( $dbh, $record,$frameworkcode );
668         $olddata->{frameworkcode} = $frameworkcode;
669     $biblionumber = REALnewbiblio( $dbh, $olddata );
670         $olddata->{biblionumber} = $biblionumber;
671         # add biblionumber into the MARC record (it's the ID for zebra)
672         my ( $tagfield, $tagsubfield ) =
673                                         MARCfind_marc_from_kohafield( $dbh, "biblio.biblionumber",$frameworkcode );
674         # create the field
675         my $newfield;
676         if ($tagfield<10) {
677                 $newfield = MARC::Field->new(
678                         $tagfield, $biblionumber,
679                 );
680         } else {
681                 $newfield = MARC::Field->new(
682                         $tagfield, '', '', "$tagsubfield" => $biblionumber,
683                 );
684         }
685         # drop old field (just in case it already exist and create new one...
686         my $old_field = $record->field($tagfield);
687         $record->delete_field($old_field);
688         $record->add_fields($newfield);
689
690         #create the marc entry, that stores the rax marc record in Koha 3.0
691         $olddata->{marc} = $record->as_usmarc();
692         $olddata->{marcxml} = $record->as_xml();
693         # and create biblioitem, that's all folks !
694     $biblioitemnumber = REALnewbiblioitem( $dbh, $olddata );
695
696     # search subtiles, addiauthors and subjects
697     ( $tagfield, $tagsubfield ) =
698       MARCfind_marc_from_kohafield( $dbh, "additionalauthors.author",$frameworkcode );
699     my @addiauthfields = $record->field($tagfield);
700     foreach my $addiauthfield (@addiauthfields) {
701         my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
702         foreach my $subfieldcount ( 0 .. $#addiauthsubfields ) {
703             REALmodaddauthor( $dbh, $biblionumber,
704                 $addiauthsubfields[$subfieldcount] );
705         }
706     }
707     ( $tagfield, $tagsubfield ) =
708       MARCfind_marc_from_kohafield( $dbh, "bibliosubtitle.subtitle",$frameworkcode );
709     my @subtitlefields = $record->field($tagfield);
710     foreach my $subtitlefield (@subtitlefields) {
711         my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
712         foreach my $subfieldcount ( 0 .. $#subtitlesubfields ) {
713             REALnewsubtitle( $dbh, $biblionumber,
714                 $subtitlesubfields[$subfieldcount] );
715         }
716     }
717     ( $tagfield, $tagsubfield ) =
718       MARCfind_marc_from_kohafield( $dbh, "bibliosubject.subject",$frameworkcode );
719     my @subj = $record->field($tagfield);
720     my @subjects;
721     foreach my $subject (@subj) {
722         my @subjsubfield = $subject->subfield($tagsubfield);
723         foreach my $subfieldcount ( 0 .. $#subjsubfield ) {
724             push @subjects, $subjsubfield[$subfieldcount];
725         }
726     }
727     REALmodsubject( $dbh, $biblionumber, 1, @subjects );
728     return ( $biblionumber, $biblioitemnumber );
729 }
730
731 =head2 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
732
733 =over 4
734
735 modify the framework of a biblio
736
737 =back
738
739 =cut
740
741 sub NEWmodbiblioframework {
742         my ($dbh,$biblionumber,$frameworkcode) =@_;
743         my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE biblionumber=?");
744         $sth->execute($frameworkcode,$biblionumber);
745         return 1;
746 }
747
748 =head2 NEWmodbiblio($dbh,$MARCrecord,$biblionumber,$frameworkcode);
749
750 =over 4
751
752 modify a biblio (MARC=ON)
753
754 =back
755
756 =cut
757
758 sub NEWmodbiblio {
759         my ($dbh,$record,$biblionumber,$frameworkcode) =@_;
760         $frameworkcode="" unless $frameworkcode;
761 #       &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,0);
762         my $oldbiblio = MARCmarc2koha($dbh,$record,$frameworkcode);
763         
764         $oldbiblio->{frameworkcode} = $frameworkcode;
765         #create the marc entry, that stores the rax marc record in Koha 3.0
766         $oldbiblio->{marc} = $record->as_usmarc();
767         $oldbiblio->{marcxml} = $record->as_xml();
768         
769         REALmodbiblio($dbh,$oldbiblio);
770         REALmodbiblioitem($dbh,$oldbiblio);
771         # now, modify addi authors, subject, addititles.
772         my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author",$frameworkcode);
773         my @addiauthfields = $record->field($tagfield);
774         foreach my $addiauthfield (@addiauthfields) {
775                 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
776                 $dbh->do("delete from additionalauthors where biblionumber=$biblionumber");
777                 foreach my $subfieldcount (0..$#addiauthsubfields) {
778                         REALmodaddauthor($dbh,$biblionumber,$addiauthsubfields[$subfieldcount]);
779                 }
780         }
781         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle",$frameworkcode);
782         my @subtitlefields = $record->field($tagfield);
783         foreach my $subtitlefield (@subtitlefields) {
784                 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
785                 # delete & create subtitle again because REALmodsubtitle can't handle new subtitles
786                 # between 2 modifs
787                 $dbh->do("delete from bibliosubtitle where biblionumber=$biblionumber");
788                 foreach my $subfieldcount (0..$#subtitlesubfields) {
789                         foreach my $subtit(split /\||#/,$subtitlesubfields[$subfieldcount]) {
790                                 REALnewsubtitle($dbh,$biblionumber,$subtit);
791                         }
792                 }
793         }
794         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject",$frameworkcode);
795         my @subj = $record->field($tagfield);
796         my @subjects;
797         foreach my $subject (@subj) {
798                 my @subjsubfield = $subject->subfield($tagsubfield);
799                 foreach my $subfieldcount (0..$#subjsubfield) {
800                         push @subjects,$subjsubfield[$subfieldcount];
801                 }
802         }
803         REALmodsubject($dbh,$biblionumber,1,@subjects);
804         return 1;
805 }
806
807 =head2 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
808
809 =over 4
810
811 delete a biblio
812
813 =back
814
815 =cut
816
817 sub NEWdelbiblio {
818     my ( $dbh, $bibid ) = @_;
819     my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
820     &REALdelbiblio( $dbh, $biblio );
821     my $sth =
822       $dbh->prepare(
823         "select biblioitemnumber from biblioitems where biblionumber=?");
824     $sth->execute($biblio);
825     while ( my ($biblioitemnumber) = $sth->fetchrow ) {
826         REALdelbiblioitem( $dbh, $biblioitemnumber );
827     }
828     &MARCdelbiblio( $dbh, $bibid, 0 );
829 }
830
831 =head2 $itemnumber = NEWnewitem($dbh, $record, $biblionumber, $biblioitemnumber);
832
833 =over 4
834
835 creates an item from a MARC::Record
836
837 =back
838
839 =cut
840
841 sub NEWnewitem {
842     my ( $dbh, $record, $biblionumber, $biblioitemnumber ) = @_;
843
844     # add item in old-DB
845         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
846     my $item = &MARCmarc2koha( $dbh, $record,$frameworkcode );
847     # needs old biblionumber and biblioitemnumber
848     $item->{'biblionumber'} = $biblionumber;
849     $item->{'biblioitemnumber'}=$biblioitemnumber;
850         $item->{marc} = $record->as_usmarc();
851     my ( $itemnumber, $error ) = &REALnewitems( $dbh, $item, $item->{barcode} );
852         return $itemnumber;
853 }
854
855
856 =head2 $itemnumber = NEWmoditem($dbh, $record, $biblionumber, $biblioitemnumber,$itemnumber);
857
858 =over 4
859
860 Modify an item
861
862 =back
863
864 =cut
865
866 sub NEWmoditem {
867     my ( $dbh, $record, $biblionumber, $biblioitemnumber, $itemnumber) = @_;
868     
869         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
870     my $olditem = MARCmarc2koha( $dbh, $record,$frameworkcode );
871         # add MARC record
872         $olditem->{marc} = $record->as_usmarc();
873         $olditem->{biblionumber} = $biblionumber;
874         $olditem->{biblioitemnumber} = $biblioitemnumber;
875         # and modify item
876     REALmoditem( $dbh, $olditem );
877 }
878
879
880 =head2 $itemnumber = NEWdelitem($dbh, $biblionumber, $biblioitemnumber, $itemnumber);
881
882 =over 4
883
884 delete an item
885
886 =back
887
888 =cut
889
890 sub NEWdelitem {
891     my ( $dbh, $bibid, $itemnumber ) = @_;
892     my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
893     &REALdelitem( $dbh, $itemnumber );
894     &MARCdelitem( $dbh, $bibid, $itemnumber );
895 }
896
897
898 =head2 $biblionumber = REALnewbiblio($dbh,$biblio);
899
900 =over 4
901
902 adds a record in biblio table. Datas are in the hash $biblio.
903
904 =back
905
906 =cut
907
908 sub REALnewbiblio {
909     my ( $dbh, $biblio ) = @_;
910
911         $dbh->do('lock tables biblio WRITE');
912     my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
913     $sth->execute;
914     my $data   = $sth->fetchrow_arrayref;
915     my $bibnum = $$data[0] + 1;
916     my $series = 0;
917
918     if ( $biblio->{'seriestitle'} ) { $series = 1 }
919     $sth->finish;
920     $sth =
921       $dbh->prepare("insert into biblio set     biblionumber=?, title=?,                author=?,       copyrightdate=?,
922                                                                                         serial=?,               seriestitle=?,  notes=?,        abstract=?,
923                                                                                         unititle=?"
924     );
925     $sth->execute(
926         $bibnum,             $biblio->{'title'},
927         $biblio->{'author'}, $biblio->{'copyrightdate'},
928         $biblio->{'serial'},             $biblio->{'seriestitle'},
929         $biblio->{'notes'},  $biblio->{'abstract'},
930                 $biblio->{'unititle'}
931     );
932
933     $sth->finish;
934         $dbh->do('unlock tables');
935     return ($bibnum);
936 }
937
938 =head2 $biblionumber = REALmodbiblio($dbh,$biblio);
939
940 =over 4
941
942 modify a record in biblio table. Datas are in the hash $biblio.
943
944 =back
945
946 =cut
947
948 sub REALmodbiblio {
949     my ( $dbh, $biblio ) = @_;
950     my $sth = $dbh->prepare("Update biblio set  title=?,                author=?,       abstract=?,     copyrightdate=?,
951                                                                                                 seriestitle=?,  serial=?,       unititle=?,     notes=?,        frameworkcode=? 
952                                                                                         where biblionumber = ?"
953     );
954     $sth->execute(
955                 $biblio->{'title'},       $biblio->{'author'},
956                 $biblio->{'abstract'},    $biblio->{'copyrightdate'},
957                 $biblio->{'seriestitle'}, $biblio->{'serial'},
958                 $biblio->{'unititle'},    $biblio->{'notes'},
959                 $biblio->{frameworkcode},
960                 $biblio->{'biblionumber'}
961     );
962         $sth->finish;
963         return ( $biblio->{'biblionumber'} );
964 }    # sub modbiblio
965
966 =head2 REALmodsubtitle($dbh,$bibnum,$subtitle);
967
968 =over 4
969
970 modify subtitles in bibliosubtitle table.
971
972 =back
973
974 =cut
975
976 sub REALmodsubtitle {
977     my ( $dbh, $bibnum, $subtitle ) = @_;
978     my $sth =
979       $dbh->prepare(
980         "update bibliosubtitle set subtitle = ? where biblionumber = ?");
981     $sth->execute( $subtitle, $bibnum );
982     $sth->finish;
983 }    # sub modsubtitle
984
985 =head2 REALmodaddauthor($dbh,$bibnum,$author);
986
987 =over 4
988
989 adds or modify additional authors
990 NOTE :  Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
991
992 =back
993
994 =cut
995
996 sub REALmodaddauthor {
997     my ( $dbh, $bibnum, @authors ) = @_;
998
999     #    my $dbh   = C4Connect;
1000     my $sth =
1001       $dbh->prepare("Delete from additionalauthors where biblionumber = ?");
1002
1003     $sth->execute($bibnum);
1004     $sth->finish;
1005     foreach my $author (@authors) {
1006         if ( $author ne '' ) {
1007             $sth =
1008               $dbh->prepare(
1009                 "Insert into additionalauthors set author = ?, biblionumber = ?"
1010             );
1011
1012             $sth->execute( $author, $bibnum );
1013
1014             $sth->finish;
1015         }    # if
1016     }
1017 }    # sub modaddauthor
1018
1019 =head2 $errors = REALmodsubject($dbh,$bibnum, $force, @subject);
1020
1021 =over 4
1022
1023 modify/adds subjects
1024
1025 =back
1026
1027 =cut
1028 sub REALmodsubject {
1029     my ( $dbh, $bibnum, $force, @subject ) = @_;
1030
1031     #  my $dbh   = C4Connect;
1032     my $count = @subject;
1033     my $error="";
1034     for ( my $i = 0 ; $i < $count ; $i++ ) {
1035         $subject[$i] =~ s/^ //g;
1036         $subject[$i] =~ s/ $//g;
1037         my $sth =
1038           $dbh->prepare(
1039 "select * from catalogueentry where entrytype = 's' and catalogueentry = ?"
1040         );
1041         $sth->execute( $subject[$i] );
1042
1043         if ( my $data = $sth->fetchrow_hashref ) {
1044         }
1045         else {
1046             if ( $force eq $subject[$i] || $force == 1 ) {
1047
1048                 # subject not in aut, chosen to force anway
1049                 # so insert into cataloguentry so its in auth file
1050                 my $sth2 =
1051                   $dbh->prepare(
1052 "Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)"
1053                 );
1054
1055                 $sth2->execute( $subject[$i] ) if ( $subject[$i] );
1056                 $sth2->finish;
1057             }
1058             else {
1059                 $error =
1060                   "$subject[$i]\n does not exist in the subject authority file";
1061                 my $sth2 =
1062                   $dbh->prepare(
1063 "Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)"
1064                 );
1065                 $sth2->execute( "$subject[$i] %", "% $subject[$i] %",
1066                     "% $subject[$i]" );
1067                 while ( my $data = $sth2->fetchrow_hashref ) {
1068                     $error .= "<br>$data->{'catalogueentry'}";
1069                 }    # while
1070                 $sth2->finish;
1071             }    # else
1072         }    # else
1073         $sth->finish;
1074     }    # else
1075     if ($error eq '') {
1076         my $sth =
1077           $dbh->prepare("Delete from bibliosubject where biblionumber = ?");
1078         $sth->execute($bibnum);
1079         $sth->finish;
1080         $sth =
1081           $dbh->prepare(
1082             "Insert into bibliosubject (subject,biblionumber) values (?,?)");
1083         my $query;
1084         foreach $query (@subject) {
1085             $sth->execute( $query, $bibnum ) if ( $query && $bibnum );
1086         }    # foreach
1087         $sth->finish;
1088     }    # if
1089
1090     #  $dbh->disconnect;
1091     return ($error);
1092 }    # sub modsubject
1093
1094 =head2 REALmodbiblioitem($dbh, $biblioitem);
1095
1096 =over 4
1097
1098 modify a biblioitem
1099
1100 =back
1101
1102 =cut
1103 sub REALmodbiblioitem {
1104     my ( $dbh, $biblioitem ) = @_;
1105     my $query;
1106
1107     my $sth = $dbh->prepare("update biblioitems set number=?,volume=?,                  volumedate=?,           lccn=?,
1108                                                                                 itemtype=?,                     url=?,                          isbn=?,                         issn=?,
1109                                                                                 publishercode=?,        publicationyear=?,      classification=?,       dewey=?,
1110                                                                                 subclass=?,                     illus=?,                        pages=?,                        volumeddesc=?,
1111                                                                                 notes=?,                        size=?,                         place=?,                        marc=?,
1112                                                                                 marcxml=?
1113                                                         where biblioitemnumber=?");
1114         $sth->execute(  $biblioitem->{number},                  $biblioitem->{volume},  $biblioitem->{volumedate},      $biblioitem->{lccn},
1115                                         $biblioitem->{itemtype},                $biblioitem->{url},             $biblioitem->{isbn},    $biblioitem->{issn},
1116                                 $biblioitem->{publishercode},   $biblioitem->{publicationyear}, $biblioitem->{classification},  $biblioitem->{dewey},
1117                                 $biblioitem->{subclass},                $biblioitem->{illus},           $biblioitem->{pages},   $biblioitem->{volumeddesc},
1118                                 $biblioitem->{bnotes},                  $biblioitem->{size},            $biblioitem->{place},   $biblioitem->{marc},
1119                                         $biblioitem->{marcxml},                 $biblioitem->{biblioitemnumber});
1120         my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1121         zebra_create($biblioitem->{biblionumber}, $record);
1122 #       warn "MOD : $biblioitem->{biblioitemnumber} = ".$biblioitem->{marc};
1123 }    # sub modbibitem
1124
1125 =head2 REALnewbiblioitem($dbh,$biblioitem);
1126
1127 =over 4
1128
1129 adds a biblioitem ($biblioitem is a hash with the values)
1130
1131 =back
1132
1133 =cut
1134
1135 sub REALnewbiblioitem {
1136         my ( $dbh, $biblioitem ) = @_;
1137
1138         $dbh->do("lock tables biblioitems WRITE, biblio WRITE, marc_subfield_structure READ");
1139         my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems");
1140         my $data;
1141         my $biblioitemnumber;
1142
1143         $sth->execute;
1144         $data       = $sth->fetchrow_arrayref;
1145         $biblioitemnumber = $$data[0] + 1;
1146         
1147         # Insert biblioitemnumber in MARC record, we need it to manage items later...
1148         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblioitem->{biblionumber});
1149         my ($biblioitemnumberfield,$biblioitemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'biblioitems.biblioitemnumber',$frameworkcode);
1150         my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1151         my $field=$record->field($biblioitemnumberfield);
1152         $field->update($biblioitemnumbersubfield => "$biblioitemnumber");
1153         $biblioitem->{marc} = $record->as_usmarc();
1154         $biblioitem->{marcxml} = $record->as_xml();
1155
1156         $sth = $dbh->prepare( "insert into biblioitems set
1157                                                                         biblioitemnumber = ?,           biblionumber     = ?,
1158                                                                         volume           = ?,                   number           = ?,
1159                                                                         classification  = ?,                    itemtype         = ?,
1160                                                                         url              = ?,                           isbn             = ?,
1161                                                                         issn             = ?,                           dewey            = ?,
1162                                                                         subclass         = ?,                           publicationyear  = ?,
1163                                                                         publishercode    = ?,           volumedate       = ?,
1164                                                                         volumeddesc      = ?,           illus            = ?,
1165                                                                         pages            = ?,                           notes            = ?,
1166                                                                         size             = ?,                           lccn             = ?,
1167                                                                         marc             = ?,                           place            = ?,
1168                                                                         marcxml          = ?"
1169         );
1170         $sth->execute(
1171                 $biblioitemnumber,               $biblioitem->{'biblionumber'},
1172                 $biblioitem->{'volume'},         $biblioitem->{'number'},
1173                 $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
1174                 $biblioitem->{'url'},            $biblioitem->{'isbn'},
1175                 $biblioitem->{'issn'},           $biblioitem->{'dewey'},
1176                 $biblioitem->{'subclass'},       $biblioitem->{'publicationyear'},
1177                 $biblioitem->{'publishercode'},  $biblioitem->{'volumedate'},
1178                 $biblioitem->{'volumeddesc'},    $biblioitem->{'illus'},
1179                 $biblioitem->{'pages'},          $biblioitem->{'bnotes'},
1180                 $biblioitem->{'size'},           $biblioitem->{'lccn'},
1181                 $biblioitem->{'marc'},           $biblioitem->{'place'},
1182                 $biblioitem->{marcxml},
1183         );
1184         $dbh->do("unlock tables");
1185         zebra_create($biblioitem->{biblionumber}, $record);
1186         return ($biblioitemnumber);
1187 }
1188
1189 =head2 REALnewsubtitle($dbh,$bibnum,$subtitle);
1190
1191 =over 4
1192
1193 create a new subtitle
1194
1195 =back
1196
1197 =cut
1198 sub REALnewsubtitle {
1199     my ( $dbh, $bibnum, $subtitle ) = @_;
1200     my $sth =
1201       $dbh->prepare(
1202         "insert into bibliosubtitle set biblionumber = ?, subtitle = ?");
1203     $sth->execute( $bibnum, $subtitle ) if $subtitle;
1204     $sth->finish;
1205 }
1206
1207 =head2 ($itemnumber,$errors)= REALnewitems($dbh,$item,$barcode);
1208
1209 =over 4
1210
1211 create a item. $item is a hash and $barcode the barcode.
1212
1213 =back
1214
1215 =cut
1216
1217 sub REALnewitems {
1218     my ( $dbh, $item, $barcode ) = @_;
1219
1220 #       warn "OLDNEWITEMS";
1221         
1222         $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE,marc_subfield_structure WRITE');
1223     my $sth = $dbh->prepare("Select max(itemnumber) from items");
1224     my $data;
1225     my $itemnumber;
1226     my $error = "";
1227     $sth->execute;
1228     $data       = $sth->fetchrow_hashref;
1229     $itemnumber = $data->{'max(itemnumber)'} + 1;
1230
1231 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
1232     if ( $item->{'loan'} ) {
1233         $item->{'notforloan'} = $item->{'loan'};
1234     }
1235
1236     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1237     if ( $item->{'dateaccessioned'} ) {
1238         $sth = $dbh->prepare( "Insert into items set
1239                                                         itemnumber           = ?,                       biblionumber         = ?,
1240                                                         multivolumepart      = ?,
1241                                                         biblioitemnumber     = ?,                       barcode              = ?,
1242                                                         booksellerid         = ?,                       dateaccessioned      = ?,
1243                                                         homebranch           = ?,                       holdingbranch        = ?,
1244                                                         price                = ?,                       replacementprice     = ?,
1245                                                         replacementpricedate = NOW(),           datelastseen            = NOW(),
1246                                                         multivolume                     = ?,                    stack                           = ?,
1247                                                         itemlost                        = ?,                    wthdrawn                        = ?,
1248                                                         paidfor                         = ?,                    itemnotes            = ?,
1249                                                         itemcallnumber  =?,                                                     notforloan = ?,
1250                                                         location = ?
1251                                                         "
1252         );
1253         $sth->execute(
1254                         $itemnumber,                            $item->{'biblionumber'},
1255                         $item->{'multivolumepart'},
1256                         $item->{'biblioitemnumber'},$item->{barcode},
1257                         $item->{'booksellerid'},        $item->{'dateaccessioned'},
1258                         $item->{'homebranch'},          $item->{'holdingbranch'},
1259                         $item->{'price'},                       $item->{'replacementprice'},
1260                         $item->{multivolume},           $item->{stack},
1261                         $item->{itemlost},                      $item->{wthdrawn},
1262                         $item->{paidfor},                       $item->{'itemnotes'},
1263                         $item->{'itemcallnumber'},      $item->{'notforloan'},
1264                         $item->{'location'}
1265         );
1266                 if ( defined $sth->errstr ) {
1267                         $error .= $sth->errstr;
1268                 }
1269     }
1270     else {
1271         $sth = $dbh->prepare( "Insert into items set
1272                                                         itemnumber           = ?,                       biblionumber         = ?,
1273                                                         multivolumepart      = ?,
1274                                                         biblioitemnumber     = ?,                       barcode              = ?,
1275                                                         booksellerid         = ?,                       dateaccessioned      = NOW(),
1276                                                         homebranch           = ?,                       holdingbranch        = ?,
1277                                                         price                = ?,                       replacementprice     = ?,
1278                                                         replacementpricedate = NOW(),           datelastseen            = NOW(),
1279                                                         multivolume                     = ?,                    stack                           = ?,
1280                                                         itemlost                        = ?,                    wthdrawn                        = ?,
1281                                                         paidfor                         = ?,                    itemnotes            = ?,
1282                                                         itemcallnumber  =?,                                                     notforloan = ?,
1283                                                         location = ?
1284                                                         "
1285         );
1286         $sth->execute(
1287                         $itemnumber,                            $item->{'biblionumber'},
1288                         $item->{'multivolumepart'},
1289                         $item->{'biblioitemnumber'},$item->{barcode},
1290                         $item->{'booksellerid'},
1291                         $item->{'homebranch'},          $item->{'holdingbranch'},
1292                         $item->{'price'},                       $item->{'replacementprice'},
1293                         $item->{multivolume},           $item->{stack},
1294                         $item->{itemlost},                      $item->{wthdrawn},
1295                         $item->{paidfor},                       $item->{'itemnotes'},
1296                         $item->{'itemcallnumber'},      $item->{'notforloan'},
1297                         $item->{'location'}
1298         );
1299                 if ( defined $sth->errstr ) {
1300                         $error .= $sth->errstr;
1301                 }
1302     }
1303         # item stored, now, deal with the marc part...
1304         $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio 
1305                                                         where   biblio.biblionumber=biblioitems.biblionumber and 
1306                                                                         biblio.biblionumber=?");
1307         $sth->execute($item->{biblionumber});
1308     if ( defined $sth->errstr ) {
1309         $error .= $sth->errstr;
1310     }
1311         my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1312         warn "ERROR IN REALnewitem, MARC record not found FOR $item->{biblionumber} => $rawmarc <=" unless $rawmarc;
1313         my $record = MARC::File::USMARC::decode($rawmarc);
1314         # ok, we have the marc record, add item number to the item field (in {marc}, and add the field to the record)
1315         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1316         my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1317         my $itemfield = $itemrecord->field($itemnumberfield);
1318         $itemfield->add_subfields($itemnumbersubfield => "$itemnumber");
1319         $record->insert_grouped_field($itemfield);
1320         # save the record into biblioitem
1321         $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=?");
1322         $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber});
1323     if ( defined $sth->errstr ) {
1324         $error .= $sth->errstr;
1325     }
1326         zebra_create($item->{biblionumber},$record);
1327         $dbh->do('unlock tables');
1328     return ( $itemnumber, $error );
1329 }
1330
1331 =head2 REALmoditem($dbh,$item);
1332
1333 =over 4
1334
1335 modify item
1336
1337 =back
1338
1339 =cut
1340
1341 sub REALmoditem {
1342     my ( $dbh, $item ) = @_;
1343         my $error;
1344         $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE');
1345     $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
1346     my $query = "update items set  barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1347     my @bind = (
1348         $item->{'barcode'},                     $item->{'itemnotes'},
1349         $item->{'itemcallnumber'},      $item->{'notforloan'},
1350         $item->{'location'},            $item->{multivolumepart},
1351                 $item->{multivolume},           $item->{stack},
1352                 $item->{wthdrawn},
1353     );
1354     if ( $item->{'lost'} ne '' ) {
1355         $query = "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
1356                                                         itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
1357                                                         location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1358         @bind = (
1359             $item->{'bibitemnum'},     $item->{'barcode'},
1360             $item->{'itemnotes'},          $item->{'homebranch'},
1361             $item->{'lost'},           $item->{'wthdrawn'},
1362             $item->{'itemcallnumber'}, $item->{'notforloan'},
1363             $item->{'location'},                $item->{multivolumepart},
1364                         $item->{multivolume},           $item->{stack},
1365                         $item->{wthdrawn},
1366         );
1367                 if ($item->{homebranch}) {
1368                         $query.=",homebranch=?";
1369                         push @bind, $item->{homebranch};
1370                 }
1371                 if ($item->{holdingbranch}) {
1372                         $query.=",holdingbranch=?";
1373                         push @bind, $item->{holdingbranch};
1374                 }
1375     }
1376         $query.=" where itemnumber=?";
1377         push @bind,$item->{'itemnum'};
1378    if ( $item->{'replacement'} ne '' ) {
1379         $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1380     }
1381     my $sth = $dbh->prepare($query);
1382     $sth->execute(@bind);
1383         
1384         # item stored, now, deal with the marc part...
1385         $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio 
1386                                                         where   biblio.biblionumber=biblioitems.biblionumber and 
1387                                                                         biblio.biblionumber=? and 
1388                                                                         biblioitems.biblioitemnumber=?");
1389         $sth->execute($item->{biblionumber},$item->{biblioitemnumber});
1390     if ( defined $sth->errstr ) {
1391         $error .= $sth->errstr;
1392     }
1393         my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1394         warn "ERROR IN REALmoditem, MARC record not found" unless $rawmarc;
1395         my $record = MARC::File::USMARC::decode($rawmarc);
1396         # ok, we have the marc record, find the previous item record for this itemnumber and delete it
1397         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1398         # prepare the new item record
1399         my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1400         my $itemfield = $itemrecord->field($itemnumberfield);
1401         $itemfield->add_subfields($itemnumbersubfield => '$itemnumber');
1402         # parse all fields fields from the complete record
1403         foreach ($record->field($itemnumberfield)) {
1404                 # when the previous field is found, replace by the new one
1405                 if ($_->subfield($itemnumbersubfield) == $item->{itemnum}) {
1406                         $_->replace_with($itemfield);
1407                 }
1408         }
1409 #       $record->insert_grouped_field($itemfield);
1410         # save the record into biblioitem
1411         $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=? and biblioitemnumber=?");
1412         $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber},$item->{biblioitemnumber});
1413         zebra_create($item->biblionumber,$record);
1414     if ( defined $sth->errstr ) {
1415         $error .= $sth->errstr;
1416     }
1417         $dbh->do('unlock tables');
1418
1419     #  $dbh->disconnect;
1420 }
1421
1422 =head2 REALdelitem($dbh,$itemnum);
1423
1424 =over 4
1425
1426 delete item
1427
1428 =back
1429
1430 =cut
1431
1432 sub REALdelitem {
1433     my ( $dbh, $itemnum ) = @_;
1434
1435     #  my $dbh=C4Connect;
1436     my $sth = $dbh->prepare("select * from items where itemnumber=?");
1437     $sth->execute($itemnum);
1438     my $data = $sth->fetchrow_hashref;
1439     $sth->finish;
1440     my $query = "Insert into deleteditems set ";
1441     my @bind  = ();
1442     foreach my $temp ( keys %$data ) {
1443         $query .= "$temp = ?,";
1444         push ( @bind, $data->{$temp} );
1445     }
1446     $query =~ s/\,$//;
1447
1448     #  print $query;
1449     $sth = $dbh->prepare($query);
1450     $sth->execute(@bind);
1451     $sth->finish;
1452     $sth = $dbh->prepare("Delete from items where itemnumber=?");
1453     $sth->execute($itemnum);
1454     $sth->finish;
1455
1456     #  $dbh->disconnect;
1457 }
1458
1459 =head2 REALdelbiblioitem($dbh,$biblioitemnumber);
1460
1461 =over 4
1462
1463 deletes a biblioitem
1464 NOTE : not standard sub name. Should be REALdelbiblioitem()
1465
1466 =back
1467
1468 =cut
1469
1470 sub REALdelbiblioitem {
1471     my ( $dbh, $biblioitemnumber ) = @_;
1472
1473     #    my $dbh   = C4Connect;
1474     my $sth = $dbh->prepare( "Select * from biblioitems
1475 where biblioitemnumber = ?"
1476     );
1477     my $results;
1478
1479     $sth->execute($biblioitemnumber);
1480
1481     if ( $results = $sth->fetchrow_hashref ) {
1482         $sth->finish;
1483         $sth =
1484           $dbh->prepare(
1485 "Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
1486                                         isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
1487                                         pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
1488         );
1489
1490         $sth->execute(
1491             $results->{biblioitemnumber}, $results->{biblionumber},
1492             $results->{volume},           $results->{number},
1493             $results->{classification},   $results->{itemtype},
1494             $results->{isbn},             $results->{issn},
1495             $results->{dewey},            $results->{subclass},
1496             $results->{publicationyear},  $results->{publishercode},
1497             $results->{volumedate},       $results->{volumeddesc},
1498             $results->{timestamp},        $results->{illus},
1499             $results->{pages},            $results->{notes},
1500             $results->{size},             $results->{url},
1501             $results->{lccn}
1502         );
1503         my $sth2 =
1504           $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?");
1505         $sth2->execute($biblioitemnumber);
1506         $sth2->finish();
1507     }    # if
1508     $sth->finish;
1509
1510     # Now delete all the items attached to the biblioitem
1511     $sth = $dbh->prepare("Select * from items where biblioitemnumber = ?");
1512     $sth->execute($biblioitemnumber);
1513     my @results;
1514     while ( my $data = $sth->fetchrow_hashref ) {
1515         my $query = "Insert into deleteditems set ";
1516         my @bind  = ();
1517         foreach my $temp ( keys %$data ) {
1518             $query .= "$temp = ?,";
1519             push ( @bind, $data->{$temp} );
1520         }
1521         $query =~ s/\,$//;
1522         my $sth2 = $dbh->prepare($query);
1523         $sth2->execute(@bind);
1524     }    # while
1525     $sth->finish;
1526     $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
1527     $sth->execute($biblioitemnumber);
1528     $sth->finish();
1529
1530     #    $dbh->disconnect;
1531 }    # sub deletebiblioitem
1532
1533 =head2 REALdelbiblio($dbh,$biblio);
1534
1535 =over 4
1536
1537 delete a biblio
1538
1539 =back
1540
1541 =cut
1542
1543 sub REALdelbiblio {
1544     my ( $dbh, $biblio ) = @_;
1545     my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
1546     $sth->execute($biblio);
1547     if ( my $data = $sth->fetchrow_hashref ) {
1548         $sth->finish;
1549         my $query = "Insert into deletedbiblio set ";
1550         my @bind  = ();
1551         foreach my $temp ( keys %$data ) {
1552             $query .= "$temp = ?,";
1553             push ( @bind, $data->{$temp} );
1554         }
1555
1556         #replacing the last , by ",?)"
1557         $query =~ s/\,$//;
1558         $sth = $dbh->prepare($query);
1559         $sth->execute(@bind);
1560         $sth->finish;
1561         $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
1562         $sth->execute($biblio);
1563         $sth->finish;
1564     }
1565     $sth->finish;
1566 }
1567
1568 =head2 $number = itemcount($biblio);
1569
1570 =over 4
1571
1572 returns the number of items attached to a biblio
1573
1574 =back
1575
1576 =cut
1577
1578 sub itemcount {
1579     my ($biblio) = @_;
1580     my $dbh = C4::Context->dbh;
1581
1582     #  print $query;
1583     my $sth = $dbh->prepare("Select count(*) from items where biblionumber=?");
1584     $sth->execute($biblio);
1585     my $data = $sth->fetchrow_hashref;
1586     $sth->finish;
1587     return ( $data->{'count(*)'} );
1588 }
1589
1590 =head2 $biblionumber = newbiblio($biblio);
1591
1592 =over 4
1593
1594 create a biblio. The parameter is a hash
1595
1596 =back
1597
1598 =cut
1599
1600 sub newbiblio {
1601     my ($biblio) = @_;
1602     my $dbh    = C4::Context->dbh;
1603     my $bibnum = REALnewbiblio( $dbh, $biblio );
1604     # finds new (MARC bibid
1605     #   my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1606 #     my $record = &MARCkoha2marcBiblio( $dbh, $bibnum );
1607 #     MARCaddbiblio( $dbh, $record, $bibnum,'' );
1608     return ($bibnum);
1609 }
1610
1611 =head2   $biblionumber = &modbiblio($biblio);
1612
1613 =over 4
1614
1615 Update a biblio record.
1616
1617 C<$biblio> is a reference-to-hash whose keys are the fields in the
1618 biblio table in the Koha database. All fields must be present, not
1619 just the ones you wish to change.
1620
1621 C<&modbiblio> updates the record defined by
1622 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1623
1624 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1625 successful or not.
1626
1627 =back
1628
1629 =cut
1630
1631 sub modbiblio {
1632         my ($biblio) = @_;
1633         my $dbh  = C4::Context->dbh;
1634         my $biblionumber=REALmodbiblio($dbh,$biblio);
1635         my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
1636         # finds new (MARC bibid
1637         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
1638         MARCmodbiblio($dbh,$bibid,$record,"",0);
1639         return($biblionumber);
1640 } # sub modbiblio
1641
1642 =head2   &modsubtitle($biblionumber, $subtitle);
1643
1644 =over 4
1645
1646 Sets the subtitle of a book.
1647
1648 C<$biblionumber> is the biblionumber of the book to modify.
1649
1650 C<$subtitle> is the new subtitle.
1651
1652 =back
1653
1654 =cut
1655
1656 sub modsubtitle {
1657     my ( $bibnum, $subtitle ) = @_;
1658     my $dbh = C4::Context->dbh;
1659     &REALmodsubtitle( $dbh, $bibnum, $subtitle );
1660 }    # sub modsubtitle
1661
1662 =head2 &modaddauthor($biblionumber, $author);
1663
1664 =over 4
1665
1666 Replaces all additional authors for the book with biblio number
1667 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1668 C<&modaddauthor> deletes all additional authors.
1669
1670 =back
1671
1672 =cut
1673
1674 sub modaddauthor {
1675     my ( $bibnum, @authors ) = @_;
1676     my $dbh = C4::Context->dbh;
1677     &REALmodaddauthor( $dbh, $bibnum, @authors );
1678 }    # sub modaddauthor
1679
1680 =head2 $error = &modsubject($biblionumber, $force, @subjects);
1681
1682 =over 4
1683
1684 $force - a subject to force
1685 $error - Error message, or undef if successful.
1686
1687 =back
1688
1689 =cut
1690
1691 sub modsubject {
1692     my ( $bibnum, $force, @subject ) = @_;
1693     my $dbh = C4::Context->dbh;
1694     my $error = &REALmodsubject( $dbh, $bibnum, $force, @subject );
1695     if ($error eq ''){
1696                 # When MARC is off, ensures that the MARC biblio table gets updated with new
1697                 # subjects, of course, it deletes the biblio in marc, and then recreates.
1698                 # This check is to ensure that no MARC data exists to lose.
1699 #               if (C4::Context->preference("MARC") eq '0'){
1700 #               warn "in modSUBJECT";
1701 #                       my $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibnum);
1702 #                       my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1703 #                       &MARCmodbiblio($dbh,$bibid, $MARCRecord);
1704 #               }
1705         }
1706         return ($error);
1707 }    # sub modsubject
1708
1709 =head2 modbibitem($biblioitem);
1710
1711 =over 4
1712
1713 modify a biblioitem. The parameter is a hash
1714
1715 =back
1716
1717 =cut
1718
1719 sub modbibitem {
1720     my ($biblioitem) = @_;
1721     my $dbh = C4::Context->dbh;
1722     &REALmodbiblioitem( $dbh, $biblioitem );
1723 }    # sub modbibitem
1724
1725 =head2 $biblioitemnumber = newbiblioitem($biblioitem)
1726
1727 =over 4
1728
1729 create a biblioitem, the parameter is a hash
1730
1731 =back
1732
1733 =cut
1734
1735 sub newbiblioitem {
1736     my ($biblioitem) = @_;
1737     my $dbh        = C4::Context->dbh;
1738         # add biblio information to the hash
1739     my $MARCbiblio = MARCkoha2marcBiblio( $dbh, $biblioitem );
1740         $biblioitem->{marc} = $MARCbiblio->as_usmarc();
1741     my $bibitemnum = &REALnewbiblioitem( $dbh, $biblioitem );
1742     return ($bibitemnum);
1743 }
1744
1745 =head2 newsubtitle($biblionumber,$subtitle);
1746
1747 =over 4
1748
1749 insert a subtitle for $biblionumber biblio
1750
1751 =back
1752
1753 =cut
1754
1755
1756 sub newsubtitle {
1757     my ( $bibnum, $subtitle ) = @_;
1758     my $dbh = C4::Context->dbh;
1759     &REALnewsubtitle( $dbh, $bibnum, $subtitle );
1760 }
1761
1762 =head2 $errors = newitems($item, @barcodes);
1763
1764 =over 4
1765
1766 insert items ($item is a hash)
1767
1768 =back
1769
1770 =cut
1771
1772
1773 sub newitems {
1774     my ( $item, @barcodes ) = @_;
1775     my $dbh = C4::Context->dbh;
1776     my $errors;
1777     my $itemnumber;
1778     my $error;
1779     foreach my $barcode (@barcodes) {
1780                 # add items, one by one for each barcode.
1781                 my $oneitem=$item;
1782                 $oneitem->{barcode}= $barcode;
1783         my $MARCitem = &MARCkoha2marcItem( $dbh, $oneitem);
1784                 $oneitem->{marc} = $MARCitem->as_usmarc;
1785         ( $itemnumber, $error ) = &REALnewitems( $dbh, $oneitem);
1786 #         $errors .= $error;
1787 #         &MARCadditem( $dbh, $MARCitem, $item->{biblionumber} );
1788     }
1789     return ($errors);
1790 }
1791
1792 =head2 moditem($item);
1793
1794 =over 4
1795
1796 modify an item ($item is a hash with all item informations)
1797
1798 =back
1799
1800 =cut
1801
1802
1803 sub moditem {
1804     my ($item) = @_;
1805     my $dbh = C4::Context->dbh;
1806     &REALmoditem( $dbh, $item );
1807     my $MARCitem =
1808       &MARCkoha2marcItem( $dbh, $item->{'biblionumber'}, $item->{'itemnum'} );
1809     my $bibid =
1810       &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $item->{biblionumber} );
1811     &MARCmoditem( $dbh, $MARCitem, $bibid, $item->{itemnum}, 0 );
1812 }
1813
1814 =head2 $error = checkitems($count,@barcodes);
1815
1816 =over 4
1817
1818 check for each @barcode entry that the barcode is not a duplicate
1819
1820 =back
1821
1822 =cut
1823
1824 sub checkitems {
1825     my ( $count, @barcodes ) = @_;
1826     my $dbh = C4::Context->dbh;
1827     my $error;
1828     my $sth = $dbh->prepare("Select * from items where barcode=?");
1829     for ( my $i = 0 ; $i < $count ; $i++ ) {
1830         $barcodes[$i] = uc $barcodes[$i];
1831         $sth->execute( $barcodes[$i] );
1832         if ( my $data = $sth->fetchrow_hashref ) {
1833             $error .= " Duplicate Barcode: $barcodes[$i]";
1834         }
1835     }
1836     $sth->finish;
1837     return ($error);
1838 }
1839
1840 =head2 $delitem($itemnum);
1841
1842 =over 4
1843
1844 delete item $itemnum being the item number to delete
1845
1846 =back
1847
1848 =cut
1849
1850 sub delitem {
1851     my ($itemnum) = @_;
1852     my $dbh = C4::Context->dbh;
1853     &REALdelitem( $dbh, $itemnum );
1854 }
1855
1856 =head2 deletebiblioitem($biblioitemnumber);
1857
1858 =over 4
1859
1860 delete the biblioitem $biblioitemnumber
1861
1862 =back
1863
1864 =cut
1865
1866 sub deletebiblioitem {
1867     my ($biblioitemnumber) = @_;
1868     my $dbh = C4::Context->dbh;
1869     &REALdelbiblioitem( $dbh, $biblioitemnumber );
1870 }    # sub deletebiblioitem
1871
1872 =head2 delbiblio($biblionumber)
1873
1874 =over 4
1875
1876 delete biblio $biblionumber
1877
1878 =back
1879
1880 =cut
1881
1882 sub delbiblio {
1883     my ($biblio) = @_;
1884     my $dbh = C4::Context->dbh;
1885     &REALdelbiblio( $dbh, $biblio );
1886     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio );
1887     &MARCdelbiblio( $dbh, $bibid, 0 );
1888 }
1889
1890 =head2 ($count,@results) = getbiblio($biblionumber);
1891
1892 =over 4
1893
1894 return an array with hash of biblios.
1895
1896 FIXME : biblionumber being the primary key, this sub will always return only 1 result, API should be modified...
1897
1898 =back
1899
1900 =cut
1901
1902 sub getbiblio {
1903     my ($biblionumber) = @_;
1904     my $dbh = C4::Context->dbh;
1905     my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
1906
1907     # || die "Cannot prepare $query\n" . $dbh->errstr;
1908     my $count = 0;
1909     my @results;
1910
1911     $sth->execute($biblionumber);
1912
1913     # || die "Cannot execute $query\n" . $sth->errstr;
1914     while ( my $data = $sth->fetchrow_hashref ) {
1915         $results[$count] = $data;
1916         $count++;
1917     }    # while
1918
1919     $sth->finish;
1920     return ( $count, @results );
1921 }    # sub getbiblio
1922
1923 =item bibdata
1924
1925   $data = &bibdata($biblionumber, $type);
1926
1927 Returns information about the book with the given biblionumber.
1928
1929 C<$type> is ignored.
1930
1931 C<&bibdata> returns a reference-to-hash. The keys are the fields in
1932 the C<biblio>, C<biblioitems>, and C<bibliosubtitle> tables in the
1933 Koha database.
1934
1935 In addition, C<$data-E<gt>{subject}> is the list of the book's
1936 subjects, separated by C<" , "> (space, comma, space).
1937
1938 If there are multiple biblioitems with the given biblionumber, only
1939 the first one is considered.
1940
1941 =cut
1942 #'
1943 sub bibdata {
1944         my ($bibnum, $type) = @_;
1945         my $dbh   = C4::Context->dbh;
1946         my $sth   = $dbh->prepare("Select *, biblioitems.notes AS bnotes, biblio.notes
1947                                                                 from biblio 
1948                                                                 left join biblioitems on biblioitems.biblionumber = biblio.biblionumber
1949                                                                 left join bibliosubtitle on
1950                                                                 biblio.biblionumber = bibliosubtitle.biblionumber
1951                                                                 left join itemtypes on biblioitems.itemtype=itemtypes.itemtype
1952                                                                 where biblio.biblionumber = ?
1953                                                                 ");
1954         $sth->execute($bibnum);
1955         my $data;
1956         $data  = $sth->fetchrow_hashref;
1957         $sth->finish;
1958         # handle management of repeated subtitle
1959         $sth   = $dbh->prepare("Select * from bibliosubtitle where biblionumber = ?");
1960         $sth->execute($bibnum);
1961         my @subtitles;
1962         while (my $dat = $sth->fetchrow_hashref){
1963                 my %line;
1964                 $line{subtitle} = $dat->{subtitle};
1965                 push @subtitles, \%line;
1966         } # while
1967         $data->{subtitles} = \@subtitles;
1968         $sth->finish;
1969         $sth   = $dbh->prepare("Select * from bibliosubject where biblionumber = ?");
1970         $sth->execute($bibnum);
1971         my @subjects;
1972         while (my $dat = $sth->fetchrow_hashref){
1973                 my %line;
1974                 $line{subject} = $dat->{'subject'};
1975                 push @subjects, \%line;
1976         } # while
1977         $data->{subjects} = \@subjects;
1978         $sth->finish;
1979         $sth   = $dbh->prepare("Select * from additionalauthors where biblionumber = ?");
1980         $sth->execute($bibnum);
1981         while (my $dat = $sth->fetchrow_hashref){
1982                 $data->{'additionalauthors'} .= "$dat->{'author'} - ";
1983         } # while
1984         chop $data->{'additionalauthors'};
1985         chop $data->{'additionalauthors'};
1986         chop $data->{'additionalauthors'};
1987         $sth->finish;
1988         return($data);
1989 } # sub bibdata
1990
1991 =head2 ($count,@results) = getbiblioitem($biblioitemnumber);
1992
1993 =over 4
1994
1995 return an array with hash of biblioitemss.
1996
1997 FIXME : biblioitemnumber being unique, this sub will always return only 1 result, API should be modified...
1998
1999 =back
2000
2001 =cut
2002
2003 sub getbiblioitem {
2004     my ($biblioitemnum) = @_;
2005     my $dbh = C4::Context->dbh;
2006     my $sth = $dbh->prepare( "Select * from biblioitems where
2007 biblioitemnumber = ?"
2008     );
2009     my $count = 0;
2010     my @results;
2011
2012     $sth->execute($biblioitemnum);
2013
2014     while ( my $data = $sth->fetchrow_hashref ) {
2015         $results[$count] = $data;
2016         $count++;
2017     }    # while
2018
2019     $sth->finish;
2020     return ( $count, @results );
2021 }    # sub getbiblioitem
2022
2023 =head2 ($count,@results) = getbiblioitembybiblionumber($biblionumber);
2024
2025 =over 4
2026
2027 return an array with hash of biblioitems for the given biblionumber.
2028
2029 =back
2030
2031 =cut
2032
2033 sub getbiblioitembybiblionumber {
2034     my ($biblionumber) = @_;
2035     my $dbh = C4::Context->dbh;
2036     my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
2037     my $count = 0;
2038     my @results;
2039
2040     $sth->execute($biblionumber);
2041
2042     while ( my $data = $sth->fetchrow_hashref ) {
2043         $results[$count] = $data;
2044         $count++;
2045     }    # while
2046
2047     $sth->finish;
2048     return ( $count, @results );
2049 }    # sub
2050
2051 =head2 ($count,@results) = getitemsbybiblioitem($biblionumber);
2052
2053 =over 4
2054
2055 returns an array with hash of items
2056
2057 =back
2058
2059 =cut
2060
2061 sub getitemsbybiblioitem {
2062     my ($biblioitemnum) = @_;
2063     my $dbh = C4::Context->dbh;
2064     my $sth = $dbh->prepare( "Select * from items, biblio where
2065 biblio.biblionumber = items.biblionumber and biblioitemnumber
2066 = ?"
2067     );
2068
2069     # || die "Cannot prepare $query\n" . $dbh->errstr;
2070     my $count = 0;
2071     my @results;
2072
2073     $sth->execute($biblioitemnum);
2074
2075     # || die "Cannot execute $query\n" . $sth->errstr;
2076     while ( my $data = $sth->fetchrow_hashref ) {
2077         $results[$count] = $data;
2078         $count++;
2079     }    # while
2080
2081     $sth->finish;
2082     return ( $count, @results );
2083 }    # sub getitemsbybiblioitem
2084
2085 =item ItemInfo
2086
2087   @results = &ItemInfo($env, $biblionumber, $type);
2088
2089 Returns information about books with the given biblionumber.
2090
2091 C<$type> may be either C<intra> or anything else. If it is not set to
2092 C<intra>, then the search will exclude lost, very overdue, and
2093 withdrawn items.
2094
2095 C<$env> is ignored.
2096
2097 C<&ItemInfo> returns a list of references-to-hash. Each element
2098 contains a number of keys. Most of them are table items from the
2099 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
2100 Koha database. Other keys include:
2101
2102 =over 4
2103
2104 =item C<$data-E<gt>{branchname}>
2105
2106 The name (not the code) of the branch to which the book belongs.
2107
2108 =item C<$data-E<gt>{datelastseen}>
2109
2110 This is simply C<items.datelastseen>, except that while the date is
2111 stored in YYYY-MM-DD format in the database, here it is converted to
2112 DD/MM/YYYY format. A NULL date is returned as C<//>.
2113
2114 =item C<$data-E<gt>{datedue}>
2115
2116 =item C<$data-E<gt>{class}>
2117
2118 This is the concatenation of C<biblioitems.classification>, the book's
2119 Dewey code, and C<biblioitems.subclass>.
2120
2121 =item C<$data-E<gt>{ocount}>
2122
2123 I think this is the number of copies of the book available.
2124
2125 =item C<$data-E<gt>{order}>
2126
2127 If this is set, it is set to C<One Order>.
2128
2129 =back
2130
2131 =cut
2132 #'
2133 sub ItemInfo {
2134         my ($env,$biblionumber,$type) = @_;
2135         my $dbh   = C4::Context->dbh;
2136         my $query = "SELECT *,items.notforloan as itemnotforloan FROM items, biblio, biblioitems 
2137                                         left join itemtypes on biblioitems.itemtype = itemtypes.itemtype
2138                                         WHERE items.biblionumber = ?
2139                                         AND biblioitems.biblioitemnumber = items.biblioitemnumber
2140                                         AND biblio.biblionumber = items.biblionumber";
2141         $query .= " order by items.dateaccessioned desc";
2142         my $sth=$dbh->prepare($query);
2143         $sth->execute($biblionumber);
2144         my $i=0;
2145         my @results;
2146         while (my $data=$sth->fetchrow_hashref){
2147                 my $datedue = '';
2148                 my $isth=$dbh->prepare("Select issues.*,borrowers.cardnumber from issues,borrowers where itemnumber = ? and returndate is null and issues.borrowernumber=borrowers.borrowernumber");
2149                 $isth->execute($data->{'itemnumber'});
2150                 if (my $idata=$isth->fetchrow_hashref){
2151                 $data->{borrowernumber} = $idata->{borrowernumber};
2152                 $data->{cardnumber} = $idata->{cardnumber};
2153                 $datedue = format_date($idata->{'date_due'});
2154                 }
2155                 if ($datedue eq ''){
2156                         my ($restype,$reserves)=C4::Reserves2::CheckReserves($data->{'itemnumber'});
2157                         if ($restype) {
2158                                 $datedue=$restype;
2159                         }
2160                 }
2161                 $isth->finish;
2162         #get branch information.....
2163                 my $bsth=$dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
2164                 $bsth->execute($data->{'holdingbranch'});
2165                 if (my $bdata=$bsth->fetchrow_hashref){
2166                         $data->{'branchname'} = $bdata->{'branchname'};
2167                 }
2168                 my $date=format_date($data->{'datelastseen'});
2169                 $data->{'datelastseen'}=$date;
2170                 $data->{'datedue'}=$datedue;
2171         # get notforloan complete status if applicable
2172                 my $sthnflstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.notforloan"');
2173                 $sthnflstatus->execute;
2174                 my ($authorised_valuecode) = $sthnflstatus->fetchrow;
2175                 if ($authorised_valuecode) {
2176                         $sthnflstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?");
2177                         $sthnflstatus->execute($authorised_valuecode,$data->{itemnotforloan});
2178                         my ($lib) = $sthnflstatus->fetchrow;
2179                         $data->{notforloan} = $lib;
2180                 }
2181                 $results[$i]=$data;
2182                 $i++;
2183         }
2184         $sth->finish;
2185         return(@results);
2186 }
2187
2188 =item bibitems
2189
2190   ($count, @results) = &bibitems($biblionumber);
2191
2192 Given the biblionumber for a book, C<&bibitems> looks up that book's
2193 biblioitems (different publications of the same book, the audio book
2194 and film versions, etc.).
2195
2196 C<$count> is the number of elements in C<@results>.
2197
2198 C<@results> is an array of references-to-hash; the keys are the fields
2199 of the C<biblioitems> and C<itemtypes> tables of the Koha database. In
2200 addition, C<itemlost> indicates the availability of the item: if it is
2201 "2", then all copies of the item are long overdue; if it is "1", then
2202 all copies are lost; otherwise, there is at least one copy available.
2203
2204 =cut
2205 #'
2206 sub bibitems {
2207     my ($bibnum) = @_;
2208     my $dbh   = C4::Context->dbh;
2209     my $sth   = $dbh->prepare("SELECT biblioitems.*,
2210                         itemtypes.*,
2211                         MIN(items.itemlost)        as itemlost,
2212                         MIN(items.dateaccessioned) as dateaccessioned
2213                           FROM biblioitems, itemtypes, items
2214                          WHERE biblioitems.biblionumber     = ?
2215                            AND biblioitems.itemtype         = itemtypes.itemtype
2216                            AND biblioitems.biblioitemnumber = items.biblioitemnumber
2217                       GROUP BY items.biblioitemnumber");
2218     my $count = 0;
2219     my @results;
2220     $sth->execute($bibnum);
2221     while (my $data = $sth->fetchrow_hashref) {
2222         $results[$count] = $data;
2223         $count++;
2224     } # while
2225     $sth->finish;
2226     return($count, @results);
2227 } # sub bibitems
2228
2229
2230 =item bibitemdata
2231
2232   $itemdata = &bibitemdata($biblioitemnumber);
2233
2234 Looks up the biblioitem with the given biblioitemnumber. Returns a
2235 reference-to-hash. The keys are the fields from the C<biblio>,
2236 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
2237 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
2238
2239 =cut
2240 #'
2241 sub bibitemdata {
2242     my ($bibitem) = @_;
2243     my $dbh   = C4::Context->dbh;
2244     my $sth   = $dbh->prepare("Select *,biblioitems.notes as bnotes from biblio, biblioitems,itemtypes where biblio.biblionumber = biblioitems.biblionumber and biblioitemnumber = ? and biblioitems.itemtype = itemtypes.itemtype");
2245     my $data;
2246
2247     $sth->execute($bibitem);
2248
2249     $data = $sth->fetchrow_hashref;
2250
2251     $sth->finish;
2252     return($data);
2253 } # sub bibitemdata
2254
2255
2256 =item getbibliofromitemnumber
2257
2258   $item = &getbibliofromitemnumber($env, $dbh, $itemnumber);
2259
2260 Looks up the item with the given itemnumber.
2261
2262 C<$env> and C<$dbh> are ignored.
2263
2264 C<&itemnodata> returns a reference-to-hash whose keys are the fields
2265 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
2266 database.
2267
2268 =cut
2269 #'
2270 sub getbibliofromitemnumber {
2271   my ($env,$dbh,$itemnumber) = @_;
2272   $dbh = C4::Context->dbh;
2273   my $sth=$dbh->prepare("Select * from biblio,items,biblioitems
2274     where items.itemnumber = ?
2275     and biblio.biblionumber = items.biblionumber
2276     and biblioitems.biblioitemnumber = items.biblioitemnumber");
2277 #  print $query;
2278   $sth->execute($itemnumber);
2279   my $data=$sth->fetchrow_hashref;
2280   $sth->finish;
2281   return($data);
2282 }
2283
2284 =item barcodes
2285
2286   @barcodes = &barcodes($biblioitemnumber);
2287
2288 Given a biblioitemnumber, looks up the corresponding items.
2289
2290 Returns an array of references-to-hash; the keys are C<barcode> and
2291 C<itemlost>.
2292
2293 The returned items include very overdue items, but not lost ones.
2294
2295 =cut
2296 #'
2297 sub barcodes{
2298     #called from request.pl
2299     my ($biblioitemnumber)=@_;
2300     my $dbh = C4::Context->dbh;
2301     my $sth=$dbh->prepare("SELECT barcode, itemlost, holdingbranch FROM items
2302                            WHERE biblioitemnumber = ?
2303                              AND (wthdrawn <> 1 OR wthdrawn IS NULL)");
2304     $sth->execute($biblioitemnumber);
2305     my @barcodes;
2306     my $i=0;
2307     while (my $data=$sth->fetchrow_hashref){
2308         $barcodes[$i]=$data;
2309         $i++;
2310     }
2311     $sth->finish;
2312     return(@barcodes);
2313 }
2314
2315
2316 =item itemdata
2317
2318   $item = &itemdata($barcode);
2319
2320 Looks up the item with the given barcode, and returns a
2321 reference-to-hash containing information about that item. The keys of
2322 the hash are the fields from the C<items> and C<biblioitems> tables in
2323 the Koha database.
2324
2325 =cut
2326 #'
2327 sub get_item_from_barcode {
2328   my ($barcode)=@_;
2329   my $dbh = C4::Context->dbh;
2330   my $sth=$dbh->prepare("Select * from items,biblioitems where barcode=?
2331   and items.biblioitemnumber=biblioitems.biblioitemnumber");
2332   $sth->execute($barcode);
2333   my $data=$sth->fetchrow_hashref;
2334   $sth->finish;
2335   return($data);
2336 }
2337
2338
2339 =item itemissues
2340
2341   @issues = &itemissues($biblioitemnumber, $biblio);
2342
2343 Looks up information about who has borrowed the bookZ<>(s) with the
2344 given biblioitemnumber.
2345
2346 C<$biblio> is ignored.
2347
2348 C<&itemissues> returns an array of references-to-hash. The keys
2349 include the fields from the C<items> table in the Koha database.
2350 Additional keys include:
2351
2352 =over 4
2353
2354 =item C<date_due>
2355
2356 If the item is currently on loan, this gives the due date.
2357
2358 If the item is not on loan, then this is either "Available" or
2359 "Cancelled", if the item has been withdrawn.
2360
2361 =item C<card>
2362
2363 If the item is currently on loan, this gives the card number of the
2364 patron who currently has the item.
2365
2366 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
2367
2368 These give the timestamp for the last three times the item was
2369 borrowed.
2370
2371 =item C<card0>, C<card1>, C<card2>
2372
2373 The card number of the last three patrons who borrowed this item.
2374
2375 =item C<borrower0>, C<borrower1>, C<borrower2>
2376
2377 The borrower number of the last three patrons who borrowed this item.
2378
2379 =back
2380
2381 =cut
2382 #'
2383 sub itemissues {
2384     my ($bibitem, $biblio)=@_;
2385     my $dbh   = C4::Context->dbh;
2386     # FIXME - If this function die()s, the script will abort, and the
2387     # user won't get anything; depending on how far the script has
2388     # gotten, the user might get a blank page. It would be much better
2389     # to at least print an error message. The easiest way to do this
2390     # is to set $SIG{__DIE__}.
2391     my $sth   = $dbh->prepare("Select * from items where
2392 items.biblioitemnumber = ?")
2393       || die $dbh->errstr;
2394     my $i     = 0;
2395     my @results;
2396
2397     $sth->execute($bibitem)
2398       || die $sth->errstr;
2399
2400     while (my $data = $sth->fetchrow_hashref) {
2401         # Find out who currently has this item.
2402         # FIXME - Wouldn't it be better to do this as a left join of
2403         # some sort? Currently, this code assumes that if
2404         # fetchrow_hashref() fails, then the book is on the shelf.
2405         # fetchrow_hashref() can fail for any number of reasons (e.g.,
2406         # database server crash), not just because no items match the
2407         # search criteria.
2408         my $sth2   = $dbh->prepare("select * from issues,borrowers
2409 where itemnumber = ?
2410 and returndate is NULL
2411 and issues.borrowernumber = borrowers.borrowernumber");
2412
2413         $sth2->execute($data->{'itemnumber'});
2414         if (my $data2 = $sth2->fetchrow_hashref) {
2415             $data->{'date_due'} = $data2->{'date_due'};
2416             $data->{'card'}     = $data2->{'cardnumber'};
2417             $data->{'borrower'}     = $data2->{'borrowernumber'};
2418         } else {
2419             if ($data->{'wthdrawn'} eq '1') {
2420                 $data->{'date_due'} = 'Cancelled';
2421             } else {
2422                 $data->{'date_due'} = 'Available';
2423             } # else
2424         } # else
2425
2426         $sth2->finish;
2427
2428         # Find the last 3 people who borrowed this item.
2429         $sth2 = $dbh->prepare("select * from issues, borrowers
2430                                                 where itemnumber = ?
2431                                                                         and issues.borrowernumber = borrowers.borrowernumber
2432                                                                         and returndate is not NULL
2433                                                                         order by returndate desc,timestamp desc") || die $dbh->errstr;
2434         $sth2->execute($data->{'itemnumber'}) || die $sth2->errstr;
2435         for (my $i2 = 0; $i2 < 2; $i2++) { # FIXME : error if there is less than 3 pple borrowing this item
2436             if (my $data2 = $sth2->fetchrow_hashref) {
2437                 $data->{"timestamp$i2"} = $data2->{'timestamp'};
2438                 $data->{"card$i2"}      = $data2->{'cardnumber'};
2439                 $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
2440             } # if
2441         } # for
2442
2443         $sth2->finish;
2444         $results[$i] = $data;
2445         $i++;
2446     }
2447
2448     $sth->finish;
2449     return(@results);
2450 }
2451
2452 =item getsubject
2453
2454   ($count, $subjects) = &getsubject($biblionumber);
2455
2456 Looks up the subjects of the book with the given biblionumber. Returns
2457 a two-element list. C<$subjects> is a reference-to-array, where each
2458 element is a subject of the book, and C<$count> is the number of
2459 elements in C<$subjects>.
2460
2461 =cut
2462 #'
2463 sub getsubject {
2464   my ($bibnum)=@_;
2465   my $dbh = C4::Context->dbh;
2466   my $sth=$dbh->prepare("Select * from bibliosubject where biblionumber=?");
2467   $sth->execute($bibnum);
2468   my @results;
2469   my $i=0;
2470   while (my $data=$sth->fetchrow_hashref){
2471     $results[$i]=$data;
2472     $i++;
2473   }
2474   $sth->finish;
2475   return($i,\@results);
2476 }
2477
2478 =item getaddauthor
2479
2480   ($count, $authors) = &getaddauthor($biblionumber);
2481
2482 Looks up the additional authors for the book with the given
2483 biblionumber.
2484
2485 Returns a two-element list. C<$authors> is a reference-to-array, where
2486 each element is an additional author, and C<$count> is the number of
2487 elements in C<$authors>.
2488
2489 =cut
2490 #'
2491 sub getaddauthor {
2492   my ($bibnum)=@_;
2493   my $dbh = C4::Context->dbh;
2494   my $sth=$dbh->prepare("Select * from additionalauthors where biblionumber=?");
2495   $sth->execute($bibnum);
2496   my @results;
2497   my $i=0;
2498   while (my $data=$sth->fetchrow_hashref){
2499     $results[$i]=$data;
2500     $i++;
2501   }
2502   $sth->finish;
2503   return($i,\@results);
2504 }
2505
2506
2507 =item getsubtitle
2508
2509   ($count, $subtitles) = &getsubtitle($biblionumber);
2510
2511 Looks up the subtitles for the book with the given biblionumber.
2512
2513 Returns a two-element list. C<$subtitles> is a reference-to-array,
2514 where each element is a subtitle, and C<$count> is the number of
2515 elements in C<$subtitles>.
2516
2517 =cut
2518 #'
2519 sub getsubtitle {
2520   my ($bibnum)=@_;
2521   my $dbh = C4::Context->dbh;
2522   my $sth=$dbh->prepare("Select * from bibliosubtitle where biblionumber=?");
2523   $sth->execute($bibnum);
2524   my @results;
2525   my $i=0;
2526   while (my $data=$sth->fetchrow_hashref){
2527     $results[$i]=$data;
2528     $i++;
2529   }
2530   $sth->finish;
2531   return($i,\@results);
2532 }
2533
2534
2535 =item getwebsites
2536
2537   ($count, @websites) = &getwebsites($biblionumber);
2538
2539 Looks up the web sites pertaining to the book with the given
2540 biblionumber.
2541
2542 C<$count> is the number of elements in C<@websites>.
2543
2544 C<@websites> is an array of references-to-hash; the keys are the
2545 fields from the C<websites> table in the Koha database.
2546
2547 =cut
2548 #FIXME : could maybe be deleted. Otherwise, would be better in a Websites.pm package
2549 #(with add / modify / delete subs)
2550
2551 sub getwebsites {
2552     my ($biblionumber) = @_;
2553     my $dbh   = C4::Context->dbh;
2554     my $sth   = $dbh->prepare("Select * from websites where biblionumber = ?");
2555     my $count = 0;
2556     my @results;
2557
2558     $sth->execute($biblionumber);
2559     while (my $data = $sth->fetchrow_hashref) {
2560         # FIXME - The URL scheme shouldn't be stripped off, at least
2561         # not here, since it's part of the URL, and will be useful in
2562         # constructing a link to the site. If you don't want the user
2563         # to see the "http://" part, strip that off when building the
2564         # HTML code.
2565         $data->{'url'} =~ s/^http:\/\///;       # FIXME - Leaning toothpick
2566                                                 # syndrome
2567         $results[$count] = $data;
2568         $count++;
2569     } # while
2570
2571     $sth->finish;
2572     return($count, @results);
2573 } # sub getwebsites
2574
2575 =item getwebbiblioitems
2576
2577   ($count, @results) = &getwebbiblioitems($biblionumber);
2578
2579 Given a book's biblionumber, looks up the web versions of the book
2580 (biblioitems with itemtype C<WEB>).
2581
2582 C<$count> is the number of items in C<@results>. C<@results> is an
2583 array of references-to-hash; the keys are the items from the
2584 C<biblioitems> table of the Koha database.
2585
2586 =cut
2587 #'
2588 sub getwebbiblioitems {
2589     my ($biblionumber) = @_;
2590     my $dbh   = C4::Context->dbh;
2591     my $sth   = $dbh->prepare("Select * from biblioitems where biblionumber = ?
2592 and itemtype = 'WEB'");
2593     my $count = 0;
2594     my @results;
2595
2596     $sth->execute($biblionumber);
2597     while (my $data = $sth->fetchrow_hashref) {
2598         $data->{'url'} =~ s/^http:\/\///;
2599         $results[$count] = $data;
2600         $count++;
2601     } # while
2602
2603     $sth->finish;
2604     return($count, @results);
2605 } # sub getwebbiblioitems
2606
2607 sub char_decode {
2608
2609     # converts ISO 5426 coded string to ISO 8859-1
2610     # sloppy code : should be improved in next issue
2611     my ( $string, $encoding ) = @_;
2612     $_ = $string;
2613
2614     #   $encoding = C4::Context->preference("marcflavour") unless $encoding;
2615     if ( $encoding eq "UNIMARC" ) {
2616 #         s/\xe1/Æ/gm;
2617         s/\xe2/Ð/gm;
2618         s/\xe9/Ø/gm;
2619         s/\xec/þ/gm;
2620         s/\xf1/æ/gm;
2621         s/\xf3/ð/gm;
2622         s/\xf9/ø/gm;
2623         s/\xfb/ß/gm;
2624         s/\xc1\x61/à/gm;
2625         s/\xc1\x65/è/gm;
2626         s/\xc1\x69/ì/gm;
2627         s/\xc1\x6f/ò/gm;
2628         s/\xc1\x75/ù/gm;
2629         s/\xc1\x41/À/gm;
2630         s/\xc1\x45/È/gm;
2631         s/\xc1\x49/Ì/gm;
2632         s/\xc1\x4f/Ò/gm;
2633         s/\xc1\x55/Ù/gm;
2634         s/\xc2\x41/Á/gm;
2635         s/\xc2\x45/É/gm;
2636         s/\xc2\x49/Í/gm;
2637         s/\xc2\x4f/Ó/gm;
2638         s/\xc2\x55/Ú/gm;
2639         s/\xc2\x59/Ý/gm;
2640         s/\xc2\x61/á/gm;
2641         s/\xc2\x65/é/gm;
2642         s/\xc2\x69/í/gm;
2643         s/\xc2\x6f/ó/gm;
2644         s/\xc2\x75/ú/gm;
2645         s/\xc2\x79/ý/gm;
2646         s/\xc3\x41/Â/gm;
2647         s/\xc3\x45/Ê/gm;
2648         s/\xc3\x49/Î/gm;
2649         s/\xc3\x4f/Ô/gm;
2650         s/\xc3\x55/Û/gm;
2651         s/\xc3\x61/â/gm;
2652         s/\xc3\x65/ê/gm;
2653         s/\xc3\x69/î/gm;
2654         s/\xc3\x6f/ô/gm;
2655         s/\xc3\x75/û/gm;
2656         s/\xc4\x41/Ã/gm;
2657         s/\xc4\x4e/Ñ/gm;
2658         s/\xc4\x4f/Õ/gm;
2659         s/\xc4\x61/ã/gm;
2660         s/\xc4\x6e/ñ/gm;
2661         s/\xc4\x6f/õ/gm;
2662         s/\xc8\x41/Ä/gm;
2663         s/\xc8\x45/Ë/gm;
2664         s/\xc8\x49/Ï/gm;
2665         s/\xc8\x61/ä/gm;
2666         s/\xc8\x65/ë/gm;
2667         s/\xc8\x69/ï/gm;
2668         s/\xc8\x6F/ö/gm;
2669         s/\xc8\x75/ü/gm;
2670         s/\xc8\x76/ÿ/gm;
2671         s/\xc9\x41/Ä/gm;
2672         s/\xc9\x45/Ë/gm;
2673         s/\xc9\x49/Ï/gm;
2674         s/\xc9\x4f/Ö/gm;
2675         s/\xc9\x55/Ü/gm;
2676         s/\xc9\x61/ä/gm;
2677         s/\xc9\x6f/ö/gm;
2678         s/\xc9\x75/ü/gm;
2679         s/\xca\x41/Å/gm;
2680         s/\xca\x61/å/gm;
2681         s/\xd0\x43/Ç/gm;
2682         s/\xd0\x63/ç/gm;
2683
2684         # this handles non-sorting blocks (if implementation requires this)
2685         $string = nsb_clean($_);
2686     }
2687     elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2688         if (/[\xc1-\xff]/) {
2689             s/\xe1\x61/à/gm;
2690             s/\xe1\x65/è/gm;
2691             s/\xe1\x69/ì/gm;
2692             s/\xe1\x6f/ò/gm;
2693             s/\xe1\x75/ù/gm;
2694             s/\xe1\x41/À/gm;
2695             s/\xe1\x45/È/gm;
2696             s/\xe1\x49/Ì/gm;
2697             s/\xe1\x4f/Ò/gm;
2698             s/\xe1\x55/Ù/gm;
2699             s/\xe2\x41/Á/gm;
2700             s/\xe2\x45/É/gm;
2701             s/\xe2\x49/Í/gm;
2702             s/\xe2\x4f/Ó/gm;
2703             s/\xe2\x55/Ú/gm;
2704             s/\xe2\x59/Ý/gm;
2705             s/\xe2\x61/á/gm;
2706             s/\xe2\x65/é/gm;
2707             s/\xe2\x69/í/gm;
2708             s/\xe2\x6f/ó/gm;
2709             s/\xe2\x75/ú/gm;
2710             s/\xe2\x79/ý/gm;
2711             s/\xe3\x41/Â/gm;
2712             s/\xe3\x45/Ê/gm;
2713             s/\xe3\x49/Î/gm;
2714             s/\xe3\x4f/Ô/gm;
2715             s/\xe3\x55/Û/gm;
2716             s/\xe3\x61/â/gm;
2717             s/\xe3\x65/ê/gm;
2718             s/\xe3\x69/î/gm;
2719             s/\xe3\x6f/ô/gm;
2720             s/\xe3\x75/û/gm;
2721             s/\xe4\x41/Ã/gm;
2722             s/\xe4\x4e/Ñ/gm;
2723             s/\xe4\x4f/Õ/gm;
2724             s/\xe4\x61/ã/gm;
2725             s/\xe4\x6e/ñ/gm;
2726             s/\xe4\x6f/õ/gm;
2727             s/\xe8\x45/Ë/gm;
2728             s/\xe8\x49/Ï/gm;
2729             s/\xe8\x65/ë/gm;
2730             s/\xe8\x69/ï/gm;
2731             s/\xe8\x76/ÿ/gm;
2732             s/\xe9\x41/Ä/gm;
2733             s/\xe9\x4f/Ö/gm;
2734             s/\xe9\x55/Ü/gm;
2735             s/\xe9\x61/ä/gm;
2736             s/\xe9\x6f/ö/gm;
2737             s/\xe9\x75/ü/gm;
2738             s/\xea\x41/Å/gm;
2739             s/\xea\x61/å/gm;
2740
2741             # this handles non-sorting blocks (if implementation requires this)
2742             $string = nsb_clean($_);
2743         }
2744     }
2745     return ($string);
2746 }
2747
2748 sub nsb_clean {
2749     my $NSB = '\x88';    # NSB : begin Non Sorting Block
2750     my $NSE = '\x89';    # NSE : Non Sorting Block end
2751                          # handles non sorting blocks
2752     my ($string) = @_;
2753     $_ = $string;
2754     s/$NSB/(/gm;
2755     s/[ ]{0,1}$NSE/) /gm;
2756     $string = $_;
2757     return ($string);
2758 }
2759
2760 sub FindDuplicate {
2761         my ($record)=@_;
2762         my $dbh = C4::Context->dbh;
2763         my $result = MARCmarc2koha($dbh,$record,'');
2764         my $sth;
2765         my ($biblionumber,$bibid,$title);
2766         # search duplicate on ISBN, easy and fast...
2767         if ($result->{isbn}) {
2768                 $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=?");
2769                 $sth->execute($result->{'isbn'});
2770                 ($biblionumber,$bibid,$title) = $sth->fetchrow;
2771                 return $biblionumber,$bibid,$title if ($biblionumber);
2772         }
2773         # a more complex search : build a request for SearchMarc::catalogsearch()
2774         my (@tags, @and_or, @excluding, @operator, @value, $offset,$length);
2775         # search on biblio.title
2776         my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.title","");
2777         if ($record->field($tag)) {
2778                 if ($record->field($tag)->subfields($subfield)) {
2779                         push @tags, "'".$tag.$subfield."'";
2780                         push @and_or, "and";
2781                         push @excluding, "";
2782                         push @operator, "contains";
2783                         push @value, $record->field($tag)->subfield($subfield);
2784 #                       warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2785                 }
2786         }
2787         # ... and on biblio.author
2788         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.author","");
2789         if ($record->field($tag)) {
2790                 if ($record->field($tag)->subfields($subfield)) {
2791                         push @tags, "'".$tag.$subfield."'";
2792                         push @and_or, "and";
2793                         push @excluding, "";
2794                         push @operator, "contains";
2795                         push @value, $record->field($tag)->subfield($subfield);
2796 #                       warn "for author, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2797                 }
2798         }
2799         # ... and on publicationyear.
2800         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publicationyear","");
2801         if ($record->field($tag)) {
2802                 if ($record->field($tag)->subfields($subfield)) {
2803                         push @tags, "'".$tag.$subfield."'";
2804                         push @and_or, "and";
2805                         push @excluding, "";
2806                         push @operator, "=";
2807                         push @value, $record->field($tag)->subfield($subfield);
2808 #                       warn "for publicationyear, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2809                 }
2810         }
2811         # ... and on size.
2812         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.size","");
2813         if ($record->field($tag)) {
2814                 if ($record->field($tag)->subfields($subfield)) {
2815                         push @tags, "'".$tag.$subfield."'";
2816                         push @and_or, "and";
2817                         push @excluding, "";
2818                         push @operator, "=";
2819                         push @value, $record->field($tag)->subfield($subfield);
2820 #                       warn "for size, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2821                 }
2822         }
2823         # ... and on publisher.
2824         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publishercode","");
2825         if ($record->field($tag)) {
2826                 if ($record->field($tag)->subfields($subfield)) {
2827                         push @tags, "'".$tag.$subfield."'";
2828                         push @and_or, "and";
2829                         push @excluding, "";
2830                         push @operator, "=";
2831                         push @value, $record->field($tag)->subfield($subfield);
2832 #                       warn "for publishercode, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2833                 }
2834         }
2835         # ... and on volume.
2836         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.volume","");
2837         if ($record->field($tag)) {
2838                 if ($record->field($tag)->subfields($subfield)) {
2839                         push @tags, "'".$tag.$subfield."'";
2840                         push @and_or, "and";
2841                         push @excluding, "";
2842                         push @operator, "=";
2843                         push @value, $record->field($tag)->subfield($subfield);
2844 #                       warn "for volume, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2845                 }
2846         }
2847
2848         my ($finalresult,$nbresult) = C4::SearchMarc::catalogsearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10);
2849         # there is at least 1 result => return the 1st one
2850         if ($nbresult) {
2851 #               warn "$nbresult => ".@$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2852                 return @$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2853         }
2854         # no result, returns nothing
2855         return;
2856 }
2857
2858 sub DisplayISBN {
2859         my ($isbn)=@_;
2860         my $seg1;
2861         if(substr($isbn, 0, 1) <=7) {
2862                 $seg1 = substr($isbn, 0, 1);
2863         } elsif(substr($isbn, 0, 2) <= 94) {
2864                 $seg1 = substr($isbn, 0, 2);
2865         } elsif(substr($isbn, 0, 3) <= 995) {
2866                 $seg1 = substr($isbn, 0, 3);
2867         } elsif(substr($isbn, 0, 4) <= 9989) {
2868                 $seg1 = substr($isbn, 0, 4);
2869         } else {
2870                 $seg1 = substr($isbn, 0, 5);
2871         }
2872         my $x = substr($isbn, length($seg1));
2873         my $seg2;
2874         if(substr($x, 0, 2) <= 19) {
2875 #               if(sTmp2 < 10) sTmp2 = "0" sTmp2;
2876                 $seg2 = substr($x, 0, 2);
2877         } elsif(substr($x, 0, 3) <= 699) {
2878                 $seg2 = substr($x, 0, 3);
2879         } elsif(substr($x, 0, 4) <= 8399) {
2880                 $seg2 = substr($x, 0, 4);
2881         } elsif(substr($x, 0, 5) <= 89999) {
2882                 $seg2 = substr($x, 0, 5);
2883         } elsif(substr($x, 0, 6) <= 9499999) {
2884                 $seg2 = substr($x, 0, 6);
2885         } else {
2886                 $seg2 = substr($x, 0, 7);
2887         }
2888         my $seg3=substr($x,length($seg2));
2889         $seg3=substr($seg3,0,length($seg3)-1) ;
2890         my $seg4 = substr($x, -1, 1);
2891         return "$seg1-$seg2-$seg3-$seg4";
2892 }
2893
2894
2895 END { }    # module clean-up code here (global destructor)
2896
2897 =back
2898
2899 =head1 AUTHOR
2900
2901 Koha Developement team <info@koha.org>
2902
2903 Paul POULAIN paul.poulain@free.fr
2904
2905 =cut
2906
2907 # $Id$
2908 # $Log$
2909 # Revision 1.136  2006/01/10 17:01:29  tipaul
2910 # adding a XMLgetbiblio in Biblio.pm (1st draft, to use with zebra)
2911 #
2912 # Revision 1.135  2006/01/06 16:39:37  tipaul
2913 # synch'ing head and rel_2_2 (from 2.2.5, including npl templates)
2914 # Seems not to break too many things, but i'm probably wrong here.
2915 # at least, new features/bugfixes from 2.2.5 are here (tested on some features on my head local copy)
2916 #
2917 # - removing useless directories (koha-html and koha-plucene)
2918 #
2919 # Revision 1.134  2006/01/04 15:54:55  tipaul
2920 # utf8 is a : go for beta test in HEAD.
2921 # some explanations :
2922 # - updater/updatedatabase => will transform all tables in innoDB (not related to utf8, just to warn you) AND collate them in utf8 / utf8_general_ci. The SQL command is : ALTER TABLE tablename DEFAULT CHARACTER SET utf8 COLLATE utf8_general_ci.
2923 # - *-top.inc will show the pages in utf8
2924 # - THE HARD THING : for me, mysql-client and mysql-server were set up to communicate in iso8859-1, whatever the mysql collation ! Thus, pages were improperly shown, as datas were transmitted in iso8859-1 format ! After a full day of investigation, someone on usenet pointed "set NAMES 'utf8'" to explain that I wanted utf8. I could put this in my.cnf, but if I do that, ALL databases will "speak" in utf8, that's not what we want. Thus, I added a line in Context.pm : everytime a DB handle is opened, the communication is set to utf8.
2925 # - using marcxml field and no more the iso2709 raw marc biblioitems.marc field.
2926 #
2927 # Revision 1.133  2005/12/12 14:25:51  thd
2928 #
2929 #
2930 # Reverse array filled with elements from repeated subfields
2931 # to avoid last to first concatenation of elements in Koha DB.-
2932 #
2933 # Revision 1.132  2005-10-26 09:12:33  tipaul
2934 # big commit, still breaking things...
2935 #
2936 # * synch with rel_2_2. Probably the last non manual synch, as rel_2_2 should not be modified deeply.
2937 # * code cleaning (cleaning warnings from perl -w) continued
2938 #
2939 # Revision 1.131  2005/09/22 10:01:45  tipaul
2940 # see mail on koha-devel : code cleaning on Search.pm + normalizing API + use of biblionumber everywhere (instead of bn, biblio, ...)
2941 #
2942 # Revision 1.130  2005/09/02 14:34:14  tipaul
2943 # continuing the work to move to zebra. Begin of work for MARC=OFF support.
2944 # IMPORTANT NOTE : the MARCkoha2marc sub API has been modified. Instead of biblionumber & biblioitemnumber, it now gets a hash.
2945 # The sub is used only in Biblio.pm, so the API change should be harmless (except for me, but i'm aware ;-) )
2946 #
2947 # Revision 1.129  2005/08/12 13:50:31  tipaul
2948 # removing useless sub declarations
2949 #
2950 # Revision 1.128  2005/08/11 16:12:47  tipaul
2951 # Playing with the zebra...
2952 #
2953 # * go to koha cvs home directory
2954 # * in misc/zebra there is a unimarc directory. I suggest that marc21 libraries create a marc21 directory
2955 # * put your zebra.cfg files here & create your database.
2956 # * from koha cvs home directory, ln -s misc/zebra/marc21 zebra (I mean create a symbolic link to YOUR zebra directory)
2957 # * now, everytime you add/modify a biblio/item your zebra DB is updated correctly.
2958 #
2959 # NOTE :
2960 # * this uses a system call in perl. CPU consumming, but we are waiting for indexdata Perl/zoom
2961 # * deletion still not work
2962 # * UNIMARC zebra config files are provided in misc/zebra/unimarc directory. The most important line being :
2963 # in zebra.cfg :
2964 # recordId: (bib1,Local-number)
2965 # storeKeys:1
2966 #
2967 # in .abs file :
2968 # elm 090            Local-number            -
2969 # elm 090/?          Local-number            -
2970 # elm 090/?/9        Local-number            !:w
2971 #
2972 # (090$9 being the field mapped to biblio.biblionumber in Koha)
2973 #
2974 # Revision 1.127  2005/08/11 14:37:32  tipaul
2975 # * POD documenting
2976 # * removing useless subs
2977 # * removing some subs that are also elsewhere
2978 # * 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)
2979 #
2980 # Revision 1.126  2005/08/11 09:13:28  tipaul
2981 # just removing useless subs (a lot !!!) for code cleaning
2982 #
2983 # Revision 1.125  2005/08/11 09:00:07  tipaul
2984 # Ok guys, this time, it seems that item add and modif begin working as expected...
2985 # Still a lot of bugs to fix, of course
2986 #
2987 # Revision 1.124  2005/08/10 10:21:15  tipaul
2988 # continuing the road to zebra :
2989 # - the biblio add begins to work.
2990 # - the biblio modif begins to work.
2991 #
2992 # (still without doing anything on zebra)
2993 # (no new change in updatedatabase)
2994 #
2995 # Revision 1.123  2005/08/09 14:10:28  tipaul
2996 # 1st commit to go to zebra.
2997 # don't update your cvs if you want to have a working head...
2998 #
2999 # this commit contains :
3000 # * 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...
3001 # * 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.
3002 # * other files : get rid of bibid and use biblionumber instead.
3003 #
3004 # What is broken :
3005 # * does not do anything on zebra yet.
3006 # * if you rename marc_subfield_table, you can't search anymore.
3007 # * you can view a biblio & bibliodetails, go to MARC editor, but NOT save any modif.
3008 # * 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 ;-) )
3009 #
3010 # 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
3011 # 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.
3012
3013 # tipaul cutted previous commit notes