5b56cfe2337aa3d6fa7d2459c7ada43d0a9eb842
[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=$res where subfieldid=?");
625             $sth->execute($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     if ($subfieldvalue) {
650         $query .= " and subfieldvalue=".$dbh->quote($subfieldvalue);
651     } else {
652         if ($subfieldorder<1) {
653             $subfieldorder=1;
654         }
655         $query .= " and subfieldorder=$subfieldorder";
656     }
657     my $sti=$dbh->prepare($query);
658     $sti->execute($bibid,$tag, $subfieldcode);
659     while (($subfieldid) = $sti->fetchrow) {
660         $resultcounter++;
661         $lastsubfieldid=$subfieldid;
662     }
663     if ($resultcounter>1) {
664         # Error condition.  Values given did not resolve into a unique record.  Don't know what to edit
665         # should rarely occur (only if we use subfieldvalue with a value that exists twice, which is strange)
666         return -1;
667     } else {
668         return $lastsubfieldid;
669     }
670 }
671
672 sub MARCfindsubfieldid {
673         my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
674         my $sth=$dbh->prepare("select subfieldid from marc_subfield_table
675                                 where bibid=? and tag=? and tagorder=?
676                                         and subfieldcode=? and subfieldorder=?");
677         $sth->execute($bibid,$tag,$tagorder,$subfield,$subfieldorder);
678         my ($res) = $sth->fetchrow;
679         unless ($res) {
680                 $sth=$dbh->prepare("select subfieldid from marc_subfield_table
681                                 where bibid=? and tag=? and tagorder=?
682                                         and subfieldcode=?");
683                 $sth->execute($bibid,$tag,$tagorder,$subfield);
684                 ($res) = $sth->fetchrow;
685         }
686     return $res;
687 }
688
689 sub MARCdelsubfield {
690 # delete a subfield for $bibid / tag / tagorder / subfield / subfieldorder
691     my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
692     $dbh->do("delete from marc_subfield_table where bibid='$bibid' and
693                         tag='$tag' and tagorder='$tagorder'
694                         and subfieldcode='$subfield' and subfieldorder='$subfieldorder
695                         ");
696 }
697
698 sub MARCkoha2marcBiblio {
699 # this function builds partial MARC::Record from the old koha-DB fields
700     my ($dbh,$biblionumber,$biblioitemnumber) = @_;
701     my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
702     my $record = MARC::Record->new();
703 #--- if bibid, then retrieve old-style koha data
704     if ($biblionumber>0) {
705         my $sth2=$dbh->prepare("select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp
706                 from biblio where biblionumber=?");
707         $sth2->execute($biblionumber);
708         my $row=$sth2->fetchrow_hashref;
709         my $code;
710         foreach $code (keys %$row) {
711             if ($row->{$code}) {
712                 &MARCkoha2marcOnefield($sth,$record,"biblio.".$code,$row->{$code});
713             }
714         }
715     }
716 #--- if biblioitem, then retrieve old-style koha data
717     if ($biblioitemnumber>0) {
718         my $sth2=$dbh->prepare(" SELECT biblioitemnumber,biblionumber,volume,number,classification,
719                                                 itemtype,url,isbn,issn,dewey,subclass,publicationyear,publishercode,
720                                                 volumedate,volumeddesc,timestamp,illus,pages,notes AS bnotes,size,place
721                                         FROM biblioitems
722                                         WHERE biblioitemnumber=?
723                                         ");
724         $sth2->execute($biblioitemnumber);
725         my $row=$sth2->fetchrow_hashref;
726         my $code;
727         foreach $code (keys %$row) {
728             if ($row->{$code}) {
729                 &MARCkoha2marcOnefield($sth,$record,"biblioitems.".$code,$row->{$code});
730             }
731         }
732     }
733         # other fields => additional authors, subjects, subtitles
734         my $sth2=$dbh->prepare(" SELECT author FROM additionalauthors WHERE biblionumber=?");
735         $sth2->execute($biblionumber);
736         while (my $row=$sth2->fetchrow_hashref) {
737                         &MARCkoha2marcOnefield($sth,$record,"additionalauthors.author",$row->{'author'});
738                 }
739         my $sth2=$dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?");
740         $sth2->execute($biblionumber);
741         while (my $row=$sth2->fetchrow_hashref) {
742                         &MARCkoha2marcOnefield($sth,$record,"bibliosubject.subject",$row->{'subject'});
743                 }
744         my $sth2=$dbh->prepare(" SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?");
745         $sth2->execute($biblionumber);
746         while (my $row=$sth2->fetchrow_hashref) {
747                         &MARCkoha2marcOnefield($sth,$record,"bibliosubtitle.title",$row->{'subtitle'});
748                 }
749     return $record;
750 }
751
752 sub MARCkoha2marcItem {
753 # this function builds partial MARC::Record from the old koha-DB fields
754     my ($dbh,$biblionumber,$itemnumber) = @_;
755 #    my $dbh=&C4Connect;
756     my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
757     my $record = MARC::Record->new();
758 #--- if item, then retrieve old-style koha data
759     if ($itemnumber>0) {
760 #       print STDERR "prepare $biblionumber,$itemnumber\n";
761         my $sth2=$dbh->prepare("SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned,
762                                                 booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
763                                                 datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,bulk,issues,renewals,
764                                         reserves,restricted,binding,itemnotes,holdingbranch,timestamp
765                                         FROM items
766                                         WHERE itemnumber=?");
767         $sth2->execute($itemnumber);
768         my $row=$sth2->fetchrow_hashref;
769         my $code;
770         foreach $code (keys %$row) {
771             if ($row->{$code}) {
772                 &MARCkoha2marcOnefield($sth,$record,"items.".$code,$row->{$code});
773             }
774         }
775     }
776     return $record;
777 }
778
779 sub MARCkoha2marcSubtitle {
780 # this function builds partial MARC::Record from the old koha-DB fields
781     my ($dbh,$bibnum,$subtitle) = @_;
782     my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
783     my $record = MARC::Record->new();
784     &MARCkoha2marcOnefield($sth,$record,"bibliosubtitle.subtitle",$subtitle);
785     return $record;
786 }
787
788 sub MARCkoha2marcOnefield {
789     my ($sth,$record,$kohafieldname,$value)=@_;
790     my $tagfield;
791     my $tagsubfield;
792     $sth->execute($kohafieldname);
793     if (($tagfield,$tagsubfield)=$sth->fetchrow) {
794         if ($record->field($tagfield)) {
795             my $tag =$record->field($tagfield);
796             if ($tag) {
797                 $tag->add_subfields($tagsubfield,$value);
798                 $record->delete_field($tag);
799                 $record->add_fields($tag);
800             }
801         } else {
802             $record->add_fields($tagfield," "," ",$tagsubfield => $value);
803         }
804     }
805     return $record;
806 }
807
808 sub MARChtml2marc {
809         my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
810         my $prevtag = -1;
811         my $record = MARC::Record->new();
812 #       my %subfieldlist=();
813         my $prevvalue; # if tag <10
814         my $field; # if tag >=10
815         for (my $i=0; $i< @$rtags; $i++) {
816                 # rebuild MARC::Record
817                 if (@$rtags[$i] ne $prevtag) {
818                         if ($prevtag < 10) {
819                                 if ($prevvalue) {
820                                         $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
821                                 }
822                         } else {
823                                 if ($field) {
824                                         $record->add_fields($field);
825                                 }
826                         }
827                         $indicators{@$rtags[$i]}.='  ';
828                         if (@$rtags[$i] <10) {
829                                 $prevvalue= @$rvalues[$i];
830                         } else {
831                                 $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
832                         }
833                         $prevtag = @$rtags[$i];
834                 } else {
835                         if (@$rtags[$i] <10) {
836                                 $prevvalue=@$rvalues[$i];
837                         } else {
838                                 if (@$rvalues[$i]) {
839                                         $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
840                                 }
841                         }
842                         $prevtag= @$rtags[$i];
843                 }
844         }
845         # the last has not been included inside the loop... do it now !
846         $record->add_fields($field);
847 #       warn $record->as_formatted;
848         return $record;
849 }
850
851 sub MARCmarc2koha {
852         my ($dbh,$record) = @_;
853         my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
854         my $result;
855         my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
856         $sth2->execute;
857         my $field;
858         #    print STDERR $record->as_formatted;
859         while (($field)=$sth2->fetchrow) {
860                 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result);
861         }
862         $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
863         $sth2->execute;
864         while (($field)=$sth2->fetchrow) {
865                 if ($field eq 'notes') { $field = 'bnotes'; }
866                 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result);
867         }
868         $sth2=$dbh->prepare("SHOW COLUMNS from items");
869         $sth2->execute;
870         while (($field)=$sth2->fetchrow) {
871                 $result = &MARCmarc2kohaOneField($sth,"items",$field,$record,$result);
872         }
873         # additional authors : specific
874         $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result);
875         $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result);
876 # modify copyrightdate to keep only the 1st year found
877         my $temp = $result->{'copyrightdate'};
878         $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
879         if ($1>0) {
880                 $result->{'copyrightdate'} = $1;
881         } else { # if no cYYYY, get the 1st date.
882                 $temp =~ m/(\d\d\d\d)/;
883                 $result->{'copyrightdate'} = $1;
884         }
885 # modify publicationyear to keep only the 1st year found
886         my $temp = $result->{'publicationyear'};
887         $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
888         if ($1>0) {
889                 $result->{'publicationyear'} = $1;
890         } else { # if no cYYYY, get the 1st date.
891                 $temp =~ m/(\d\d\d\d)/;
892                 $result->{'publicationyear'} = $1;
893         }
894         return $result;
895 }
896
897 sub MARCmarc2kohaOneField {
898 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
899         my ($sth,$kohatable,$kohafield,$record,$result)= @_;
900 #    warn "kohatable / $kohafield / $result / ";
901         my $res="";
902         my $tagfield;
903         my $subfield;
904         $sth->execute($kohatable.".".$kohafield);
905         ($tagfield,$subfield) = $sth->fetchrow;
906         foreach my $field ($record->field($tagfield)) {
907                 if ($field->subfield($subfield)) {
908                 if ($result->{$kohafield}) {
909                         $result->{$kohafield} .= " | ".$field->subfield($subfield);
910                 } else {
911                         $result->{$kohafield}=$field->subfield($subfield);
912                 }
913                 }
914         }
915         return $result;
916 }
917
918 sub MARCaddword {
919 # split a subfield string and adds it into the word table.
920 # removes stopwords
921     my ($dbh,$bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$sentence) =@_;
922     $sentence =~ s/(\.|\?|\:|\!|\'|,|\-|\"|\(|\)|\[|\]|\{|\})/ /g;
923     my @words = split / /,$sentence;
924     my $stopwords= C4::Context->stopwords;
925     my $sth=$dbh->prepare("insert into marc_word (bibid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word)
926                         values (?,?,?,?,?,?,soundex(?))");
927     foreach my $word (@words) {
928 # we record only words longer than 2 car and not in stopwords hash
929         if (length($word)>2 and !($stopwords->{uc($word)})) {
930             $sth->execute($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,$word);
931             if ($sth->err()) {
932                 warn "ERROR ==> insert into marc_word (bibid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word) values ($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,soundex($word))\n";
933             }
934         }
935     }
936 }
937
938 sub MARCdelword {
939 # delete words. this sub deletes all the words from a sentence. a subfield modif is done by a delete then a add
940     my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
941     my $sth=$dbh->prepare("delete from marc_word where bibid=? and tag=? and tagorder=? and subfieldid=? and subfieldorder=?");
942     $sth->execute($bibid,$tag,$tagorder,$subfield,$subfieldorder);
943 }
944
945 #
946 #
947 # NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW
948 #
949 #
950 # all the following subs are useful to manage MARC-DB with complete MARC records.
951 # it's used with marcimport, and marc management tools
952 #
953
954
955 =item ($bibid,$oldbibnum,$oldbibitemnum) = NEWnewbibilio($dbh,$MARCRecord,$oldbiblio,$oldbiblioitem);
956
957 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
958 are builded from the MARC::Record. If they are passed, they are used.
959
960 =item NEWnewitem($dbh, $record,$bibid);
961
962 adds an item in the db.
963
964 =cut
965
966 sub NEWnewbiblio {
967         my ($dbh, $record, $oldbiblio, $oldbiblioitem) = @_;
968         # note $oldbiblio and $oldbiblioitem are not mandatory.
969         # if not present, they will be builded from $record with MARCmarc2koha function
970         if (($oldbiblio) and not($oldbiblioitem)) {
971                 print STDERR "NEWnewbiblio : missing parameter\n";
972                 print "NEWnewbiblio : missing parameter : contact koha development  team\n";
973                 die;
974         }
975         my $oldbibnum;
976         my $oldbibitemnum;
977         if ($oldbiblio) {
978                 $oldbibnum = OLDnewbiblio($dbh,$oldbiblio);
979                 $oldbiblioitem->{'biblionumber'} = $oldbibnum;
980                 $oldbibitemnum = OLDnewbiblioitem($dbh,$oldbiblioitem);
981         } else {
982                 my $olddata = MARCmarc2koha($dbh,$record);
983                 $oldbibnum = OLDnewbiblio($dbh,$olddata);
984                 $olddata->{'biblionumber'} = $oldbibnum;
985                 $oldbibitemnum = OLDnewbiblioitem($dbh,$olddata);
986         }
987         # search subtiles, addiauthors and subjects
988         my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author");
989         my @addiauthfields = $record->field($tagfield);
990         foreach my $addiauthfield (@addiauthfields) {
991                 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
992                 foreach my $subfieldcount (0..$#addiauthsubfields) {
993                         OLDmodaddauthor($dbh,$oldbibnum,$addiauthsubfields[$subfieldcount]);
994                 }
995         }
996         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.title");
997         my @subtitlefields = $record->field($tagfield);
998         foreach my $subtitlefield (@subtitlefields) {
999                 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
1000                 foreach my $subfieldcount (0..$#subtitlesubfields) {
1001                         OLDnewsubtitle($dbh,$oldbibnum,$subtitlesubfields[$subfieldcount]);
1002                 }
1003         }
1004         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject");
1005         my @subj = $record->field($tagfield);
1006         my @subjects;
1007         foreach my $subject (@subj) {
1008                 my @subjsubfield = $subject->subfield($tagsubfield);
1009                 foreach my $subfieldcount (0..$#subjsubfield) {
1010                         push @subjects,$subjsubfield[$subfieldcount];
1011                 }
1012         }
1013         OLDmodsubject($dbh,$oldbibnum,1,@subjects);
1014         # we must add bibnum and bibitemnum in MARC::Record...
1015         # we build the new field with biblionumber and biblioitemnumber
1016         # we drop the original field
1017         # we add the new builded field.
1018         # NOTE : Works only if the field is ONLY for biblionumber and biblioitemnumber
1019         # (steve and paul : thinks 090 is a good choice)
1020         my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
1021         $sth->execute("biblio.biblionumber");
1022         (my $tagfield1, my $tagsubfield1) = $sth->fetchrow;
1023         $sth->execute("biblioitems.biblioitemnumber");
1024         (my $tagfield2, my $tagsubfield2) = $sth->fetchrow;
1025         if ($tagfield1 != $tagfield2) {
1026                 warn "Error in NEWnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number";
1027                 print "Content-Type: text/html\n\nError in NEWnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number";
1028                 die;
1029         }
1030         my $newfield = MARC::Field->new( $tagfield1,'','',
1031                                                 "$tagsubfield1" => $oldbibnum,
1032                                                 "$tagsubfield2" => $oldbibitemnum);
1033         # drop old field and create new one...
1034         my $old_field = $record->field($tagfield1);
1035         $record->delete_field($old_field);
1036         $record->add_fields($newfield);
1037         my $bibid = MARCaddbiblio($dbh,$record,$oldbibnum);
1038         return ($bibid,$oldbibnum,$oldbibitemnum );
1039 }
1040
1041 sub NEWmodbiblio {
1042         my ($dbh,$record,$bibid) =@_;
1043         &MARCmodbiblio($dbh,$bibid,$record,0);
1044         my $oldbiblio = MARCmarc2koha($dbh,$record);
1045         my $oldbiblionumber = OLDmodbiblio($dbh,$oldbiblio);
1046         OLDmodbibitem($dbh,$oldbiblio);
1047         # now, modify addi authors, subject, addititles.
1048         my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author");
1049         my @addiauthfields = $record->field($tagfield);
1050         foreach my $addiauthfield (@addiauthfields) {
1051                 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
1052                 foreach my $subfieldcount (0..$#addiauthsubfields) {
1053                         OLDmodaddauthor($dbh,$oldbiblionumber,$addiauthsubfields[$subfieldcount]);
1054                 }
1055         }
1056         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle");
1057         my @subtitlefields = $record->field($tagfield);
1058         foreach my $subtitlefield (@subtitlefields) {
1059                 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
1060                 foreach my $subfieldcount (0..$#subtitlesubfields) {
1061                         OLDmodsubtitle($dbh,$oldbiblionumber,$subtitlesubfields[$subfieldcount]);
1062                 }
1063         }
1064         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject");
1065         my @subj = $record->field($tagfield);
1066         my @subjects;
1067         foreach my $subject (@subj) {
1068                 my @subjsubfield = $subject->subfield($tagsubfield);
1069                 foreach my $subfieldcount (0..$#subjsubfield) {
1070                         push @subjects,$subjsubfield[$subfieldcount];
1071                 }
1072         }
1073         OLDmodsubject($dbh,$oldbiblionumber,1,@subjects);
1074         return 1;
1075 }
1076
1077 sub NEWdelbiblio {
1078         my ($dbh,$bibid)=@_;
1079         my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
1080         &OLDdelbiblio($dbh,$biblio);
1081         my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
1082         $sth->execute($biblio);
1083         while(my ($biblioitemnumber) = $sth->fetchrow) {
1084                 OLDdeletebiblioitem($dbh,$biblioitemnumber);
1085         }
1086         &MARCdelbiblio($dbh,$bibid,0);
1087 }
1088
1089
1090 sub NEWnewitem {
1091         my ($dbh, $record,$bibid) = @_;
1092         # add item in old-DB
1093         my $item = &MARCmarc2koha($dbh,$record);
1094         # needs old biblionumber and biblioitemnumber
1095         $item->{'biblionumber'} = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
1096         my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
1097         $sth->execute($item->{'biblionumber'});
1098         ($item->{'biblioitemnumber'}) = $sth->fetchrow;
1099         my ($itemnumber,$error) = &OLDnewitems($dbh,$item,$item->{barcode});
1100         # add itemnumber to MARC::Record before adding the item.
1101         my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
1102         &MARCkoha2marcOnefield($sth,$record,"items.itemnumber",$itemnumber);
1103         # add the item
1104         my $bib = &MARCadditem($dbh,$record,$item->{'biblionumber'});
1105 }
1106
1107 sub NEWmoditem {
1108         my ($dbh,$record,$bibid,$itemnumber,$delete) = @_;
1109         &MARCmoditem($dbh,$record,$bibid,$itemnumber,$delete);
1110         my $olditem = MARCmarc2koha($dbh,$record);
1111         OLDmoditem($dbh,$olditem);
1112 }
1113
1114 sub NEWdelitem {
1115         my ($dbh,$bibid,$itemnumber)=@_;
1116         my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
1117         &OLDdelitem($dbh,$itemnumber);
1118         &MARCdelitem($dbh,$bibid,$itemnumber);
1119 }
1120
1121 #
1122 #
1123 # OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD
1124 #
1125 #
1126
1127 =item $biblionumber = OLDnewbiblio($dbh,$biblio);
1128
1129 adds a record in biblio table. Datas are in the hash $biblio.
1130
1131 =item $biblionumber = OLDmodbiblio($dbh,$biblio);
1132
1133 modify a record in biblio table. Datas are in the hash $biblio.
1134
1135 =item OLDmodsubtitle($dbh,$bibnum,$subtitle);
1136
1137 modify subtitles in bibliosubtitle table.
1138
1139 =item OLDmodaddauthor($dbh,$bibnum,$author);
1140
1141 adds or modify additional authors
1142 NOTE :  Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
1143
1144 =item $errors = OLDmodsubject($dbh,$bibnum, $force, @subject);
1145
1146 modify/adds subjects
1147
1148 =item OLDmodbibitem($dbh, $biblioitem);
1149
1150 modify a biblioitem
1151
1152 =item OLDmodnote($dbh,$bibitemnum,$note
1153
1154 modify a note for a biblioitem
1155
1156 =item OLDnewbiblioitem($dbh,$biblioitem);
1157
1158 adds a biblioitem ($biblioitem is a hash with the values)
1159
1160 =item OLDnewsubject($dbh,$bibnum);
1161
1162 adds a subject
1163
1164 =item OLDnewsubtitle($dbh,$bibnum,$subtitle);
1165
1166 create a new subtitle
1167
1168 =item ($itemnumber,$errors)= OLDnewitems($dbh,$item,$barcode);
1169
1170 create a item. $item is a hash and $barcode the barcode.
1171
1172 =item OLDmoditem($dbh,$item);
1173
1174 modify item
1175
1176 =item OLDdelitem($dbh,$itemnum);
1177
1178 delete item
1179
1180 =item OLDdeletebiblioitem($dbh,$biblioitemnumber);
1181
1182 deletes a biblioitem
1183 NOTE : not standard sub name. Should be OLDdelbiblioitem()
1184
1185 =item OLDdelbiblio($dbh,$biblio);
1186
1187 delete a biblio
1188
1189 =cut
1190
1191 sub OLDnewbiblio {
1192   my ($dbh,$biblio) = @_;
1193 #  my $dbh    = &C4Connect;
1194   my $query  = "Select max(biblionumber) from biblio";
1195   my $sth    = $dbh->prepare($query);
1196   $sth->execute;
1197   my $data   = $sth->fetchrow_arrayref;
1198   my $bibnum = $$data[0] + 1;
1199   my $series = 0;
1200
1201   if ($biblio->{'seriestitle'}) { $series = 1 };
1202   $sth->finish;
1203   $query = "insert into biblio set biblionumber  = ?, title         = ?, author        = ?, copyrightdate = ?,
1204                                                                         serial        = ?, seriestitle   = ?, notes         = ?, abstract      = ?";
1205   $sth = $dbh->prepare($query);
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 = "Update biblio set title         = ?, author        = ?, abstract      = ?, copyrightdate = ?,
1220                                         seriestitle   = ?, serial        = ?, unititle      = ?, notes         = ? where biblionumber = ?";
1221         $sth   = $dbh->prepare($query);
1222         $sth->execute($biblio->{'title'},$biblio->{'author'},$biblio->{'abstract'},$biblio->{'copyrightdate'},
1223                                                 $biblio->{'seriestitle'},$biblio->{'serial'},$biblio->{'unititle'},$biblio->{'notes'},$biblio->{'biblionumber'});
1224
1225         $sth->finish;
1226         return($biblio->{'biblionumber'});
1227 } # sub modbiblio
1228
1229 sub OLDmodsubtitle {
1230         my ($dbh,$bibnum, $subtitle) = @_;
1231         my $query = "update bibliosubtitle set subtitle = ? where biblionumber = ?";
1232         my $sth   = $dbh->prepare($query);
1233         $sth->execute($subtitle,$bibnum);
1234         $sth->finish;
1235 } # sub modsubtitle
1236
1237
1238 sub OLDmodaddauthor {
1239     my ($dbh,$bibnum, $author) = @_;
1240 #    my $dbh   = C4Connect;
1241     my $query = "Delete from additionalauthors where biblionumber = $bibnum";
1242     my $sth = $dbh->prepare($query);
1243
1244     $sth->execute;
1245     $sth->finish;
1246
1247     if ($author ne '') {
1248         $query = "Insert into additionalauthors set
1249                         author       = ?,
1250                         biblionumber = ?";
1251         $sth   = $dbh->prepare($query);
1252
1253         $sth->execute($author,$bibnum);
1254
1255         $sth->finish;
1256     } # if
1257 } # sub modaddauthor
1258
1259
1260 sub OLDmodsubject {
1261         my ($dbh,$bibnum, $force, @subject) = @_;
1262         #  my $dbh   = C4Connect;
1263         my $count = @subject;
1264         my $error;
1265         for (my $i = 0; $i < $count; $i++) {
1266                 $subject[$i] =~ s/^ //g;
1267                 $subject[$i] =~ s/ $//g;
1268                 my $query = "select * from catalogueentry where entrytype = 's' and catalogueentry = '$subject[$i]'";
1269                 my $sth   = $dbh->prepare($query);
1270                 $sth->execute;
1271
1272                 if (my $data = $sth->fetchrow_hashref) {
1273                 } else {
1274                         if ($force eq $subject[$i] || $force == 1) {
1275                                 # subject not in aut, chosen to force anway
1276                                 # so insert into cataloguentry so its in auth file
1277                                 $query = "Insert into catalogueentry (entrytype,catalogueentry) values ('s','$subject[$i]')";
1278                                 my $sth2 = $dbh->prepare($query);
1279
1280                                 $sth2->execute;
1281                                 $sth2->finish;
1282                         } else {
1283                                 $error = "$subject[$i]\n does not exist in the subject authority file";
1284                                 $query = "Select * from catalogueentry where entrytype = 's' and (catalogueentry like '$subject[$i] %'
1285                                                                         or catalogueentry like '% $subject[$i] %' or catalogueentry like '% $subject[$i]')";
1286                                 my $sth2 = $dbh->prepare($query);
1287                                 $sth2->execute;
1288                                 while (my $data = $sth2->fetchrow_hashref) {
1289                                         $error .= "<br>$data->{'catalogueentry'}";
1290                                 } # while
1291                                 $sth2->finish;
1292                         } # else
1293                 } # else
1294                 $sth->finish;
1295         } # else
1296         if ($error eq '') {
1297                 my $query = "Delete from bibliosubject where biblionumber = $bibnum";
1298                 my $sth   = $dbh->prepare($query);
1299                 $sth->execute;
1300                 $sth->finish;
1301                 $sth = $dbh->prepare("Insert into bibliosubject values (?,?)");
1302                 foreach $query (@subject) {
1303                         $sth->execute($query,$bibnum);
1304                 } # foreach
1305                 $sth->finish;
1306         } # if
1307
1308         #  $dbh->disconnect;
1309         return($error);
1310 } # sub modsubject
1311
1312 sub OLDmodbibitem {
1313     my ($dbh,$biblioitem) = @_;
1314 #    my $dbh   = C4Connect;
1315     my $query;
1316
1317     $biblioitem->{'itemtype'}        = $dbh->quote($biblioitem->{'itemtype'});
1318     $biblioitem->{'url'}             = $dbh->quote($biblioitem->{'url'});
1319     $biblioitem->{'isbn'}            = $dbh->quote($biblioitem->{'isbn'});
1320     $biblioitem->{'publishercode'}   = $dbh->quote($biblioitem->{'publishercode'});
1321     $biblioitem->{'publicationyear'} = $dbh->quote($biblioitem->{'publicationyear'});
1322     $biblioitem->{'classification'}  = $dbh->quote($biblioitem->{'classification'});
1323     $biblioitem->{'dewey'}           = $dbh->quote($biblioitem->{'dewey'});
1324     $biblioitem->{'subclass'}        = $dbh->quote($biblioitem->{'subclass'});
1325     $biblioitem->{'illus'}           = $dbh->quote($biblioitem->{'illus'});
1326     $biblioitem->{'pages'}           = $dbh->quote($biblioitem->{'pages'});
1327     $biblioitem->{'volumeddesc'}     = $dbh->quote($biblioitem->{'volumeddesc'});
1328     $biblioitem->{'bnotes'}          = $dbh->quote($biblioitem->{'bnotes'});
1329     $biblioitem->{'size'}            = $dbh->quote($biblioitem->{'size'});
1330     $biblioitem->{'place'}           = $dbh->quote($biblioitem->{'place'});
1331
1332     $query = "Update biblioitems set
1333 itemtype        = $biblioitem->{'itemtype'},
1334 url             = $biblioitem->{'url'},
1335 isbn            = $biblioitem->{'isbn'},
1336 publishercode   = $biblioitem->{'publishercode'},
1337 publicationyear = $biblioitem->{'publicationyear'},
1338 classification  = $biblioitem->{'classification'},
1339 dewey           = $biblioitem->{'dewey'},
1340 subclass        = $biblioitem->{'subclass'},
1341 illus           = $biblioitem->{'illus'},
1342 pages           = $biblioitem->{'pages'},
1343 volumeddesc     = $biblioitem->{'volumeddesc'},
1344 notes           = $biblioitem->{'bnotes'},
1345 size            = $biblioitem->{'size'},
1346 place           = $biblioitem->{'place'}
1347 where biblioitemnumber = $biblioitem->{'biblioitemnumber'}";
1348
1349 $dbh->do($query);
1350 if ($dbh->errstr) {
1351         warn "$query";
1352 }
1353 #    $dbh->disconnect;
1354 } # sub modbibitem
1355
1356 sub OLDmodnote {
1357   my ($dbh,$bibitemnum,$note)=@_;
1358 #  my $dbh=C4Connect;
1359   my $query="update biblioitems set notes='$note' where
1360   biblioitemnumber='$bibitemnum'";
1361   my $sth=$dbh->prepare($query);
1362   $sth->execute;
1363   $sth->finish;
1364 #  $dbh->disconnect;
1365 }
1366
1367 sub OLDnewbiblioitem {
1368         my ($dbh,$biblioitem) = @_;
1369         #  my $dbh   = C4Connect;
1370         my $query = "Select max(biblioitemnumber) from biblioitems";
1371         my $sth   = $dbh->prepare($query);
1372         my $data;
1373         my $bibitemnum;
1374
1375         $sth->execute;
1376         $data       = $sth->fetchrow_arrayref;
1377         $bibitemnum = $$data[0] + 1;
1378
1379         $sth->finish;
1380
1381         $sth = $dbh->prepare("insert into biblioitems set
1382                                                                         biblioitemnumber = ?,           biblionumber     = ?,
1383                                                                         volume           = ?,                   number           = ?,
1384                                                                         classification  = ?,                    itemtype         = ?,
1385                                                                         url              = ?,                           isbn             = ?,
1386                                                                         issn             = ?,                           dewey            = ?,
1387                                                                         subclass         = ?,                           publicationyear  = ?,
1388                                                                         publishercode    = ?,           volumedate       = ?,
1389                                                                         volumeddesc      = ?,           illus            = ?,
1390                                                                         pages            = ?,                           notes            = ?,
1391                                                                         size             = ?,                           lccn             = ?,
1392                                                                         marc             = ?,                           place            = ?");
1393         $sth->execute($bibitemnum,                                                      $biblioitem->{'biblionumber'},
1394                                                 $biblioitem->{'volume'},                        $biblioitem->{'number'},
1395                                                 $biblioitem->{'classification'},                $biblioitem->{'itemtype'},
1396                                                 $biblioitem->{'url'},                                   $biblioitem->{'isbn'},
1397                                                 $biblioitem->{'issn'},                          $biblioitem->{'dewey'},
1398                                                 $biblioitem->{'subclass'},                      $biblioitem->{'publicationyear'},
1399                                                 $biblioitem->{'publishercode'}, $biblioitem->{'volumedate'},
1400                                                 $biblioitem->{'volumeddesc'},           $biblioitem->{'illus'},
1401                                                 $biblioitem->{'pages'},                         $biblioitem->{'bnotes'},
1402                                                 $biblioitem->{'size'},                          $biblioitem->{'lccn'},
1403                                                 $biblioitem->{'marc'},                          $biblioitem->{'place'});
1404         $sth->finish;
1405         #    $dbh->disconnect;
1406         return($bibitemnum);
1407 }
1408
1409 sub OLDnewsubject {
1410   my ($dbh,$bibnum)=@_;
1411   my $query="insert into bibliosubject (biblionumber) values ($bibnum)";
1412   my $sth=$dbh->prepare($query);
1413   $sth->execute;
1414   $sth->finish;
1415 }
1416
1417 sub OLDnewsubtitle {
1418     my ($dbh,$bibnum, $subtitle) = @_;
1419     my $query = "insert into bibliosubtitle set biblionumber = ?, subtitle = ?";
1420     my $sth   = $dbh->prepare($query);
1421     $sth->execute($bibnum,$subtitle);
1422     $sth->finish;
1423 }
1424
1425
1426 sub OLDnewitems {
1427         my ($dbh,$item, $barcode) = @_;
1428         #  my $dbh   = C4Connect;
1429         my $query = "Select max(itemnumber) from items";
1430         my $sth   = $dbh->prepare($query);
1431         my $data;
1432         my $itemnumber;
1433         my $error = "";
1434
1435         $sth->execute;
1436         $data       = $sth->fetchrow_hashref;
1437         $itemnumber = $data->{'max(itemnumber)'} + 1;
1438         $sth->finish;
1439 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
1440         if ($item->{'loan'}) {
1441                 $item->{'notforloan'} = $item->{'loan'};
1442         }
1443 # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1444         if ($item->{'dateaccessioned'}) {
1445                 $sth=$dbh->prepare("Insert into items set
1446                                                         itemnumber           = ?,                               biblionumber         = ?,
1447                                                         biblioitemnumber     = ?,                               barcode              = ?,
1448                                                         booksellerid         = ?,                                       dateaccessioned      = ?,
1449                                                         homebranch           = ?,                               holdingbranch        = ?,
1450                                                         price                = ?,                                               replacementprice     = ?,
1451                                                         replacementpricedate = NOW(),   itemnotes            = ?,
1452                                                         notforloan = ?
1453                                                         ");
1454                 $sth->execute($itemnumber,      $item->{'biblionumber'},
1455                                                                 $item->{'biblioitemnumber'},$barcode,
1456                                                                 $item->{'booksellerid'},$item->{'dateaccessioned'},
1457                                                                 $item->{'homebranch'},$item->{'holdingbranch'},
1458                                                                 $item->{'price'},$item->{'replacementprice'},
1459                                                                 $item->{'itemnotes'},$item->{'notforloan'});
1460         } else {
1461                 $sth=$dbh->prepare("Insert into items set
1462                                                         itemnumber           = ?,                               biblionumber         = ?,
1463                                                         biblioitemnumber     = ?,                               barcode              = ?,
1464                                                         booksellerid         = ?,                                       dateaccessioned      = NOW(),
1465                                                         homebranch           = ?,                               holdingbranch        = ?,
1466                                                         price                = ?,                                               replacementprice     = ?,
1467                                                         replacementpricedate = NOW(),   itemnotes            = ?,
1468                                                         notforloan = ?
1469                                                         ");
1470                 $sth->execute($itemnumber,      $item->{'biblionumber'},
1471                                                                 $item->{'biblioitemnumber'},$barcode,
1472                                                                 $item->{'booksellerid'},
1473                                                                 $item->{'homebranch'},$item->{'holdingbranch'},
1474                                                                 $item->{'price'},$item->{'replacementprice'},
1475                                                                 $item->{'itemnotes'},$item->{'notforloan'});
1476         }
1477         if (defined $sth->errstr) {
1478                 $error .= $sth->errstr;
1479         }
1480         $sth->finish;
1481         return($itemnumber,$error);
1482 }
1483
1484 sub OLDmoditem {
1485     my ($dbh,$item) = @_;
1486 #  my ($dbh,$loan,$itemnum,$bibitemnum,$barcode,$notes,$homebranch,$lost,$wthdrawn,$replacement)=@_;
1487 #  my $dbh=C4Connect;
1488 $item->{'itemnum'}=$item->{'itemnumber'} unless $item->{'itemnum'};
1489   my $query="update items set  barcode='$item->{'barcode'}',itemnotes='$item->{'notes'}'
1490                           where itemnumber=$item->{'itemnum'}";
1491   if ($item->{'barcode'} eq ''){
1492         $item->{'notforloan'}=0 unless $item->{'notforloan'};
1493     $query="update items set notforloan=$item->{'notforloan'} where itemnumber=$item->{'itemnum'}";
1494   }
1495   if ($item->{'lost'} ne ''){
1496     $query="update items set biblioitemnumber=$item->{'bibitemnum'},
1497                              barcode='$item->{'barcode'}',
1498                              itemnotes='$item->{'notes'}',
1499                              homebranch='$item->{'homebranch'}',
1500                              itemlost='$item->{'lost'}',
1501                              wthdrawn='$item->{'wthdrawn'}'
1502                           where itemnumber=$item->{'itemnum'}";
1503   }
1504   if ($item->{'replacement'} ne ''){
1505     $query=~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1506   }
1507   my $sth=$dbh->prepare($query);
1508   $sth->execute;
1509   $sth->finish;
1510 #  $dbh->disconnect;
1511 }
1512
1513 sub OLDdelitem{
1514   my ($dbh,$itemnum)=@_;
1515 #  my $dbh=C4Connect;
1516   my $query="select * from items where itemnumber=$itemnum";
1517   my $sth=$dbh->prepare($query);
1518   $sth->execute;
1519   my $data=$sth->fetchrow_hashref;
1520   $sth->finish;
1521   $query="Insert into deleteditems set ";
1522   foreach my $temp (keys %$data){
1523     $query .= "$temp = ".$dbh->quote($data->{$temp}).",";
1524   }
1525   $query=~ s/\,$//;
1526 #  print $query;
1527   $sth=$dbh->prepare($query);
1528   $sth->execute;
1529   $sth->finish;
1530   $query = "Delete from items where itemnumber=$itemnum";
1531   $sth=$dbh->prepare($query);
1532   $sth->execute;
1533   $sth->finish;
1534 #  $dbh->disconnect;
1535 }
1536
1537 sub OLDdeletebiblioitem {
1538     my ($dbh,$biblioitemnumber) = @_;
1539 #    my $dbh   = C4Connect;
1540     my $query = "Select * from biblioitems
1541 where biblioitemnumber = $biblioitemnumber";
1542     my $sth   = $dbh->prepare($query);
1543     my $results;
1544
1545     $sth->execute;
1546
1547     if ($results = $sth->fetchrow_hashref) {
1548         $sth->finish;
1549         $sth=$dbh->prepare("Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
1550                                         isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
1551                                         pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)");
1552
1553         $sth->execute($results->{biblioitemnumber}, $results->{biblionumber}, $results->{volume}, $results->{number}, $results->{classification}, $results->{itemtype},
1554                                         $results->{isbn}, $results->{issn} ,$results->{dewey} ,$results->{subclass} ,$results->{publicationyear} ,$results->{publishercode} ,$results->{volumedate} ,$results->{volumeddesc} ,$results->{timestamp} ,$results->{illus} ,
1555                                         $results->{pages} ,$results->{notes} ,$results->{size} ,$results->{url} ,$results->{lccn} );
1556         $query = "Delete from biblioitems
1557                         where biblioitemnumber = $biblioitemnumber";
1558         $dbh->do($query);
1559     } # if
1560     $sth->finish;
1561 # Now delete all the items attached to the biblioitem
1562     $query = "Select * from items where biblioitemnumber = $biblioitemnumber";
1563     $sth   = $dbh->prepare($query);
1564     $sth->execute;
1565     my @results;
1566     while (@results = $sth->fetchrow_array) {
1567         $query = "Insert into deleteditems values (";
1568         foreach my $value (@results) {
1569             $value  = $dbh->quote($value);
1570             $query .= "$value,";
1571         } # foreach
1572         $query =~ s/\,$/\)/;
1573         $dbh->do($query);
1574     } # while
1575     $sth->finish;
1576     $query = "Delete from items where biblioitemnumber = $biblioitemnumber";
1577     $dbh->do($query);
1578 #    $dbh->disconnect;
1579 } # sub deletebiblioitem
1580
1581 sub OLDdelbiblio{
1582   my ($dbh,$biblio)=@_;
1583   my $query="select * from biblio where biblionumber=$biblio";
1584   my $sth=$dbh->prepare($query);
1585   $sth->execute;
1586   if (my @data=$sth->fetchrow_array){
1587     $sth->finish;
1588 # FIXME => replace insert values by insert (field) values ($value)
1589     $query="Insert into deletedbiblio values (";
1590     foreach my $temp (@data){
1591       $temp=~ s/\'/\\\'/g;
1592       $query .= "'$temp',";
1593     }
1594     #replacing the last , by ",?)"
1595     $query=~ s/\,$/\,\?\)/;
1596     $sth=$dbh->prepare($query);
1597     $sth->execute;
1598     $sth->finish;
1599     $query = "Delete from biblio where biblionumber=$biblio";
1600     $sth=$dbh->prepare($query);
1601     $sth->execute;
1602     $sth->finish;
1603   }
1604   $sth->finish;
1605 }
1606
1607 #
1608 #
1609 # old functions
1610 #
1611 #
1612
1613 sub itemcount{
1614   my ($biblio)=@_;
1615   my $dbh = C4::Context->dbh;
1616   my $query="Select count(*) from items where biblionumber=$biblio";
1617 #  print $query;
1618   my $sth=$dbh->prepare($query);
1619   $sth->execute;
1620   my $data=$sth->fetchrow_hashref;
1621   $sth->finish;
1622   return($data->{'count(*)'});
1623 }
1624
1625 =item getorder
1626
1627   ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
1628
1629 Looks up the order with the given biblionumber and biblioitemnumber.
1630
1631 Returns a two-element array. C<$ordernumber> is the order number.
1632 C<$order> is a reference-to-hash describing the order; its keys are
1633 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
1634 tables of the Koha database.
1635
1636 =cut
1637 #'
1638 # FIXME - This is effectively identical to &C4::Catalogue::getorder.
1639 # Pick one and stick with it.
1640 sub getorder{
1641   my ($bi,$bib)=@_;
1642   my $dbh = C4::Context->dbh;
1643   my $query="Select ordernumber
1644         from aqorders
1645         where biblionumber=? and biblioitemnumber=?";
1646   my $sth=$dbh->prepare($query);
1647   $sth->execute($bib,$bi);
1648   # FIXME - Use fetchrow_array(), since we're only interested in the one
1649   # value.
1650   my $ordnum=$sth->fetchrow_hashref;
1651   $sth->finish;
1652   my $order=getsingleorder($ordnum->{'ordernumber'});
1653 #  print $query;
1654   return ($order,$ordnum->{'ordernumber'});
1655 }
1656
1657 =item getsingleorder
1658
1659   $order = &getsingleorder($ordernumber);
1660
1661 Looks up an order by order number.
1662
1663 Returns a reference-to-hash describing the order. The keys of
1664 C<$order> are fields from the biblio, biblioitems, aqorders, and
1665 aqorderbreakdown tables of the Koha database.
1666
1667 =cut
1668 #'
1669 # FIXME - This is effectively identical to
1670 # &C4::Catalogue::getsingleorder.
1671 # Pick one and stick with it.
1672 sub getsingleorder {
1673   my ($ordnum)=@_;
1674   my $dbh = C4::Context->dbh;
1675   my $query="Select * from biblio,biblioitems,aqorders,aqorderbreakdown
1676   where aqorders.ordernumber=?
1677   and biblio.biblionumber=aqorders.biblionumber and
1678   biblioitems.biblioitemnumber=aqorders.biblioitemnumber and
1679   aqorders.ordernumber=aqorderbreakdown.ordernumber";
1680   my $sth=$dbh->prepare($query);
1681   $sth->execute($ordnum);
1682   my $data=$sth->fetchrow_hashref;
1683   $sth->finish;
1684   return($data);
1685 }
1686
1687 sub newbiblio {
1688         my ($biblio) = @_;
1689         my $dbh    = C4::Context->dbh;
1690         my $bibnum=OLDnewbiblio($dbh,$biblio);
1691         # finds new (MARC bibid
1692 #       my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1693         my $record = &MARCkoha2marcBiblio($dbh,$bibnum);
1694         MARCaddbiblio($dbh,$record,$bibnum);
1695         return($bibnum);
1696 }
1697
1698 =item modbiblio
1699
1700   $biblionumber = &modbiblio($biblio);
1701
1702 Update a biblio record.
1703
1704 C<$biblio> is a reference-to-hash whose keys are the fields in the
1705 biblio table in the Koha database. All fields must be present, not
1706 just the ones you wish to change.
1707
1708 C<&modbiblio> updates the record defined by
1709 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1710
1711 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1712 successful or not.
1713
1714 =cut
1715
1716 sub modbiblio {
1717         my ($biblio) = @_;
1718         my $dbh  = C4::Context->dbh;
1719         my $biblionumber=OLDmodbiblio($dbh,$biblio);
1720         my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
1721         # finds new (MARC bibid
1722         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
1723         MARCmodbiblio($dbh,$bibid,$record,0);
1724         return($biblionumber);
1725 } # sub modbiblio
1726
1727 =item modsubtitle
1728
1729   &modsubtitle($biblionumber, $subtitle);
1730
1731 Sets the subtitle of a book.
1732
1733 C<$biblionumber> is the biblionumber of the book to modify.
1734
1735 C<$subtitle> is the new subtitle.
1736
1737 =cut
1738
1739 sub modsubtitle {
1740   my ($bibnum, $subtitle) = @_;
1741   my $dbh   = C4::Context->dbh;
1742   &OLDmodsubtitle($dbh,$bibnum,$subtitle);
1743 } # sub modsubtitle
1744
1745 =item modaddauthor
1746
1747   &modaddauthor($biblionumber, $author);
1748
1749 Replaces all additional authors for the book with biblio number
1750 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1751 C<&modaddauthor> deletes all additional authors.
1752
1753 =cut
1754
1755 sub modaddauthor {
1756     my ($bibnum, $author) = @_;
1757     my $dbh   = C4::Context->dbh;
1758     &OLDmodaddauthor($dbh,$bibnum,$author);
1759 } # sub modaddauthor
1760
1761 =item modsubject
1762
1763   $error = &modsubject($biblionumber, $force, @subjects);
1764
1765 $force - a subject to force
1766
1767 $error - Error message, or undef if successful.
1768
1769 =cut
1770
1771 sub modsubject {
1772   my ($bibnum, $force, @subject) = @_;
1773   my $dbh   = C4::Context->dbh;
1774   my $error= &OLDmodsubject($dbh,$bibnum,$force, @subject);
1775   return($error);
1776 } # sub modsubject
1777
1778 sub modbibitem {
1779     my ($biblioitem) = @_;
1780     my $dbh   = C4::Context->dbh;
1781     &OLDmodbibitem($dbh,$biblioitem);
1782 } # sub modbibitem
1783
1784 sub modnote {
1785   my ($bibitemnum,$note)=@_;
1786   my $dbh = C4::Context->dbh;
1787   &OLDmodnote($dbh,$bibitemnum,$note);
1788 }
1789
1790 sub newbiblioitem {
1791         my ($biblioitem) = @_;
1792         my $dbh   = C4::Context->dbh;
1793         my $bibitemnum = &OLDnewbiblioitem($dbh,$biblioitem);
1794         my $MARCbiblio= MARCkoha2marcBiblio($dbh,0,$bibitemnum); # the 0 means "do NOT retrieve biblio, only biblioitem, in the MARC record
1795         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblioitem->{biblionumber});
1796         &MARCaddbiblio($dbh,$MARCbiblio,$biblioitem->{biblionumber},$bibid);
1797         return($bibitemnum);
1798 }
1799
1800 sub newsubject {
1801   my ($bibnum)=@_;
1802   my $dbh = C4::Context->dbh;
1803   &OLDnewsubject($dbh,$bibnum);
1804 }
1805
1806 sub newsubtitle {
1807     my ($bibnum, $subtitle) = @_;
1808     my $dbh   = C4::Context->dbh;
1809     &OLDnewsubtitle($dbh,$bibnum,$subtitle);
1810 }
1811
1812 sub newitems {
1813   my ($item, @barcodes) = @_;
1814   my $dbh   = C4::Context->dbh;
1815   my $errors;
1816   my $itemnumber;
1817   my $error;
1818   foreach my $barcode (@barcodes) {
1819       ($itemnumber,$error)=&OLDnewitems($dbh,$item,uc($barcode));
1820       $errors .=$error;
1821       my $MARCitem = &MARCkoha2marcItem($dbh,$item->{biblionumber},$itemnumber);
1822       &MARCadditem($dbh,$MARCitem,$item->{biblionumber});
1823   }
1824   return($errors);
1825 }
1826
1827 sub moditem {
1828     my ($item) = @_;
1829     my $dbh = C4::Context->dbh;
1830     &OLDmoditem($dbh,$item);
1831     my $MARCitem = &MARCkoha2marcItem($dbh,$item->{'biblionumber'},$item->{'itemnum'});
1832     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$item->{biblionumber});
1833     &MARCmoditem($dbh,$MARCitem,$bibid,$item->{itemnum},0);
1834 }
1835
1836 sub checkitems{
1837   my ($count,@barcodes)=@_;
1838   my $dbh = C4::Context->dbh;
1839   my $error;
1840   for (my $i=0;$i<$count;$i++){
1841     $barcodes[$i]=uc $barcodes[$i];
1842     my $query="Select * from items where barcode='$barcodes[$i]'";
1843     my $sth=$dbh->prepare($query);
1844     $sth->execute;
1845     if (my $data=$sth->fetchrow_hashref){
1846       $error.=" Duplicate Barcode: $barcodes[$i]";
1847     }
1848     $sth->finish;
1849   }
1850   return($error);
1851 }
1852
1853 sub countitems{
1854   my ($bibitemnum)=@_;
1855   my $dbh = C4::Context->dbh;
1856   my $query="Select count(*) from items where biblioitemnumber='$bibitemnum'";
1857   my $sth=$dbh->prepare($query);
1858   $sth->execute;
1859   my $data=$sth->fetchrow_hashref;
1860   $sth->finish;
1861   return($data->{'count(*)'});
1862 }
1863
1864 sub delitem{
1865   my ($itemnum)=@_;
1866   my $dbh = C4::Context->dbh;
1867   &OLDdelitem($dbh,$itemnum);
1868 }
1869
1870 sub deletebiblioitem {
1871     my ($biblioitemnumber) = @_;
1872     my $dbh   = C4::Context->dbh;
1873     &OLDdeletebiblioitem($dbh,$biblioitemnumber);
1874 } # sub deletebiblioitem
1875
1876
1877 sub delbiblio {
1878         my ($biblio)=@_;
1879         my $dbh = C4::Context->dbh;
1880         &OLDdelbiblio($dbh,$biblio);
1881         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblio);
1882         &MARCdelbiblio($dbh,$bibid,0);
1883 }
1884
1885 sub getitemtypes {
1886   my $dbh   = C4::Context->dbh;
1887   my $query = "select * from itemtypes order by description";
1888   my $sth   = $dbh->prepare($query);
1889     # || die "Cannot prepare $query" . $dbh->errstr;
1890   my $count = 0;
1891   my @results;
1892
1893   $sth->execute;
1894     # || die "Cannot execute $query\n" . $sth->errstr;
1895   while (my $data = $sth->fetchrow_hashref) {
1896     $results[$count] = $data;
1897     $count++;
1898   } # while
1899
1900   $sth->finish;
1901   return($count, @results);
1902 } # sub getitemtypes
1903
1904 sub getbiblio {
1905     my ($biblionumber) = @_;
1906     my $dbh   = C4::Context->dbh;
1907     my $query = "Select * from biblio where biblionumber = $biblionumber";
1908     my $sth   = $dbh->prepare($query);
1909       # || die "Cannot prepare $query\n" . $dbh->errstr;
1910     my $count = 0;
1911     my @results;
1912
1913     $sth->execute;
1914       # || die "Cannot execute $query\n" . $sth->errstr;
1915     while (my $data = $sth->fetchrow_hashref) {
1916       $results[$count] = $data;
1917       $count++;
1918     } # while
1919
1920     $sth->finish;
1921     return($count, @results);
1922 } # sub getbiblio
1923
1924 sub getbiblioitem {
1925     my ($biblioitemnum) = @_;
1926     my $dbh   = C4::Context->dbh;
1927     my $query = "Select * from biblioitems where
1928 biblioitemnumber = $biblioitemnum";
1929     my $sth   = $dbh->prepare($query);
1930     my $count = 0;
1931     my @results;
1932
1933     $sth->execute;
1934
1935     while (my $data = $sth->fetchrow_hashref) {
1936         $results[$count] = $data;
1937         $count++;
1938     } # while
1939
1940     $sth->finish;
1941     return($count, @results);
1942 } # sub getbiblioitem
1943
1944 sub getbiblioitembybiblionumber {
1945     my ($biblionumber) = @_;
1946     my $dbh   = C4::Context->dbh;
1947     my $query = "Select * from biblioitems where biblionumber =
1948 $biblionumber";
1949     my $sth   = $dbh->prepare($query);
1950     my $count = 0;
1951     my @results;
1952
1953     $sth->execute;
1954
1955     while (my $data = $sth->fetchrow_hashref) {
1956         $results[$count] = $data;
1957         $count++;
1958     } # while
1959
1960     $sth->finish;
1961     return($count, @results);
1962 } # sub
1963
1964 sub getitemsbybiblioitem {
1965     my ($biblioitemnum) = @_;
1966     my $dbh   = C4::Context->dbh;
1967     my $query = "Select * from items, biblio where
1968 biblio.biblionumber = items.biblionumber and biblioitemnumber
1969 = $biblioitemnum";
1970     my $sth   = $dbh->prepare($query);
1971       # || die "Cannot prepare $query\n" . $dbh->errstr;
1972     my $count = 0;
1973     my @results;
1974
1975     $sth->execute;
1976       # || die "Cannot execute $query\n" . $sth->errstr;
1977     while (my $data = $sth->fetchrow_hashref) {
1978       $results[$count] = $data;
1979       $count++;
1980     } # while
1981
1982     $sth->finish;
1983     return($count, @results);
1984 } # sub getitemsbybiblioitem
1985
1986
1987 sub logchange {
1988 # Subroutine to log changes to databases
1989 # Eventually, this subroutine will be used to create a log of all changes made,
1990 # with the possibility of "undo"ing some changes
1991     my $database=shift;
1992     if ($database eq 'kohadb') {
1993         my $type=shift;
1994         my $section=shift;
1995         my $item=shift;
1996         my $original=shift;
1997         my $new=shift;
1998 #       print STDERR "KOHA: $type $section $item $original $new\n";
1999     } elsif ($database eq 'marc') {
2000         my $type=shift;
2001         my $Record_ID=shift;
2002         my $tag=shift;
2003         my $mark=shift;
2004         my $subfield_ID=shift;
2005         my $original=shift;
2006         my $new=shift;
2007 #       print STDERR "MARC: $type $Record_ID $tag $mark $subfield_ID $original $new\n";
2008     }
2009 }
2010
2011 #------------------------------------------------
2012
2013
2014 #---------------------------------------
2015 # Find a biblio entry, or create a new one if it doesn't exist.
2016 #  If a "subtitle" entry is in hash, add it to subtitle table
2017 sub getoraddbiblio {
2018         # input params
2019         my (
2020           $dbh,         # db handle
2021                         # FIXME - Unused argument
2022           $biblio,      # hash ref to fields
2023         )=@_;
2024
2025         # return
2026         my $biblionumber;
2027
2028         my $debug=0;
2029         my $sth;
2030         my $error;
2031
2032         #-----
2033         $dbh = C4::Context->dbh;
2034
2035         print "<PRE>Looking for biblio </PRE>\n" if $debug;
2036         $sth=$dbh->prepare("select biblionumber
2037                 from biblio
2038                 where title=? and author=?
2039                   and copyrightdate=? and seriestitle=?");
2040         $sth->execute(
2041                 $biblio->{title}, $biblio->{author},
2042                 $biblio->{copyright}, $biblio->{seriestitle} );
2043         if ($sth->rows) {
2044             ($biblionumber) = $sth->fetchrow;
2045             print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
2046         } else {
2047             # Doesn't exist.  Add new one.
2048             print "<PRE>Adding biblio</PRE>\n" if $debug;
2049             ($biblionumber,$error)=&newbiblio($biblio);
2050             if ( $biblionumber ) {
2051               print "<PRE>Added with biblio number=$biblionumber</PRE>\n" if $debug;
2052               if ( $biblio->{subtitle} ) {
2053                 &newsubtitle($biblionumber,$biblio->{subtitle} );
2054               } # if subtitle
2055             } else {
2056                 print "<PRE>Couldn't add biblio: $error</PRE>\n" if $debug;
2057             } # if added
2058         }
2059
2060         return $biblionumber,$error;
2061
2062 } # sub getoraddbiblio
2063
2064 sub char_decode {
2065         # converts ISO 5426 coded string to ISO 8859-1
2066         # sloppy code : should be improved in next issue
2067         my ($string,$encoding) = @_ ;
2068         $_ = $string ;
2069 #       $encoding = C4::Context->preference("marcflavour") unless $encoding;
2070         if ($encoding eq "UNIMARC") {
2071                 s/\xe1/Æ/gm ;
2072                 s/\xe2/Ð/gm ;
2073                 s/\xe9/Ø/gm ;
2074                 s/\xec/þ/gm ;
2075                 s/\xf1/æ/gm ;
2076                 s/\xf3/ð/gm ;
2077                 s/\xf9/ø/gm ;
2078                 s/\xfb/ß/gm ;
2079                 s/\xc1\x61/à/gm ;
2080                 s/\xc1\x65/è/gm ;
2081                 s/\xc1\x69/ì/gm ;
2082                 s/\xc1\x6f/ò/gm ;
2083                 s/\xc1\x75/ù/gm ;
2084                 s/\xc1\x41/À/gm ;
2085                 s/\xc1\x45/È/gm ;
2086                 s/\xc1\x49/Ì/gm ;
2087                 s/\xc1\x4f/Ò/gm ;
2088                 s/\xc1\x55/Ù/gm ;
2089                 s/\xc2\x41/Á/gm ;
2090                 s/\xc2\x45/É/gm ;
2091                 s/\xc2\x49/Í/gm ;
2092                 s/\xc2\x4f/Ó/gm ;
2093                 s/\xc2\x55/Ú/gm ;
2094                 s/\xc2\x59/Ý/gm ;
2095                 s/\xc2\x61/á/gm ;
2096                 s/\xc2\x65/é/gm ;
2097                 s/\xc2\x69/í/gm ;
2098                 s/\xc2\x6f/ó/gm ;
2099                 s/\xc2\x75/ú/gm ;
2100                 s/\xc2\x79/ý/gm ;
2101                 s/\xc3\x41/Â/gm ;
2102                 s/\xc3\x45/Ê/gm ;
2103                 s/\xc3\x49/Î/gm ;
2104                 s/\xc3\x4f/Ô/gm ;
2105                 s/\xc3\x55/Û/gm ;
2106                 s/\xc3\x61/â/gm ;
2107                 s/\xc3\x65/ê/gm ;
2108                 s/\xc3\x69/î/gm ;
2109                 s/\xc3\x6f/ô/gm ;
2110                 s/\xc3\x75/û/gm ;
2111                 s/\xc4\x41/Ã/gm ;
2112                 s/\xc4\x4e/Ñ/gm ;
2113                 s/\xc4\x4f/Õ/gm ;
2114                 s/\xc4\x61/ã/gm ;
2115                 s/\xc4\x6e/ñ/gm ;
2116                 s/\xc4\x6f/õ/gm ;
2117                 s/\xc8\x45/Ë/gm ;
2118                 s/\xc8\x49/Ï/gm ;
2119                 s/\xc8\x65/ë/gm ;
2120                 s/\xc8\x69/ï/gm ;
2121                 s/\xc8\x76/ÿ/gm ;
2122                 s/\xc9\x41/Ä/gm ;
2123                 s/\xc9\x4f/Ö/gm ;
2124                 s/\xc9\x55/Ü/gm ;
2125                 s/\xc9\x61/ä/gm ;
2126                 s/\xc9\x6f/ö/gm ;
2127                 s/\xc9\x75/ü/gm ;
2128                 s/\xca\x41/Å/gm ;
2129                 s/\xca\x61/å/gm ;
2130                 s/\xd0\x43/Ç/gm ;
2131                 s/\xd0\x63/ç/gm ;
2132                 # this handles non-sorting blocks (if implementation requires this)
2133                 $string = nsb_clean($_) ;
2134         } elsif ($encoding eq "USMARC" || $encoding eq "MARC21") {
2135                 if(/[\xc1-\xff]/) {
2136                         s/\xe1\x61/à/gm ;
2137                         s/\xe1\x65/è/gm ;
2138                         s/\xe1\x69/ì/gm ;
2139                         s/\xe1\x6f/ò/gm ;
2140                         s/\xe1\x75/ù/gm ;
2141                         s/\xe1\x41/À/gm ;
2142                         s/\xe1\x45/È/gm ;
2143                         s/\xe1\x49/Ì/gm ;
2144                         s/\xe1\x4f/Ò/gm ;
2145                         s/\xe1\x55/Ù/gm ;
2146                         s/\xe2\x41/Á/gm ;
2147                         s/\xe2\x45/É/gm ;
2148                         s/\xe2\x49/Í/gm ;
2149                         s/\xe2\x4f/Ó/gm ;
2150                         s/\xe2\x55/Ú/gm ;
2151                         s/\xe2\x59/Ý/gm ;
2152                         s/\xe2\x61/á/gm ;
2153                         s/\xe2\x65/é/gm ;
2154                         s/\xe2\x69/í/gm ;
2155                         s/\xe2\x6f/ó/gm ;
2156                         s/\xe2\x75/ú/gm ;
2157                         s/\xe2\x79/ý/gm ;
2158                         s/\xe3\x41/Â/gm ;
2159                         s/\xe3\x45/Ê/gm ;
2160                         s/\xe3\x49/Î/gm ;
2161                         s/\xe3\x4f/Ô/gm ;
2162                         s/\xe3\x55/Û/gm ;
2163                         s/\xe3\x61/â/gm ;
2164                         s/\xe3\x65/ê/gm ;
2165                         s/\xe3\x69/î/gm ;
2166                         s/\xe3\x6f/ô/gm ;
2167                         s/\xe3\x75/û/gm ;
2168                         s/\xe4\x41/Ã/gm ;
2169                         s/\xe4\x4e/Ñ/gm ;
2170                         s/\xe4\x4f/Õ/gm ;
2171                         s/\xe4\x61/ã/gm ;
2172                         s/\xe4\x6e/ñ/gm ;
2173                         s/\xe4\x6f/õ/gm ;
2174                         s/\xe8\x45/Ë/gm ;
2175                         s/\xe8\x49/Ï/gm ;
2176                         s/\xe8\x65/ë/gm ;
2177                         s/\xe8\x69/ï/gm ;
2178                         s/\xe8\x76/ÿ/gm ;
2179                         s/\xe9\x41/Ä/gm ;
2180                         s/\xe9\x4f/Ö/gm ;
2181                         s/\xe9\x55/Ü/gm ;
2182                         s/\xe9\x61/ä/gm ;
2183                         s/\xe9\x6f/ö/gm ;
2184                         s/\xe9\x75/ü/gm ;
2185                         s/\xea\x41/Å/gm ;
2186                         s/\xea\x61/å/gm ;
2187                         # this handles non-sorting blocks (if implementation requires this)
2188                         $string = nsb_clean($_) ;
2189                 }
2190         }
2191         return($string) ;
2192 }
2193
2194 sub nsb_clean {
2195         my $NSB = '\x88' ;              # NSB : begin Non Sorting Block
2196         my $NSE = '\x89' ;              # NSE : Non Sorting Block end
2197         # handles non sorting blocks
2198         my ($string) = @_ ;
2199         $_ = $string ;
2200         s/$NSB/(/gm ;
2201         s/[ ]{0,1}$NSE/) /gm ;
2202         $string = $_ ;
2203         return($string) ;
2204 }
2205
2206 END { }       # module clean-up code here (global destructor)
2207
2208 =back
2209
2210 =head1 AUTHOR
2211
2212 Koha Developement team <info@koha.org>
2213
2214 Paul POULAIN paul.poulain@free.fr
2215
2216 =cut
2217
2218 # $Id$
2219 # $Log$
2220 # Revision 1.73  2003/11/28 09:45:25  tipaul
2221 # bugfix for iso2709 file import in the "notforloan" field.
2222 #
2223 # But notforloan field called "loan" somewhere, so in case "loan" is used, copied to "notforloan" to avoid a bug.
2224 #
2225 # Revision 1.72  2003/11/24 17:40:14  tipaul
2226 # fix for #385
2227 #
2228 # Revision 1.71  2003/11/24 16:28:49  tipaul
2229 # biblio & item deletion now works fine in MARC editor.
2230 # Stores deleted biblio/item in the marc field of the deletedbiblio/deleteditem table.
2231 #
2232 # Revision 1.70  2003/11/24 13:29:55  tipaul
2233 # moving $id from beginning to end of file (70 commits... huge comments...)
2234 #
2235 # Revision 1.69  2003/11/24 13:27:17  tipaul
2236 # fix for #380 (bibliosubject)
2237 #
2238 # Revision 1.68  2003/11/06 17:18:30  tipaul
2239 # bugfix for #384
2240 #
2241 # 1st draft for MARC biblio deletion.
2242 # Still does not work well, but at least, Biblio.pm compiles & it should'nt break too many things
2243 # (Note the trash in the MARCdetail, but don't use it, please :-) )
2244 #
2245 # Revision 1.67  2003/10/25 08:46:27  tipaul
2246 # minor fixes for bilbio deletion (still buggy)
2247 #
2248 # Revision 1.66  2003/10/17 10:02:56  tipaul
2249 # Indexing only words longer than 2 letters. Was >=2 before, & 2 letters words usually means nothing.
2250 #
2251 # Revision 1.65  2003/10/14 09:45:29  tipaul
2252 # 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)
2253 #
2254 # Revision 1.64  2003/10/06 15:20:51  tipaul
2255 # fix for 536 (subtitle error)
2256 #
2257 # Revision 1.63  2003/10/01 13:25:49  tipaul
2258 # seems a char encoding problem modified something in char_decode sub... changing back to something that works...
2259 #
2260 # Revision 1.62  2003/09/17 14:21:13  tipaul
2261 # fixing bug that makes a MARC biblio disappear when using full acquisition (order => recieve ==> MARC editor).
2262 # Before this 2 lines fix, the MARC biblio was deleted during recieve, and had to be entirely recreated :-(
2263 #
2264 # Revision 1.61  2003/09/17 10:24:39  tipaul
2265 # notforloan value in itemtype was overwritting notforloan value in a given item.
2266 # I changed this behaviour :
2267 # if notforloan is set for a given item, and NOT for all items from this itemtype, the notforloan is kept.
2268 # If notforloan is set for itemtype, it's used (and impossible to loan a specific item from this itemtype)
2269 #
2270 # Revision 1.60  2003/09/04 14:11:23  tipaul
2271 # fix for 593 (data duplication in MARC-DB)
2272 #
2273 # Revision 1.58  2003/08/06 12:54:52  tipaul
2274 # fix for publicationyear : extracting numeric value from MARC string, like for copyrightdate.
2275 # (note that copyrightdate still extracted to get numeric format)
2276 #
2277 # Revision 1.57  2003/07/15 23:09:18  slef
2278 # change show columns to use biblioitems bnotes too
2279 #
2280 # Revision 1.56  2003/07/15 11:34:52  slef
2281 # fixes from paul email
2282 #
2283 # Revision 1.55  2003/07/15 00:02:49  slef
2284 # Work on bug 515... can we do a single-side rename of notes to bnotes?
2285 #
2286 # Revision 1.54  2003/07/11 11:51:32  tipaul
2287 # *** empty log message ***
2288 #
2289 # Revision 1.52  2003/07/10 10:37:19  tipaul
2290 # fix for copyrightdate problem, #514
2291 #
2292 # Revision 1.51  2003/07/02 14:47:17  tipaul
2293 # fix for #519 : items.dateaccessioned imports incorrectly
2294 #
2295 # Revision 1.49  2003/06/17 11:21:13  tipaul
2296 # improvments/fixes for z3950 support.
2297 # * Works now even on ADD, not only on MODIFY
2298 # * able to search on ISBN, author, title
2299 #
2300 # Revision 1.48  2003/06/16 09:22:53  rangi
2301 # Just added an order clause to getitemtypes
2302 #
2303 # Revision 1.47  2003/05/20 16:22:44  tipaul
2304 # fixing typo in Biblio.pm POD
2305 #
2306 # Revision 1.46  2003/05/19 13:45:18  tipaul
2307 # support for subtitles, additional authors, subject.
2308 # 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.
2309 # Note that some OLD-DB subs are strange (dummy ?) see OLDmodsubject, OLDmodsubtitle, OLDmodaddiauthor in C4/Biblio.pm
2310 # 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.
2311 #
2312 # Revision 1.45  2003/04/29 16:50:49  tipaul
2313 # really proud of this commit :-)
2314 # z3950 search and import seems to works fine.
2315 # Let me explain how :
2316 # * a "search z3950" button is added in the addbiblio template.
2317 # * when clicked, a popup appears and z3950/search.pl is called
2318 # * z3950/search.pl calls addz3950search in the DB
2319 # * the z3950 daemon retrieve the records and stores them in z3950results AND in marc_breeding table.
2320 # * as long as there as searches pending, the popup auto refresh every 2 seconds, and says how many searches are pending.
2321 # * when the user clicks on a z3950 result => the parent popup is called with the requested biblio, and auto-filled
2322 #
2323 # Note :
2324 # * 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.
2325 # * 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.
2326 #
2327 # Revision 1.44  2003/04/28 13:07:14  tipaul
2328 # Those fixes solves the "internal server error" with MARC::Record 1.12.
2329 # It was due to an illegal contruction in Koha : we tried to retrive subfields from <10 tags.
2330 # That's not possible. MARC::Record accepted this in 0.93 version, but it was fixed after.
2331 # Now, the construct/retrieving is OK !
2332 #
2333 # Revision 1.43  2003/04/10 13:56:02  tipaul
2334 # Fix some bugs :
2335 # * worked in 1.9.0, but not in 1.9.1 :
2336 # - modif of a biblio didn't work
2337 # - 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.
2338 #
2339 # * did not work before :
2340 # - repeatable subfields now works correctly. Enter 2 subfields separated by | and they will be splitted during saving.
2341 # - dropped the last subfield of the MARC form :-(
2342 #
2343 # Internal changes :
2344 # - 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.
2345 # Note the MARCdelbiblio has been rewritted to enable deletion of a biblio WITHOUT deleting items.
2346 #
2347 # Revision 1.42  2003/04/04 08:41:11  tipaul
2348 # last commits before 1.9.1
2349 #
2350 # Revision 1.41  2003/04/01 12:26:43  tipaul
2351 # fixes
2352 #
2353 # Revision 1.40  2003/03/11 15:14:03  tipaul
2354 # pod updating
2355 #
2356 # Revision 1.39  2003/03/07 16:35:42  tipaul
2357 # * moving generic functions to Koha.pm
2358 # * improvement of SearchMarc.pm
2359 # * bugfixes
2360 # * code cleaning
2361 #
2362 # Revision 1.38  2003/02/27 16:51:59  tipaul
2363 # * moving prepare / execute to ? form.
2364 # * some # cleaning
2365 # * little bugfix.
2366 # * road to 1.9.2 => acquisition and cataloguing merging
2367 #
2368 # Revision 1.37  2003/02/12 11:03:03  tipaul
2369 # Support for 000 -> 010 fields.
2370 # Those fields doesn't have subfields.
2371 # In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@".
2372 # 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.
2373 #
2374 # Revision 1.36  2003/02/12 11:01:01  tipaul
2375 # Support for 000 -> 010 fields.
2376 # Those fields doesn't have subfields.
2377 # In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@".
2378 # 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.
2379 #
2380 # Revision 1.35  2003/02/03 18:46:00  acli
2381 # Minor factoring in C4/Biblio.pm, plus change to export the per-tag
2382 # 'mandatory' property to a per-subfield 'tag_mandatory' template parameter,
2383 # so that addbiblio.tmpl can distinguish between mandatory subfields in a
2384 # mandatory tag and mandatory subfields in an optional tag
2385 #
2386 # Not-minor factoring in acqui.simple/addbiblio.pl to make the if-else blocks
2387 # smaller, and to add some POD; need further testing for this
2388 #
2389 # Added function to check if a MARC subfield name is "koha-internal" (instead
2390 # of checking it for 'lib' and 'tag' everywhere); temporarily added to Koha.pm
2391 #
2392 # Use above function in acqui.simple/additem.pl and search.marc/search.pl
2393 #
2394 # Revision 1.34  2003/01/28 14:50:04  tipaul
2395 # fixing MARCmodbiblio API and reindenting code
2396 #
2397 # Revision 1.33  2003/01/23 12:22:37  tipaul
2398 # adding char_decode to decode MARC21 or UNIMARC extended chars
2399 #
2400 # Revision 1.32  2002/12/16 15:08:50  tipaul
2401 # small but important bugfix (fixes a problem in export)
2402 #
2403 # Revision 1.31  2002/12/13 16:22:04  tipaul
2404 # 1st draft of marc export
2405 #
2406 # Revision 1.30  2002/12/12 21:26:35  tipaul
2407 # YAB ! (Yet Another Bugfix) => related to biblio modif
2408 # (some warning cleaning too)
2409 #
2410 # Revision 1.29  2002/12/12 16:35:00  tipaul
2411 # adding authentification with Auth.pm and
2412 # MAJOR BUGFIX on marc biblio modification
2413 #
2414 # Revision 1.28  2002/12/10 13:30:03  tipaul
2415 # fugfixes from Dombes Abbey work
2416 #
2417 # Revision 1.27  2002/11/19 12:36:16  tipaul
2418 # road to 1.3.2
2419 # various bugfixes, improvments, and migration from acquisition.pm to biblio.pm
2420 #
2421 # Revision 1.26  2002/11/12 15:58:43  tipaul
2422 # road to 1.3.2 :
2423 # * many bugfixes
2424 # * 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)
2425 #
2426 # Revision 1.25  2002/10/25 10:58:26  tipaul
2427 # Road to 1.3.2
2428 # * bugfixes and improvements
2429 #
2430 # Revision 1.24  2002/10/24 12:09:01  arensb
2431 # Fixed "no title" warning when generating HTML documentation from POD.
2432 #
2433 # Revision 1.23  2002/10/16 12:43:08  arensb
2434 # Added some FIXME comments.
2435 #
2436 # Revision 1.22  2002/10/15 13:39:17  tipaul
2437 # removing Acquisition.pm
2438 # deleting unused code in biblio.pm, rewriting POD and answering most FIXME comments
2439 #
2440 # Revision 1.21  2002/10/13 11:34:14  arensb
2441 # Replaced expressions of the form "$x = $x <op> $y" with "$x <op>= $y".
2442 # Thus, $x = $x+2 becomes $x += 2, and so forth.
2443 #
2444 # Revision 1.20  2002/10/13 08:28:32  arensb
2445 # Deleted unused variables.
2446 # Removed trailing whitespace.
2447 #
2448 # Revision 1.19  2002/10/13 05:56:10  arensb
2449 # Added some FIXME comments.
2450 #
2451 # Revision 1.18  2002/10/11 12:34:53  arensb
2452 # Replaced &requireDBI with C4::Context->dbh
2453 #
2454 # Revision 1.17  2002/10/10 14:48:25  tipaul
2455 # bugfixes
2456 #
2457 # Revision 1.16  2002/10/07 14:04:26  tipaul
2458 # road to 1.3.1 : viewing MARC biblio
2459 #
2460 # Revision 1.15  2002/10/05 09:49:25  arensb
2461 # Merged with arensb-context branch: use C4::Context->dbh instead of
2462 # &C4Connect, and generally prefer C4::Context over C4::Database.
2463 #
2464 # Revision 1.14  2002/10/03 11:28:18  tipaul
2465 # Extending Context.pm to add stopword management and using it in MARC-API.
2466 # First benchmarks show a medium speed improvement, which  is nice as this part is heavily called.
2467 #
2468 # Revision 1.13  2002/10/02 16:26:44  tipaul
2469 # road to 1.3.1
2470 #
2471 # Revision 1.12.2.4  2002/10/05 07:09:31  arensb
2472 # Merged in changes from main branch.
2473 #
2474 # Revision 1.12.2.3  2002/10/05 06:12:10  arensb
2475 # Added a whole mess of FIXME comments.
2476 #
2477 # Revision 1.12.2.2  2002/10/05 04:03:14  arensb
2478 # Added some missing semicolons.
2479 #
2480 # Revision 1.12.2.1  2002/10/04 02:24:01  arensb
2481 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
2482 # C4Connect.
2483 #
2484 # Revision 1.12.2.3  2002/10/05 06:12:10  arensb
2485 # Added a whole mess of FIXME comments.
2486 #
2487 # Revision 1.12.2.2  2002/10/05 04:03:14  arensb
2488 # Added some missing semicolons.
2489 #
2490 # Revision 1.12.2.1  2002/10/04 02:24:01  arensb
2491 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
2492 # C4Connect.
2493 #
2494 # Revision 1.12  2002/10/01 11:48:51  arensb
2495 # Added some FIXME comments, mostly marking duplicate functions.
2496 #
2497 # Revision 1.11  2002/09/24 13:49:26  tipaul
2498 # long WAS the road to 1.3.0...
2499 # coming VERY SOON NOW...
2500 # modifying installer and buildrelease to update the DB
2501 #
2502 # Revision 1.10  2002/09/22 16:50:08  arensb
2503 # Added some FIXME comments.
2504 #
2505 # Revision 1.9  2002/09/20 12:57:46  tipaul
2506 # long is the road to 1.4.0
2507 # * MARCadditem and MARCmoditem now wroks
2508 # * various bugfixes in MARC management
2509 # !!! 1.3.0 should be released very soon now. Be careful !!!
2510 #
2511 # Revision 1.8  2002/09/10 13:53:52  tipaul
2512 # MARC API continued...
2513 # * some bugfixes
2514 # * 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)
2515 #
2516 # Note : it should not be hard for marcimport and marcexport to re-link fields from internal tag/subfield to "legal" tag/subfield.
2517 #
2518 # Revision 1.7  2002/08/14 18:12:51  tonnesen
2519 # Added copyright statement to all .pl and .pm files
2520 #
2521 # Revision 1.6  2002/07/25 13:40:31  tipaul
2522 # pod documenting the API.
2523 #
2524 # Revision 1.5  2002/07/24 16:11:37  tipaul
2525 # Now, the API...
2526 # Database.pm and Output.pm are almost not modified (var test...)
2527 #
2528 # Biblio.pm is almost completly rewritten.
2529 #
2530 # WHAT DOES IT ??? ==> END of Hitchcock suspens
2531 #
2532 # 1st, it does... nothing...
2533 # 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 ...
2534 #
2535 # All old-API functions have been cloned. for example, the "newbiblio" sub, now has become :
2536 # * a "newbiblio" sub, with the same parameters. It just call a sub named OLDnewbiblio
2537 # * 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.
2538 # * 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.
2539 # 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 ;-)
2540 #
2541 # 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.
2542 # Note we have decided with steve that a old-biblio <=> a MARC-Biblio.
2543 #