bugfixes for biblio deletion
[koha.git] / C4 / Biblio.pm
1 package C4::Biblio;
2 # Copyright 2000-2002 Katipo Communications
3 #
4 # This file is part of Koha.
5 #
6 # Koha is free software; you can redistribute it and/or modify it under the
7 # terms of the GNU General Public License as published by the Free Software
8 # Foundation; either version 2 of the License, or (at your option) any later
9 # version.
10 #
11 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
12 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
13 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
14 #
15 # You should have received a copy of the GNU General Public License along with
16 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
17 # Suite 330, Boston, MA  02111-1307 USA
18
19 use strict;
20 require Exporter;
21 use C4::Context;
22 use C4::Database;
23 use MARC::Record;
24
25 use vars qw($VERSION @ISA @EXPORT);
26
27 # set the version for version checking
28 $VERSION = 0.01;
29
30 @ISA = qw(Exporter);
31 #
32 # don't forget MARCxxx subs are exported only for testing purposes. Should not be used
33 # as the old-style API and the NEW one are the only public functions.
34 #
35 @EXPORT = qw(
36              &updateBiblio &updateBiblioItem &updateItem
37              &itemcount &newbiblio &newbiblioitem
38              &modnote &newsubject &newsubtitle
39              &modbiblio &checkitems
40              &newitems &modbibitem
41              &modsubtitle &modsubject &modaddauthor &moditem &countitems
42              &delitem &deletebiblioitem &delbiblio
43              &getitemtypes &getbiblio
44              &getbiblioitembybiblionumber
45              &getbiblioitem &getitemsbybiblioitem
46              &skip
47              &newcompletebiblioitem
48
49              &MARCfind_oldbiblionumber_from_MARCbibid
50              &MARCfind_MARCbibid_from_oldbiblionumber
51                 &MARCfind_marc_from_kohafield
52              &MARCfindsubfield
53              &MARCgettagslib
54
55                 &NEWnewbiblio &NEWnewitem
56                 &NEWmodbiblio &NEWmoditem
57                 &NEWdelbiblio &NEWdelitem
58
59              &MARCaddbiblio &MARCadditem
60              &MARCmodsubfield &MARCaddsubfield
61              &MARCmodbiblio &MARCmoditem
62              &MARCkoha2marcBiblio &MARCmarc2koha
63                 &MARCkoha2marcItem &MARChtml2marc
64              &MARCgetbiblio &MARCgetitem
65              &MARCaddword &MARCdelword
66                 &char_decode
67  );
68
69 #
70 #
71 # MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC
72 #
73 #
74 # all the following subs takes a MARC::Record as parameter and manage
75 # the MARC-DB. They are called by the 1.0/1.2 xxx subs, and by the
76 # NEWxxx subs (xxx deals with old-DB parameters, the NEWxxx deals with MARC-DB parameter)
77
78 =head1 NAME
79
80 C4::Biblio - acquisition, catalog  management functions
81
82 =head1 SYNOPSIS
83
84 move from 1.2 to 1.4 version :
85 1.2 and previous version uses a specific API to manage biblios. This API uses old-DB style parameters.
86 In the 1.4 version, we want to do 2 differents things :
87  - keep populating the old-DB, that has a LOT less datas than MARC
88  - populate the MARC-DB
89 To populate the DBs we have 2 differents sources :
90  - the standard acquisition system (through book sellers), that does'nt use MARC data
91  - the MARC acquisition system, that uses MARC data.
92
93 Thus, we have 2 differents cases :
94 - with the standard acquisition system, we have non MARC data and want to populate old-DB and MARC-DB, knowing it's an incomplete MARC-record
95 - with the MARC acquisition system, we have MARC datas, and want to loose nothing in MARC-DB. So, we can't store datas in old-DB, then copy in MARC-DB. we MUST have an API for true MARC data, that populate MARC-DB then old-DB
96
97 That's why we need 4 subs :
98 all I<subs beginning by MARC> manage only MARC tables. They manage MARC-DB with MARC::Record parameters
99 all I<subs beginning by OLD> manage only OLD-DB tables. They manage old-DB with old-DB parameters
100 all I<subs beginning by NEW> manage both OLD-DB and MARC tables. They use MARC::Record as parameters. it's the API that MUST be used in MARC acquisition system
101 all I<subs beginning by seomething else> are the old-style API. They use old-DB as parameter, then call internally the OLD and MARC subs.
102
103 - NEW and old-style API should be used in koha to manage biblio
104 - MARCsubs are divided in 2 parts :
105 * some of them manage MARC parameters. They are heavily used in koha.
106 * some of them manage MARC biblio : they are mostly used by NEW and old-style subs.
107 - OLD are used internally only
108
109 all subs requires/use $dbh as 1st parameter.
110
111 I<NEWxxx related subs>
112
113 all subs requires/use $dbh as 1st parameter.
114 those subs are used by the MARC-compliant version of koha : marc import, or marc management.
115
116 I<OLDxxx related subs>
117
118 all subs requires/use $dbh as 1st parameter.
119 those subs are used by the MARC-compliant version of koha : marc import, or marc management.
120
121 They all are the exact copy of 1.0/1.2 version of the sub without the OLD.
122 The OLDxxx is called by the original xxx sub.
123 the 1.4 xxx sub also builds MARC::Record an calls the MARCxxx
124
125 WARNING : there is 1 difference between initialxxx and OLDxxx :
126 the db header $dbh is always passed as parameter to avoid over-DB connexion
127
128 =head1 DESCRIPTION
129
130 =over 4
131
132 =item @tagslib = &MARCgettagslib($dbh,1|0);
133
134 last param is 1 for liblibrarian and 0 for libopac
135 returns a hash with tag/subfield meaning
136 =item ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
137
138 finds MARC tag and subfield for a given kohafield
139 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
140
141 =item $biblionumber = &MARCfind_oldbiblionumber_from_MARCbibid($dbh,$MARCbibi);
142
143 finds a old-db biblio number for a given MARCbibid number
144
145 =item $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$oldbiblionumber);
146
147 finds a MARC bibid from a old-db biblionumber
148
149 =item $MARCRecord = &MARCkoha2marcBiblio($dbh,$biblionumber,biblioitemnumber);
150
151 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem
152
153 =item $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);
154
155 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB item
156
157 =item $MARCRecord = &MARCkoha2marcSubtitle($dbh,$biblionumber,$subtitle);
158
159 MARCkoha2marcSubtitle is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB subtitle
160
161 =item $olddb = &MARCmarc2koha($dbh,$MARCRecord);
162
163 builds a hash with old-db datas from a MARC::Record
164
165 =item &MARCaddbiblio($dbh,$MARC::Record,$biblionumber);
166
167 creates a biblio (in the MARC tables only). $biblionumber is the old-db biblionumber of the biblio
168
169 =item &MARCaddsubfield($dbh,$bibid,$tagid,$indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
170
171 adds a subfield in a biblio (in the MARC tables only).
172
173 =item $MARCRecord = &MARCgetbiblio($dbh,$bibid);
174
175 Returns a MARC::Record for the biblio $bibid.
176
177 =item &MARCmodbiblio($dbh,$bibid,$record,$delete);
178
179 MARCmodbiblio changes a biblio for a biblio,MARC::Record passed as parameter
180 It 1st delete the biblio, then recreates it.
181 WARNING : the $delete parameter is not used anymore (too much unsolvable cases).
182 =item ($subfieldid,$subfieldvalue) = &MARCmodsubfield($dbh,$subfieldid,$subfieldvalue);
183
184 MARCmodsubfield changes the value of a given subfield
185
186 =item $subfieldid = &MARCfindsubfield($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue);
187
188 MARCfindsubfield returns a subfield number given a bibid/tag/subfieldvalue values.
189 Returns -1 if more than 1 answer
190
191 =item $subfieldid = &MARCfindsubfieldid($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
192
193 MARCfindsubfieldid find a subfieldid for a bibid/tag/tagorder/subfield/subfieldorder
194
195 =item &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
196
197 MARCdelsubfield delete a subfield for a bibid/tag/tagorder/subfield/subfieldorder
198
199 =item &MARCdelbiblio($dbh,$bibid);
200
201 MARCdelbiblio delete biblio $bibid
202
203 =item &MARCkoha2marcOnefield
204
205 used by MARCkoha2marc and should not be useful elsewhere
206
207 =item &MARCmarc2kohaOnefield
208
209 used by MARCmarc2koha and should not be useful elsewhere
210
211 =item MARCaddword
212
213 used to manage MARC_word table and should not be useful elsewhere
214
215 =item MARCdelword
216
217 used to manage MARC_word table and should not be useful elsewhere
218
219 =cut
220
221 sub MARCgettagslib {
222         my ($dbh,$forlibrarian)= @_;
223         my $sth;
224         my $libfield = ($forlibrarian eq 1)? 'liblibrarian' : 'libopac';
225         $sth=$dbh->prepare("select tagfield,$libfield as lib,mandatory from marc_tag_structure order by tagfield");
226         $sth->execute;
227         my ($lib,$tag,$res,$tab,$mandatory,$repeatable);
228         while ( ($tag,$lib,$mandatory) = $sth->fetchrow) {
229                 $res->{$tag}->{lib}=$lib;
230                 $res->{$tab}->{tab}=""; # XXX
231                 $res->{$tag}->{mandatory}=$mandatory;
232         }
233
234         $sth=$dbh->prepare("select tagfield,tagsubfield,$libfield as lib,tab, mandatory, repeatable,authorised_value,thesaurus_category,value_builder,kohafield from marc_subfield_structure order by tagfield,tagsubfield");
235         $sth->execute;
236
237         my $subfield;
238         my $authorised_value;
239         my $thesaurus_category;
240         my $value_builder;
241         my $kohafield;
242         while ( ($tag, $subfield, $lib, $tab, $mandatory, $repeatable,$authorised_value,$thesaurus_category,$value_builder,$kohafield) = $sth->fetchrow) {
243                 $res->{$tag}->{$subfield}->{lib}=$lib;
244                 $res->{$tag}->{$subfield}->{tab}=$tab;
245                 $res->{$tag}->{$subfield}->{mandatory}=$mandatory;
246                 $res->{$tag}->{$subfield}->{repeatable}=$repeatable;
247                 $res->{$tag}->{$subfield}->{authorised_value}=$authorised_value;
248                 $res->{$tag}->{$subfield}->{thesaurus_category}=$thesaurus_category;
249                 $res->{$tag}->{$subfield}->{value_builder}=$value_builder;
250                 $res->{$tag}->{$subfield}->{kohafield}=$kohafield;
251         }
252         return $res;
253 }
254
255 sub MARCfind_marc_from_kohafield {
256     my ($dbh,$kohafield) = @_;
257     my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
258     $sth->execute($kohafield);
259     my ($tagfield,$tagsubfield) = $sth->fetchrow;
260     return ($tagfield,$tagsubfield);
261 }
262
263 sub MARCfind_oldbiblionumber_from_MARCbibid {
264     my ($dbh,$MARCbibid) = @_;
265     my $sth=$dbh->prepare("select biblionumber from marc_biblio where bibid=?");
266     $sth->execute($MARCbibid);
267     my ($biblionumber) = $sth->fetchrow;
268     return $biblionumber;
269 }
270
271 sub MARCfind_MARCbibid_from_oldbiblionumber {
272     my ($dbh,$oldbiblionumber) = @_;
273     my $sth=$dbh->prepare("select bibid from marc_biblio where biblionumber=?");
274     $sth->execute($oldbiblionumber);
275     my ($bibid) = $sth->fetchrow;
276     return $bibid;
277 }
278
279 sub MARCaddbiblio {
280 # pass the MARC::Record to this function, and it will create the records in the marc tables
281         my ($dbh,$record,$biblionumber,$bibid) = @_;
282         my @fields=$record->fields();
283 #       warn "IN MARCaddbiblio $bibid => ".$record->as_formatted;
284 # my $bibid;
285 # adding main table, and retrieving bibid
286 # if bibid is sent, then it's not a true add, it's only a re-add, after a delete (ie, a mod)
287 # if bibid empty => true add, find a new bibid number
288         unless ($bibid) {
289                 $dbh->do("lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ");
290                 my $sth=$dbh->prepare("insert into marc_biblio (datecreated,biblionumber) values (now(),?)");
291                 $sth->execute($biblionumber);
292                 $sth=$dbh->prepare("select max(bibid) from marc_biblio");
293                 $sth->execute;
294                 ($bibid)=$sth->fetchrow;
295                 $sth->finish;
296         }
297         my $fieldcount=0;
298         # now, add subfields...
299         foreach my $field (@fields) {
300                 $fieldcount++;
301                 if ($field->tag() <10) {
302                                 &MARCaddsubfield($dbh,$bibid,
303                                                 $field->tag(),
304                                                 '',
305                                                 $fieldcount,
306                                                 '',
307                                                 1,
308                                                 $field->data()
309                                                 );
310                 } else {
311                         my @subfields=$field->subfields();
312                         foreach my $subfieldcount (0..$#subfields) {
313                                 &MARCaddsubfield($dbh,$bibid,
314                                                 $field->tag(),
315                                                 $field->indicator(1).$field->indicator(2),
316                                                 $fieldcount,
317                                                 $subfields[$subfieldcount][0],
318                                                 $subfieldcount+1,
319                                                 $subfields[$subfieldcount][1]
320                                                 );
321                         }
322                 }
323         }
324         $dbh->do("unlock tables");
325         return $bibid;
326 }
327
328 sub MARCadditem {
329 # pass the MARC::Record to this function, and it will create the records in the marc tables
330     my ($dbh,$record,$biblionumber) = @_;
331 #    warn "adding : ".$record->as_formatted();
332 # search for MARC biblionumber
333     $dbh->do("lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ");
334     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
335     my @fields=$record->fields();
336     my $sth = $dbh->prepare("select max(tagorder) from marc_subfield_table where bibid=?");
337     $sth->execute($bibid);
338     my ($fieldcount) = $sth->fetchrow;
339     # now, add subfields...
340     foreach my $field (@fields) {
341         my @subfields=$field->subfields();
342         $fieldcount++;
343         foreach my $subfieldcount (0..$#subfields) {
344                     &MARCaddsubfield($dbh,$bibid,
345                                  $field->tag(),
346                                  $field->indicator(1).$field->indicator(2),
347                                  $fieldcount,
348                                  $subfields[$subfieldcount][0],
349                                  $subfieldcount+1,
350                                  $subfields[$subfieldcount][1]
351                                  );
352         }
353     }
354     $dbh->do("unlock tables");
355     return $bibid;
356 }
357
358 sub MARCaddsubfield {
359 # Add a new subfield to a tag into the DB.
360         my ($dbh,$bibid,$tagid,$tag_indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalues) = @_;
361         # if not value, end of job, we do nothing
362         if (length($subfieldvalues) ==0) {
363                 return;
364         }
365         if (not($subfieldcode)) {
366                 $subfieldcode=' ';
367         }
368         my @subfieldvalues = split /\|/,$subfieldvalues;
369         foreach my $subfieldvalue (@subfieldvalues) {
370                 if (length($subfieldvalue)>255) {
371                         $dbh->do("lock tables marc_blob_subfield WRITE, marc_subfield_table WRITE");
372                         my $sth=$dbh->prepare("insert into marc_blob_subfield (subfieldvalue) values (?)");
373                         $sth->execute($subfieldvalue);
374                         $sth=$dbh->prepare("select max(blobidlink)from marc_blob_subfield");
375                         $sth->execute;
376                         my ($res)=$sth->fetchrow;
377                         $sth=$dbh->prepare("insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,valuebloblink) values (?,?,?,?,?,?,?)");
378                         $sth->execute($bibid,(sprintf "%03s",$tagid),$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$res);
379                         if ($sth->errstr) {
380                                 warn "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
381                         }
382                 $dbh->do("unlock tables");
383                 } else {
384                         my $sth=$dbh->prepare("insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values (?,?,?,?,?,?,?)");
385                         $sth->execute($bibid,(sprintf "%03s",$tagid),$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue);
386                         if ($sth->errstr) {
387                         warn "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
388                         }
389                 }
390                 &MARCaddword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
391         }
392 }
393
394 sub MARCgetbiblio {
395 # Returns MARC::Record of the biblio passed in parameter.
396     my ($dbh,$bibid)=@_;
397     my $record = MARC::Record->new();
398 #---- TODO : the leader is missing
399         $record->leader('                        ');
400     my $sth=$dbh->prepare("select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
401                                  from marc_subfield_table
402                                  where bibid=? order by tag,tagorder,subfieldcode
403                          ");
404         my $sth2=$dbh->prepare("select subfieldvalue from marc_blob_subfield where blobidlink=?");
405         $sth->execute($bibid);
406         my $prevtagorder=1;
407         my $prevtag='XXX';
408         my $previndicator;
409         my $field; # for >=10 tags
410         my $prevvalue; # for <10 tags
411         while (my $row=$sth->fetchrow_hashref) {
412                 if ($row->{'valuebloblink'}) { #---- search blob if there is one
413                         $sth2->execute($row->{'valuebloblink'});
414                         my $row2=$sth2->fetchrow_hashref;
415                         $sth2->finish;
416                         $row->{'subfieldvalue'}=$row2->{'subfieldvalue'};
417                 }
418                 if ($row->{tagorder} ne $prevtagorder || $row->{tag} ne $prevtag) {
419                         $previndicator.="  ";
420                         if ($prevtag <10) {
421                         $record->add_fields((sprintf "%03s",$prevtag),$prevvalue) unless $prevtag eq "XXX"; # ignore the 1st loop
422                         } else {
423                                 $record->add_fields($field) unless $prevtag eq "XXX";
424                         }
425                         undef $field;
426                         $prevtagorder=$row->{tagorder};
427                         $prevtag = $row->{tag};
428                         $previndicator=$row->{tag_indicator};
429                         if ($row->{tag}<10) {
430                                 $prevvalue = $row->{subfieldvalue};
431                         } else {
432                                 $field = MARC::Field->new((sprintf "%03s",$prevtag), substr($row->{tag_indicator}.'  ',0,1), substr($row->{tag_indicator}.'  ',1,1), $row->{'subfieldcode'}, $row->{'subfieldvalue'} );
433                         }
434                 } else {
435                         if ($row->{tag} <10) {
436                                 $record->add_fields((sprintf "%03s",$row->{tag}), $row->{'subfieldvalue'});
437                         } else {
438                                 $field->add_subfields($row->{'subfieldcode'}, $row->{'subfieldvalue'} );
439                         }
440                         $prevtag= $row->{tag};
441                         $previndicator=$row->{tag_indicator};
442                 }
443         }
444         # the last has not been included inside the loop... do it now !
445         if ($prevtag ne "XXX") { # check that we have found something. Otherwise, prevtag is still XXX and we
446                                                 # must return an empty record, not make MARC::Record fail because we try to
447                                                 # create a record with XXX as field :-(
448                 if ($prevtag <10) {
449                         $record->add_fields($prevtag,$prevvalue);
450                 } else {
451         #               my $field = MARC::Field->new( $prevtag, "", "", %subfieldlist);
452                         $record->add_fields($field);
453                 }
454         }
455         return $record;
456 }
457 sub MARCgetitem {
458 # Returns MARC::Record of the biblio passed in parameter.
459     my ($dbh,$bibid,$itemnumber)=@_;
460     my $record = MARC::Record->new();
461 # search MARC tagorder
462     my $sth2 = $dbh->prepare("select tagorder from marc_subfield_table,marc_subfield_structure where marc_subfield_table.tag=marc_subfield_structure.tagfield and marc_subfield_table.subfieldcode=marc_subfield_structure.tagsubfield and bibid=? and kohafield='items.itemnumber' and subfieldvalue=?");
463     $sth2->execute($bibid,$itemnumber);
464     my ($tagorder) = $sth2->fetchrow_array();
465 #---- TODO : the leader is missing
466     my $sth=$dbh->prepare("select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
467                                  from marc_subfield_table
468                                  where bibid=? and tagorder=? order by subfieldcode,subfieldorder
469                          ");
470         $sth2=$dbh->prepare("select subfieldvalue from marc_blob_subfield where blobidlink=?");
471         $sth->execute($bibid,$tagorder);
472         while (my $row=$sth->fetchrow_hashref) {
473         if ($row->{'valuebloblink'}) { #---- search blob if there is one
474                 $sth2->execute($row->{'valuebloblink'});
475                 my $row2=$sth2->fetchrow_hashref;
476                 $sth2->finish;
477                 $row->{'subfieldvalue'}=$row2->{'subfieldvalue'};
478         }
479         if ($record->field($row->{'tag'})) {
480             my $field;
481 #--- this test must stay as this, because of strange behaviour of mySQL/Perl DBI with char var containing a number...
482 #--- sometimes, eliminates 0 at beginning, sometimes no ;-\\\
483             if (length($row->{'tag'}) <3) {
484                 $row->{'tag'} = "0".$row->{'tag'};
485             }
486             $field =$record->field($row->{'tag'});
487             if ($field) {
488                 my $x = $field->add_subfields($row->{'subfieldcode'},$row->{'subfieldvalue'});
489                 $record->delete_field($field);
490                 $record->add_fields($field);
491             }
492         } else {
493             if (length($row->{'tag'}) < 3) {
494                 $row->{'tag'} = "0".$row->{'tag'};
495             }
496             my $temp = MARC::Field->new($row->{'tag'}," "," ", $row->{'subfieldcode'} => $row->{'subfieldvalue'});
497             $record->add_fields($temp);
498         }
499
500     }
501     return $record;
502 }
503
504 sub MARCmodbiblio {
505         my ($dbh,$bibid,$record,$delete)=@_;
506         my $oldrecord=&MARCgetbiblio($dbh,$bibid);
507         if ($oldrecord eq $record) {
508                 return;
509         }
510 # 1st delete the biblio,
511 # 2nd recreate it
512         my $biblionumber = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
513         &MARCdelbiblio($dbh,$bibid,1);
514         &MARCaddbiblio($dbh,$record,$biblionumber,$bibid);
515 }
516
517 sub MARCdelbiblio {
518         my ($dbh,$bibid,$keep_items) = @_;
519 # if the keep_item is set to 1, then all items are preserved.
520 # This flag is set when the delbiblio is called by modbiblio
521 # due to a too complex structure of MARC (repeatable fields and subfields),
522 # the best solution for a modif is to delete / recreate the record.
523
524 # 1st of all, copy the MARC::Record to deletedbiblio table => if a true deletion, MARC data will be kept.
525 # if deletion called before MARCmodbiblio => won't do anything, as the oldbiblionumber doesn't
526 # exist in deletedbiblio table
527         my $record = MARCgetbiblio($dbh,$bibid);
528         my $oldbiblionumber = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
529         my $copy2deleted=$dbh->prepare("update deletedbiblio set marc=? where biblionumber=?");
530         $copy2deleted->execute($record->as_usmarc(),$oldbiblionumber);
531 # now, delete in MARC tables.
532         if ($keep_items eq 1) {
533         #search item field code
534                 my $sth = $dbh->prepare("select tagfield from marc_subfield_structure where kohafield like 'items.%'");
535                 $sth->execute;
536                 my $itemtag = $sth->fetchrow_hashref->{tagfield};
537                 $dbh->do("delete from marc_subfield_table where bibid=$bibid and tag<>$itemtag");
538                 $dbh->do("delete from marc_word where bibid=$bibid and tag<>$itemtag");
539         } else {
540                 $dbh->do("delete from marc_biblio where bibid=$bibid");
541                 $dbh->do("delete from marc_subfield_table where bibid=$bibid");
542                 $dbh->do("delete from marc_word where bibid=$bibid");
543         }
544 }
545
546 sub MARCdelitem {
547 # delete the item passed in parameter in MARC tables.
548         my ($dbh,$bibid,$itemnumber)=@_;
549         #    my $record = MARC::Record->new();
550         # search MARC tagorder
551         my $record = MARCgetitem($dbh,$bibid,$itemnumber);
552         my $copy2deleted=$dbh->prepare("update deleteditems set marc=? where itemnumber=?");
553         $copy2deleted->execute($record->as_usmarc(),$itemnumber);
554
555         my $sth2 = $dbh->prepare("select tagorder from marc_subfield_table,marc_subfield_structure where marc_subfield_table.tag=marc_subfield_structure.tagfield and marc_subfield_table.subfieldcode=marc_subfield_structure.tagsubfield and bibid=? and kohafield='items.itemnumber' and subfieldvalue=?");
556         $sth2->execute($bibid,$itemnumber);
557         my ($tagorder) = $sth2->fetchrow_array();
558         my $sth=$dbh->prepare("delete from marc_subfield_table where bibid=? and tagorder=?");
559         $sth->execute($bibid,$tagorder);
560 }
561
562 sub MARCmoditem {
563         my ($dbh,$record,$bibid,$itemnumber,$delete)=@_;
564         my $oldrecord=&MARCgetitem($dbh,$bibid,$itemnumber);
565         # if nothing to change, don't waste time...
566         if ($oldrecord eq $record) {
567                 return;
568         }
569
570         # otherwise, skip through each subfield...
571         my @fields = $record->fields();
572         # search old MARC item
573         my $sth2 = $dbh->prepare("select tagorder from marc_subfield_table,marc_subfield_structure where marc_subfield_table.tag=marc_subfield_structure.tagfield and marc_subfield_table.subfieldcode=marc_subfield_structure.tagsubfield and bibid=? and kohafield='items.itemnumber' and subfieldvalue=?");
574         $sth2->execute($bibid,$itemnumber);
575         my ($tagorder) = $sth2->fetchrow_array();
576         foreach my $field (@fields) {
577                 my $oldfield = $oldrecord->field($field->tag());
578                 my @subfields=$field->subfields();
579                 my $subfieldorder=0;
580                 foreach my $subfield (@subfields) {
581                         $subfieldorder++;
582 #                       warn "compare : $oldfield".$oldfield->subfield(@$subfield[0]);
583                         if ($oldfield eq 0 or (length($oldfield->subfield(@$subfield[0])) ==0) ) {
584                 # just adding datas...
585 #               warn "addfield : / $subfieldorder / @$subfield[0] - @$subfield[1]";
586 #                               warn "NEW subfield : $bibid,".$field->tag().",".$tagorder.",".@$subfield[0].",".$subfieldorder.",".@$subfield[1].")";
587                                 &MARCaddsubfield($dbh,$bibid,$field->tag(),$field->indicator(1).$field->indicator(2),
588                                                 $tagorder,@$subfield[0],$subfieldorder,@$subfield[1]);
589                         } else {
590 #               warn "modfield : / $subfieldorder / @$subfield[0] - @$subfield[1]";
591                 # modify he subfield if it's a different string
592                                 if ($oldfield->subfield(@$subfield[0]) ne @$subfield[1] ) {
593                                         my $subfieldid=&MARCfindsubfieldid($dbh,$bibid,$field->tag(),$tagorder,@$subfield[0],$subfieldorder);
594 #                                       warn "changing : $subfieldid, $bibid,".$field->tag(),",$tagorder,@$subfield[0],@$subfield[1],$subfieldorder";
595                                         &MARCmodsubfield($dbh,$subfieldid,@$subfield[1]);
596                                 }
597                         }
598                 }
599         }
600 }
601
602
603 sub MARCmodsubfield {
604 # Subroutine changes a subfield value given a subfieldid.
605     my ($dbh, $subfieldid, $subfieldvalue )=@_;
606     $dbh->do("lock tables marc_blob_subfield WRITE,marc_subfield_table WRITE");
607     my $sth1=$dbh->prepare("select valuebloblink from marc_subfield_table where subfieldid=?");
608     $sth1->execute($subfieldid);
609     my ($oldvaluebloblink)=$sth1->fetchrow;
610     $sth1->finish;
611     my $sth;
612     # if too long, use a bloblink
613     if (length($subfieldvalue)>255 ) {
614         # if already a bloblink, update it, otherwise, insert a new one.
615         if ($oldvaluebloblink) {
616             $sth=$dbh->prepare("update marc_blob_subfield set subfieldvalue=? where blobidlink=?");
617             $sth->execute($subfieldvalue,$oldvaluebloblink);
618         } else {
619             $sth=$dbh->prepare("insert into marc_blob_subfield (subfieldvalue) values (?)");
620             $sth->execute($subfieldvalue);
621             $sth=$dbh->prepare("select max(blobidlink) from marc_blob_subfield");
622             $sth->execute;
623             my ($res)=$sth->fetchrow;
624             $sth=$dbh->prepare("update marc_subfield_table set subfieldvalue=null, valuebloblink=? where subfieldid=?");
625             $sth->execute($res,$subfieldid);
626         }
627     } else {
628         # note this can leave orphan bloblink. Not a big problem, but we should build somewhere a orphan deleting script...
629         $sth=$dbh->prepare("update marc_subfield_table set subfieldvalue=?,valuebloblink=null where subfieldid=?");
630         $sth->execute($subfieldvalue, $subfieldid);
631     }
632     $dbh->do("unlock tables");
633     $sth->finish;
634     $sth=$dbh->prepare("select bibid,tag,tagorder,subfieldcode,subfieldid,subfieldorder from marc_subfield_table where subfieldid=?");
635     $sth->execute($subfieldid);
636     my ($bibid,$tagid,$tagorder,$subfieldcode,$x,$subfieldorder) = $sth->fetchrow;
637     $subfieldid=$x;
638     &MARCdelword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder);
639     &MARCaddword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
640     return($subfieldid, $subfieldvalue);
641 }
642
643 sub MARCfindsubfield {
644     my ($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue) = @_;
645     my $resultcounter=0;
646     my $subfieldid;
647     my $lastsubfieldid;
648     my $query="select subfieldid from marc_subfield_table where bibid=? and tag=? and subfieldcode=?";
649     my @bind_values = ($bibid,$tag, $subfieldcode);
650     if ($subfieldvalue) {
651         $query .= " and subfieldvalue=?";
652         push(@bind_values,$subfieldvalue);
653     } else {
654         if ($subfieldorder<1) {
655             $subfieldorder=1;
656         }
657         $query .= " and subfieldorder=?";
658         push(@bind_values,$subfieldorder);
659     }
660     my $sti=$dbh->prepare($query);
661     $sti->execute(@bind_values);
662     while (($subfieldid) = $sti->fetchrow) {
663         $resultcounter++;
664         $lastsubfieldid=$subfieldid;
665     }
666     if ($resultcounter>1) {
667         # Error condition.  Values given did not resolve into a unique record.  Don't know what to edit
668         # should rarely occur (only if we use subfieldvalue with a value that exists twice, which is strange)
669         return -1;
670     } else {
671         return $lastsubfieldid;
672     }
673 }
674
675 sub MARCfindsubfieldid {
676         my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
677         my $sth=$dbh->prepare("select subfieldid from marc_subfield_table
678                                 where bibid=? and tag=? and tagorder=?
679                                         and subfieldcode=? and subfieldorder=?");
680         $sth->execute($bibid,$tag,$tagorder,$subfield,$subfieldorder);
681         my ($res) = $sth->fetchrow;
682         unless ($res) {
683                 $sth=$dbh->prepare("select subfieldid from marc_subfield_table
684                                 where bibid=? and tag=? and tagorder=?
685                                         and subfieldcode=?");
686                 $sth->execute($bibid,$tag,$tagorder,$subfield);
687                 ($res) = $sth->fetchrow;
688         }
689     return $res;
690 }
691
692 sub MARCdelsubfield {
693 # delete a subfield for $bibid / tag / tagorder / subfield / subfieldorder
694     my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
695     $dbh->do("delete from marc_subfield_table where bibid='$bibid' and
696                         tag='$tag' and tagorder='$tagorder'
697                         and subfieldcode='$subfield' and subfieldorder='$subfieldorder
698                         ");
699 }
700
701 sub MARCkoha2marcBiblio {
702 # this function builds partial MARC::Record from the old koha-DB fields
703     my ($dbh,$biblionumber,$biblioitemnumber) = @_;
704     my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
705     my $record = MARC::Record->new();
706 #--- if bibid, then retrieve old-style koha data
707     if ($biblionumber>0) {
708         my $sth2=$dbh->prepare("select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp
709                 from biblio where biblionumber=?");
710         $sth2->execute($biblionumber);
711         my $row=$sth2->fetchrow_hashref;
712         my $code;
713         foreach $code (keys %$row) {
714             if ($row->{$code}) {
715                 &MARCkoha2marcOnefield($sth,$record,"biblio.".$code,$row->{$code});
716             }
717         }
718     }
719 #--- if biblioitem, then retrieve old-style koha data
720     if ($biblioitemnumber>0) {
721         my $sth2=$dbh->prepare(" SELECT biblioitemnumber,biblionumber,volume,number,classification,
722                                                 itemtype,url,isbn,issn,dewey,subclass,publicationyear,publishercode,
723                                                 volumedate,volumeddesc,timestamp,illus,pages,notes AS bnotes,size,place
724                                         FROM biblioitems
725                                         WHERE biblioitemnumber=?
726                                         ");
727         $sth2->execute($biblioitemnumber);
728         my $row=$sth2->fetchrow_hashref;
729         my $code;
730         foreach $code (keys %$row) {
731             if ($row->{$code}) {
732                 &MARCkoha2marcOnefield($sth,$record,"biblioitems.".$code,$row->{$code});
733             }
734         }
735     }
736         # other fields => additional authors, subjects, subtitles
737         my $sth2=$dbh->prepare(" SELECT author FROM additionalauthors WHERE biblionumber=?");
738         $sth2->execute($biblionumber);
739         while (my $row=$sth2->fetchrow_hashref) {
740                         &MARCkoha2marcOnefield($sth,$record,"additionalauthors.author",$row->{'author'});
741                 }
742         my $sth2=$dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?");
743         $sth2->execute($biblionumber);
744         while (my $row=$sth2->fetchrow_hashref) {
745                         &MARCkoha2marcOnefield($sth,$record,"bibliosubject.subject",$row->{'subject'});
746                 }
747         my $sth2=$dbh->prepare(" SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?");
748         $sth2->execute($biblionumber);
749         while (my $row=$sth2->fetchrow_hashref) {
750                         &MARCkoha2marcOnefield($sth,$record,"bibliosubtitle.title",$row->{'subtitle'});
751                 }
752     return $record;
753 }
754
755 sub MARCkoha2marcItem {
756 # this function builds partial MARC::Record from the old koha-DB fields
757     my ($dbh,$biblionumber,$itemnumber) = @_;
758 #    my $dbh=&C4Connect;
759     my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
760     my $record = MARC::Record->new();
761 #--- if item, then retrieve old-style koha data
762     if ($itemnumber>0) {
763 #       print STDERR "prepare $biblionumber,$itemnumber\n";
764         my $sth2=$dbh->prepare("SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned,
765                                                 booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
766                                                 datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,bulk,issues,renewals,
767                                         reserves,restricted,binding,itemnotes,holdingbranch,timestamp
768                                         FROM items
769                                         WHERE itemnumber=?");
770         $sth2->execute($itemnumber);
771         my $row=$sth2->fetchrow_hashref;
772         my $code;
773         foreach $code (keys %$row) {
774             if ($row->{$code}) {
775                 &MARCkoha2marcOnefield($sth,$record,"items.".$code,$row->{$code});
776             }
777         }
778     }
779     return $record;
780 }
781
782 sub MARCkoha2marcSubtitle {
783 # this function builds partial MARC::Record from the old koha-DB fields
784     my ($dbh,$bibnum,$subtitle) = @_;
785     my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
786     my $record = MARC::Record->new();
787     &MARCkoha2marcOnefield($sth,$record,"bibliosubtitle.subtitle",$subtitle);
788     return $record;
789 }
790
791 sub MARCkoha2marcOnefield {
792     my ($sth,$record,$kohafieldname,$value)=@_;
793     my $tagfield;
794     my $tagsubfield;
795     $sth->execute($kohafieldname);
796     if (($tagfield,$tagsubfield)=$sth->fetchrow) {
797         if ($record->field($tagfield)) {
798             my $tag =$record->field($tagfield);
799             if ($tag) {
800                 $tag->add_subfields($tagsubfield,$value);
801                 $record->delete_field($tag);
802                 $record->add_fields($tag);
803             }
804         } else {
805             $record->add_fields($tagfield," "," ",$tagsubfield => $value);
806         }
807     }
808     return $record;
809 }
810
811 sub MARChtml2marc {
812         my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
813         my $prevtag = -1;
814         my $record = MARC::Record->new();
815 #       my %subfieldlist=();
816         my $prevvalue; # if tag <10
817         my $field; # if tag >=10
818         for (my $i=0; $i< @$rtags; $i++) {
819                 # rebuild MARC::Record
820                 if (@$rtags[$i] ne $prevtag) {
821                         if ($prevtag < 10) {
822                                 if ($prevvalue) {
823                                         $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
824                                 }
825                         } else {
826                                 if ($field) {
827                                         $record->add_fields($field);
828                                 }
829                         }
830                         $indicators{@$rtags[$i]}.='  ';
831                         if (@$rtags[$i] <10) {
832                                 $prevvalue= @$rvalues[$i];
833                         } else {
834                                 $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
835                         }
836                         $prevtag = @$rtags[$i];
837                 } else {
838                         if (@$rtags[$i] <10) {
839                                 $prevvalue=@$rvalues[$i];
840                         } else {
841                                 if (@$rvalues[$i]) {
842                                         $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
843                                 }
844                         }
845                         $prevtag= @$rtags[$i];
846                 }
847         }
848         # the last has not been included inside the loop... do it now !
849         $record->add_fields($field);
850 #       warn $record->as_formatted;
851         return $record;
852 }
853
854 sub MARCmarc2koha {
855         my ($dbh,$record) = @_;
856         my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
857         my $result;
858         my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
859         $sth2->execute;
860         my $field;
861         #    print STDERR $record->as_formatted;
862         while (($field)=$sth2->fetchrow) {
863                 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result);
864         }
865         $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
866         $sth2->execute;
867         while (($field)=$sth2->fetchrow) {
868                 if ($field eq 'notes') { $field = 'bnotes'; }
869                 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result);
870         }
871         $sth2=$dbh->prepare("SHOW COLUMNS from items");
872         $sth2->execute;
873         while (($field)=$sth2->fetchrow) {
874                 $result = &MARCmarc2kohaOneField($sth,"items",$field,$record,$result);
875         }
876         # additional authors : specific
877         $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result);
878         $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result);
879 # modify copyrightdate to keep only the 1st year found
880         my $temp = $result->{'copyrightdate'};
881         $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
882         if ($1>0) {
883                 $result->{'copyrightdate'} = $1;
884         } else { # if no cYYYY, get the 1st date.
885                 $temp =~ m/(\d\d\d\d)/;
886                 $result->{'copyrightdate'} = $1;
887         }
888 # modify publicationyear to keep only the 1st year found
889         my $temp = $result->{'publicationyear'};
890         $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
891         if ($1>0) {
892                 $result->{'publicationyear'} = $1;
893         } else { # if no cYYYY, get the 1st date.
894                 $temp =~ m/(\d\d\d\d)/;
895                 $result->{'publicationyear'} = $1;
896         }
897         return $result;
898 }
899
900 sub MARCmarc2kohaOneField {
901 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
902         my ($sth,$kohatable,$kohafield,$record,$result)= @_;
903 #    warn "kohatable / $kohafield / $result / ";
904         my $res="";
905         my $tagfield;
906         my $subfield;
907         $sth->execute($kohatable.".".$kohafield);
908         ($tagfield,$subfield) = $sth->fetchrow;
909         foreach my $field ($record->field($tagfield)) {
910                 if ($field->subfield($subfield)) {
911                 if ($result->{$kohafield}) {
912                         $result->{$kohafield} .= " | ".$field->subfield($subfield);
913                 } else {
914                         $result->{$kohafield}=$field->subfield($subfield);
915                 }
916                 }
917         }
918         return $result;
919 }
920
921 sub MARCaddword {
922 # split a subfield string and adds it into the word table.
923 # removes stopwords
924     my ($dbh,$bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$sentence) =@_;
925     $sentence =~ s/(\.|\?|\:|\!|\'|,|\-|\"|\(|\)|\[|\]|\{|\})/ /g;
926     my @words = split / /,$sentence;
927     my $stopwords= C4::Context->stopwords;
928     my $sth=$dbh->prepare("insert into marc_word (bibid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word)
929                         values (?,?,?,?,?,?,soundex(?))");
930     foreach my $word (@words) {
931 # we record only words longer than 2 car and not in stopwords hash
932         if (length($word)>2 and !($stopwords->{uc($word)})) {
933             $sth->execute($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,$word);
934             if ($sth->err()) {
935                 warn "ERROR ==> insert into marc_word (bibid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word) values ($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,soundex($word))\n";
936             }
937         }
938     }
939 }
940
941 sub MARCdelword {
942 # delete words. this sub deletes all the words from a sentence. a subfield modif is done by a delete then a add
943     my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
944     my $sth=$dbh->prepare("delete from marc_word where bibid=? and tag=? and tagorder=? and subfieldid=? and subfieldorder=?");
945     $sth->execute($bibid,$tag,$tagorder,$subfield,$subfieldorder);
946 }
947
948 #
949 #
950 # NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW
951 #
952 #
953 # all the following subs are useful to manage MARC-DB with complete MARC records.
954 # it's used with marcimport, and marc management tools
955 #
956
957
958 =item ($bibid,$oldbibnum,$oldbibitemnum) = NEWnewbibilio($dbh,$MARCRecord,$oldbiblio,$oldbiblioitem);
959
960 creates a new biblio from a MARC::Record. The 3rd and 4th parameter are hashes and may be ignored. If only 2 params are passed to the sub, the old-db hashes
961 are builded from the MARC::Record. If they are passed, they are used.
962
963 =item NEWnewitem($dbh, $record,$bibid);
964
965 adds an item in the db.
966
967 =cut
968
969 sub NEWnewbiblio {
970         my ($dbh, $record, $oldbiblio, $oldbiblioitem) = @_;
971         # note $oldbiblio and $oldbiblioitem are not mandatory.
972         # if not present, they will be builded from $record with MARCmarc2koha function
973         if (($oldbiblio) and not($oldbiblioitem)) {
974                 print STDERR "NEWnewbiblio : missing parameter\n";
975                 print "NEWnewbiblio : missing parameter : contact koha development  team\n";
976                 die;
977         }
978         my $oldbibnum;
979         my $oldbibitemnum;
980         if ($oldbiblio) {
981                 $oldbibnum = OLDnewbiblio($dbh,$oldbiblio);
982                 $oldbiblioitem->{'biblionumber'} = $oldbibnum;
983                 $oldbibitemnum = OLDnewbiblioitem($dbh,$oldbiblioitem);
984         } else {
985                 my $olddata = MARCmarc2koha($dbh,$record);
986                 $oldbibnum = OLDnewbiblio($dbh,$olddata);
987                 $olddata->{'biblionumber'} = $oldbibnum;
988                 $oldbibitemnum = OLDnewbiblioitem($dbh,$olddata);
989         }
990         # search subtiles, addiauthors and subjects
991         my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author");
992         my @addiauthfields = $record->field($tagfield);
993         foreach my $addiauthfield (@addiauthfields) {
994                 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
995                 foreach my $subfieldcount (0..$#addiauthsubfields) {
996                         OLDmodaddauthor($dbh,$oldbibnum,$addiauthsubfields[$subfieldcount]);
997                 }
998         }
999         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.title");
1000         my @subtitlefields = $record->field($tagfield);
1001         foreach my $subtitlefield (@subtitlefields) {
1002                 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
1003                 foreach my $subfieldcount (0..$#subtitlesubfields) {
1004                         OLDnewsubtitle($dbh,$oldbibnum,$subtitlesubfields[$subfieldcount]);
1005                 }
1006         }
1007         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject");
1008         my @subj = $record->field($tagfield);
1009         my @subjects;
1010         foreach my $subject (@subj) {
1011                 my @subjsubfield = $subject->subfield($tagsubfield);
1012                 foreach my $subfieldcount (0..$#subjsubfield) {
1013                         push @subjects,$subjsubfield[$subfieldcount];
1014                 }
1015         }
1016         OLDmodsubject($dbh,$oldbibnum,1,@subjects);
1017         # we must add bibnum and bibitemnum in MARC::Record...
1018         # we build the new field with biblionumber and biblioitemnumber
1019         # we drop the original field
1020         # we add the new builded field.
1021         # NOTE : Works only if the field is ONLY for biblionumber and biblioitemnumber
1022         # (steve and paul : thinks 090 is a good choice)
1023         my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
1024         $sth->execute("biblio.biblionumber");
1025         (my $tagfield1, my $tagsubfield1) = $sth->fetchrow;
1026         $sth->execute("biblioitems.biblioitemnumber");
1027         (my $tagfield2, my $tagsubfield2) = $sth->fetchrow;
1028         if ($tagfield1 != $tagfield2) {
1029                 warn "Error in NEWnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number";
1030                 print "Content-Type: text/html\n\nError in NEWnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number";
1031                 die;
1032         }
1033         my $newfield = MARC::Field->new( $tagfield1,'','',
1034                                                 "$tagsubfield1" => $oldbibnum,
1035                                                 "$tagsubfield2" => $oldbibitemnum);
1036         # drop old field and create new one...
1037         my $old_field = $record->field($tagfield1);
1038         $record->delete_field($old_field);
1039         $record->add_fields($newfield);
1040         my $bibid = MARCaddbiblio($dbh,$record,$oldbibnum);
1041         return ($bibid,$oldbibnum,$oldbibitemnum );
1042 }
1043
1044 sub NEWmodbiblio {
1045         my ($dbh,$record,$bibid) =@_;
1046         &MARCmodbiblio($dbh,$bibid,$record,0);
1047         my $oldbiblio = MARCmarc2koha($dbh,$record);
1048         my $oldbiblionumber = OLDmodbiblio($dbh,$oldbiblio);
1049         OLDmodbibitem($dbh,$oldbiblio);
1050         # now, modify addi authors, subject, addititles.
1051         my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author");
1052         my @addiauthfields = $record->field($tagfield);
1053         foreach my $addiauthfield (@addiauthfields) {
1054                 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
1055                 foreach my $subfieldcount (0..$#addiauthsubfields) {
1056                         OLDmodaddauthor($dbh,$oldbiblionumber,$addiauthsubfields[$subfieldcount]);
1057                 }
1058         }
1059         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle");
1060         my @subtitlefields = $record->field($tagfield);
1061         foreach my $subtitlefield (@subtitlefields) {
1062                 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
1063                 foreach my $subfieldcount (0..$#subtitlesubfields) {
1064                         OLDmodsubtitle($dbh,$oldbiblionumber,$subtitlesubfields[$subfieldcount]);
1065                 }
1066         }
1067         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject");
1068         my @subj = $record->field($tagfield);
1069         my @subjects;
1070         foreach my $subject (@subj) {
1071                 my @subjsubfield = $subject->subfield($tagsubfield);
1072                 foreach my $subfieldcount (0..$#subjsubfield) {
1073                         push @subjects,$subjsubfield[$subfieldcount];
1074                 }
1075         }
1076         OLDmodsubject($dbh,$oldbiblionumber,1,@subjects);
1077         return 1;
1078 }
1079
1080 sub NEWdelbiblio {
1081         my ($dbh,$bibid)=@_;
1082         my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
1083         &OLDdelbiblio($dbh,$biblio);
1084         my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
1085         $sth->execute($biblio);
1086         while(my ($biblioitemnumber) = $sth->fetchrow) {
1087                 OLDdeletebiblioitem($dbh,$biblioitemnumber);
1088         }
1089         &MARCdelbiblio($dbh,$bibid,0);
1090 }
1091
1092
1093 sub NEWnewitem {
1094         my ($dbh, $record,$bibid) = @_;
1095         # add item in old-DB
1096         my $item = &MARCmarc2koha($dbh,$record);
1097         # needs old biblionumber and biblioitemnumber
1098         $item->{'biblionumber'} = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
1099         my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
1100         $sth->execute($item->{'biblionumber'});
1101         ($item->{'biblioitemnumber'}) = $sth->fetchrow;
1102         my ($itemnumber,$error) = &OLDnewitems($dbh,$item,$item->{barcode});
1103         # add itemnumber to MARC::Record before adding the item.
1104         my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
1105         &MARCkoha2marcOnefield($sth,$record,"items.itemnumber",$itemnumber);
1106         # add the item
1107         my $bib = &MARCadditem($dbh,$record,$item->{'biblionumber'});
1108 }
1109
1110 sub NEWmoditem {
1111         my ($dbh,$record,$bibid,$itemnumber,$delete) = @_;
1112         &MARCmoditem($dbh,$record,$bibid,$itemnumber,$delete);
1113         my $olditem = MARCmarc2koha($dbh,$record);
1114         OLDmoditem($dbh,$olditem);
1115 }
1116
1117 sub NEWdelitem {
1118         my ($dbh,$bibid,$itemnumber)=@_;
1119         my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
1120         &OLDdelitem($dbh,$itemnumber);
1121         &MARCdelitem($dbh,$bibid,$itemnumber);
1122 }
1123
1124 #
1125 #
1126 # OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD
1127 #
1128 #
1129
1130 =item $biblionumber = OLDnewbiblio($dbh,$biblio);
1131
1132 adds a record in biblio table. Datas are in the hash $biblio.
1133
1134 =item $biblionumber = OLDmodbiblio($dbh,$biblio);
1135
1136 modify a record in biblio table. Datas are in the hash $biblio.
1137
1138 =item OLDmodsubtitle($dbh,$bibnum,$subtitle);
1139
1140 modify subtitles in bibliosubtitle table.
1141
1142 =item OLDmodaddauthor($dbh,$bibnum,$author);
1143
1144 adds or modify additional authors
1145 NOTE :  Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
1146
1147 =item $errors = OLDmodsubject($dbh,$bibnum, $force, @subject);
1148
1149 modify/adds subjects
1150
1151 =item OLDmodbibitem($dbh, $biblioitem);
1152
1153 modify a biblioitem
1154
1155 =item OLDmodnote($dbh,$bibitemnum,$note
1156
1157 modify a note for a biblioitem
1158
1159 =item OLDnewbiblioitem($dbh,$biblioitem);
1160
1161 adds a biblioitem ($biblioitem is a hash with the values)
1162
1163 =item OLDnewsubject($dbh,$bibnum);
1164
1165 adds a subject
1166
1167 =item OLDnewsubtitle($dbh,$bibnum,$subtitle);
1168
1169 create a new subtitle
1170
1171 =item ($itemnumber,$errors)= OLDnewitems($dbh,$item,$barcode);
1172
1173 create a item. $item is a hash and $barcode the barcode.
1174
1175 =item OLDmoditem($dbh,$item);
1176
1177 modify item
1178
1179 =item OLDdelitem($dbh,$itemnum);
1180
1181 delete item
1182
1183 =item OLDdeletebiblioitem($dbh,$biblioitemnumber);
1184
1185 deletes a biblioitem
1186 NOTE : not standard sub name. Should be OLDdelbiblioitem()
1187
1188 =item OLDdelbiblio($dbh,$biblio);
1189
1190 delete a biblio
1191
1192 =cut
1193
1194 sub OLDnewbiblio {
1195   my ($dbh,$biblio) = @_;
1196 #  my $dbh    = &C4Connect;
1197   my $sth    = $dbh->prepare("Select max(biblionumber) from biblio");
1198   $sth->execute;
1199   my $data   = $sth->fetchrow_arrayref;
1200   my $bibnum = $$data[0] + 1;
1201   my $series = 0;
1202
1203   if ($biblio->{'seriestitle'}) { $series = 1 };
1204   $sth->finish;
1205   $sth = $dbh->prepare("insert into biblio set biblionumber  = ?, title = ?, author = ?, copyrightdate = ?, serial = ?, seriestitle = ?, notes = ?, abstract = ?");
1206   $sth->execute($bibnum,$biblio->{'title'},$biblio->{'author'},$biblio->{'copyrightdate'},$series,$biblio->{'seriestitle'},$biblio->{'notes'},$biblio->{'abstract'});
1207
1208   $sth->finish;
1209 #  $dbh->disconnect;
1210   return($bibnum);
1211 }
1212
1213 sub OLDmodbiblio {
1214         my ($dbh,$biblio) = @_;
1215         #  my $dbh   = C4Connect;
1216         my $query;
1217         my $sth;
1218
1219         $query = "";
1220         $sth   = $dbh->prepare("Update biblio set title = ?, author = ?, abstract = ?, copyrightdate = ?, seriestitle = ?, serial = ?, unititle = ?, notes = ? where biblionumber = ?");
1221         $sth->execute($biblio->{'title'},$biblio->{'author'},$biblio->{'abstract'},$biblio->{'copyrightdate'}, $biblio->{'seriestitle'},$biblio->{'serial'},$biblio->{'unititle'},$biblio->{'notes'},$biblio->{'biblionumber'});
1222
1223         $sth->finish;
1224         return($biblio->{'biblionumber'});
1225 } # sub modbiblio
1226
1227 sub OLDmodsubtitle {
1228         my ($dbh,$bibnum, $subtitle) = @_;
1229         my $sth   = $dbh->prepare("update bibliosubtitle set subtitle = ? where biblionumber = ?");
1230         $sth->execute($subtitle,$bibnum);
1231         $sth->finish;
1232 } # sub modsubtitle
1233
1234
1235 sub OLDmodaddauthor {
1236     my ($dbh,$bibnum, $author) = @_;
1237 #    my $dbh   = C4Connect;
1238     my $sth = $dbh->prepare("Delete from additionalauthors where biblionumber = ?");
1239
1240     $sth->execute($bibnum);
1241     $sth->finish;
1242
1243     if ($author ne '') {
1244         $sth   = $dbh->prepare("Insert into additionalauthors set author = ?, biblionumber = ?");
1245
1246         $sth->execute($author,$bibnum);
1247
1248         $sth->finish;
1249     } # if
1250 } # sub modaddauthor
1251
1252
1253 sub OLDmodsubject {
1254         my ($dbh,$bibnum, $force, @subject) = @_;
1255         #  my $dbh   = C4Connect;
1256         my $count = @subject;
1257         my $error;
1258         for (my $i = 0; $i < $count; $i++) {
1259                 $subject[$i] =~ s/^ //g;
1260                 $subject[$i] =~ s/ $//g;
1261                 my $sth   = $dbh->prepare("select * from catalogueentry where entrytype = 's' and catalogueentry = ?");
1262                 $sth->execute($subject[$i]);
1263
1264                 if (my $data = $sth->fetchrow_hashref) {
1265                 } else {
1266                         if ($force eq $subject[$i] || $force == 1) {
1267                                 # subject not in aut, chosen to force anway
1268                                 # so insert into cataloguentry so its in auth file
1269                                 my $sth2 = $dbh->prepare("Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)");
1270
1271                                 $sth2->execute($subject[$i]);
1272                                 $sth2->finish;
1273                         } else {
1274                                 $error = "$subject[$i]\n does not exist in the subject authority file";
1275                                 my $sth2 = $dbh->prepare("Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)");
1276                                 $sth2->execute("$subject[$i] %","% $subject[$i] %","% $subject[$i]");
1277                                 while (my $data = $sth2->fetchrow_hashref) {
1278                                         $error .= "<br>$data->{'catalogueentry'}";
1279                                 } # while
1280                                 $sth2->finish;
1281                         } # else
1282                 } # else
1283                 $sth->finish;
1284         } # else
1285         if ($error eq '') {
1286                 my $sth   = $dbh->prepare("Delete from bibliosubject where biblionumber = ?");
1287                 $sth->execute($bibnum);
1288                 $sth->finish;
1289                 $sth = $dbh->prepare("Insert into bibliosubject values (?,?)");
1290                 my $query;
1291                 foreach $query (@subject) {
1292                         $sth->execute($query,$bibnum);
1293                 } # foreach
1294                 $sth->finish;
1295         } # if
1296
1297         #  $dbh->disconnect;
1298         return($error);
1299 } # sub modsubject
1300
1301 sub OLDmodbibitem {
1302     my ($dbh,$biblioitem) = @_;
1303 #    my $dbh   = C4Connect;
1304     my $query;
1305
1306     $biblioitem->{'itemtype'}        = $dbh->quote($biblioitem->{'itemtype'});
1307     $biblioitem->{'url'}             = $dbh->quote($biblioitem->{'url'});
1308     $biblioitem->{'isbn'}            = $dbh->quote($biblioitem->{'isbn'});
1309     $biblioitem->{'publishercode'}   = $dbh->quote($biblioitem->{'publishercode'});
1310     $biblioitem->{'publicationyear'} = $dbh->quote($biblioitem->{'publicationyear'});
1311     $biblioitem->{'classification'}  = $dbh->quote($biblioitem->{'classification'});
1312     $biblioitem->{'dewey'}           = $dbh->quote($biblioitem->{'dewey'});
1313     $biblioitem->{'subclass'}        = $dbh->quote($biblioitem->{'subclass'});
1314     $biblioitem->{'illus'}           = $dbh->quote($biblioitem->{'illus'});
1315     $biblioitem->{'pages'}           = $dbh->quote($biblioitem->{'pages'});
1316     $biblioitem->{'volumeddesc'}     = $dbh->quote($biblioitem->{'volumeddesc'});
1317     $biblioitem->{'bnotes'}          = $dbh->quote($biblioitem->{'bnotes'});
1318     $biblioitem->{'size'}            = $dbh->quote($biblioitem->{'size'});
1319     $biblioitem->{'place'}           = $dbh->quote($biblioitem->{'place'});
1320
1321     $query = "Update biblioitems set
1322 itemtype        = $biblioitem->{'itemtype'},
1323 url             = $biblioitem->{'url'},
1324 isbn            = $biblioitem->{'isbn'},
1325 publishercode   = $biblioitem->{'publishercode'},
1326 publicationyear = $biblioitem->{'publicationyear'},
1327 classification  = $biblioitem->{'classification'},
1328 dewey           = $biblioitem->{'dewey'},
1329 subclass        = $biblioitem->{'subclass'},
1330 illus           = $biblioitem->{'illus'},
1331 pages           = $biblioitem->{'pages'},
1332 volumeddesc     = $biblioitem->{'volumeddesc'},
1333 notes           = $biblioitem->{'bnotes'},
1334 size            = $biblioitem->{'size'},
1335 place           = $biblioitem->{'place'}
1336 where biblioitemnumber = $biblioitem->{'biblioitemnumber'}";
1337
1338 $dbh->do($query);
1339 if ($dbh->errstr) {
1340         warn "$query";
1341 }
1342 #    $dbh->disconnect;
1343 } # sub modbibitem
1344
1345 sub OLDmodnote {
1346   my ($dbh,$bibitemnum,$note)=@_;
1347 #  my $dbh=C4Connect;
1348   my $query="update biblioitems set notes='$note' where
1349   biblioitemnumber='$bibitemnum'";
1350   my $sth=$dbh->prepare($query);
1351   $sth->execute;
1352   $sth->finish;
1353 #  $dbh->disconnect;
1354 }
1355
1356 sub OLDnewbiblioitem {
1357         my ($dbh,$biblioitem) = @_;
1358         #  my $dbh   = C4Connect;
1359         my $sth   = $dbh->prepare("Select max(biblioitemnumber) from biblioitems");
1360         my $data;
1361         my $bibitemnum;
1362
1363         $sth->execute;
1364         $data       = $sth->fetchrow_arrayref;
1365         $bibitemnum = $$data[0] + 1;
1366
1367         $sth->finish;
1368
1369         $sth = $dbh->prepare("insert into biblioitems set
1370                                                                         biblioitemnumber = ?,           biblionumber     = ?,
1371                                                                         volume           = ?,                   number           = ?,
1372                                                                         classification  = ?,                    itemtype         = ?,
1373                                                                         url              = ?,                           isbn             = ?,
1374                                                                         issn             = ?,                           dewey            = ?,
1375                                                                         subclass         = ?,                           publicationyear  = ?,
1376                                                                         publishercode    = ?,           volumedate       = ?,
1377                                                                         volumeddesc      = ?,           illus            = ?,
1378                                                                         pages            = ?,                           notes            = ?,
1379                                                                         size             = ?,                           lccn             = ?,
1380                                                                         marc             = ?,                           place            = ?");
1381         $sth->execute($bibitemnum,                                                      $biblioitem->{'biblionumber'},
1382                                                 $biblioitem->{'volume'},                        $biblioitem->{'number'},
1383                                                 $biblioitem->{'classification'},                $biblioitem->{'itemtype'},
1384                                                 $biblioitem->{'url'},                                   $biblioitem->{'isbn'},
1385                                                 $biblioitem->{'issn'},                          $biblioitem->{'dewey'},
1386                                                 $biblioitem->{'subclass'},                      $biblioitem->{'publicationyear'},
1387                                                 $biblioitem->{'publishercode'}, $biblioitem->{'volumedate'},
1388                                                 $biblioitem->{'volumeddesc'},           $biblioitem->{'illus'},
1389                                                 $biblioitem->{'pages'},                         $biblioitem->{'bnotes'},
1390                                                 $biblioitem->{'size'},                          $biblioitem->{'lccn'},
1391                                                 $biblioitem->{'marc'},                          $biblioitem->{'place'});
1392         $sth->finish;
1393         #    $dbh->disconnect;
1394         return($bibitemnum);
1395 }
1396
1397 sub OLDnewsubject {
1398   my ($dbh,$bibnum)=@_;
1399   my $sth=$dbh->prepare("insert into bibliosubject (biblionumber) values (?)");
1400   $sth->execute($bibnum);
1401   $sth->finish;
1402 }
1403
1404 sub OLDnewsubtitle {
1405     my ($dbh,$bibnum, $subtitle) = @_;
1406     my $sth   = $dbh->prepare("insert into bibliosubtitle set biblionumber = ?, subtitle = ?");
1407     $sth->execute($bibnum,$subtitle);
1408     $sth->finish;
1409 }
1410
1411
1412 sub OLDnewitems {
1413         my ($dbh,$item, $barcode) = @_;
1414         #  my $dbh   = C4Connect;
1415         my $sth   = $dbh->prepare("Select max(itemnumber) from items");
1416         my $data;
1417         my $itemnumber;
1418         my $error = "";
1419
1420         $sth->execute;
1421         $data       = $sth->fetchrow_hashref;
1422         $itemnumber = $data->{'max(itemnumber)'} + 1;
1423         $sth->finish;
1424 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
1425         if ($item->{'loan'}) {
1426                 $item->{'notforloan'} = $item->{'loan'};
1427         }
1428 # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1429         if ($item->{'dateaccessioned'}) {
1430                 $sth=$dbh->prepare("Insert into items set
1431                                                         itemnumber           = ?,                               biblionumber         = ?,
1432                                                         biblioitemnumber     = ?,                               barcode              = ?,
1433                                                         booksellerid         = ?,                                       dateaccessioned      = ?,
1434                                                         homebranch           = ?,                               holdingbranch        = ?,
1435                                                         price                = ?,                                               replacementprice     = ?,
1436                                                         replacementpricedate = NOW(),   itemnotes            = ?,
1437                                                         notforloan = ?
1438                                                         ");
1439                 $sth->execute($itemnumber,      $item->{'biblionumber'},
1440                                                                 $item->{'biblioitemnumber'},$barcode,
1441                                                                 $item->{'booksellerid'},$item->{'dateaccessioned'},
1442                                                                 $item->{'homebranch'},$item->{'holdingbranch'},
1443                                                                 $item->{'price'},$item->{'replacementprice'},
1444                                                                 $item->{'itemnotes'},$item->{'notforloan'});
1445         } else {
1446                 $sth=$dbh->prepare("Insert into items set
1447                                                         itemnumber           = ?,                               biblionumber         = ?,
1448                                                         biblioitemnumber     = ?,                               barcode              = ?,
1449                                                         booksellerid         = ?,                                       dateaccessioned      = NOW(),
1450                                                         homebranch           = ?,                               holdingbranch        = ?,
1451                                                         price                = ?,                                               replacementprice     = ?,
1452                                                         replacementpricedate = NOW(),   itemnotes            = ?,
1453                                                         notforloan = ?
1454                                                         ");
1455                 $sth->execute($itemnumber,      $item->{'biblionumber'},
1456                                                                 $item->{'biblioitemnumber'},$barcode,
1457                                                                 $item->{'booksellerid'},
1458                                                                 $item->{'homebranch'},$item->{'holdingbranch'},
1459                                                                 $item->{'price'},$item->{'replacementprice'},
1460                                                                 $item->{'itemnotes'},$item->{'notforloan'});
1461         }
1462         if (defined $sth->errstr) {
1463                 $error .= $sth->errstr;
1464         }
1465         $sth->finish;
1466         return($itemnumber,$error);
1467 }
1468
1469 sub OLDmoditem {
1470     my ($dbh,$item) = @_;
1471 #  my ($dbh,$loan,$itemnum,$bibitemnum,$barcode,$notes,$homebranch,$lost,$wthdrawn,$replacement)=@_;
1472 #  my $dbh=C4Connect;
1473 $item->{'itemnum'}=$item->{'itemnumber'} unless $item->{'itemnum'};
1474   my $query="update items set  barcode=?,itemnotes=? where itemnumber=?";
1475   my @bind = ($item->{'barcode'},$item->{'notes'},$item->{'itemnum'});
1476   if ($item->{'barcode'} eq ''){
1477         $item->{'notforloan'}=0 unless $item->{'notforloan'};
1478     $query="update items set notforloan=? where itemnumber=?";
1479     @bind = ($item->{'notforloan'},$item->{'itemnum'});
1480   }
1481   if ($item->{'lost'} ne ''){
1482     $query="update items set biblioitemnumber=?,
1483                              barcode=?,
1484                              itemnotes=?,
1485                              homebranch=?,
1486                              itemlost=?,
1487                              wthdrawn=?
1488                           where itemnumber=?";
1489     @bind = ($item->{'bibitemnum'},$item->{'barcode'},$item->{'notes'},$item->{'homebranch'},$item->{'lost'},$item->{'wthdrawn'},$item->{'itemnum'});
1490   }
1491   if ($item->{'replacement'} ne ''){
1492     $query=~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1493   }
1494   my $sth=$dbh->prepare($query);
1495   $sth->execute(@bind);
1496   $sth->finish;
1497 #  $dbh->disconnect;
1498 }
1499
1500 sub OLDdelitem{
1501         my ($dbh,$itemnum)=@_;
1502         #  my $dbh=C4Connect;
1503         my $sth=$dbh->prepare("select * from items where itemnumber=?");
1504         $sth->execute($itemnum);
1505         my $data=$sth->fetchrow_hashref;
1506         $sth->finish;
1507         my $query="Insert into deleteditems set ";
1508         my @bind = ();
1509         foreach my $temp (keys %$data){
1510                 $query .= "$temp = ?,";
1511                 push(@bind,$data->{$temp});
1512         }
1513         $query =~ s/\,$//;
1514 #  print $query;
1515         $sth=$dbh->prepare($query);
1516         $sth->execute(@bind);
1517         $sth->finish;
1518         $sth=$dbh->prepare("Delete from items where itemnumber=?");
1519         $sth->execute($itemnum);
1520         $sth->finish;
1521 #  $dbh->disconnect;
1522 }
1523
1524 sub OLDdeletebiblioitem {
1525     my ($dbh,$biblioitemnumber) = @_;
1526 #    my $dbh   = C4Connect;
1527     my $sth   = $dbh->prepare("Select * from biblioitems
1528 where biblioitemnumber = ?");
1529     my $results;
1530
1531     $sth->execute($biblioitemnumber);
1532
1533     if ($results = $sth->fetchrow_hashref) {
1534         $sth->finish;
1535         $sth=$dbh->prepare("Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
1536                                         isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
1537                                         pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)");
1538
1539         $sth->execute($results->{biblioitemnumber}, $results->{biblionumber}, $results->{volume}, $results->{number}, $results->{classification}, $results->{itemtype},
1540                                         $results->{isbn}, $results->{issn} ,$results->{dewey} ,$results->{subclass} ,$results->{publicationyear} ,$results->{publishercode} ,$results->{volumedate} ,$results->{volumeddesc} ,$results->{timestamp} ,$results->{illus} ,
1541                                         $results->{pages} ,$results->{notes} ,$results->{size} ,$results->{url} ,$results->{lccn} );
1542         my $sth2 = $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?");
1543         $sth2->execute($biblioitemnumber);
1544         $sth2->finish();
1545     } # if
1546     $sth->finish;
1547 # Now delete all the items attached to the biblioitem
1548         $sth   = $dbh->prepare("Select * from items where biblioitemnumber = ?");
1549         $sth->execute($biblioitemnumber);
1550         my @results;
1551         while (my $data = $sth->fetchrow_hashref) {
1552                 my $query="Insert into deleteditems set ";
1553                 my @bind = ();
1554                 foreach my $temp (keys %$data){
1555                         $query .= "$temp = ?,";
1556                         push(@bind,$data->{$temp});
1557                 }
1558                 $query =~ s/\,$//;
1559                 warn "Q 1560 : $query";
1560                 my $sth2=$dbh->prepare($query);
1561                 $sth2->execute(@bind);
1562         } # while
1563         $sth->finish;
1564         $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
1565         $sth->execute($biblioitemnumber);
1566         $sth->finish();
1567 #    $dbh->disconnect;
1568 } # sub deletebiblioitem
1569
1570 sub OLDdelbiblio{
1571         my ($dbh,$biblio)=@_;
1572         my $sth=$dbh->prepare("select * from biblio where biblionumber=?");
1573         $sth->execute($biblio);
1574         if (my $data=$sth->fetchrow_hashref){
1575                 $sth->finish;
1576                 my $query="Insert into deletedbiblio set ";
1577                 my @bind =();
1578                 foreach my $temp (keys %$data){
1579                         $query .= "$temp = ?,";
1580                         push(@bind,$data->{$temp});
1581                 }
1582                 #replacing the last , by ",?)"
1583                 $query=~ s/\,$//;
1584                 warn "Q olddelbiblio : $query";
1585                 $sth=$dbh->prepare($query);
1586                 $sth->execute(@bind);
1587                 $sth->finish;
1588                 $sth=$dbh->prepare("Delete from biblio where biblionumber=?");
1589                 $sth->execute($biblio);
1590                 $sth->finish;
1591         }
1592         $sth->finish;
1593 }
1594
1595 #
1596 #
1597 # old functions
1598 #
1599 #
1600
1601 sub itemcount{
1602   my ($biblio)=@_;
1603   my $dbh = C4::Context->dbh;
1604 #  print $query;
1605   my $sth=$dbh->prepare("Select count(*) from items where biblionumber=?");
1606   $sth->execute($biblio);
1607   my $data=$sth->fetchrow_hashref;
1608   $sth->finish;
1609   return($data->{'count(*)'});
1610 }
1611
1612 =item getorder
1613
1614   ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
1615
1616 Looks up the order with the given biblionumber and biblioitemnumber.
1617
1618 Returns a two-element array. C<$ordernumber> is the order number.
1619 C<$order> is a reference-to-hash describing the order; its keys are
1620 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
1621 tables of the Koha database.
1622
1623 =cut
1624 #'
1625 # FIXME - This is effectively identical to &C4::Catalogue::getorder.
1626 # Pick one and stick with it.
1627 sub getorder{
1628   my ($bi,$bib)=@_;
1629   my $dbh = C4::Context->dbh;
1630   my $sth=$dbh->prepare("Select ordernumber
1631         from aqorders
1632         where biblionumber=? and biblioitemnumber=?");
1633   $sth->execute($bib,$bi);
1634   # FIXME - Use fetchrow_array(), since we're only interested in the one
1635   # value.
1636   my $ordnum=$sth->fetchrow_hashref;
1637   $sth->finish;
1638   my $order=getsingleorder($ordnum->{'ordernumber'});
1639   return ($order,$ordnum->{'ordernumber'});
1640 }
1641
1642 =item getsingleorder
1643
1644   $order = &getsingleorder($ordernumber);
1645
1646 Looks up an order by order number.
1647
1648 Returns a reference-to-hash describing the order. The keys of
1649 C<$order> are fields from the biblio, biblioitems, aqorders, and
1650 aqorderbreakdown tables of the Koha database.
1651
1652 =cut
1653 #'
1654 # FIXME - This is effectively identical to
1655 # &C4::Catalogue::getsingleorder.
1656 # Pick one and stick with it.
1657 sub getsingleorder {
1658   my ($ordnum)=@_;
1659   my $dbh = C4::Context->dbh;
1660   my $sth=$dbh->prepare("Select * from biblio,biblioitems,aqorders,aqorderbreakdown
1661   where aqorders.ordernumber=?
1662   and biblio.biblionumber=aqorders.biblionumber and
1663   biblioitems.biblioitemnumber=aqorders.biblioitemnumber and
1664   aqorders.ordernumber=aqorderbreakdown.ordernumber");
1665   $sth->execute($ordnum);
1666   my $data=$sth->fetchrow_hashref;
1667   $sth->finish;
1668   return($data);
1669 }
1670
1671 sub newbiblio {
1672         my ($biblio) = @_;
1673         my $dbh    = C4::Context->dbh;
1674         my $bibnum=OLDnewbiblio($dbh,$biblio);
1675         # finds new (MARC bibid
1676 #       my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1677         my $record = &MARCkoha2marcBiblio($dbh,$bibnum);
1678         MARCaddbiblio($dbh,$record,$bibnum);
1679         return($bibnum);
1680 }
1681
1682 =item modbiblio
1683
1684   $biblionumber = &modbiblio($biblio);
1685
1686 Update a biblio record.
1687
1688 C<$biblio> is a reference-to-hash whose keys are the fields in the
1689 biblio table in the Koha database. All fields must be present, not
1690 just the ones you wish to change.
1691
1692 C<&modbiblio> updates the record defined by
1693 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1694
1695 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1696 successful or not.
1697
1698 =cut
1699
1700 sub modbiblio {
1701         my ($biblio) = @_;
1702         my $dbh  = C4::Context->dbh;
1703         my $biblionumber=OLDmodbiblio($dbh,$biblio);
1704         my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
1705         # finds new (MARC bibid
1706         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
1707         MARCmodbiblio($dbh,$bibid,$record,0);
1708         return($biblionumber);
1709 } # sub modbiblio
1710
1711 =item modsubtitle
1712
1713   &modsubtitle($biblionumber, $subtitle);
1714
1715 Sets the subtitle of a book.
1716
1717 C<$biblionumber> is the biblionumber of the book to modify.
1718
1719 C<$subtitle> is the new subtitle.
1720
1721 =cut
1722
1723 sub modsubtitle {
1724   my ($bibnum, $subtitle) = @_;
1725   my $dbh   = C4::Context->dbh;
1726   &OLDmodsubtitle($dbh,$bibnum,$subtitle);
1727 } # sub modsubtitle
1728
1729 =item modaddauthor
1730
1731   &modaddauthor($biblionumber, $author);
1732
1733 Replaces all additional authors for the book with biblio number
1734 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1735 C<&modaddauthor> deletes all additional authors.
1736
1737 =cut
1738
1739 sub modaddauthor {
1740     my ($bibnum, $author) = @_;
1741     my $dbh   = C4::Context->dbh;
1742     &OLDmodaddauthor($dbh,$bibnum,$author);
1743 } # sub modaddauthor
1744
1745 =item modsubject
1746
1747   $error = &modsubject($biblionumber, $force, @subjects);
1748
1749 $force - a subject to force
1750
1751 $error - Error message, or undef if successful.
1752
1753 =cut
1754
1755 sub modsubject {
1756   my ($bibnum, $force, @subject) = @_;
1757   my $dbh   = C4::Context->dbh;
1758   my $error= &OLDmodsubject($dbh,$bibnum,$force, @subject);
1759   return($error);
1760 } # sub modsubject
1761
1762 sub modbibitem {
1763     my ($biblioitem) = @_;
1764     my $dbh   = C4::Context->dbh;
1765     &OLDmodbibitem($dbh,$biblioitem);
1766 } # sub modbibitem
1767
1768 sub modnote {
1769   my ($bibitemnum,$note)=@_;
1770   my $dbh = C4::Context->dbh;
1771   &OLDmodnote($dbh,$bibitemnum,$note);
1772 }
1773
1774 sub newbiblioitem {
1775         my ($biblioitem) = @_;
1776         my $dbh   = C4::Context->dbh;
1777         my $bibitemnum = &OLDnewbiblioitem($dbh,$biblioitem);
1778         my $MARCbiblio= MARCkoha2marcBiblio($dbh,0,$bibitemnum); # the 0 means "do NOT retrieve biblio, only biblioitem, in the MARC record
1779         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblioitem->{biblionumber});
1780         &MARCaddbiblio($dbh,$MARCbiblio,$biblioitem->{biblionumber},$bibid);
1781         return($bibitemnum);
1782 }
1783
1784 sub newsubject {
1785   my ($bibnum)=@_;
1786   my $dbh = C4::Context->dbh;
1787   &OLDnewsubject($dbh,$bibnum);
1788 }
1789
1790 sub newsubtitle {
1791     my ($bibnum, $subtitle) = @_;
1792     my $dbh   = C4::Context->dbh;
1793     &OLDnewsubtitle($dbh,$bibnum,$subtitle);
1794 }
1795
1796 sub newitems {
1797   my ($item, @barcodes) = @_;
1798   my $dbh   = C4::Context->dbh;
1799   my $errors;
1800   my $itemnumber;
1801   my $error;
1802   foreach my $barcode (@barcodes) {
1803       ($itemnumber,$error)=&OLDnewitems($dbh,$item,uc($barcode));
1804       $errors .=$error;
1805       my $MARCitem = &MARCkoha2marcItem($dbh,$item->{biblionumber},$itemnumber);
1806       &MARCadditem($dbh,$MARCitem,$item->{biblionumber});
1807   }
1808   return($errors);
1809 }
1810
1811 sub moditem {
1812     my ($item) = @_;
1813     my $dbh = C4::Context->dbh;
1814     &OLDmoditem($dbh,$item);
1815     my $MARCitem = &MARCkoha2marcItem($dbh,$item->{'biblionumber'},$item->{'itemnum'});
1816     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$item->{biblionumber});
1817     &MARCmoditem($dbh,$MARCitem,$bibid,$item->{itemnum},0);
1818 }
1819
1820 sub checkitems{
1821   my ($count,@barcodes)=@_;
1822   my $dbh = C4::Context->dbh;
1823   my $error;
1824   my $sth=$dbh->prepare("Select * from items where barcode=?");
1825   for (my $i=0;$i<$count;$i++){
1826     $barcodes[$i]=uc $barcodes[$i];
1827     $sth->execute($barcodes[$i]);
1828     if (my $data=$sth->fetchrow_hashref){
1829       $error.=" Duplicate Barcode: $barcodes[$i]";
1830     }
1831   }
1832   $sth->finish;
1833   return($error);
1834 }
1835
1836 sub countitems{
1837   my ($bibitemnum)=@_;
1838   my $dbh = C4::Context->dbh;
1839   my $query="";
1840   my $sth=$dbh->prepare("Select count(*) from items where biblioitemnumber=?");
1841   $sth->execute($bibitemnum);
1842   my $data=$sth->fetchrow_hashref;
1843   $sth->finish;
1844   return($data->{'count(*)'});
1845 }
1846
1847 sub delitem{
1848   my ($itemnum)=@_;
1849   my $dbh = C4::Context->dbh;
1850   &OLDdelitem($dbh,$itemnum);
1851 }
1852
1853 sub deletebiblioitem {
1854     my ($biblioitemnumber) = @_;
1855     my $dbh   = C4::Context->dbh;
1856     &OLDdeletebiblioitem($dbh,$biblioitemnumber);
1857 } # sub deletebiblioitem
1858
1859
1860 sub delbiblio {
1861         my ($biblio)=@_;
1862         my $dbh = C4::Context->dbh;
1863         &OLDdelbiblio($dbh,$biblio);
1864         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblio);
1865         &MARCdelbiblio($dbh,$bibid,0);
1866 }
1867
1868 sub getitemtypes {
1869   my $dbh   = C4::Context->dbh;
1870   my $sth   = $dbh->prepare("select * from itemtypes order by description");
1871   my $count = 0;
1872   my @results;
1873
1874   $sth->execute;
1875   while (my $data = $sth->fetchrow_hashref) {
1876     $results[$count] = $data;
1877     $count++;
1878   } # while
1879
1880   $sth->finish;
1881   return($count, @results);
1882 } # sub getitemtypes
1883
1884 sub getbiblio {
1885     my ($biblionumber) = @_;
1886     my $dbh   = C4::Context->dbh;
1887     my $sth   = $dbh->prepare("Select * from biblio where biblionumber = ?");
1888       # || die "Cannot prepare $query\n" . $dbh->errstr;
1889     my $count = 0;
1890     my @results;
1891
1892     $sth->execute($biblionumber);
1893       # || die "Cannot execute $query\n" . $sth->errstr;
1894     while (my $data = $sth->fetchrow_hashref) {
1895       $results[$count] = $data;
1896       $count++;
1897     } # while
1898
1899     $sth->finish;
1900     return($count, @results);
1901 } # sub getbiblio
1902
1903 sub getbiblioitem {
1904     my ($biblioitemnum) = @_;
1905     my $dbh   = C4::Context->dbh;
1906     my $sth   = $dbh->prepare("Select * from biblioitems where
1907 biblioitemnumber = ?");
1908     my $count = 0;
1909     my @results;
1910
1911     $sth->execute($biblioitemnum);
1912
1913     while (my $data = $sth->fetchrow_hashref) {
1914         $results[$count] = $data;
1915         $count++;
1916     } # while
1917
1918     $sth->finish;
1919     return($count, @results);
1920 } # sub getbiblioitem
1921
1922 sub getbiblioitembybiblionumber {
1923     my ($biblionumber) = @_;
1924     my $dbh   = C4::Context->dbh;
1925     my $sth   = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
1926     my $count = 0;
1927     my @results;
1928
1929     $sth->execute($biblionumber);
1930
1931     while (my $data = $sth->fetchrow_hashref) {
1932         $results[$count] = $data;
1933         $count++;
1934     } # while
1935
1936     $sth->finish;
1937     return($count, @results);
1938 } # sub
1939
1940 sub getitemsbybiblioitem {
1941     my ($biblioitemnum) = @_;
1942     my $dbh   = C4::Context->dbh;
1943     my $sth   = $dbh->prepare("Select * from items, biblio where
1944 biblio.biblionumber = items.biblionumber and biblioitemnumber
1945 = ?");
1946       # || die "Cannot prepare $query\n" . $dbh->errstr;
1947     my $count = 0;
1948     my @results;
1949
1950     $sth->execute($biblioitemnum);
1951       # || die "Cannot execute $query\n" . $sth->errstr;
1952     while (my $data = $sth->fetchrow_hashref) {
1953       $results[$count] = $data;
1954       $count++;
1955     } # while
1956
1957     $sth->finish;
1958     return($count, @results);
1959 } # sub getitemsbybiblioitem
1960
1961
1962 sub logchange {
1963 # Subroutine to log changes to databases
1964 # Eventually, this subroutine will be used to create a log of all changes made,
1965 # with the possibility of "undo"ing some changes
1966     my $database=shift;
1967     if ($database eq 'kohadb') {
1968         my $type=shift;
1969         my $section=shift;
1970         my $item=shift;
1971         my $original=shift;
1972         my $new=shift;
1973 #       print STDERR "KOHA: $type $section $item $original $new\n";
1974     } elsif ($database eq 'marc') {
1975         my $type=shift;
1976         my $Record_ID=shift;
1977         my $tag=shift;
1978         my $mark=shift;
1979         my $subfield_ID=shift;
1980         my $original=shift;
1981         my $new=shift;
1982 #       print STDERR "MARC: $type $Record_ID $tag $mark $subfield_ID $original $new\n";
1983     }
1984 }
1985
1986 #------------------------------------------------
1987
1988
1989 #---------------------------------------
1990 # Find a biblio entry, or create a new one if it doesn't exist.
1991 #  If a "subtitle" entry is in hash, add it to subtitle table
1992 sub getoraddbiblio {
1993         # input params
1994         my (
1995           $dbh,         # db handle
1996                         # FIXME - Unused argument
1997           $biblio,      # hash ref to fields
1998         )=@_;
1999
2000         # return
2001         my $biblionumber;
2002
2003         my $debug=0;
2004         my $sth;
2005         my $error;
2006
2007         #-----
2008         $dbh = C4::Context->dbh;
2009
2010         print "<PRE>Looking for biblio </PRE>\n" if $debug;
2011         $sth=$dbh->prepare("select biblionumber
2012                 from biblio
2013                 where title=? and author=?
2014                   and copyrightdate=? and seriestitle=?");
2015         $sth->execute(
2016                 $biblio->{title}, $biblio->{author},
2017                 $biblio->{copyright}, $biblio->{seriestitle} );
2018         if ($sth->rows) {
2019             ($biblionumber) = $sth->fetchrow;
2020             print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
2021         } else {
2022             # Doesn't exist.  Add new one.
2023             print "<PRE>Adding biblio</PRE>\n" if $debug;
2024             ($biblionumber,$error)=&newbiblio($biblio);
2025             if ( $biblionumber ) {
2026               print "<PRE>Added with biblio number=$biblionumber</PRE>\n" if $debug;
2027               if ( $biblio->{subtitle} ) {
2028                 &newsubtitle($biblionumber,$biblio->{subtitle} );
2029               } # if subtitle
2030             } else {
2031                 print "<PRE>Couldn't add biblio: $error</PRE>\n" if $debug;
2032             } # if added
2033         }
2034
2035         return $biblionumber,$error;
2036
2037 } # sub getoraddbiblio
2038
2039 sub char_decode {
2040         # converts ISO 5426 coded string to ISO 8859-1
2041         # sloppy code : should be improved in next issue
2042         my ($string,$encoding) = @_ ;
2043         $_ = $string ;
2044 #       $encoding = C4::Context->preference("marcflavour") unless $encoding;
2045         if ($encoding eq "UNIMARC") {
2046                 s/\xe1/\80/gm ;
2047                 s/\xe2/\80/gm ;
2048                 s/\xe9/\80/gm ;
2049                 s/\xec/\80/gm ;
2050                 s/\xf1/\80/gm ;
2051                 s/\xf3/\80/gm ;
2052                 s/\xf9/\80/gm ;
2053                 s/\xfb/\80/gm ;
2054                 s/\xc1\x61/\80/gm ;
2055                 s/\xc1\x65/\80/gm ;
2056                 s/\xc1\x69/\80/gm ;
2057                 s/\xc1\x6f/\80/gm ;
2058                 s/\xc1\x75/\80/gm ;
2059                 s/\xc1\x41/\80/gm ;
2060                 s/\xc1\x45/\80/gm ;
2061                 s/\xc1\x49/\80/gm ;
2062                 s/\xc1\x4f/\80/gm ;
2063                 s/\xc1\x55/\80/gm ;
2064                 s/\xc2\x41/\80/gm ;
2065                 s/\xc2\x45/\80/gm ;
2066                 s/\xc2\x49/\80/gm ;
2067                 s/\xc2\x4f/\80/gm ;
2068                 s/\xc2\x55/\80/gm ;
2069                 s/\xc2\x59/\80/gm ;
2070                 s/\xc2\x61/\80/gm ;
2071                 s/\xc2\x65/\80/gm ;
2072                 s/\xc2\x69/\80/gm ;
2073                 s/\xc2\x6f/\80/gm ;
2074                 s/\xc2\x75/\80/gm ;
2075                 s/\xc2\x79/\80/gm ;
2076                 s/\xc3\x41/\80/gm ;
2077                 s/\xc3\x45/\80/gm ;
2078                 s/\xc3\x49/\80/gm ;
2079                 s/\xc3\x4f/\80/gm ;
2080                 s/\xc3\x55/\80/gm ;
2081                 s/\xc3\x61/\80/gm ;
2082                 s/\xc3\x65/\80/gm ;
2083                 s/\xc3\x69/\80/gm ;
2084                 s/\xc3\x6f/\80/gm ;
2085                 s/\xc3\x75/\80/gm ;
2086                 s/\xc4\x41/\80/gm ;
2087                 s/\xc4\x4e/\80/gm ;
2088                 s/\xc4\x4f/\80/gm ;
2089                 s/\xc4\x61/\80/gm ;
2090                 s/\xc4\x6e/\80/gm ;
2091                 s/\xc4\x6f/\80/gm ;
2092                 s/\xc8\x45/\80/gm ;
2093                 s/\xc8\x49/\80/gm ;
2094                 s/\xc8\x65/\80/gm ;
2095                 s/\xc8\x69/\80/gm ;
2096                 s/\xc8\x76/\80/gm ;
2097                 s/\xc9\x41/\80/gm ;
2098                 s/\xc9\x4f/\80/gm ;
2099                 s/\xc9\x55/\80/gm ;
2100                 s/\xc9\x61/\80/gm ;
2101                 s/\xc9\x6f/\80/gm ;
2102                 s/\xc9\x75/\80/gm ;
2103                 s/\xca\x41/\80/gm ;
2104                 s/\xca\x61/\80/gm ;
2105                 s/\xd0\x43/\80/gm ;
2106                 s/\xd0\x63/\80/gm ;
2107                 # this handles non-sorting blocks (if implementation requires this)
2108                 $string = nsb_clean($_) ;
2109         } elsif ($encoding eq "USMARC" || $encoding eq "MARC21") {
2110                 if(/[\xc1-\xff]/) {
2111                         s/\xe1\x61/\80/gm ;
2112                         s/\xe1\x65/\80/gm ;
2113                         s/\xe1\x69/\80/gm ;
2114                         s/\xe1\x6f/\80/gm ;
2115                         s/\xe1\x75/\80/gm ;
2116                         s/\xe1\x41/\80/gm ;
2117                         s/\xe1\x45/\80/gm ;
2118                         s/\xe1\x49/\80/gm ;
2119                         s/\xe1\x4f/\80/gm ;
2120                         s/\xe1\x55/\80/gm ;
2121                         s/\xe2\x41/\80/gm ;
2122                         s/\xe2\x45/\80/gm ;
2123                         s/\xe2\x49/\80/gm ;
2124                         s/\xe2\x4f/\80/gm ;
2125                         s/\xe2\x55/\80/gm ;
2126                         s/\xe2\x59/\80/gm ;
2127                         s/\xe2\x61/\80/gm ;
2128                         s/\xe2\x65/\80/gm ;
2129                         s/\xe2\x69/\80/gm ;
2130                         s/\xe2\x6f/\80/gm ;
2131                         s/\xe2\x75/\80/gm ;
2132                         s/\xe2\x79/\80/gm ;
2133                         s/\xe3\x41/\80/gm ;
2134                         s/\xe3\x45/\80/gm ;
2135                         s/\xe3\x49/\80/gm ;
2136                         s/\xe3\x4f/\80/gm ;
2137                         s/\xe3\x55/\80/gm ;
2138                         s/\xe3\x61/\80/gm ;
2139                         s/\xe3\x65/\80/gm ;
2140                         s/\xe3\x69/\80/gm ;
2141                         s/\xe3\x6f/\80/gm ;
2142                         s/\xe3\x75/\80/gm ;
2143                         s/\xe4\x41/\80/gm ;
2144                         s/\xe4\x4e/\80/gm ;
2145                         s/\xe4\x4f/\80/gm ;
2146                         s/\xe4\x61/\80/gm ;
2147                         s/\xe4\x6e/\80/gm ;
2148                         s/\xe4\x6f/\80/gm ;
2149                         s/\xe8\x45/\80/gm ;
2150                         s/\xe8\x49/\80/gm ;
2151                         s/\xe8\x65/\80/gm ;
2152                         s/\xe8\x69/\80/gm ;
2153                         s/\xe8\x76/\80/gm ;
2154                         s/\xe9\x41/\80/gm ;
2155                         s/\xe9\x4f/\80/gm ;
2156                         s/\xe9\x55/\80/gm ;
2157                         s/\xe9\x61/\80/gm ;
2158                         s/\xe9\x6f/\80/gm ;
2159                         s/\xe9\x75/\80/gm ;
2160                         s/\xea\x41/\80/gm ;
2161                         s/\xea\x61/\80/gm ;
2162                         # this handles non-sorting blocks (if implementation requires this)
2163                         $string = nsb_clean($_) ;
2164                 }
2165         }
2166         return($string) ;
2167 }
2168
2169 sub nsb_clean {
2170         my $NSB = '\x88' ;              # NSB : begin Non Sorting Block
2171         my $NSE = '\x89' ;              # NSE : Non Sorting Block end
2172         # handles non sorting blocks
2173         my ($string) = @_ ;
2174         $_ = $string ;
2175         s/$NSB/(/gm ;
2176         s/[ ]{0,1}$NSE/) /gm ;
2177         $string = $_ ;
2178         return($string) ;
2179 }
2180
2181 END { }       # module clean-up code here (global destructor)
2182
2183 =back
2184
2185 =head1 AUTHOR
2186
2187 Koha Developement team <info@koha.org>
2188
2189 Paul POULAIN paul.poulain@free.fr
2190
2191 =cut
2192
2193 # $Id$
2194 # $Log$
2195 # Revision 1.77  2003/12/03 17:47:14  tipaul
2196 # bugfixes for biblio deletion
2197 #
2198 # Revision 1.76  2003/12/03 01:43:41  slef
2199 # conflict markers?
2200 #
2201 # Revision 1.75  2003/12/03 01:42:03  slef
2202 # bug 662 fixes securing DBI
2203 #
2204 # Revision 1.74  2003/11/28 09:48:33  tipaul
2205 # bugfix : misusing prepare & execute => now using prepare(?) and execute($var)
2206 #
2207 # Revision 1.73  2003/11/28 09:45:25  tipaul
2208 # bugfix for iso2709 file import in the "notforloan" field.
2209 #
2210 # But notforloan field called "loan" somewhere, so in case "loan" is used, copied to "notforloan" to avoid a bug.
2211 #
2212 # Revision 1.72  2003/11/24 17:40:14  tipaul
2213 # fix for #385
2214 #
2215 # Revision 1.71  2003/11/24 16:28:49  tipaul
2216 # biblio & item deletion now works fine in MARC editor.
2217 # Stores deleted biblio/item in the marc field of the deletedbiblio/deleteditem table.
2218 #
2219 # Revision 1.70  2003/11/24 13:29:55  tipaul
2220 # moving $id from beginning to end of file (70 commits... huge comments...)
2221 #
2222 # Revision 1.69  2003/11/24 13:27:17  tipaul
2223 # fix for #380 (bibliosubject)
2224 #
2225 # Revision 1.68  2003/11/06 17:18:30  tipaul
2226 # bugfix for #384
2227 #
2228 # 1st draft for MARC biblio deletion.
2229 # Still does not work well, but at least, Biblio.pm compiles & it should'nt break too many things
2230 # (Note the trash in the MARCdetail, but don't use it, please :-) )
2231 #
2232 # Revision 1.67  2003/10/25 08:46:27  tipaul
2233 # minor fixes for bilbio deletion (still buggy)
2234 #
2235 # Revision 1.66  2003/10/17 10:02:56  tipaul
2236 # Indexing only words longer than 2 letters. Was >=2 before, & 2 letters words usually means nothing.
2237 #
2238 # Revision 1.65  2003/10/14 09:45:29  tipaul
2239 # adding rebuildnonmarc.pl script : run this script when you change a link between marc and non MARC DB. It rebuilds the non-MARC DB (long operation)
2240 #
2241 # Revision 1.64  2003/10/06 15:20:51  tipaul
2242 # fix for 536 (subtitle error)
2243 #
2244 # Revision 1.63  2003/10/01 13:25:49  tipaul
2245 # seems a char encoding problem modified something in char_decode sub... changing back to something that works...
2246 #
2247 # Revision 1.62  2003/09/17 14:21:13  tipaul
2248 # fixing bug that makes a MARC biblio disappear when using full acquisition (order => recieve ==> MARC editor).
2249 # Before this 2 lines fix, the MARC biblio was deleted during recieve, and had to be entirely recreated :-(
2250 #
2251 # Revision 1.61  2003/09/17 10:24:39  tipaul
2252 # notforloan value in itemtype was overwritting notforloan value in a given item.
2253 # I changed this behaviour :
2254 # if notforloan is set for a given item, and NOT for all items from this itemtype, the notforloan is kept.
2255 # If notforloan is set for itemtype, it's used (and impossible to loan a specific item from this itemtype)
2256 #
2257 # Revision 1.60  2003/09/04 14:11:23  tipaul
2258 # fix for 593 (data duplication in MARC-DB)
2259 #
2260 # Revision 1.58  2003/08/06 12:54:52  tipaul
2261 # fix for publicationyear : extracting numeric value from MARC string, like for copyrightdate.
2262 # (note that copyrightdate still extracted to get numeric format)
2263 #
2264 # Revision 1.57  2003/07/15 23:09:18  slef
2265 # change show columns to use biblioitems bnotes too
2266 #
2267 # Revision 1.56  2003/07/15 11:34:52  slef
2268 # fixes from paul email
2269 #
2270 # Revision 1.55  2003/07/15 00:02:49  slef
2271 # Work on bug 515... can we do a single-side rename of notes to bnotes?
2272 #
2273 # Revision 1.54  2003/07/11 11:51:32  tipaul
2274 # *** empty log message ***
2275 #
2276 # Revision 1.52  2003/07/10 10:37:19  tipaul
2277 # fix for copyrightdate problem, #514
2278 #
2279 # Revision 1.51  2003/07/02 14:47:17  tipaul
2280 # fix for #519 : items.dateaccessioned imports incorrectly
2281 #
2282 # Revision 1.49  2003/06/17 11:21:13  tipaul
2283 # improvments/fixes for z3950 support.
2284 # * Works now even on ADD, not only on MODIFY
2285 # * able to search on ISBN, author, title
2286 #
2287 # Revision 1.48  2003/06/16 09:22:53  rangi
2288 # Just added an order clause to getitemtypes
2289 #
2290 # Revision 1.47  2003/05/20 16:22:44  tipaul
2291 # fixing typo in Biblio.pm POD
2292 #
2293 # Revision 1.46  2003/05/19 13:45:18  tipaul
2294 # support for subtitles, additional authors, subject.
2295 # This supports is only for MARC <-> OLD-DB link. It worked previously, but values entered as MARC were not reported to OLD-DB, neither values entered as OLD-DB were reported to MARC.
2296 # Note that some OLD-DB subs are strange (dummy ?) see OLDmodsubject, OLDmodsubtitle, OLDmodaddiauthor in C4/Biblio.pm
2297 # For example it seems impossible to have more that 1 addi author and 1 subtitle. In MARC it's not the case. So, if you enter more than one, I'm afraid only the LAST will be stored.
2298 #
2299 # Revision 1.45  2003/04/29 16:50:49  tipaul
2300 # really proud of this commit :-)
2301 # z3950 search and import seems to works fine.
2302 # Let me explain how :
2303 # * a "search z3950" button is added in the addbiblio template.
2304 # * when clicked, a popup appears and z3950/search.pl is called
2305 # * z3950/search.pl calls addz3950search in the DB
2306 # * the z3950 daemon retrieve the records and stores them in z3950results AND in marc_breeding table.
2307 # * as long as there as searches pending, the popup auto refresh every 2 seconds, and says how many searches are pending.
2308 # * when the user clicks on a z3950 result => the parent popup is called with the requested biblio, and auto-filled
2309 #
2310 # Note :
2311 # * character encoding support : (It's a nightmare...) In the z3950servers table, a "encoding" column has been added. You can put "UNIMARC" or "USMARC" in this column. Depending on this, the char_decode in C4::Biblio.pm replaces marc-char-encode by an iso 8859-1 encoding. Note that in the breeding import this value has been added too, for a better support.
2312 # * the marc_breeding and z3950* tables have been modified : they have an encoding column and the random z3950 number is stored too for convenience => it's the key I use to list only requested biblios in the popup.
2313 #
2314 # Revision 1.44  2003/04/28 13:07:14  tipaul
2315 # Those fixes solves the "internal server error" with MARC::Record 1.12.
2316 # It was due to an illegal contruction in Koha : we tried to retrive subfields from <10 tags.
2317 # That's not possible. MARC::Record accepted this in 0.93 version, but it was fixed after.
2318 # Now, the construct/retrieving is OK !
2319 #
2320 # Revision 1.43  2003/04/10 13:56:02  tipaul
2321 # Fix some bugs :
2322 # * worked in 1.9.0, but not in 1.9.1 :
2323 # - modif of a biblio didn't work
2324 # - empty fields where not shown when modifying a biblio. empty fields managed by the library (ie in tab 0->9 in MARC parameter table) MUST be entered, even if not presented.
2325 #
2326 # * did not work before :
2327 # - repeatable subfields now works correctly. Enter 2 subfields separated by | and they will be splitted during saving.
2328 # - dropped the last subfield of the MARC form :-(
2329 #
2330 # Internal changes :
2331 # - MARCmodbiblio now works by deleting and recreating the biblio. It's not perf optimized, but MARC is a "do_something_impossible_to_trace" standard, so, it's the best solution. not a problem for me, as biblio are rarely modified.
2332 # Note the MARCdelbiblio has been rewritted to enable deletion of a biblio WITHOUT deleting items.
2333 #
2334 # Revision 1.42  2003/04/04 08:41:11  tipaul
2335 # last commits before 1.9.1
2336 #
2337 # Revision 1.41  2003/04/01 12:26:43  tipaul
2338 # fixes
2339 #
2340 # Revision 1.40  2003/03/11 15:14:03  tipaul
2341 # pod updating
2342 #
2343 # Revision 1.39  2003/03/07 16:35:42  tipaul
2344 # * moving generic functions to Koha.pm
2345 # * improvement of SearchMarc.pm
2346 # * bugfixes
2347 # * code cleaning
2348 #
2349 # Revision 1.38  2003/02/27 16:51:59  tipaul
2350 # * moving prepare / execute to ? form.
2351 # * some # cleaning
2352 # * little bugfix.
2353 # * road to 1.9.2 => acquisition and cataloguing merging
2354 #
2355 # Revision 1.37  2003/02/12 11:03:03  tipaul
2356 # Support for 000 -> 010 fields.
2357 # Those fields doesn't have subfields.
2358 # In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@".
2359 # Note it's only virtual : when rebuilding the MARC::Record, the koha API handle correctly "@" subfields => the resulting MARC record has a 00x field without subfield.
2360 #
2361 # Revision 1.36  2003/02/12 11:01:01  tipaul
2362 # Support for 000 -> 010 fields.
2363 # Those fields doesn't have subfields.
2364 # In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@".
2365 # Note it's only virtual : when rebuilding the MARC::Record, the koha API handle correctly "@" subfields => the resulting MARC record has a 00x field without subfield.
2366 #
2367 # Revision 1.35  2003/02/03 18:46:00  acli
2368 # Minor factoring in C4/Biblio.pm, plus change to export the per-tag
2369 # 'mandatory' property to a per-subfield 'tag_mandatory' template parameter,
2370 # so that addbiblio.tmpl can distinguish between mandatory subfields in a
2371 # mandatory tag and mandatory subfields in an optional tag
2372 #
2373 # Not-minor factoring in acqui.simple/addbiblio.pl to make the if-else blocks
2374 # smaller, and to add some POD; need further testing for this
2375 #
2376 # Added function to check if a MARC subfield name is "koha-internal" (instead
2377 # of checking it for 'lib' and 'tag' everywhere); temporarily added to Koha.pm
2378 #
2379 # Use above function in acqui.simple/additem.pl and search.marc/search.pl
2380 #
2381 # Revision 1.34  2003/01/28 14:50:04  tipaul
2382 # fixing MARCmodbiblio API and reindenting code
2383 #
2384 # Revision 1.33  2003/01/23 12:22:37  tipaul
2385 # adding char_decode to decode MARC21 or UNIMARC extended chars
2386 #
2387 # Revision 1.32  2002/12/16 15:08:50  tipaul
2388 # small but important bugfix (fixes a problem in export)
2389 #
2390 # Revision 1.31  2002/12/13 16:22:04  tipaul
2391 # 1st draft of marc export
2392 #
2393 # Revision 1.30  2002/12/12 21:26:35  tipaul
2394 # YAB ! (Yet Another Bugfix) => related to biblio modif
2395 # (some warning cleaning too)
2396 #
2397 # Revision 1.29  2002/12/12 16:35:00  tipaul
2398 # adding authentification with Auth.pm and
2399 # MAJOR BUGFIX on marc biblio modification
2400 #
2401 # Revision 1.28  2002/12/10 13:30:03  tipaul
2402 # fugfixes from Dombes Abbey work
2403 #
2404 # Revision 1.27  2002/11/19 12:36:16  tipaul
2405 # road to 1.3.2
2406 # various bugfixes, improvments, and migration from acquisition.pm to biblio.pm
2407 #
2408 # Revision 1.26  2002/11/12 15:58:43  tipaul
2409 # road to 1.3.2 :
2410 # * many bugfixes
2411 # * adding value_builder : you can map a subfield in the marc_subfield_structure to a sub stored in "value_builder" directory. In this directory you can create screen used to build values with any method. In this commit is a 1st draft of the builder for 100$a unimarc french subfield, which is composed of 35 digits, with 12 differents values (only the 4th first are provided for instance)
2412 #
2413 # Revision 1.25  2002/10/25 10:58:26  tipaul
2414 # Road to 1.3.2
2415 # * bugfixes and improvements
2416 #
2417 # Revision 1.24  2002/10/24 12:09:01  arensb
2418 # Fixed "no title" warning when generating HTML documentation from POD.
2419 #
2420 # Revision 1.23  2002/10/16 12:43:08  arensb
2421 # Added some FIXME comments.
2422 #
2423 # Revision 1.22  2002/10/15 13:39:17  tipaul
2424 # removing Acquisition.pm
2425 # deleting unused code in biblio.pm, rewriting POD and answering most FIXME comments
2426 #
2427 # Revision 1.21  2002/10/13 11:34:14  arensb
2428 # Replaced expressions of the form "$x = $x <op> $y" with "$x <op>= $y".
2429 # Thus, $x = $x+2 becomes $x += 2, and so forth.
2430 #
2431 # Revision 1.20  2002/10/13 08:28:32  arensb
2432 # Deleted unused variables.
2433 # Removed trailing whitespace.
2434 #
2435 # Revision 1.19  2002/10/13 05:56:10  arensb
2436 # Added some FIXME comments.
2437 #
2438 # Revision 1.18  2002/10/11 12:34:53  arensb
2439 # Replaced &requireDBI with C4::Context->dbh
2440 #
2441 # Revision 1.17  2002/10/10 14:48:25  tipaul
2442 # bugfixes
2443 #
2444 # Revision 1.16  2002/10/07 14:04:26  tipaul
2445 # road to 1.3.1 : viewing MARC biblio
2446 #
2447 # Revision 1.15  2002/10/05 09:49:25  arensb
2448 # Merged with arensb-context branch: use C4::Context->dbh instead of
2449 # &C4Connect, and generally prefer C4::Context over C4::Database.
2450 #
2451 # Revision 1.14  2002/10/03 11:28:18  tipaul
2452 # Extending Context.pm to add stopword management and using it in MARC-API.
2453 # First benchmarks show a medium speed improvement, which  is nice as this part is heavily called.
2454 #
2455 # Revision 1.13  2002/10/02 16:26:44  tipaul
2456 # road to 1.3.1
2457 #
2458 # Revision 1.12.2.4  2002/10/05 07:09:31  arensb
2459 # Merged in changes from main branch.
2460 #
2461 # Revision 1.12.2.3  2002/10/05 06:12:10  arensb
2462 # Added a whole mess of FIXME comments.
2463 #
2464 # Revision 1.12.2.2  2002/10/05 04:03:14  arensb
2465 # Added some missing semicolons.
2466 #
2467 # Revision 1.12.2.1  2002/10/04 02:24:01  arensb
2468 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
2469 # C4Connect.
2470 #
2471 # Revision 1.12.2.3  2002/10/05 06:12:10  arensb
2472 # Added a whole mess of FIXME comments.
2473 #
2474 # Revision 1.12.2.2  2002/10/05 04:03:14  arensb
2475 # Added some missing semicolons.
2476 #
2477 # Revision 1.12.2.1  2002/10/04 02:24:01  arensb
2478 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
2479 # C4Connect.
2480 #
2481 # Revision 1.12  2002/10/01 11:48:51  arensb
2482 # Added some FIXME comments, mostly marking duplicate functions.
2483 #
2484 # Revision 1.11  2002/09/24 13:49:26  tipaul
2485 # long WAS the road to 1.3.0...
2486 # coming VERY SOON NOW...
2487 # modifying installer and buildrelease to update the DB
2488 #
2489 # Revision 1.10  2002/09/22 16:50:08  arensb
2490 # Added some FIXME comments.
2491 #
2492 # Revision 1.9  2002/09/20 12:57:46  tipaul
2493 # long is the road to 1.4.0
2494 # * MARCadditem and MARCmoditem now wroks
2495 # * various bugfixes in MARC management
2496 # !!! 1.3.0 should be released very soon now. Be careful !!!
2497 #
2498 # Revision 1.8  2002/09/10 13:53:52  tipaul
2499 # MARC API continued...
2500 # * some bugfixes
2501 # * multiple item management : MARCadditem and MARCmoditem have been added. They suppose that ALL the MARC field linked to koha-item are in the same MARC tag (on the same line of MARC file)
2502 #
2503 # Note : it should not be hard for marcimport and marcexport to re-link fields from internal tag/subfield to "legal" tag/subfield.
2504 #
2505 # Revision 1.7  2002/08/14 18:12:51  tonnesen
2506 # Added copyright statement to all .pl and .pm files
2507 #
2508 # Revision 1.6  2002/07/25 13:40:31  tipaul
2509 # pod documenting the API.
2510 #
2511 # Revision 1.5  2002/07/24 16:11:37  tipaul
2512 # Now, the API...
2513 # Database.pm and Output.pm are almost not modified (var test...)
2514 #
2515 # Biblio.pm is almost completly rewritten.
2516 #
2517 # WHAT DOES IT ??? ==> END of Hitchcock suspens
2518 #
2519 # 1st, it does... nothing...
2520 # Every old API should be there. So if MARC-stuff is not done, the behaviour is EXACTLY the same (if there is no added bug, of course). So, if you use normal acquisition, you won't find anything new neither on screen or old-DB tables ...
2521 #
2522 # All old-API functions have been cloned. for example, the "newbiblio" sub, now has become :
2523 # * a "newbiblio" sub, with the same parameters. It just call a sub named OLDnewbiblio
2524 # * a "OLDnewbiblio" sub, which is a copy/paste of the previous newbiblio sub. Then, when you want to add the MARC-DB stuff, you can modify the newbiblio sub without modifying the OLDnewbiblio one. If we correct a bug in 1.2 in newbiblio, we can do the same in main branch by correcting OLDnewbiblio.
2525 # * The MARC stuff is usually done through a sub named MARCxxx where xxx is the same as OLDxxx. For example, newbiblio calls MARCnewbiblio. the MARCxxx subs use a MARC::Record as parameter.
2526 # The last thing to solve was to manage biblios through real MARC import : they must populate the old-db, but must populate the MARC-DB too, without loosing information (if we go from MARC::Record to old-data then back to MARC::Record, we loose A LOT OF ROWS). To do this, there are subs beginning by "NEWxxx" : they manage datas with MARC::Record datas. they call OLDxxx sub too (to populate old-DB), but MARCxxx subs too, with a complete MARC::Record ;-)
2527 #
2528 # In Biblio.pm, there are some subs that permits to build a old-style record from a MARC::Record, and the opposite. There is also a sub finding a MARC-bibid from a old-biblionumber and the opposite too.
2529 # Note we have decided with steve that a old-biblio <=> a MARC-Biblio.
2530 #
2531
2532 sub itemcount{
2533   my ($biblio)=@_;
2534   my $dbh = C4::Context->dbh;
2535   my $query="Select count(*) from items where biblionumber=$biblio";
2536 #  print $query;
2537   my $sth=$dbh->prepare($query);
2538   $sth->execute;
2539   my $data=$sth->fetchrow_hashref;
2540   $sth->finish;
2541   return($data->{'count(*)'});
2542 }
2543
2544 =item getorder
2545
2546   ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
2547
2548 Looks up the order with the given biblionumber and biblioitemnumber.
2549
2550 Returns a two-element array. C<$ordernumber> is the order number.
2551 C<$order> is a reference-to-hash describing the order; its keys are
2552 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
2553 tables of the Koha database.
2554
2555 =cut
2556 #'
2557 # FIXME - This is effectively identical to &C4::Catalogue::getorder.
2558 # Pick one and stick with it.
2559 sub getorder{
2560   my ($bi,$bib)=@_;
2561   my $dbh = C4::Context->dbh;
2562   my $query="Select ordernumber
2563         from aqorders
2564         where biblionumber=? and biblioitemnumber=?";
2565   my $sth=$dbh->prepare($query);
2566   $sth->execute($bib,$bi);
2567   # FIXME - Use fetchrow_array(), since we're only interested in the one
2568   # value.
2569   my $ordnum=$sth->fetchrow_hashref;
2570   $sth->finish;
2571   my $order=getsingleorder($ordnum->{'ordernumber'});
2572 #  print $query;
2573   return ($order,$ordnum->{'ordernumber'});
2574 }
2575
2576 =item getsingleorder
2577
2578   $order = &getsingleorder($ordernumber);
2579
2580 Looks up an order by order number.
2581
2582 Returns a reference-to-hash describing the order. The keys of
2583 C<$order> are fields from the biblio, biblioitems, aqorders, and
2584 aqorderbreakdown tables of the Koha database.
2585
2586 =cut
2587 #'
2588 # FIXME - This is effectively identical to
2589 # &C4::Catalogue::getsingleorder.
2590 # Pick one and stick with it.
2591 sub getsingleorder {
2592   my ($ordnum)=@_;
2593   my $dbh = C4::Context->dbh;
2594   my $query="Select * from biblio,biblioitems,aqorders,aqorderbreakdown
2595   where aqorders.ordernumber=?
2596   and biblio.biblionumber=aqorders.biblionumber and
2597   biblioitems.biblioitemnumber=aqorders.biblioitemnumber and
2598   aqorders.ordernumber=aqorderbreakdown.ordernumber";
2599   my $sth=$dbh->prepare($query);
2600   $sth->execute($ordnum);
2601   my $data=$sth->fetchrow_hashref;
2602   $sth->finish;
2603   return($data);
2604 }
2605
2606 sub newbiblio {
2607         my ($biblio) = @_;
2608         my $dbh    = C4::Context->dbh;
2609         my $bibnum=OLDnewbiblio($dbh,$biblio);
2610         # finds new (MARC bibid
2611 #       my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
2612         my $record = &MARCkoha2marcBiblio($dbh,$bibnum);
2613         MARCaddbiblio($dbh,$record,$bibnum);
2614         return($bibnum);
2615 }
2616
2617 =item modbiblio
2618
2619   $biblionumber = &modbiblio($biblio);
2620
2621 Update a biblio record.
2622
2623 C<$biblio> is a reference-to-hash whose keys are the fields in the
2624 biblio table in the Koha database. All fields must be present, not
2625 just the ones you wish to change.
2626
2627 C<&modbiblio> updates the record defined by
2628 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
2629
2630 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
2631 successful or not.
2632
2633 =cut
2634
2635 sub modbiblio {
2636         my ($biblio) = @_;
2637         my $dbh  = C4::Context->dbh;
2638         my $biblionumber=OLDmodbiblio($dbh,$biblio);
2639         my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
2640         # finds new (MARC bibid
2641         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
2642         MARCmodbiblio($dbh,$bibid,$record,0);
2643         return($biblionumber);
2644 } # sub modbiblio
2645
2646 =item modsubtitle
2647
2648   &modsubtitle($biblionumber, $subtitle);
2649
2650 Sets the subtitle of a book.
2651
2652 C<$biblionumber> is the biblionumber of the book to modify.
2653
2654 C<$subtitle> is the new subtitle.
2655
2656 =cut
2657
2658 sub modsubtitle {
2659   my ($bibnum, $subtitle) = @_;
2660   my $dbh   = C4::Context->dbh;
2661   &OLDmodsubtitle($dbh,$bibnum,$subtitle);
2662 } # sub modsubtitle
2663
2664 =item modaddauthor
2665
2666   &modaddauthor($biblionumber, $author);
2667
2668 Replaces all additional authors for the book with biblio number
2669 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
2670 C<&modaddauthor> deletes all additional authors.
2671
2672 =cut
2673
2674 sub modaddauthor {
2675     my ($bibnum, $author) = @_;
2676     my $dbh   = C4::Context->dbh;
2677     &OLDmodaddauthor($dbh,$bibnum,$author);
2678 } # sub modaddauthor
2679
2680 =item modsubject
2681
2682   $error = &modsubject($biblionumber, $force, @subjects);
2683
2684 $force - a subject to force
2685
2686 $error - Error message, or undef if successful.
2687
2688 =cut
2689
2690 sub modsubject {
2691   my ($bibnum, $force, @subject) = @_;
2692   my $dbh   = C4::Context->dbh;
2693   my $error= &OLDmodsubject($dbh,$bibnum,$force, @subject);
2694   return($error);
2695 } # sub modsubject
2696
2697 sub modbibitem {
2698     my ($biblioitem) = @_;
2699     my $dbh   = C4::Context->dbh;
2700     &OLDmodbibitem($dbh,$biblioitem);
2701 } # sub modbibitem
2702
2703 sub modnote {
2704   my ($bibitemnum,$note)=@_;
2705   my $dbh = C4::Context->dbh;
2706   &OLDmodnote($dbh,$bibitemnum,$note);
2707 }
2708
2709 sub newbiblioitem {
2710         my ($biblioitem) = @_;
2711         my $dbh   = C4::Context->dbh;
2712         my $bibitemnum = &OLDnewbiblioitem($dbh,$biblioitem);
2713         my $MARCbiblio= MARCkoha2marcBiblio($dbh,0,$bibitemnum); # the 0 means "do NOT retrieve biblio, only biblioitem, in the MARC record
2714         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblioitem->{biblionumber});
2715         &MARCaddbiblio($dbh,$MARCbiblio,$biblioitem->{biblionumber},$bibid);
2716         return($bibitemnum);
2717 }
2718
2719 sub newsubject {
2720   my ($bibnum)=@_;
2721   my $dbh = C4::Context->dbh;
2722   &OLDnewsubject($dbh,$bibnum);
2723 }
2724
2725 sub newsubtitle {
2726     my ($bibnum, $subtitle) = @_;
2727     my $dbh   = C4::Context->dbh;
2728     &OLDnewsubtitle($dbh,$bibnum,$subtitle);
2729 }
2730
2731 sub newitems {
2732   my ($item, @barcodes) = @_;
2733   my $dbh   = C4::Context->dbh;
2734   my $errors;
2735   my $itemnumber;
2736   my $error;
2737   foreach my $barcode (@barcodes) {
2738       ($itemnumber,$error)=&OLDnewitems($dbh,$item,uc($barcode));
2739       $errors .=$error;
2740       my $MARCitem = &MARCkoha2marcItem($dbh,$item->{biblionumber},$itemnumber);
2741       &MARCadditem($dbh,$MARCitem,$item->{biblionumber});
2742   }
2743   return($errors);
2744 }
2745
2746 sub moditem {
2747     my ($item) = @_;
2748     my $dbh = C4::Context->dbh;
2749     &OLDmoditem($dbh,$item);
2750     my $MARCitem = &MARCkoha2marcItem($dbh,$item->{'biblionumber'},$item->{'itemnum'});
2751     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$item->{biblionumber});
2752     &MARCmoditem($dbh,$MARCitem,$bibid,$item->{itemnum},0);
2753 }
2754
2755 sub checkitems{
2756   my ($count,@barcodes)=@_;
2757   my $dbh = C4::Context->dbh;
2758   my $error;
2759   for (my $i=0;$i<$count;$i++){
2760     $barcodes[$i]=uc $barcodes[$i];
2761     my $query="Select * from items where barcode='$barcodes[$i]'";
2762     my $sth=$dbh->prepare($query);
2763     $sth->execute;
2764     if (my $data=$sth->fetchrow_hashref){
2765       $error.=" Duplicate Barcode: $barcodes[$i]";
2766     }
2767     $sth->finish;
2768   }
2769   return($error);
2770 }
2771
2772 sub countitems{
2773   my ($bibitemnum)=@_;
2774   my $dbh = C4::Context->dbh;
2775   my $query="Select count(*) from items where biblioitemnumber='$bibitemnum'";
2776   my $sth=$dbh->prepare($query);
2777   $sth->execute;
2778   my $data=$sth->fetchrow_hashref;
2779   $sth->finish;
2780   return($data->{'count(*)'});
2781 }
2782
2783 sub delitem{
2784   my ($itemnum)=@_;
2785   my $dbh = C4::Context->dbh;
2786   &OLDdelitem($dbh,$itemnum);
2787 }
2788
2789 sub deletebiblioitem {
2790     my ($biblioitemnumber) = @_;
2791     my $dbh   = C4::Context->dbh;
2792     &OLDdeletebiblioitem($dbh,$biblioitemnumber);
2793 } # sub deletebiblioitem
2794
2795
2796 sub delbiblio {
2797         my ($biblio)=@_;
2798         my $dbh = C4::Context->dbh;
2799         &OLDdelbiblio($dbh,$biblio);
2800         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblio);
2801         &MARCdelbiblio($dbh,$bibid,0);
2802 }
2803
2804 sub getitemtypes {
2805   my $dbh   = C4::Context->dbh;
2806   my $query = "select * from itemtypes order by description";
2807   my $sth   = $dbh->prepare($query);
2808     # || die "Cannot prepare $query" . $dbh->errstr;
2809   my $count = 0;
2810   my @results;
2811
2812   $sth->execute;
2813     # || die "Cannot execute $query\n" . $sth->errstr;
2814   while (my $data = $sth->fetchrow_hashref) {
2815     $results[$count] = $data;
2816     $count++;
2817   } # while
2818
2819   $sth->finish;
2820   return($count, @results);
2821 } # sub getitemtypes
2822
2823 sub getbiblio {
2824     my ($biblionumber) = @_;
2825     my $dbh   = C4::Context->dbh;
2826     my $query = "Select * from biblio where biblionumber = $biblionumber";
2827     my $sth   = $dbh->prepare($query);
2828       # || die "Cannot prepare $query\n" . $dbh->errstr;
2829     my $count = 0;
2830     my @results;
2831
2832     $sth->execute;
2833       # || die "Cannot execute $query\n" . $sth->errstr;
2834     while (my $data = $sth->fetchrow_hashref) {
2835       $results[$count] = $data;
2836       $count++;
2837     } # while
2838
2839     $sth->finish;
2840     return($count, @results);
2841 } # sub getbiblio
2842
2843 sub getbiblioitem {
2844     my ($biblioitemnum) = @_;
2845     my $dbh   = C4::Context->dbh;
2846     my $query = "Select * from biblioitems where
2847 biblioitemnumber = $biblioitemnum";
2848     my $sth   = $dbh->prepare($query);
2849     my $count = 0;
2850     my @results;
2851
2852     $sth->execute;
2853
2854     while (my $data = $sth->fetchrow_hashref) {
2855         $results[$count] = $data;
2856         $count++;
2857     } # while
2858
2859     $sth->finish;
2860     return($count, @results);
2861 } # sub getbiblioitem
2862
2863 sub getbiblioitembybiblionumber {
2864     my ($biblionumber) = @_;
2865     my $dbh   = C4::Context->dbh;
2866     my $query = "Select * from biblioitems where biblionumber =
2867 $biblionumber";
2868     my $sth   = $dbh->prepare($query);
2869     my $count = 0;
2870     my @results;
2871
2872     $sth->execute;
2873
2874     while (my $data = $sth->fetchrow_hashref) {
2875         $results[$count] = $data;
2876         $count++;
2877     } # while
2878
2879     $sth->finish;
2880     return($count, @results);
2881 } # sub
2882
2883 sub getitemsbybiblioitem {
2884     my ($biblioitemnum) = @_;
2885     my $dbh   = C4::Context->dbh;
2886     my $query = "Select * from items, biblio where
2887 biblio.biblionumber = items.biblionumber and biblioitemnumber
2888 = $biblioitemnum";
2889     my $sth   = $dbh->prepare($query);
2890       # || die "Cannot prepare $query\n" . $dbh->errstr;
2891     my $count = 0;
2892     my @results;
2893
2894     $sth->execute;
2895       # || die "Cannot execute $query\n" . $sth->errstr;
2896     while (my $data = $sth->fetchrow_hashref) {
2897       $results[$count] = $data;
2898       $count++;
2899     } # while
2900
2901     $sth->finish;
2902     return($count, @results);
2903 } # sub getitemsbybiblioitem
2904
2905
2906 sub logchange {
2907 # Subroutine to log changes to databases
2908 # Eventually, this subroutine will be used to create a log of all changes made,
2909 # with the possibility of "undo"ing some changes
2910     my $database=shift;
2911     if ($database eq 'kohadb') {
2912         my $type=shift;
2913         my $section=shift;
2914         my $item=shift;
2915         my $original=shift;
2916         my $new=shift;
2917 #       print STDERR "KOHA: $type $section $item $original $new\n";
2918     } elsif ($database eq 'marc') {
2919         my $type=shift;
2920         my $Record_ID=shift;
2921         my $tag=shift;
2922         my $mark=shift;
2923         my $subfield_ID=shift;
2924         my $original=shift;
2925         my $new=shift;
2926 #       print STDERR "MARC: $type $Record_ID $tag $mark $subfield_ID $original $new\n";
2927     }
2928 }
2929
2930 #------------------------------------------------
2931
2932
2933 #---------------------------------------
2934 # Find a biblio entry, or create a new one if it doesn't exist.
2935 #  If a "subtitle" entry is in hash, add it to subtitle table
2936 sub getoraddbiblio {
2937         # input params
2938         my (
2939           $dbh,         # db handle
2940                         # FIXME - Unused argument
2941           $biblio,      # hash ref to fields
2942         )=@_;
2943
2944         # return
2945         my $biblionumber;
2946
2947         my $debug=0;
2948         my $sth;
2949         my $error;
2950
2951         #-----
2952         $dbh = C4::Context->dbh;
2953
2954         print "<PRE>Looking for biblio </PRE>\n" if $debug;
2955         $sth=$dbh->prepare("select biblionumber
2956                 from biblio
2957                 where title=? and author=?
2958                   and copyrightdate=? and seriestitle=?");
2959         $sth->execute(
2960                 $biblio->{title}, $biblio->{author},
2961                 $biblio->{copyright}, $biblio->{seriestitle} );
2962         if ($sth->rows) {
2963             ($biblionumber) = $sth->fetchrow;
2964             print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
2965         } else {
2966             # Doesn't exist.  Add new one.
2967             print "<PRE>Adding biblio</PRE>\n" if $debug;
2968             ($biblionumber,$error)=&newbiblio($biblio);
2969             if ( $biblionumber ) {
2970               print "<PRE>Added with biblio number=$biblionumber</PRE>\n" if $debug;
2971               if ( $biblio->{subtitle} ) {
2972                 &newsubtitle($biblionumber,$biblio->{subtitle} );
2973               } # if subtitle
2974             } else {
2975                 print "<PRE>Couldn't add biblio: $error</PRE>\n" if $debug;
2976             } # if added
2977         }
2978
2979         return $biblionumber,$error;
2980
2981 } # sub getoraddbiblio
2982
2983 sub char_decode {
2984         # converts ISO 5426 coded string to ISO 8859-1
2985         # sloppy code : should be improved in next issue
2986         my ($string,$encoding) = @_ ;
2987         $_ = $string ;
2988 #       $encoding = C4::Context->preference("marcflavour") unless $encoding;
2989         if ($encoding eq "UNIMARC") {
2990                 s/\xe1/\80/gm ;
2991                 s/\xe2/\80/gm ;
2992                 s/\xe9/\80/gm ;
2993                 s/\xec/\80/gm ;
2994                 s/\xf1/\80/gm ;
2995                 s/\xf3/\80/gm ;
2996                 s/\xf9/\80/gm ;
2997                 s/\xfb/\80/gm ;
2998                 s/\xc1\x61/\80/gm ;
2999                 s/\xc1\x65/\80/gm ;
3000                 s/\xc1\x69/\80/gm ;
3001                 s/\xc1\x6f/\80/gm ;
3002                 s/\xc1\x75/\80/gm ;
3003                 s/\xc1\x41/\80/gm ;
3004                 s/\xc1\x45/\80/gm ;
3005                 s/\xc1\x49/\80/gm ;
3006                 s/\xc1\x4f/\80/gm ;
3007                 s/\xc1\x55/\80/gm ;
3008                 s/\xc2\x41/\80/gm ;
3009                 s/\xc2\x45/\80/gm ;
3010                 s/\xc2\x49/\80/gm ;
3011                 s/\xc2\x4f/\80/gm ;
3012                 s/\xc2\x55/\80/gm ;
3013                 s/\xc2\x59/\80/gm ;
3014                 s/\xc2\x61/\80/gm ;
3015                 s/\xc2\x65/\80/gm ;
3016                 s/\xc2\x69/\80/gm ;
3017                 s/\xc2\x6f/\80/gm ;
3018                 s/\xc2\x75/\80/gm ;
3019                 s/\xc2\x79/\80/gm ;
3020                 s/\xc3\x41/\80/gm ;
3021                 s/\xc3\x45/\80/gm ;
3022                 s/\xc3\x49/\80/gm ;
3023                 s/\xc3\x4f/\80/gm ;
3024                 s/\xc3\x55/\80/gm ;
3025                 s/\xc3\x61/\80/gm ;
3026                 s/\xc3\x65/\80/gm ;
3027                 s/\xc3\x69/\80/gm ;
3028                 s/\xc3\x6f/\80/gm ;
3029                 s/\xc3\x75/\80/gm ;
3030                 s/\xc4\x41/\80/gm ;
3031                 s/\xc4\x4e/\80/gm ;
3032                 s/\xc4\x4f/\80/gm ;
3033                 s/\xc4\x61/\80/gm ;
3034                 s/\xc4\x6e/\80/gm ;
3035                 s/\xc4\x6f/\80/gm ;
3036                 s/\xc8\x45/\80/gm ;
3037                 s/\xc8\x49/\80/gm ;
3038                 s/\xc8\x65/\80/gm ;
3039                 s/\xc8\x69/\80/gm ;
3040                 s/\xc8\x76/\80/gm ;
3041                 s/\xc9\x41/\80/gm ;
3042                 s/\xc9\x4f/\80/gm ;
3043                 s/\xc9\x55/\80/gm ;
3044                 s/\xc9\x61/\80/gm ;
3045                 s/\xc9\x6f/\80/gm ;
3046                 s/\xc9\x75/\80/gm ;
3047                 s/\xca\x41/\80/gm ;
3048                 s/\xca\x61/\80/gm ;
3049                 s/\xd0\x43/\80/gm ;
3050                 s/\xd0\x63/\80/gm ;
3051                 # this handles non-sorting blocks (if implementation requires this)
3052                 $string = nsb_clean($_) ;
3053         } elsif ($encoding eq "USMARC" || $encoding eq "MARC21") {
3054                 if(/[\xc1-\xff]/) {
3055                         s/\xe1\x61/\80/gm ;
3056                         s/\xe1\x65/\80/gm ;
3057                         s/\xe1\x69/\80/gm ;
3058                         s/\xe1\x6f/\80/gm ;
3059                         s/\xe1\x75/\80/gm ;
3060                         s/\xe1\x41/\80/gm ;
3061                         s/\xe1\x45/\80/gm ;
3062                         s/\xe1\x49/\80/gm ;
3063                         s/\xe1\x4f/\80/gm ;
3064                         s/\xe1\x55/\80/gm ;
3065                         s/\xe2\x41/\80/gm ;
3066                         s/\xe2\x45/\80/gm ;
3067                         s/\xe2\x49/\80/gm ;
3068                         s/\xe2\x4f/\80/gm ;
3069                         s/\xe2\x55/\80/gm ;
3070                         s/\xe2\x59/\80/gm ;
3071                         s/\xe2\x61/\80/gm ;
3072                         s/\xe2\x65/\80/gm ;
3073                         s/\xe2\x69/\80/gm ;
3074                         s/\xe2\x6f/\80/gm ;
3075                         s/\xe2\x75/\80/gm ;
3076                         s/\xe2\x79/\80/gm ;
3077                         s/\xe3\x41/\80/gm ;
3078                         s/\xe3\x45/\80/gm ;
3079                         s/\xe3\x49/\80/gm ;
3080                         s/\xe3\x4f/\80/gm ;
3081                         s/\xe3\x55/\80/gm ;
3082                         s/\xe3\x61/\80/gm ;
3083                         s/\xe3\x65/\80/gm ;
3084                         s/\xe3\x69/\80/gm ;
3085                         s/\xe3\x6f/\80/gm ;
3086                         s/\xe3\x75/\80/gm ;
3087                         s/\xe4\x41/\80/gm ;
3088                         s/\xe4\x4e/\80/gm ;
3089                         s/\xe4\x4f/\80/gm ;
3090                         s/\xe4\x61/\80/gm ;
3091                         s/\xe4\x6e/\80/gm ;
3092                         s/\xe4\x6f/\80/gm ;
3093                         s/\xe8\x45/\80/gm ;
3094                         s/\xe8\x49/\80/gm ;
3095                         s/\xe8\x65/\80/gm ;
3096                         s/\xe8\x69/\80/gm ;
3097                         s/\xe8\x76/\80/gm ;
3098                         s/\xe9\x41/\80/gm ;
3099                         s/\xe9\x4f/\80/gm ;
3100                         s/\xe9\x55/\80/gm ;
3101                         s/\xe9\x61/\80/gm ;
3102                         s/\xe9\x6f/\80/gm ;
3103                         s/\xe9\x75/\80/gm ;
3104                         s/\xea\x41/\80/gm ;
3105                         s/\xea\x61/\80/gm ;
3106                         # this handles non-sorting blocks (if implementation requires this)
3107                         $string = nsb_clean($_) ;
3108                 }
3109         }
3110         return($string) ;
3111 }
3112
3113 sub nsb_clean {
3114         my $NSB = '\x88' ;              # NSB : begin Non Sorting Block
3115         my $NSE = '\x89' ;              # NSE : Non Sorting Block end
3116         # handles non sorting blocks
3117         my ($string) = @_ ;
3118         $_ = $string ;
3119         s/$NSB/(/gm ;
3120         s/[ ]{0,1}$NSE/) /gm ;
3121         $string = $_ ;
3122         return($string) ;
3123 }
3124
3125 END { }       # module clean-up code here (global destructor)
3126
3127 =back
3128
3129 =head1 AUTHOR
3130
3131 Koha Developement team <info@koha.org>
3132
3133 Paul POULAIN paul.poulain@free.fr
3134
3135 =cut