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