* moving generic functions to Koha.pm
[wip/koha-chris_n.git] / C4 / Biblio.pm
1 package C4::Biblio;
2 # $Id$
3 # $Log$
4 # Revision 1.39  2003/03/07 16:35:42  tipaul
5 # * moving generic functions to Koha.pm
6 # * improvement of SearchMarc.pm
7 # * bugfixes
8 # * code cleaning
9 #
10 # Revision 1.38  2003/02/27 16:51:59  tipaul
11 # * moving prepare / execute to ? form.
12 # * some # cleaning
13 # * little bugfix.
14 # * road to 1.9.2 => acquisition and cataloguing merging
15 #
16 # Revision 1.37  2003/02/12 11:03:03  tipaul
17 # Support for 000 -> 010 fields.
18 # Those fields doesn't have subfields.
19 # In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@".
20 # 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.
21 #
22 # Revision 1.36  2003/02/12 11:01:01  tipaul
23 # Support for 000 -> 010 fields.
24 # Those fields doesn't have subfields.
25 # In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@".
26 # 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.
27 #
28 # Revision 1.35  2003/02/03 18:46:00  acli
29 # Minor factoring in C4/Biblio.pm, plus change to export the per-tag
30 # 'mandatory' property to a per-subfield 'tag_mandatory' template parameter,
31 # so that addbiblio.tmpl can distinguish between mandatory subfields in a
32 # mandatory tag and mandatory subfields in an optional tag
33 #
34 # Not-minor factoring in acqui.simple/addbiblio.pl to make the if-else blocks
35 # smaller, and to add some POD; need further testing for this
36 #
37 # Added function to check if a MARC subfield name is "koha-internal" (instead
38 # of checking it for 'lib' and 'tag' everywhere); temporarily added to Koha.pm
39 #
40 # Use above function in acqui.simple/additem.pl and search.marc/search.pl
41 #
42 # Revision 1.34  2003/01/28 14:50:04  tipaul
43 # fixing MARCmodbiblio API and reindenting code
44 #
45 # Revision 1.33  2003/01/23 12:22:37  tipaul
46 # adding char_decode to decode MARC21 or UNIMARC extended chars
47 #
48 # Revision 1.32  2002/12/16 15:08:50  tipaul
49 # small but important bugfix (fixes a problem in export)
50 #
51 # Revision 1.31  2002/12/13 16:22:04  tipaul
52 # 1st draft of marc export
53 #
54 # Revision 1.30  2002/12/12 21:26:35  tipaul
55 # YAB ! (Yet Another Bugfix) => related to biblio modif
56 # (some warning cleaning too)
57 #
58 # Revision 1.29  2002/12/12 16:35:00  tipaul
59 # adding authentification with Auth.pm and
60 # MAJOR BUGFIX on marc biblio modification
61 #
62 # Revision 1.28  2002/12/10 13:30:03  tipaul
63 # fugfixes from Dombes Abbey work
64 #
65 # Revision 1.27  2002/11/19 12:36:16  tipaul
66 # road to 1.3.2
67 # various bugfixes, improvments, and migration from acquisition.pm to biblio.pm
68 #
69 # Revision 1.26  2002/11/12 15:58:43  tipaul
70 # road to 1.3.2 :
71 # * many bugfixes
72 # * 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)
73 #
74 # Revision 1.25  2002/10/25 10:58:26  tipaul
75 # Road to 1.3.2
76 # * bugfixes and improvements
77 #
78 # Revision 1.24  2002/10/24 12:09:01  arensb
79 # Fixed "no title" warning when generating HTML documentation from POD.
80 #
81 # Revision 1.23  2002/10/16 12:43:08  arensb
82 # Added some FIXME comments.
83 #
84 # Revision 1.22  2002/10/15 13:39:17  tipaul
85 # removing Acquisition.pm
86 # deleting unused code in biblio.pm, rewriting POD and answering most FIXME comments
87 #
88 # Revision 1.21  2002/10/13 11:34:14  arensb
89 # Replaced expressions of the form "$x = $x <op> $y" with "$x <op>= $y".
90 # Thus, $x = $x+2 becomes $x += 2, and so forth.
91 #
92 # Revision 1.20  2002/10/13 08:28:32  arensb
93 # Deleted unused variables.
94 # Removed trailing whitespace.
95 #
96 # Revision 1.19  2002/10/13 05:56:10  arensb
97 # Added some FIXME comments.
98 #
99 # Revision 1.18  2002/10/11 12:34:53  arensb
100 # Replaced &requireDBI with C4::Context->dbh
101 #
102 # Revision 1.17  2002/10/10 14:48:25  tipaul
103 # bugfixes
104 #
105 # Revision 1.16  2002/10/07 14:04:26  tipaul
106 # road to 1.3.1 : viewing MARC biblio
107 #
108 # Revision 1.15  2002/10/05 09:49:25  arensb
109 # Merged with arensb-context branch: use C4::Context->dbh instead of
110 # &C4Connect, and generally prefer C4::Context over C4::Database.
111 #
112 # Revision 1.14  2002/10/03 11:28:18  tipaul
113 # Extending Context.pm to add stopword management and using it in MARC-API.
114 # First benchmarks show a medium speed improvement, which  is nice as this part is heavily called.
115 #
116 # Revision 1.13  2002/10/02 16:26:44  tipaul
117 # road to 1.3.1
118 #
119 # Revision 1.12.2.4  2002/10/05 07:09:31  arensb
120 # Merged in changes from main branch.
121 #
122 # Revision 1.12.2.3  2002/10/05 06:12:10  arensb
123 # Added a whole mess of FIXME comments.
124 #
125 # Revision 1.12.2.2  2002/10/05 04:03:14  arensb
126 # Added some missing semicolons.
127 #
128 # Revision 1.12.2.1  2002/10/04 02:24:01  arensb
129 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
130 # C4Connect.
131 #
132 # Revision 1.12.2.3  2002/10/05 06:12:10  arensb
133 # Added a whole mess of FIXME comments.
134 #
135 # Revision 1.12.2.2  2002/10/05 04:03:14  arensb
136 # Added some missing semicolons.
137 #
138 # Revision 1.12.2.1  2002/10/04 02:24:01  arensb
139 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
140 # C4Connect.
141 #
142 # Revision 1.12  2002/10/01 11:48:51  arensb
143 # Added some FIXME comments, mostly marking duplicate functions.
144 #
145 # Revision 1.11  2002/09/24 13:49:26  tipaul
146 # long WAS the road to 1.3.0...
147 # coming VERY SOON NOW...
148 # modifying installer and buildrelease to update the DB
149 #
150 # Revision 1.10  2002/09/22 16:50:08  arensb
151 # Added some FIXME comments.
152 #
153 # Revision 1.9  2002/09/20 12:57:46  tipaul
154 # long is the road to 1.4.0
155 # * MARCadditem and MARCmoditem now wroks
156 # * various bugfixes in MARC management
157 # !!! 1.3.0 should be released very soon now. Be careful !!!
158 #
159 # Revision 1.8  2002/09/10 13:53:52  tipaul
160 # MARC API continued...
161 # * some bugfixes
162 # * 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)
163 #
164 # Note : it should not be hard for marcimport and marcexport to re-link fields from internal tag/subfield to "legal" tag/subfield.
165 #
166 # Revision 1.7  2002/08/14 18:12:51  tonnesen
167 # Added copyright statement to all .pl and .pm files
168 #
169 # Revision 1.6  2002/07/25 13:40:31  tipaul
170 # pod documenting the API.
171 #
172 # Revision 1.5  2002/07/24 16:11:37  tipaul
173 # Now, the API...
174 # Database.pm and Output.pm are almost not modified (var test...)
175 #
176 # Biblio.pm is almost completly rewritten.
177 #
178 # WHAT DOES IT ??? ==> END of Hitchcock suspens
179 #
180 # 1st, it does... nothing...
181 # 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 ...
182 #
183 # All old-API functions have been cloned. for example, the "newbiblio" sub, now has become :
184 # * a "newbiblio" sub, with the same parameters. It just call a sub named OLDnewbiblio
185 # * 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.
186 # * 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.
187 # 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 ;-)
188 #
189 # 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.
190 # Note we have decided with steve that a old-biblio <=> a MARC-Biblio.
191 #
192
193
194 # Copyright 2000-2002 Katipo Communications
195 #
196 # This file is part of Koha.
197 #
198 # Koha is free software; you can redistribute it and/or modify it under the
199 # terms of the GNU General Public License as published by the Free Software
200 # Foundation; either version 2 of the License, or (at your option) any later
201 # version.
202 #
203 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
204 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
205 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
206 #
207 # You should have received a copy of the GNU General Public License along with
208 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
209 # Suite 330, Boston, MA  02111-1307 USA
210
211 use strict;
212 require Exporter;
213 use C4::Context;
214 use C4::Database;
215 use MARC::Record;
216
217 use vars qw($VERSION @ISA @EXPORT);
218
219 # set the version for version checking
220 $VERSION = 0.01;
221
222 @ISA = qw(Exporter);
223 #
224 # don't forget MARCxxx subs are here only for testing purposes. Should not be used
225 # as the old-style API and the NEW one are the only public functions.
226 #
227 @EXPORT = qw(
228              &updateBiblio &updateBiblioItem &updateItem
229              &itemcount &newbiblio &newbiblioitem
230              &modnote &newsubject &newsubtitle
231              &modbiblio &checkitems
232              &newitems &modbibitem
233              &modsubtitle &modsubject &modaddauthor &moditem &countitems
234              &delitem &deletebiblioitem &delbiblio
235              &getitemtypes &getbiblio
236              &getbiblioitembybiblionumber
237              &getbiblioitem &getitemsbybiblioitem
238              &skip
239              &newcompletebiblioitem
240
241              &MARCfind_oldbiblionumber_from_MARCbibid
242              &MARCfind_MARCbibid_from_oldbiblionumber
243                 &MARCfind_marc_from_kohafield
244              &MARCfindsubfield
245              &MARCgettagslib
246
247                 &NEWnewbiblio &NEWnewitem
248                 &NEWmodbiblio &NEWmoditem
249
250              &MARCaddbiblio &MARCadditem
251              &MARCmodsubfield &MARCaddsubfield
252              &MARCmodbiblio &MARCmoditem
253              &MARCkoha2marcBiblio &MARCmarc2koha
254                 &MARCkoha2marcItem &MARChtml2marc
255              &MARCgetbiblio &MARCgetitem
256              &MARCaddword &MARCdelword
257                 &char_decode
258  );
259
260 #
261 #
262 # MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC
263 #
264 #
265 # all the following subs takes a MARC::Record as parameter and manage
266 # the MARC-DB. They are called by the 1.0/1.2 xxx subs, and by the
267 # NEWxxx subs (xxx deals with old-DB parameters, the NEWxxx deals with MARC-DB parameter)
268
269 =head1 NAME
270
271 C4::Biblio - acquisition, catalog  management functions
272
273 =head1 SYNOPSIS
274
275 move from 1.2 to 1.4 version :
276 1.2 and previous version uses a specific API to manage biblios. This API uses old-DB style parameters.
277 In the 1.4 version, we want to do 2 differents things :
278  - keep populating the old-DB, that has a LOT less datas than MARC
279  - populate the MARC-DB
280 To populate the DBs we have 2 differents sources :
281  - the standard acquisition system (through book sellers), that does'nt use MARC data
282  - the MARC acquisition system, that uses MARC data.
283
284 Thus, we have 2 differents cases :
285 - 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
286 - 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
287
288 That's why we need 4 subs :
289 all I<subs beginning by MARC> manage only MARC tables. They manage MARC-DB with MARC::Record parameters
290 all I<subs beginning by OLD> manage only OLD-DB tables. They manage old-DB with old-DB parameters
291 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
292 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.
293
294 - NEW and old-style API should be used in koha to manage biblio
295 - MARCsubs are divided in 2 parts :
296 * some of them manage MARC parameters. They are heavily used in koha.
297 * some of them manage MARC biblio : they are mostly used by NEW and old-style subs.
298 - OLD are used internally only
299
300 all subs requires/use $dbh as 1st parameter.
301
302 I<NEWxxx related subs>
303
304 all subs requires/use $dbh as 1st parameter.
305 those subs are used by the MARC-compliant version of koha : marc import, or marc management.
306
307 I<OLDxxx related subs>
308
309 all subs requires/use $dbh as 1st parameter.
310 those subs are used by the MARC-compliant version of koha : marc import, or marc management.
311
312 They all are the exact copy of 1.0/1.2 version of the sub without the OLD.
313 The OLDxxx is called by the original xxx sub.
314 the 1.4 xxx sub also builds MARC::Record an calls the MARCxxx
315
316 WARNING : there is 1 difference between initialxxx and OLDxxx :
317 the db header $dbh is always passed as parameter to avoid over-DB connexion
318
319 =head1 DESCRIPTION
320
321 =over 4
322
323 =item @tagslib = &MARCgettagslib($dbh,1|0);
324
325 last param is 1 for liblibrarian and 0 for libopac
326 returns a hash with tag/subfield meaning
327 =item ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
328
329 finds MARC tag and subfield for a given kohafield
330 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
331
332 =item $biblionumber = &MARCfind_oldbiblionumber_from_MARCbibid($dbh,$MARCbibi);
333
334 finds a old-db biblio number for a given MARCbibid number
335
336 =item $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$oldbiblionumber);
337
338 finds a MARC bibid from a old-db biblionumber
339
340 =item $MARCRecord = &MARCkoha2marcBiblio($dbh,$biblionumber,biblioitemnumber);
341
342 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem
343
344 =item $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);
345
346 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB item
347
348 =item $MARCRecord = &MARCkoha2marcSubtitle($dbh,$biblionumber,$subtitle);
349
350 MARCkoha2marcSubtitle is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB subtitle
351
352 =item $olddb = &MARCmarc2koha($dbh,$MARCRecord);
353
354 builds a hash with old-db datas from a MARC::Record
355
356 =item &MARCaddbiblio($dbh,$MARC::Record,$biblionumber);
357
358 creates a biblio (in the MARC tables only). $biblionumber is the old-db biblionumber of the biblio
359
360 =item &MARCaddsubfield($dbh,$bibid,$tagid,$indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
361
362 adds a subfield in a biblio (in the MARC tables only).
363
364 =item $MARCRecord = &MARCgetbiblio($dbh,$bibid);
365
366 Returns a MARC::Record for the biblio $bibid.
367
368 =item &MARCmodbiblio($dbh,$bibid,$record,$delete);
369
370 MARCmodbiblio changes a biblio for a biblio,MARC::Record passed as parameter
371 if $delete == 1, every field/subfield not found is deleted in the biblio
372 otherwise, only data passed to MARCmodbiblio is managed.
373 thus, you can change only a small part of a biblio (like an item, or a subtitle, or a additionalauthor...)
374
375 =item ($subfieldid,$subfieldvalue) = &MARCmodsubfield($dbh,$subfieldid,$subfieldvalue);
376
377 MARCmodsubfield changes the value of a given subfield
378
379 =item $subfieldid = &MARCfindsubfield($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue);
380
381 MARCfindsubfield returns a subfield number given a bibid/tag/subfieldvalue values.
382 Returns -1 if more than 1 answer
383
384 =item $subfieldid = &MARCfindsubfieldid($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
385
386 MARCfindsubfieldid find a subfieldid for a bibid/tag/tagorder/subfield/subfieldorder
387
388 =item &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
389
390 MARCdelsubfield delete a subfield for a bibid/tag/tagorder/subfield/subfieldorder
391
392 =item &MARCdelbiblio($dbh,$bibid);
393
394 MARCdelbiblio delete biblio $bibid
395
396 =item &MARCkoha2marcOnefield
397
398 used by MARCkoha2marc and should not be useful elsewhere
399
400 =item &MARCmarc2kohaOnefield
401
402 used by MARCmarc2koha and should not be useful elsewhere
403
404 =item MARCaddword
405
406 used to manage MARC_word table and should not be useful elsewhere
407
408 =item MARCdelword
409
410 used to manage MARC_word table and should not be useful elsewhere
411
412 =cut
413
414 sub MARCgettagslib {
415         my ($dbh,$forlibrarian)= @_;
416         my $sth;
417         my $libfield = ($forlibrarian eq 1)? 'liblibrarian' : 'libopac';
418         $sth=$dbh->prepare("select tagfield,$libfield as lib,mandatory from marc_tag_structure order by tagfield");
419         $sth->execute;
420         my ($lib,$tag,$res,$tab,$mandatory,$repeatable);
421         while ( ($tag,$lib,$mandatory) = $sth->fetchrow) {
422                 $res->{$tag}->{lib}=$lib;
423                 $res->{$tab}->{tab}=""; # XXX
424                 $res->{$tag}->{mandatory}=$mandatory;
425         }
426
427         $sth=$dbh->prepare("select tagfield,tagsubfield,$libfield as lib,tab, mandatory, repeatable,authorised_value,thesaurus_category,value_builder from marc_subfield_structure order by tagfield,tagsubfield");
428         $sth->execute;
429
430         my $subfield;
431         my $authorised_value;
432         my $thesaurus_category;
433         my $value_builder;
434         while ( ($tag, $subfield, $lib, $tab, $mandatory, $repeatable,$authorised_value,$thesaurus_category,$value_builder) = $sth->fetchrow) {
435                 $res->{$tag}->{$subfield}->{lib}=$lib;
436                 $res->{$tag}->{$subfield}->{tab}=$tab;
437                 $res->{$tag}->{$subfield}->{mandatory}=$mandatory;
438                 $res->{$tag}->{$subfield}->{repeatable}=$repeatable;
439                 $res->{$tag}->{$subfield}->{authorised_value}=$authorised_value;
440                 $res->{$tag}->{$subfield}->{thesaurus_category}=$thesaurus_category;
441                 $res->{$tag}->{$subfield}->{value_builder}=$value_builder;
442         }
443         return $res;
444 }
445
446 sub MARCfind_marc_from_kohafield {
447     my ($dbh,$kohafield) = @_;
448     my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
449     $sth->execute($kohafield);
450     my ($tagfield,$tagsubfield) = $sth->fetchrow;
451     return ($tagfield,$tagsubfield);
452 }
453
454 sub MARCfind_oldbiblionumber_from_MARCbibid {
455     my ($dbh,$MARCbibid) = @_;
456     my $sth=$dbh->prepare("select biblionumber from marc_biblio where bibid=?");
457     $sth->execute($MARCbibid);
458     my ($biblionumber) = $sth->fetchrow;
459     return $biblionumber;
460 }
461
462 sub MARCfind_MARCbibid_from_oldbiblionumber {
463     my ($dbh,$oldbiblionumber) = @_;
464     my $sth=$dbh->prepare("select bibid from marc_biblio where biblionumber=?");
465     $sth->execute($oldbiblionumber);
466     my ($bibid) = $sth->fetchrow;
467     return $bibid;
468 }
469
470 sub MARCaddbiblio {
471 # pass the MARC::Record to this function, and it will create the records in the marc tables
472         my ($dbh,$record,$biblionumber) = @_;
473         my @fields=$record->fields();
474         my $bibid;
475         # adding main table, and retrieving bibid
476         $dbh->do("lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ");
477         my $sth=$dbh->prepare("insert into marc_biblio (datecreated,biblionumber) values (now(),?)");
478         $sth->execute($biblionumber);
479         $sth=$dbh->prepare("select max(bibid) from marc_biblio");
480         $sth->execute;
481         ($bibid)=$sth->fetchrow;
482         $sth->finish;
483         my $fieldcount=0;
484         # now, add subfields...
485         foreach my $field (@fields) {
486                 $fieldcount++;
487                 if ($field->tag() <10) {
488                                 &MARCaddsubfield($dbh,$bibid,
489                                                 $field->tag(),
490                                                 '',
491                                                 $fieldcount,
492                                                 '',
493                                                 1,
494                                                 $field->data()
495                                                 );
496                 } else {
497                         my @subfields=$field->subfields();
498                         foreach my $subfieldcount (0..$#subfields) {
499                                 &MARCaddsubfield($dbh,$bibid,
500                                                 $field->tag(),
501                                                 $field->indicator(1).$field->indicator(2),
502                                                 $fieldcount,
503                                                 $subfields[$subfieldcount][0],
504                                                 $subfieldcount+1,
505                                                 $subfields[$subfieldcount][1]
506                                                 );
507                         }
508                 }
509         }
510         $dbh->do("unlock tables");
511         return $bibid;
512 }
513
514 sub MARCadditem {
515 # pass the MARC::Record to this function, and it will create the records in the marc tables
516     my ($dbh,$record,$biblionumber) = @_;
517 #    warn "adding : ".$record->as_formatted();
518 # search for MARC biblionumber
519     $dbh->do("lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ");
520     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
521     my @fields=$record->fields();
522     my $sth = $dbh->prepare("select max(tagorder) from marc_subfield_table where bibid=?");
523     $sth->execute($bibid);
524     my ($fieldcount) = $sth->fetchrow;
525     # now, add subfields...
526     foreach my $field (@fields) {
527         my @subfields=$field->subfields();
528         $fieldcount++;
529         foreach my $subfieldcount (0..$#subfields) {
530                     &MARCaddsubfield($dbh,$bibid,
531                                  $field->tag(),
532                                  $field->indicator(1).$field->indicator(2),
533                                  $fieldcount,
534                                  $subfields[$subfieldcount][0],
535                                  $subfieldcount+1,
536                                  $subfields[$subfieldcount][1]
537                                  );
538 #                                warn "ADDING :$bibid,".
539 #                                $field->tag().
540 #                                $field->indicator(1).$field->indicator(2).",
541 #                                $fieldcount,
542 #                                $subfields[$subfieldcount][0],
543 #                                $subfieldcount+1,
544 #                                $subfields[$subfieldcount][1]";
545         }
546     }
547     $dbh->do("unlock tables");
548     return $bibid;
549 }
550
551 sub MARCaddsubfield {
552 # Add a new subfield to a tag into the DB.
553         my ($dbh,$bibid,$tagid,$tag_indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue) = @_;
554         # if not value, end of job, we do nothing
555         if (length($subfieldvalue) ==0) {
556                 return;
557         }
558     if (not($subfieldcode)) {
559         $subfieldcode=' ';
560     }
561         if (length($subfieldvalue)>255) {
562         #       $dbh->do("lock tables marc_blob_subfield WRITE, marc_subfield_table WRITE");
563                 my $sth=$dbh->prepare("insert into marc_blob_subfield (subfieldvalue) values (?)");
564                 $sth->execute($subfieldvalue);
565                 $sth=$dbh->prepare("select max(blobidlink)from marc_blob_subfield");
566                 $sth->execute;
567                 my ($res)=$sth->fetchrow;
568                 $sth=$dbh->prepare("insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,valuebloblink) values (?,?,?,?,?,?,?)");
569                 $sth->execute($bibid,(sprintf "%03s",$tagid),$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$res);
570                 if ($sth->errstr) {
571                 print STDERR "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
572                 }
573 #       $dbh->do("unlock tables");
574         } else {
575                 my $sth=$dbh->prepare("insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values (?,?,?,?,?,?,?)");
576                 $sth->execute($bibid,(sprintf "%03s",$tagid),$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue);
577                 if ($sth->errstr) {
578                 print STDERR "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
579                 }
580     }
581     &MARCaddword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
582 }
583
584 sub MARCgetbiblio {
585 # Returns MARC::Record of the biblio passed in parameter.
586     my ($dbh,$bibid)=@_;
587     my $record = MARC::Record->new();
588 #---- TODO : the leader is missing
589         $record->leader('                   ');
590     my $sth=$dbh->prepare("select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
591                                  from marc_subfield_table
592                                  where bibid=? order by tag,tagorder,subfieldcode
593                          ");
594     my $sth2=$dbh->prepare("select subfieldvalue from marc_blob_subfield where blobidlink=?");
595     $sth->execute($bibid);
596     my $prevtagorder=1;
597     my $prevtag='  ';
598     my $previndicator;
599     my %subfieldlist;
600     while (my $row=$sth->fetchrow_hashref) {
601                 if ($row->{'valuebloblink'}) { #---- search blob if there is one
602                         $sth2->execute($row->{'valuebloblink'});
603                         my $row2=$sth2->fetchrow_hashref;
604                         $sth2->finish;
605                         $row->{'subfieldvalue'}=$row2->{'subfieldvalue'};
606                 }
607 #               warn "prev : $prevtag . ".$row->{tag}." => ".$row->{subfieldvalue};
608                 if ($row->{tagorder} ne $prevtagorder || $row->{tag} ne $prevtag) {
609                         $previndicator.="  ";
610                         my $field;
611                         if ($prevtag <10) {
612                                 $record->add_fields((sprintf "%03s",$prevtag),%subfieldlist->{'@'});
613                         } else {
614                                 $field = MARC::Field->new( (sprintf "%03s",$prevtag), substr($previndicator,0,1), substr($previndicator,1,1), %subfieldlist);
615                                 $record->add_fields($field);
616                         }
617                         undef %subfieldlist;
618                         $prevtagorder=$row->{tagorder};
619                         $prevtag = $row->{tag};
620                         $previndicator=$row->{tag_indicator};
621                         %subfieldlist;
622                         %subfieldlist->{$row->{'subfieldcode'}} = $row->{'subfieldvalue'};
623                 } else {
624                         %subfieldlist->{$row->{'subfieldcode'}} .= $row->{'subfieldvalue'};
625                         $prevtag= $row->{tag};
626                         $previndicator=$row->{tag_indicator};
627                 }
628         }
629         # the last has not been included inside the loop... do it now !
630         if ($prevtag <10) {
631                 $record->add_fields($prevtag,%subfieldlist->{'@'});
632         } else {
633                 my $field = MARC::Field->new( $prevtag, "", "", %subfieldlist);
634                 $record->add_fields($field);
635         }
636         return $record;
637 }
638 sub MARCgetitem {
639 # Returns MARC::Record of the biblio passed in parameter.
640     my ($dbh,$bibid,$itemnumber)=@_;
641     my $record = MARC::Record->new();
642 # search MARC tagorder
643     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=?");
644     $sth2->execute($bibid,$itemnumber);
645     my ($tagorder) = $sth2->fetchrow_array();
646 #---- TODO : the leader is missing
647     my $sth=$dbh->prepare("select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
648                                  from marc_subfield_table
649                                  where bibid=? and tagorder=? order by subfieldcode,subfieldorder
650                          ");
651         $sth2=$dbh->prepare("select subfieldvalue from marc_blob_subfield where blobidlink=?");
652         $sth->execute($bibid,$tagorder);
653         while (my $row=$sth->fetchrow_hashref) {
654         if ($row->{'valuebloblink'}) { #---- search blob if there is one
655                 $sth2->execute($row->{'valuebloblink'});
656                 my $row2=$sth2->fetchrow_hashref;
657                 $sth2->finish;
658                 $row->{'subfieldvalue'}=$row2->{'subfieldvalue'};
659         }
660         if ($record->field($row->{'tag'})) {
661             my $field;
662 #--- this test must stay as this, because of strange behaviour of mySQL/Perl DBI with char var containing a number...
663 #--- sometimes, eliminates 0 at beginning, sometimes no ;-\\\
664             if (length($row->{'tag'}) <3) {
665                 $row->{'tag'} = "0".$row->{'tag'};
666             }
667             $field =$record->field($row->{'tag'});
668             if ($field) {
669                 my $x = $field->add_subfields($row->{'subfieldcode'},$row->{'subfieldvalue'});
670                 $record->delete_field($field);
671                 $record->add_fields($field);
672             }
673         } else {
674             if (length($row->{'tag'}) < 3) {
675                 $row->{'tag'} = "0".$row->{'tag'};
676             }
677             my $temp = MARC::Field->new($row->{'tag'}," "," ", $row->{'subfieldcode'} => $row->{'subfieldvalue'});
678             $record->add_fields($temp);
679         }
680
681     }
682     return $record;
683 }
684
685 sub MARCmodbiblio {
686         my ($dbh,$bibid,$record,$delete)=@_;
687         my $oldrecord=&MARCgetbiblio($dbh,$bibid);
688         if ($oldrecord eq $record) {
689                 return;
690         }
691         # otherwise, skip through each subfield...
692         my @fields = $record->fields();
693         my $tagorder=0;
694         foreach my $field (@fields) {
695                 my $oldfield = $oldrecord->field($field->tag());
696                 my @subfields=$field->subfields();
697                 my $subfieldorder=0;
698                 $tagorder++;
699                 if ($field->tag() <10) {
700                                 if ($oldfield eq 0 or (! $oldfield->data()) ) {
701                                         &MARCaddsubfield($dbh,$bibid,$field->tag(),'',
702                                                         1,'@',1,$field->data());
703                                 } else {
704                                                 my $subfieldid=&MARCfindsubfieldid($dbh,$bibid,$field->tag(),$tagorder,'@',$subfieldorder);
705                                                 &MARCmodsubfield($dbh,$subfieldid,$field->data());
706                                 }
707                 } else {
708                         foreach my $subfield (@subfields) {
709                                 $subfieldorder++;
710                                 if ($oldfield eq 0 or (! $oldfield->subfield(@$subfield[0])) ) {
711                         # just adding datas...
712                                         &MARCaddsubfield($dbh,$bibid,$field->tag(),$field->indicator(1).$field->indicator(2),
713                                                         1,@$subfield[0],$subfieldorder,@$subfield[1]);
714                                 } else {
715                 # modify the subfield if it's a different string
716                                         if ($oldfield->subfield(@$subfield[0]) ne @$subfield[1] ) {
717                                                 my $subfieldid=&MARCfindsubfieldid($dbh,$bibid,$field->tag(),$tagorder,@$subfield[0],$subfieldorder);
718                                                 &MARCmodsubfield($dbh,$subfieldid,@$subfield[1]);
719                                         }
720                                 }
721                         }
722                 }
723         }
724 }
725 sub MARCmoditem {
726         my ($dbh,$record,$bibid,$itemnumber,$delete)=@_;
727         my $oldrecord=&MARCgetitem($dbh,$bibid,$itemnumber);
728         # if nothing to change, don't waste time...
729         if ($oldrecord eq $record) {
730 #               warn "nothing to change";
731                 return;
732         }
733 #       warn "MARCmoditem : ".$record->as_formatted;
734 #       warn "OLD : ".$oldrecord->as_formatted;
735
736         # otherwise, skip through each subfield...
737         my @fields = $record->fields();
738         # search old MARC item
739         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=?");
740         $sth2->execute($bibid,$itemnumber);
741         my ($tagorder) = $sth2->fetchrow_array();
742         foreach my $field (@fields) {
743                 my $oldfield = $oldrecord->field($field->tag());
744                 my @subfields=$field->subfields();
745                 my $subfieldorder=0;
746                 foreach my $subfield (@subfields) {
747                         $subfieldorder++;
748 #                       warn "compare : $oldfield".$oldfield->subfield(@$subfield[0]);
749                         if ($oldfield eq 0 or (length($oldfield->subfield(@$subfield[0])) ==0) ) {
750                 # just adding datas...
751 #               warn "addfield : / $subfieldorder / @$subfield[0] - @$subfield[1]";
752 #                               warn "NEW subfield : $bibid,".$field->tag().",".$tagorder.",".@$subfield[0].",".$subfieldorder.",".@$subfield[1].")";
753                                 &MARCaddsubfield($dbh,$bibid,$field->tag(),$field->indicator(1).$field->indicator(2),
754                                                 $tagorder,@$subfield[0],$subfieldorder,@$subfield[1]);
755                         } else {
756 #               warn "modfield : / $subfieldorder / @$subfield[0] - @$subfield[1]";
757                 # modify he subfield if it's a different string
758                                 if ($oldfield->subfield(@$subfield[0]) ne @$subfield[1] ) {
759                                         my $subfieldid=&MARCfindsubfieldid($dbh,$bibid,$field->tag(),$tagorder,@$subfield[0],$subfieldorder);
760 #                                       warn "changing : $subfieldid, $bibid,".$field->tag(),",$tagorder,@$subfield[0],@$subfield[1],$subfieldorder";
761                                         &MARCmodsubfield($dbh,$subfieldid,@$subfield[1]);
762                                 }
763                         }
764                 }
765         }
766 }
767
768
769 sub MARCmodsubfield {
770 # Subroutine changes a subfield value given a subfieldid.
771     my ($dbh, $subfieldid, $subfieldvalue )=@_;
772     $dbh->do("lock tables marc_blob_subfield WRITE,marc_subfield_table WRITE");
773     my $sth1=$dbh->prepare("select valuebloblink from marc_subfield_table where subfieldid=?");
774     $sth1->execute($subfieldid);
775     my ($oldvaluebloblink)=$sth1->fetchrow;
776     $sth1->finish;
777     my $sth;
778     # if too long, use a bloblink
779     if (length($subfieldvalue)>255 ) {
780         # if already a bloblink, update it, otherwise, insert a new one.
781         if ($oldvaluebloblink) {
782             $sth=$dbh->prepare("update marc_blob_subfield set subfieldvalue=? where blobidlink=?");
783             $sth->execute($subfieldvalue,$oldvaluebloblink);
784         } else {
785             $sth=$dbh->prepare("insert into marc_blob_subfield (subfieldvalue) values (?)");
786             $sth->execute($subfieldvalue);
787             $sth=$dbh->prepare("select max(blobidlink) from marc_blob_subfield");
788             $sth->execute;
789             my ($res)=$sth->fetchrow;
790             $sth=$dbh->prepare("update marc_subfield_table set subfieldvalue=null, valuebloblink=$res where subfieldid=?");
791             $sth->execute($subfieldid);
792         }
793     } else {
794         # note this can leave orphan bloblink. Not a big problem, but we should build somewhere a orphan deleting script...
795         $sth=$dbh->prepare("update marc_subfield_table set subfieldvalue=?,valuebloblink=null where subfieldid=?");
796         $sth->execute($subfieldvalue, $subfieldid);
797     }
798     $dbh->do("unlock tables");
799     $sth->finish;
800     $sth=$dbh->prepare("select bibid,tag,tagorder,subfieldcode,subfieldid,subfieldorder from marc_subfield_table where subfieldid=?");
801     $sth->execute($subfieldid);
802     my ($bibid,$tagid,$tagorder,$subfieldcode,$x,$subfieldorder) = $sth->fetchrow;
803     $subfieldid=$x;
804     &MARCdelword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder);
805     &MARCaddword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
806     return($subfieldid, $subfieldvalue);
807 }
808
809 sub MARCfindsubfield {
810     my ($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue) = @_;
811     my $resultcounter=0;
812     my $subfieldid;
813     my $lastsubfieldid;
814     my $query="select subfieldid from marc_subfield_table where bibid=? and tag=? and subfieldcode=?";
815     if ($subfieldvalue) {
816         $query .= " and subfieldvalue=".$dbh->quote($subfieldvalue);
817     } else {
818         if ($subfieldorder<1) {
819             $subfieldorder=1;
820         }
821         $query .= " and subfieldorder=$subfieldorder";
822     }
823     my $sti=$dbh->prepare($query);
824     $sti->execute($bibid,$tag, $subfieldcode);
825     while (($subfieldid) = $sti->fetchrow) {
826         $resultcounter++;
827         $lastsubfieldid=$subfieldid;
828     }
829     if ($resultcounter>1) {
830         # Error condition.  Values given did not resolve into a unique record.  Don't know what to edit
831         # should rarely occur (only if we use subfieldvalue with a value that exists twice, which is strange)
832         return -1;
833     } else {
834         return $lastsubfieldid;
835     }
836 }
837
838 sub MARCfindsubfieldid {
839         my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
840         my $sth=$dbh->prepare("select subfieldid from marc_subfield_table
841                                 where bibid=? and tag=? and tagorder=?
842                                         and subfieldcode=? and subfieldorder=?");
843         $sth->execute($bibid,$tag,$tagorder,$subfield,$subfieldorder);
844         my ($res) = $sth->fetchrow;
845         unless ($res) {
846                 $sth=$dbh->prepare("select subfieldid from marc_subfield_table
847                                 where bibid=? and tag=? and tagorder=?
848                                         and subfieldcode=?");
849                 $sth->execute($bibid,$tag,$tagorder,$subfield);
850                 ($res) = $sth->fetchrow;
851         }
852     return $res;
853 }
854
855 sub MARCdelsubfield {
856 # delete a subfield for $bibid / tag / tagorder / subfield / subfieldorder
857     my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
858     $dbh->do("delete from marc_subfield_table where bibid='$bibid' and
859                         tag='$tag' and tagorder='$tagorder'
860                         and subfieldcode='$subfield' and subfieldorder='$subfieldorder
861                         ");
862 }
863
864 sub MARCdelbiblio {
865 # delete a biblio for a $bibid
866     my ($dbh,$bibid) = @_;
867     $dbh->do("delete from marc_subfield_table where bibid='$bibid'");
868     $dbh->do("delete from marc_biblio where bibid='$bibid'");
869 }
870
871 sub MARCkoha2marcBiblio {
872 # this function builds partial MARC::Record from the old koha-DB fields
873     my ($dbh,$biblionumber,$biblioitemnumber) = @_;
874     my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
875     my $record = MARC::Record->new();
876 #--- if bibid, then retrieve old-style koha data
877     if ($biblionumber>0) {
878         my $sth2=$dbh->prepare("select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp
879                 from biblio where biblionumber=?");
880         $sth2->execute($biblionumber);
881         my $row=$sth2->fetchrow_hashref;
882         my $code;
883         foreach $code (keys %$row) {
884             if ($row->{$code}) {
885                 &MARCkoha2marcOnefield($sth,$record,"biblio.".$code,$row->{$code});
886             }
887         }
888     }
889 #--- if biblioitem, then retrieve old-style koha data
890     if ($biblioitemnumber>0) {
891         my $sth2=$dbh->prepare(" SELECT biblioitemnumber,biblionumber,volume,number,classification,
892                                                 itemtype,url,isbn,issn,dewey,subclass,publicationyear,publishercode,
893                                                 volumedate,volumeddesc,timestamp,illus,pages,notes,size,place
894                                         FROM biblioitems
895                                         WHERE biblionumber=? and biblioitemnumber=?
896                                         ");
897         $sth2->execute($biblionumber,$biblioitemnumber);
898         my $row=$sth2->fetchrow_hashref;
899         my $code;
900         foreach $code (keys %$row) {
901             if ($row->{$code}) {
902                 &MARCkoha2marcOnefield($sth,$record,"biblioitems.".$code,$row->{$code});
903             }
904         }
905     }
906     return $record;
907 # TODO : retrieve notes, additionalauthors
908 }
909
910 sub MARCkoha2marcItem {
911 # this function builds partial MARC::Record from the old koha-DB fields
912     my ($dbh,$biblionumber,$itemnumber) = @_;
913 #    my $dbh=&C4Connect;
914     my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
915     my $record = MARC::Record->new();
916 #--- if item, then retrieve old-style koha data
917     if ($itemnumber>0) {
918 #       print STDERR "prepare $biblionumber,$itemnumber\n";
919         my $sth2=$dbh->prepare("SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned,
920                                                 booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
921                                                 datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,bulk,issues,renewals,
922                                         reserves,restricted,binding,itemnotes,holdingbranch,timestamp
923                                         FROM items
924                                         WHERE itemnumber=?");
925         $sth2->execute($itemnumber);
926         my $row=$sth2->fetchrow_hashref;
927         my $code;
928         foreach $code (keys %$row) {
929             if ($row->{$code}) {
930                 &MARCkoha2marcOnefield($sth,$record,"items.".$code,$row->{$code});
931             }
932         }
933     }
934     return $record;
935 # TODO : retrieve notes, additionalauthors
936 }
937
938 sub MARCkoha2marcSubtitle {
939 # this function builds partial MARC::Record from the old koha-DB fields
940     my ($dbh,$bibnum,$subtitle) = @_;
941     my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
942     my $record = MARC::Record->new();
943     &MARCkoha2marcOnefield($sth,$record,"bibliosubtitle.subtitle",$subtitle);
944     return $record;
945 }
946
947 sub MARCkoha2marcOnefield {
948     my ($sth,$record,$kohafieldname,$value)=@_;
949     my $tagfield;
950     my $tagsubfield;
951     $sth->execute($kohafieldname);
952     if (($tagfield,$tagsubfield)=$sth->fetchrow) {
953         if ($record->field($tagfield)) {
954             my $tag =$record->field($tagfield);
955             if ($tag) {
956                 $tag->add_subfields($tagsubfield,$value);
957                 $record->delete_field($tag);
958                 $record->add_fields($tag);
959             }
960         } else {
961             $record->add_fields($tagfield," "," ",$tagsubfield => $value);
962         }
963     }
964     return $record;
965 }
966
967 sub MARChtml2marc {
968         my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
969         my $prevtag = @$rtags[0];
970         my $record = MARC::Record->new();
971         my %subfieldlist={};
972         for (my $i=0; $i< @$rtags; $i++) {
973                 # rebuild MARC::Record
974                 if (@$rtags[$i] ne $prevtag) {
975 #                       if ($prevtag<10) {
976 #                               $prevtag='0'.10;
977 #                       }
978                         $indicators{$prevtag}.='  ';
979                         if ($prevtag < 10) {
980                                 $record->add_fields((sprintf "%03s",$prevtag),%subfieldlist->{'@'});
981                         } else {
982                                 my $field = MARC::Field->new( (sprintf "%03s",$prevtag), substr($indicators{$prevtag},0,1),substr($indicators{$prevtag},1,1), %subfieldlist);
983                                 $record->add_fields($field);
984                         }
985                         $prevtag = @$rtags[$i];
986                         %subfieldlist={};
987                         %subfieldlist->{@$rsubfields[$i]} = @$rvalues[$i];
988                 } else {
989                         if (%subfieldlist->{@$rsubfields[$i]}) {
990                                 %subfieldlist->{@$rsubfields[$i]} .= '|';
991                         }
992                         %subfieldlist->{@$rsubfields[$i]} .=@$rvalues[$i];
993                         $prevtag= @$rtags[$i];
994                 }
995         }
996         # the last has not been included inside the loop... do it now !
997         my $field = MARC::Field->new( $prevtag, "", "", %subfieldlist);
998         $record->add_fields($field);
999         return $record;
1000 }
1001
1002 sub MARCmarc2koha {
1003         my ($dbh,$record) = @_;
1004         my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
1005         my $result;
1006         my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
1007         $sth2->execute;
1008         my $field;
1009         #    print STDERR $record->as_formatted;
1010         while (($field)=$sth2->fetchrow) {
1011                 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result);
1012         }
1013         $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
1014         $sth2->execute;
1015         while (($field)=$sth2->fetchrow) {
1016                 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result);
1017         }
1018         $sth2=$dbh->prepare("SHOW COLUMNS from items");
1019         $sth2->execute;
1020         while (($field)=$sth2->fetchrow) {
1021                 $result = &MARCmarc2kohaOneField($sth,"items",$field,$record,$result);
1022         }
1023         # additional authors : specific
1024         $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result);
1025         return $result;
1026 }
1027
1028 sub MARCmarc2kohaOneField {
1029 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
1030         my ($sth,$kohatable,$kohafield,$record,$result)= @_;
1031 #    warn "kohatable / $kohafield / $result / ";
1032         my $res="";
1033         my $tagfield;
1034         my $subfield;
1035         $sth->execute($kohatable.".".$kohafield);
1036         ($tagfield,$subfield) = $sth->fetchrow;
1037         foreach my $field ($record->field($tagfield)) {
1038                 if ($field->subfield($subfield)) {
1039                 if ($result->{$kohafield}) {
1040                         $result->{$kohafield} .= " | ".$field->subfield($subfield);
1041                 } else {
1042                         $result->{$kohafield}=$field->subfield($subfield);
1043                 }
1044                 }
1045         }
1046         return $result;
1047 }
1048
1049 sub MARCaddword {
1050 # split a subfield string and adds it into the word table.
1051 # removes stopwords
1052     my ($dbh,$bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$sentence) =@_;
1053     $sentence =~ s/(\.|\?|\:|\!|\'|,|\-)/ /g;
1054     my @words = split / /,$sentence;
1055     my $stopwords= C4::Context->stopwords;
1056     my $sth=$dbh->prepare("insert into marc_word (bibid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word)
1057                         values (?,?,?,?,?,?,soundex(?))");
1058     foreach my $word (@words) {
1059 # we record only words longer than 2 car and not in stopwords hash
1060         if (length($word)>1 and !($stopwords->{uc($word)})) {
1061             $sth->execute($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,$word);
1062             if ($sth->err()) {
1063                 print STDERR "ERROR ==> insert into marc_word (bibid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word) values ($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,soundex($word))\n";
1064             }
1065         }
1066     }
1067 }
1068
1069 sub MARCdelword {
1070 # delete words. this sub deletes all the words from a sentence. a subfield modif is done by a delete then a add
1071     my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
1072     my $sth=$dbh->prepare("delete from marc_word where bibid=? and tag=? and tagorder=? and subfieldid=? and subfieldorder=?");
1073     $sth->execute($bibid,$tag,$tagorder,$subfield,$subfieldorder);
1074 }
1075
1076 #
1077 #
1078 # NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW
1079 #
1080 #
1081 # all the following subs are useful to manage MARC-DB with complete MARC records.
1082 # it's used with marcimport, and marc management tools
1083 #
1084
1085
1086 =item (oldbibnum,$oldbibitemnum) = NEWnewbibilio($dbh,$MARCRecord,$oldbiblio,$oldbiblioitem);
1087
1088 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
1089 are builded from the MARC::Record. If they are passed, they are used.
1090
1091 =item NEWnewitem($dbh,$olditem);
1092
1093 adds an item in the db. $olditem is a old-db hash.
1094
1095 =cut
1096
1097 sub NEWnewbiblio {
1098     my ($dbh, $record, $oldbiblio, $oldbiblioitem) = @_;
1099 # note $oldbiblio and $oldbiblioitem are not mandatory.
1100 # if not present, they will be builded from $record with MARCmarc2koha function
1101     if (($oldbiblio) and not($oldbiblioitem)) {
1102         print STDERR "NEWnewbiblio : missing parameter\n";
1103         print "NEWnewbiblio : missing parameter : contact koha development  team\n";
1104         die;
1105     }
1106     my $oldbibnum;
1107     my $oldbibitemnum;
1108     if ($oldbiblio) {
1109         $oldbibnum = OLDnewbiblio($dbh,$oldbiblio);
1110         $oldbiblioitem->{'biblionumber'} = $oldbibnum;
1111         $oldbibitemnum = OLDnewbiblioitem($dbh,$oldbiblioitem);
1112     } else {
1113         my $olddata = MARCmarc2koha($dbh,$record);
1114         $oldbibnum = OLDnewbiblio($dbh,$olddata);
1115         $olddata->{'biblionumber'} = $oldbibnum;
1116         $oldbibitemnum = OLDnewbiblioitem($dbh,$olddata);
1117     }
1118 # we must add bibnum and bibitemnum in MARC::Record...
1119 # we build the new field with biblionumber and biblioitemnumber
1120 # we drop the original field
1121 # we add the new builded field.
1122 # NOTE : Works only if the field is ONLY for biblionumber and biblioitemnumber
1123 # (steve and paul : thinks 090 is a good choice)
1124     my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
1125     $sth->execute("biblio.biblionumber");
1126     (my $tagfield1, my $tagsubfield1) = $sth->fetchrow;
1127     $sth->execute("biblioitems.biblioitemnumber");
1128     (my $tagfield2, my $tagsubfield2) = $sth->fetchrow;
1129     if ($tagfield1 != $tagfield2) {
1130         print STDERR "Error in NEWnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number";
1131         print "Content-Type: text/html\n\nError in NEWnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number";
1132         die;
1133     }
1134     my $newfield = MARC::Field->new( $tagfield1,'','',
1135                                      "$tagsubfield1" => $oldbibnum,
1136                                      "$tagsubfield2" => $oldbibitemnum);
1137 # drop old field and create new one...
1138     my $old_field = $record->field($tagfield1);
1139     $record->delete_field($old_field);
1140     $record->add_fields($newfield);
1141     my $bibid = MARCaddbiblio($dbh,$record,$oldbibnum);
1142     return ($bibid,$oldbibnum,$oldbibitemnum );
1143 }
1144
1145 sub NEWmodbiblio {
1146 my ($dbh,$record,$bibid) =@_;
1147 &MARCmodbiblio($dbh,$bibid,$record,0);
1148 my $oldbiblio = MARCmarc2koha($dbh,$record);
1149 my $oldbiblionumber = OLDmodbiblio($dbh,$oldbiblio);
1150 OLDmodbibitem($dbh,$oldbiblio);
1151 return 1;
1152 }
1153
1154
1155 sub NEWnewitem {
1156         my ($dbh, $record,$bibid) = @_;
1157         # add item in old-DB
1158         my $item = &MARCmarc2koha($dbh,$record);
1159         # needs old biblionumber and biblioitemnumber
1160         $item->{'biblionumber'} = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
1161         my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
1162         $sth->execute($item->{'biblionumber'});
1163         ($item->{'biblioitemnumber'}) = $sth->fetchrow;
1164         my ($itemnumber,$error) = &OLDnewitems($dbh,$item,$item->{barcode});
1165         # add itemnumber to MARC::Record before adding the item.
1166         my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
1167         &MARCkoha2marcOnefield($sth,$record,"items.itemnumber",$itemnumber);
1168         # add the item
1169         my $bib = &MARCadditem($dbh,$record,$item->{'biblionumber'});
1170 }
1171
1172 sub NEWmoditem {
1173         my ($dbh,$record,$bibid,$itemnumber,$delete) = @_;
1174         &MARCmoditem($dbh,$record,$bibid,$itemnumber,$delete);
1175         my $olditem = MARCmarc2koha($dbh,$record);
1176         OLDmoditem($dbh,$olditem);
1177 }
1178
1179 #
1180 #
1181 # OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD
1182 #
1183 #
1184
1185 =item $biblionumber = OLDnewbiblio($dbh,$biblio);
1186
1187 adds a record in biblio table. Datas are in the hash $biblio.
1188
1189 =item $biblionumber = OLDmodbiblio($dbh,$biblio);
1190
1191 modify a record in biblio table. Datas are in the hash $biblio.
1192
1193 =item OLDmodsubtitle($dbh,$bibnum,$subtitle);
1194
1195 modify subtitles in bibliosubtitle table.
1196
1197 =item OLDmodaddauthor($dbh,$bibnum,$author);
1198
1199 adds or modify additional authors
1200 NOTE :  Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
1201
1202 =item $errors = OLDmodsubject($dbh,$bibnum, $force, @subject);
1203
1204 modify/adds subjects
1205
1206 =item OLDmodbibitem($dbh, $biblioitem);
1207
1208 modify a biblioitem
1209
1210 =item OLDmodnote($dbh,$bibitemnum,$note
1211
1212 modify a note for a biblioitem
1213
1214 =item OLDnewbiblioitem($dbh,$biblioitem);
1215
1216 adds a biblioitem ($biblioitem is a hash with the values)
1217
1218 =item OLDnewsubject($dbh,$bibnum);
1219
1220 adds a subject
1221
1222 =item OLDnewsubtitle($dbh,$bibnum,$subtitle);
1223
1224 create a new subtitle
1225
1226 =item ($itemnumber,$errors)= OLDnewitems($dbh,$item,$barcode);
1227
1228 create a item. $item is a hash and $barcode the barcode.
1229
1230 =item OLDmoditem($dbh,$item);
1231
1232 modify item
1233
1234 =item OLDdelitem($dbh,$itemnum);
1235
1236 delete item
1237
1238 =item OLDdeletebiblioitem($dbh,$biblioitemnumber);
1239
1240 deletes a biblioitem
1241 NOTE : not standard sub name. Should be OLDdelbiblioitem()
1242
1243 =item OLDdelbiblio($dbh,$biblio);
1244
1245 delete a biblio
1246
1247 =cut
1248
1249 sub OLDnewbiblio {
1250   my ($dbh,$biblio) = @_;
1251 #  my $dbh    = &C4Connect;
1252   my $query  = "Select max(biblionumber) from biblio";
1253   my $sth    = $dbh->prepare($query);
1254   $sth->execute;
1255   my $data   = $sth->fetchrow_arrayref;
1256   my $bibnum = $$data[0] + 1;
1257   my $series = 0;
1258
1259   if ($biblio->{'seriestitle'}) { $series = 1 };
1260   $sth->finish;
1261   $query = "insert into biblio set biblionumber  = ?, title         = ?, author        = ?, copyrightdate = ?,
1262                                                                         serial        = ?, seriestitle   = ?, notes         = ?, abstract      = ?";
1263   $sth = $dbh->prepare($query);
1264   $sth->execute($bibnum,$biblio->{'title'},$biblio->{'author'},$biblio->{'copyright'},$series,$biblio->{'seriestitle'},$biblio->{'notes'},$biblio->{'abstract'});
1265
1266   $sth->finish;
1267 #  $dbh->disconnect;
1268   return($bibnum);
1269 }
1270
1271 sub OLDmodbiblio {
1272         my ($dbh,$biblio) = @_;
1273         #  my $dbh   = C4Connect;
1274         my $query;
1275         my $sth;
1276
1277         $query = "Update biblio set title         = ?, author        = ?, abstract      = ?, copyrightdate = ?,
1278                                         seriestitle   = ?, serial        = ?, unititle      = ?, notes         = ? where biblionumber = ?";
1279         $sth   = $dbh->prepare($query);
1280         $sth->execute($biblio->{'title'},$biblio->{'author'},$biblio->{'abstract'},$biblio->{'copyrightdate'},
1281                                                 $biblio->{'seriestitle'},$biblio->{'serial'},$biblio->{'unititle'},$biblio->{'notes'},$biblio->{'biblionumber'});
1282
1283         $sth->finish;
1284         return($biblio->{'biblionumber'});
1285 } # sub modbiblio
1286
1287 sub OLDmodsubtitle {
1288         my ($dbh,$bibnum, $subtitle) = @_;
1289         my $query = "update bibliosubtitle set subtitle = ? where biblionumber = ?";
1290         my $sth   = $dbh->prepare($query);
1291         $sth->execute($subtitle,$bibnum);
1292         $sth->finish;
1293 } # sub modsubtitle
1294
1295
1296 sub OLDmodaddauthor {
1297     my ($dbh,$bibnum, $author) = @_;
1298 #    my $dbh   = C4Connect;
1299     my $query = "Delete from additionalauthors where biblionumber = $bibnum";
1300     my $sth = $dbh->prepare($query);
1301
1302     $sth->execute;
1303     $sth->finish;
1304
1305     if ($author ne '') {
1306         $query = "Insert into additionalauthors set
1307                         author       = ?,
1308                         biblionumber = ?";
1309         $sth   = $dbh->prepare($query);
1310
1311         $sth->execute($author,$bibnum);
1312
1313         $sth->finish;
1314     } # if
1315 } # sub modaddauthor
1316
1317
1318 sub OLDmodsubject {
1319     my ($dbh,$bibnum, $force, @subject) = @_;
1320 #  my $dbh   = C4Connect;
1321     my $count = @subject;
1322     my $error;
1323     for (my $i = 0; $i < $count; $i++) {
1324         $subject[$i] =~ s/^ //g;
1325         $subject[$i] =~ s/ $//g;
1326         my $query = "select * from catalogueentry
1327                         where entrytype = 's'
1328                                 and catalogueentry = '$subject[$i]'";
1329         my $sth   = $dbh->prepare($query);
1330         $sth->execute;
1331
1332         if (my $data = $sth->fetchrow_hashref) {
1333         } else {
1334             if ($force eq $subject[$i]) {
1335                 # subject not in aut, chosen to force anway
1336                 # so insert into cataloguentry so its in auth file
1337                 $query = "Insert into catalogueentry
1338                                 (entrytype,catalogueentry)
1339                             values ('s','$subject[$i]')";
1340          my $sth2 = $dbh->prepare($query);
1341
1342          $sth2->execute;
1343          $sth2->finish;
1344       } else {
1345         $error = "$subject[$i]\n does not exist in the subject authority file";
1346         $query = "Select * from catalogueentry
1347                             where entrytype = 's'
1348                             and (catalogueentry like '$subject[$i] %'
1349                                  or catalogueentry like '% $subject[$i] %'
1350                                  or catalogueentry like '% $subject[$i]')";
1351         my $sth2 = $dbh->prepare($query);
1352
1353         $sth2->execute;
1354         while (my $data = $sth2->fetchrow_hashref) {
1355           $error .= "<br>$data->{'catalogueentry'}";
1356         } # while
1357         $sth2->finish;
1358       } # else
1359     } # else
1360     $sth->finish;
1361   } # else
1362   if ($error eq '') {
1363     my $query = "Delete from bibliosubject where biblionumber = $bibnum";
1364     my $sth   = $dbh->prepare($query);
1365     $sth->execute;
1366     $sth->finish;
1367     for (my $i = 0; $i < $count; $i++) {
1368       $sth = $dbh->prepare("Insert into bibliosubject
1369                             values ('$subject[$i]', $bibnum)");
1370
1371       $sth->execute;
1372       $sth->finish;
1373     } # for
1374   } # if
1375
1376 #  $dbh->disconnect;
1377   return($error);
1378 } # sub modsubject
1379
1380 sub OLDmodbibitem {
1381     my ($dbh,$biblioitem) = @_;
1382 #    my $dbh   = C4Connect;
1383     my $query;
1384
1385     $biblioitem->{'itemtype'}        = $dbh->quote($biblioitem->{'itemtype'});
1386     $biblioitem->{'url'}             = $dbh->quote($biblioitem->{'url'});
1387     $biblioitem->{'isbn'}            = $dbh->quote($biblioitem->{'isbn'});
1388     $biblioitem->{'publishercode'}   = $dbh->quote($biblioitem->{'publishercode'});
1389     $biblioitem->{'publicationyear'} = $dbh->quote($biblioitem->{'publicationyear'});
1390     $biblioitem->{'classification'}  = $dbh->quote($biblioitem->{'classification'});
1391     $biblioitem->{'dewey'}           = $dbh->quote($biblioitem->{'dewey'});
1392     $biblioitem->{'subclass'}        = $dbh->quote($biblioitem->{'subclass'});
1393     $biblioitem->{'illus'}           = $dbh->quote($biblioitem->{'illus'});
1394     $biblioitem->{'pages'}           = $dbh->quote($biblioitem->{'pages'});
1395     $biblioitem->{'volumeddesc'}     = $dbh->quote($biblioitem->{'volumeddesc'});
1396     $biblioitem->{'notes'}           = $dbh->quote($biblioitem->{'notes'});
1397     $biblioitem->{'size'}            = $dbh->quote($biblioitem->{'size'});
1398     $biblioitem->{'place'}           = $dbh->quote($biblioitem->{'place'});
1399
1400     $query = "Update biblioitems set
1401 itemtype        = $biblioitem->{'itemtype'},
1402 url             = $biblioitem->{'url'},
1403 isbn            = $biblioitem->{'isbn'},
1404 publishercode   = $biblioitem->{'publishercode'},
1405 publicationyear = $biblioitem->{'publicationyear'},
1406 classification  = $biblioitem->{'classification'},
1407 dewey           = $biblioitem->{'dewey'},
1408 subclass        = $biblioitem->{'subclass'},
1409 illus           = $biblioitem->{'illus'},
1410 pages           = $biblioitem->{'pages'},
1411 volumeddesc     = $biblioitem->{'volumeddesc'},
1412 notes           = $biblioitem->{'notes'},
1413 size            = $biblioitem->{'size'},
1414 place           = $biblioitem->{'place'}
1415 where biblioitemnumber = $biblioitem->{'biblioitemnumber'}";
1416
1417     $dbh->do($query);
1418
1419 #    $dbh->disconnect;
1420 } # sub modbibitem
1421
1422 sub OLDmodnote {
1423   my ($dbh,$bibitemnum,$note)=@_;
1424 #  my $dbh=C4Connect;
1425   my $query="update biblioitems set notes='$note' where
1426   biblioitemnumber='$bibitemnum'";
1427   my $sth=$dbh->prepare($query);
1428   $sth->execute;
1429   $sth->finish;
1430 #  $dbh->disconnect;
1431 }
1432
1433 sub OLDnewbiblioitem {
1434         my ($dbh,$biblioitem) = @_;
1435         #  my $dbh   = C4Connect;
1436         my $query = "Select max(biblioitemnumber) from biblioitems";
1437         my $sth   = $dbh->prepare($query);
1438         my $data;
1439         my $bibitemnum;
1440
1441         $sth->execute;
1442         $data       = $sth->fetchrow_arrayref;
1443         $bibitemnum = $$data[0] + 1;
1444
1445         $sth->finish;
1446
1447         $sth = $dbh->prepare("insert into biblioitems set
1448                                                                         biblioitemnumber = ?,           biblionumber     = ?,
1449                                                                         volume           = ?,                   number           = ?,
1450                                                                         classification  = ?,                    itemtype         = ?,
1451                                                                         url              = ?,                           isbn             = ?,
1452                                                                         issn             = ?,                           dewey            = ?,
1453                                                                         subclass         = ?,                           publicationyear  = ?,
1454                                                                         publishercode    = ?,           volumedate       = ?,
1455                                                                         volumeddesc      = ?,           illus            = ?,
1456                                                                         pages            = ?,                           notes            = ?,
1457                                                                         size             = ?,                           lccn             = ?,
1458                                                                         marc             = ?,                           place            = ?");
1459         $sth->execute($bibitemnum,                                                      $biblioitem->{'biblionumber'},
1460                                                 $biblioitem->{'volume'},                        $biblioitem->{'number'},
1461                                                 $biblioitem->{'classification'},                $biblioitem->{'itemtype'},
1462                                                 $biblioitem->{'url'},                                   $biblioitem->{'isbn'},
1463                                                 $biblioitem->{'issn'},                          $biblioitem->{'dewey'},
1464                                                 $biblioitem->{'subclass'},                      $biblioitem->{'publicationyear'},
1465                                                 $biblioitem->{'publishercode'}, $biblioitem->{'volumedate'},
1466                                                 $biblioitem->{'volumeddesc'},           $biblioitem->{'illus'},
1467                                                 $biblioitem->{'pages'},                         $biblioitem->{'notes'},
1468                                                 $biblioitem->{'size'},                          $biblioitem->{'lccn'},
1469                                                 $biblioitem->{'marc'},                          $biblioitem->{'place'});
1470         $sth->finish;
1471         #    $dbh->disconnect;
1472         return($bibitemnum);
1473 }
1474
1475 sub OLDnewsubject {
1476   my ($dbh,$bibnum)=@_;
1477 #  my $dbh=C4Connect;
1478   my $query="insert into bibliosubject (biblionumber) values
1479   ($bibnum)";
1480   my $sth=$dbh->prepare($query);
1481 #  print $query;
1482   $sth->execute;
1483   $sth->finish;
1484 #  $dbh->disconnect;
1485 }
1486
1487 sub OLDnewsubtitle {
1488     my ($dbh,$bibnum, $subtitle) = @_;
1489 #  my $dbh   = C4Connect;
1490     my $query = "insert into bibliosubtitle set
1491                             biblionumber = ?,
1492                             subtitle = ?";
1493     my $sth   = $dbh->prepare($query);
1494
1495     $sth->execute($bibnum,$subtitle);
1496
1497     $sth->finish;
1498 #  $dbh->disconnect;
1499 }
1500
1501
1502 sub OLDnewitems {
1503         my ($dbh,$item, $barcode) = @_;
1504         #  my $dbh   = C4Connect;
1505         my $query = "Select max(itemnumber) from items";
1506         my $sth   = $dbh->prepare($query);
1507         my $data;
1508         my $itemnumber;
1509         my $error = "";
1510
1511         $sth->execute;
1512         $data       = $sth->fetchrow_hashref;
1513         $itemnumber = $data->{'max(itemnumber)'} + 1;
1514         $sth->finish;
1515
1516         $sth=$dbh->prepare("Insert into items set
1517                                                 itemnumber           = ?,                               biblionumber         = ?,
1518                                                 biblioitemnumber     = ?,                               barcode              = ?,
1519                                                 booksellerid         = ?,                                       dateaccessioned      = NOW(),
1520                                                 homebranch           = ?,                               holdingbranch        = ?,
1521                                                 price                = ?,                                               replacementprice     = ?,
1522                                                 replacementpricedate = NOW(),   itemnotes            = ?,
1523                                                 notforloan = ?
1524                                                 ");
1525         $sth->execute($itemnumber,      $item->{'biblionumber'},
1526                                                         $item->{'biblioitemnumber'},$barcode,
1527                                                         $item->{'booksellerid'},
1528                                                         $item->{'homebranch'},$item->{'homebranch'},
1529                                                         $item->{'price'},$item->{'replacementprice'},
1530                                                         $item->{'itemnotes'},$item->{'loan'});
1531         if (defined $sth->errstr) {
1532                 $error .= $sth->errstr;
1533         }
1534         $sth->finish;
1535         return($itemnumber,$error);
1536 }
1537
1538 sub OLDmoditem {
1539     my ($dbh,$item) = @_;
1540 #  my ($dbh,$loan,$itemnum,$bibitemnum,$barcode,$notes,$homebranch,$lost,$wthdrawn,$replacement)=@_;
1541 #  my $dbh=C4Connect;
1542 $item->{'itemnum'}=$item->{'itemnumber'} unless $item->{'itemnum'};
1543   my $query="update items set  barcode='$item->{'barcode'}',itemnotes='$item->{'notes'}'
1544                           where itemnumber=$item->{'itemnum'}";
1545   if ($item->{'barcode'} eq ''){
1546     $query="update items set notforloan=$item->{'loan'} where itemnumber=$item->{'itemnum'}";
1547   }
1548   if ($item->{'lost'} ne ''){
1549     $query="update items set biblioitemnumber=$item->{'bibitemnum'},
1550                              barcode='$item->{'barcode'}',
1551                              itemnotes='$item->{'notes'}',
1552                              homebranch='$item->{'homebranch'}',
1553                              itemlost='$item->{'lost'}',
1554                              wthdrawn='$item->{'wthdrawn'}'
1555                           where itemnumber=$item->{'itemnum'}";
1556   }
1557   if ($item->{'replacement'} ne ''){
1558     $query=~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1559   }
1560   my $sth=$dbh->prepare($query);
1561   $sth->execute;
1562   $sth->finish;
1563 #  $dbh->disconnect;
1564 }
1565
1566 sub OLDdelitem{
1567   my ($dbh,$itemnum)=@_;
1568 #  my $dbh=C4Connect;
1569   my $query="select * from items where itemnumber=$itemnum";
1570   my $sth=$dbh->prepare($query);
1571   $sth->execute;
1572   my @data=$sth->fetchrow_array;
1573   $sth->finish;
1574   $query="Insert into deleteditems values (";
1575   foreach my $temp (@data){
1576     $query .= "'$temp',";
1577   }
1578   $query=~ s/\,$/\)/;
1579 #  print $query;
1580   $sth=$dbh->prepare($query);
1581   $sth->execute;
1582   $sth->finish;
1583   $query = "Delete from items where itemnumber=$itemnum";
1584   $sth=$dbh->prepare($query);
1585   $sth->execute;
1586   $sth->finish;
1587 #  $dbh->disconnect;
1588 }
1589
1590 sub OLDdeletebiblioitem {
1591     my ($dbh,$biblioitemnumber) = @_;
1592 #    my $dbh   = C4Connect;
1593     my $query = "Select * from biblioitems
1594 where biblioitemnumber = $biblioitemnumber";
1595     my $sth   = $dbh->prepare($query);
1596     my @results;
1597
1598     $sth->execute;
1599
1600     if (@results = $sth->fetchrow_array) {
1601         $query = "Insert into deletedbiblioitems values (";
1602         foreach my $value (@results) {
1603             $value  = $dbh->quote($value);
1604             $query .= "$value,";
1605         } # foreach
1606
1607         $query =~ s/\,$/\)/;
1608         $dbh->do($query);
1609
1610         $query = "Delete from biblioitems
1611                         where biblioitemnumber = $biblioitemnumber";
1612         $dbh->do($query);
1613     } # if
1614     $sth->finish;
1615 # Now delete all the items attached to the biblioitem
1616     $query = "Select * from items where biblioitemnumber = $biblioitemnumber";
1617     $sth   = $dbh->prepare($query);
1618     $sth->execute;
1619     while (@results = $sth->fetchrow_array) {
1620         $query = "Insert into deleteditems values (";
1621         foreach my $value (@results) {
1622             $value  = $dbh->quote($value);
1623             $query .= "$value,";
1624         } # foreach
1625         $query =~ s/\,$/\)/;
1626         $dbh->do($query);
1627     } # while
1628     $sth->finish;
1629     $query = "Delete from items where biblioitemnumber = $biblioitemnumber";
1630     $dbh->do($query);
1631 #    $dbh->disconnect;
1632 } # sub deletebiblioitem
1633
1634 sub OLDdelbiblio{
1635   my ($dbh,$biblio)=@_;
1636 #  my $dbh=C4Connect;
1637   my $query="select * from biblio where biblionumber=$biblio";
1638   my $sth=$dbh->prepare($query);
1639   $sth->execute;
1640   if (my @data=$sth->fetchrow_array){
1641     $sth->finish;
1642     $query="Insert into deletedbiblio values (";
1643     foreach my $temp (@data){
1644       $temp=~ s/\'/\\\'/g;
1645       $query .= "'$temp',";
1646     }
1647     $query=~ s/\,$/\)/;
1648 #   print $query;
1649     $sth=$dbh->prepare($query);
1650     $sth->execute;
1651     $sth->finish;
1652     $query = "Delete from biblio where biblionumber=$biblio";
1653     $sth=$dbh->prepare($query);
1654     $sth->execute;
1655     $sth->finish;
1656   }
1657   $sth->finish;
1658 #  $dbh->disconnect;
1659 }
1660
1661 #
1662 #
1663 # old functions
1664 #
1665 #
1666
1667 sub itemcount{
1668   my ($biblio)=@_;
1669   my $dbh = C4::Context->dbh;
1670   my $query="Select count(*) from items where biblionumber=$biblio";
1671 #  print $query;
1672   my $sth=$dbh->prepare($query);
1673   $sth->execute;
1674   my $data=$sth->fetchrow_hashref;
1675   $sth->finish;
1676   return($data->{'count(*)'});
1677 }
1678
1679 =item getorder
1680
1681   ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
1682
1683 Looks up the order with the given biblionumber and biblioitemnumber.
1684
1685 Returns a two-element array. C<$ordernumber> is the order number.
1686 C<$order> is a reference-to-hash describing the order; its keys are
1687 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
1688 tables of the Koha database.
1689
1690 =cut
1691 #'
1692 # FIXME - This is effectively identical to &C4::Catalogue::getorder.
1693 # Pick one and stick with it.
1694 sub getorder{
1695   my ($bi,$bib)=@_;
1696   my $dbh = C4::Context->dbh;
1697   my $query="Select ordernumber
1698         from aqorders
1699         where biblionumber=? and biblioitemnumber=?";
1700   my $sth=$dbh->prepare($query);
1701   $sth->execute($bib,$bi);
1702   # FIXME - Use fetchrow_array(), since we're only interested in the one
1703   # value.
1704   my $ordnum=$sth->fetchrow_hashref;
1705   $sth->finish;
1706   my $order=getsingleorder($ordnum->{'ordernumber'});
1707 #  print $query;
1708   return ($order,$ordnum->{'ordernumber'});
1709 }
1710
1711 =item getsingleorder
1712
1713   $order = &getsingleorder($ordernumber);
1714
1715 Looks up an order by order number.
1716
1717 Returns a reference-to-hash describing the order. The keys of
1718 C<$order> are fields from the biblio, biblioitems, aqorders, and
1719 aqorderbreakdown tables of the Koha database.
1720
1721 =cut
1722 #'
1723 # FIXME - This is effectively identical to
1724 # &C4::Catalogue::getsingleorder.
1725 # Pick one and stick with it.
1726 sub getsingleorder {
1727   my ($ordnum)=@_;
1728   my $dbh = C4::Context->dbh;
1729   my $query="Select * from biblio,biblioitems,aqorders,aqorderbreakdown
1730   where aqorders.ordernumber=?
1731   and biblio.biblionumber=aqorders.biblionumber and
1732   biblioitems.biblioitemnumber=aqorders.biblioitemnumber and
1733   aqorders.ordernumber=aqorderbreakdown.ordernumber";
1734   my $sth=$dbh->prepare($query);
1735   $sth->execute($ordnum);
1736   my $data=$sth->fetchrow_hashref;
1737   $sth->finish;
1738   return($data);
1739 }
1740
1741 sub newbiblio {
1742   my ($biblio) = @_;
1743   my $dbh    = C4::Context->dbh;
1744   my $bibnum=OLDnewbiblio($dbh,$biblio);
1745 # FIXME : MARC add
1746   return($bibnum);
1747 }
1748
1749 =item modbiblio
1750
1751   $biblionumber = &modbiblio($biblio);
1752
1753 Update a biblio record.
1754
1755 C<$biblio> is a reference-to-hash whose keys are the fields in the
1756 biblio table in the Koha database. All fields must be present, not
1757 just the ones you wish to change.
1758
1759 C<&modbiblio> updates the record defined by
1760 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1761
1762 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1763 successful or not.
1764
1765 =cut
1766
1767 sub modbiblio {
1768   my ($biblio) = @_;
1769   my $dbh  = C4::Context->dbh;
1770   my $biblionumber=OLDmodbiblio($dbh,$biblio);
1771   return($biblionumber);
1772 # FIXME : MARC mod
1773 } # sub modbiblio
1774
1775 =item modsubtitle
1776
1777   &modsubtitle($biblionumber, $subtitle);
1778
1779 Sets the subtitle of a book.
1780
1781 C<$biblionumber> is the biblionumber of the book to modify.
1782
1783 C<$subtitle> is the new subtitle.
1784
1785 =cut
1786
1787 sub modsubtitle {
1788   my ($bibnum, $subtitle) = @_;
1789   my $dbh   = C4::Context->dbh;
1790   &OLDmodsubtitle($dbh,$bibnum,$subtitle);
1791 } # sub modsubtitle
1792
1793 =item modaddauthor
1794
1795   &modaddauthor($biblionumber, $author);
1796
1797 Replaces all additional authors for the book with biblio number
1798 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1799 C<&modaddauthor> deletes all additional authors.
1800
1801 =cut
1802
1803 sub modaddauthor {
1804     my ($bibnum, $author) = @_;
1805     my $dbh   = C4::Context->dbh;
1806     &OLDmodaddauthor($dbh,$bibnum,$author);
1807 } # sub modaddauthor
1808
1809 =item modsubject
1810
1811   $error = &modsubject($biblionumber, $force, @subjects);
1812
1813 $force - a subject to force
1814
1815 $error - Error message, or undef if successful.
1816
1817 =cut
1818
1819 sub modsubject {
1820   my ($bibnum, $force, @subject) = @_;
1821   my $dbh   = C4::Context->dbh;
1822   my $error= &OLDmodsubject($dbh,$bibnum,$force, @subject);
1823   return($error);
1824 } # sub modsubject
1825
1826 sub modbibitem {
1827     my ($biblioitem) = @_;
1828     my $dbh   = C4::Context->dbh;
1829     &OLDmodbibitem($dbh,$biblioitem);
1830     my $MARCbibitem = MARCkoha2marcBiblio($dbh,$biblioitem);
1831     &MARCmodbiblio($dbh,$biblioitem->{biblionumber},$MARCbibitem,0);
1832 } # sub modbibitem
1833
1834 sub modnote {
1835   my ($bibitemnum,$note)=@_;
1836   my $dbh = C4::Context->dbh;
1837   &OLDmodnote($dbh,$bibitemnum,$note);
1838 }
1839
1840 sub newbiblioitem {
1841   my ($biblioitem) = @_;
1842   my $dbh   = C4::Context->dbh;
1843   my $bibitemnum = &OLDnewbiblioitem($dbh,$biblioitem);
1844 #  print STDERR "bibitemnum : $bibitemnum\n";
1845   my $MARCbiblio= MARCkoha2marcBiblio($dbh,$biblioitem->{biblionumber},$bibitemnum);
1846 #  print STDERR $MARCbiblio->as_formatted();
1847   &MARCaddbiblio($dbh,$MARCbiblio,$biblioitem->{biblionumber});
1848   return($bibitemnum);
1849 }
1850
1851 sub newsubject {
1852   my ($bibnum)=@_;
1853   my $dbh = C4::Context->dbh;
1854   &OLDnewsubject($dbh,$bibnum);
1855 }
1856
1857 sub newsubtitle {
1858     my ($bibnum, $subtitle) = @_;
1859     my $dbh   = C4::Context->dbh;
1860     &OLDnewsubtitle($dbh,$bibnum,$subtitle);
1861 }
1862
1863 sub newitems {
1864   my ($item, @barcodes) = @_;
1865   my $dbh   = C4::Context->dbh;
1866   my $errors;
1867   my $itemnumber;
1868   my $error;
1869   foreach my $barcode (@barcodes) {
1870       ($itemnumber,$error)=&OLDnewitems($dbh,$item,uc($barcode));
1871       $errors .=$error;
1872       my $MARCitem = &MARCkoha2marcItem($dbh,$item->{biblionumber},$itemnumber);
1873       &MARCadditem($dbh,$MARCitem,$item->{biblionumber});
1874   }
1875   return($errors);
1876 }
1877
1878 sub moditem {
1879     my ($item) = @_;
1880     my $dbh = C4::Context->dbh;
1881     &OLDmoditem($dbh,$item);
1882     my $MARCitem = &MARCkoha2marcItem($dbh,$item->{'biblionumber'},$item->{'itemnum'});
1883     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$item->{biblionumber});
1884     &MARCmoditem($dbh,$MARCitem,$bibid,$item->{itemnum},0);
1885 }
1886
1887 sub checkitems{
1888   my ($count,@barcodes)=@_;
1889   my $dbh = C4::Context->dbh;
1890   my $error;
1891   for (my $i=0;$i<$count;$i++){
1892     $barcodes[$i]=uc $barcodes[$i];
1893     my $query="Select * from items where barcode='$barcodes[$i]'";
1894     my $sth=$dbh->prepare($query);
1895     $sth->execute;
1896     if (my $data=$sth->fetchrow_hashref){
1897       $error.=" Duplicate Barcode: $barcodes[$i]";
1898     }
1899     $sth->finish;
1900   }
1901   return($error);
1902 }
1903
1904 sub countitems{
1905   my ($bibitemnum)=@_;
1906   my $dbh = C4::Context->dbh;
1907   my $query="Select count(*) from items where biblioitemnumber='$bibitemnum'";
1908   my $sth=$dbh->prepare($query);
1909   $sth->execute;
1910   my $data=$sth->fetchrow_hashref;
1911   $sth->finish;
1912   return($data->{'count(*)'});
1913 }
1914
1915 sub delitem{
1916   my ($itemnum)=@_;
1917   my $dbh = C4::Context->dbh;
1918   &OLDdelitem($dbh,$itemnum);
1919 }
1920
1921 sub deletebiblioitem {
1922     my ($biblioitemnumber) = @_;
1923     my $dbh   = C4::Context->dbh;
1924     &OLDdeletebiblioitem($dbh,$biblioitemnumber);
1925 } # sub deletebiblioitem
1926
1927
1928 sub delbiblio {
1929   my ($biblio)=@_;
1930   my $dbh = C4::Context->dbh;
1931   &OLDdelbiblio($dbh,$biblio);
1932 }
1933
1934 sub getitemtypes {
1935   my $dbh   = C4::Context->dbh;
1936   my $query = "select * from itemtypes";
1937   my $sth   = $dbh->prepare($query);
1938     # || die "Cannot prepare $query" . $dbh->errstr;
1939   my $count = 0;
1940   my @results;
1941
1942   $sth->execute;
1943     # || die "Cannot execute $query\n" . $sth->errstr;
1944   while (my $data = $sth->fetchrow_hashref) {
1945     $results[$count] = $data;
1946     $count++;
1947   } # while
1948
1949   $sth->finish;
1950   return($count, @results);
1951 } # sub getitemtypes
1952
1953 sub getbiblio {
1954     my ($biblionumber) = @_;
1955     my $dbh   = C4::Context->dbh;
1956     my $query = "Select * from biblio where biblionumber = $biblionumber";
1957     my $sth   = $dbh->prepare($query);
1958       # || die "Cannot prepare $query\n" . $dbh->errstr;
1959     my $count = 0;
1960     my @results;
1961
1962     $sth->execute;
1963       # || die "Cannot execute $query\n" . $sth->errstr;
1964     while (my $data = $sth->fetchrow_hashref) {
1965       $results[$count] = $data;
1966       $count++;
1967     } # while
1968
1969     $sth->finish;
1970     return($count, @results);
1971 } # sub getbiblio
1972
1973 sub getbiblioitem {
1974     my ($biblioitemnum) = @_;
1975     my $dbh   = C4::Context->dbh;
1976     my $query = "Select * from biblioitems where
1977 biblioitemnumber = $biblioitemnum";
1978     my $sth   = $dbh->prepare($query);
1979     my $count = 0;
1980     my @results;
1981
1982     $sth->execute;
1983
1984     while (my $data = $sth->fetchrow_hashref) {
1985         $results[$count] = $data;
1986         $count++;
1987     } # while
1988
1989     $sth->finish;
1990     return($count, @results);
1991 } # sub getbiblioitem
1992
1993 sub getbiblioitembybiblionumber {
1994     my ($biblionumber) = @_;
1995     my $dbh   = C4::Context->dbh;
1996     my $query = "Select * from biblioitems where biblionumber =
1997 $biblionumber";
1998     my $sth   = $dbh->prepare($query);
1999     my $count = 0;
2000     my @results;
2001
2002     $sth->execute;
2003
2004     while (my $data = $sth->fetchrow_hashref) {
2005         $results[$count] = $data;
2006         $count++;
2007     } # while
2008
2009     $sth->finish;
2010     return($count, @results);
2011 } # sub
2012
2013 sub getitemsbybiblioitem {
2014     my ($biblioitemnum) = @_;
2015     my $dbh   = C4::Context->dbh;
2016     my $query = "Select * from items, biblio where
2017 biblio.biblionumber = items.biblionumber and biblioitemnumber
2018 = $biblioitemnum";
2019     my $sth   = $dbh->prepare($query);
2020       # || die "Cannot prepare $query\n" . $dbh->errstr;
2021     my $count = 0;
2022     my @results;
2023
2024     $sth->execute;
2025       # || die "Cannot execute $query\n" . $sth->errstr;
2026     while (my $data = $sth->fetchrow_hashref) {
2027       $results[$count] = $data;
2028       $count++;
2029     } # while
2030
2031     $sth->finish;
2032     return($count, @results);
2033 } # sub getitemsbybiblioitem
2034
2035
2036 sub logchange {
2037 # Subroutine to log changes to databases
2038 # Eventually, this subroutine will be used to create a log of all changes made,
2039 # with the possibility of "undo"ing some changes
2040     my $database=shift;
2041     if ($database eq 'kohadb') {
2042         my $type=shift;
2043         my $section=shift;
2044         my $item=shift;
2045         my $original=shift;
2046         my $new=shift;
2047 #       print STDERR "KOHA: $type $section $item $original $new\n";
2048     } elsif ($database eq 'marc') {
2049         my $type=shift;
2050         my $Record_ID=shift;
2051         my $tag=shift;
2052         my $mark=shift;
2053         my $subfield_ID=shift;
2054         my $original=shift;
2055         my $new=shift;
2056 #       print STDERR "MARC: $type $Record_ID $tag $mark $subfield_ID $original $new\n";
2057     }
2058 }
2059
2060 #------------------------------------------------
2061
2062
2063 #---------------------------------------
2064 # Find a biblio entry, or create a new one if it doesn't exist.
2065 #  If a "subtitle" entry is in hash, add it to subtitle table
2066 sub getoraddbiblio {
2067         # input params
2068         my (
2069           $dbh,         # db handle
2070                         # FIXME - Unused argument
2071           $biblio,      # hash ref to fields
2072         )=@_;
2073
2074         # return
2075         my $biblionumber;
2076
2077         my $debug=0;
2078         my $sth;
2079         my $error;
2080
2081         #-----
2082         $dbh = C4::Context->dbh;
2083
2084         print "<PRE>Looking for biblio </PRE>\n" if $debug;
2085         $sth=$dbh->prepare("select biblionumber
2086                 from biblio
2087                 where title=? and author=?
2088                   and copyrightdate=? and seriestitle=?");
2089         $sth->execute(
2090                 $biblio->{title}, $biblio->{author},
2091                 $biblio->{copyright}, $biblio->{seriestitle} );
2092         if ($sth->rows) {
2093             ($biblionumber) = $sth->fetchrow;
2094             print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
2095         } else {
2096             # Doesn't exist.  Add new one.
2097             print "<PRE>Adding biblio</PRE>\n" if $debug;
2098             ($biblionumber,$error)=&newbiblio($biblio);
2099             if ( $biblionumber ) {
2100               print "<PRE>Added with biblio number=$biblionumber</PRE>\n" if $debug;
2101               if ( $biblio->{subtitle} ) {
2102                 &newsubtitle($biblionumber,$biblio->{subtitle} );
2103               } # if subtitle
2104             } else {
2105                 print "<PRE>Couldn't add biblio: $error</PRE>\n" if $debug;
2106             } # if added
2107         }
2108
2109         return $biblionumber,$error;
2110
2111 } # sub getoraddbiblio
2112
2113 sub char_decode {
2114         # converts ISO 5426 coded string to ISO 8859-1
2115         # sloppy code : should be improved in next issue
2116         my ($string) = @_ ;
2117         $_ = $string ;
2118         if (C4::Context->preference("marcflavour") eq "UNIMARC") {
2119                 s/\xe1/Æ/gm ;
2120                 s/\xe2/Ð/gm ;
2121                 s/\xe9/Ø/gm ;
2122                 s/\xec/þ/gm ;
2123                 s/\xf1/æ/gm ;
2124                 s/\xf3/ð/gm ;
2125                 s/\xf9/ø/gm ;
2126                 s/\xfb/ß/gm ;
2127                 s/\xc1\x61/à/gm ;
2128                 s/\xc1\x65/è/gm ;
2129                 s/\xc1\x69/ì/gm ;
2130                 s/\xc1\x6f/ò/gm ;
2131                 s/\xc1\x75/ù/gm ;
2132                 s/\xc1\x41/À/gm ;
2133                 s/\xc1\x45/È/gm ;
2134                 s/\xc1\x49/Ì/gm ;
2135                 s/\xc1\x4f/Ò/gm ;
2136                 s/\xc1\x55/Ù/gm ;
2137                 s/\xc2\x41/Á/gm ;
2138                 s/\xc2\x45/É/gm ;
2139                 s/\xc2\x49/Í/gm ;
2140                 s/\xc2\x4f/Ó/gm ;
2141                 s/\xc2\x55/Ú/gm ;
2142                 s/\xc2\x59/Ý/gm ;
2143                 s/\xc2\x61/á/gm ;
2144                 s/\xc2\x65/é/gm ;
2145                 s/\xc2\x69/í/gm ;
2146                 s/\xc2\x6f/ó/gm ;
2147                 s/\xc2\x75/ú/gm ;
2148                 s/\xc2\x79/ý/gm ;
2149                 s/\xc3\x41/Â/gm ;
2150                 s/\xc3\x45/Ê/gm ;
2151                 s/\xc3\x49/Î/gm ;
2152                 s/\xc3\x4f/Ô/gm ;
2153                 s/\xc3\x55/Û/gm ;
2154                 s/\xc3\x61/â/gm ;
2155                 s/\xc3\x65/ê/gm ;
2156                 s/\xc3\x69/î/gm ;
2157                 s/\xc3\x6f/ô/gm ;
2158                 s/\xc3\x75/û/gm ;
2159                 s/\xc4\x41/Ã/gm ;
2160                 s/\xc4\x4e/Ñ/gm ;
2161                 s/\xc4\x4f/Õ/gm ;
2162                 s/\xc4\x61/ã/gm ;
2163                 s/\xc4\x6e/ñ/gm ;
2164                 s/\xc4\x6f/õ/gm ;
2165                 s/\xc8\x45/Ë/gm ;
2166                 s/\xc8\x49/Ï/gm ;
2167                 s/\xc8\x65/ë/gm ;
2168                 s/\xc8\x69/ï/gm ;
2169                 s/\xc8\x76/ÿ/gm ;
2170                 s/\xc9\x41/Ä/gm ;
2171                 s/\xc9\x4f/Ö/gm ;
2172                 s/\xc9\x55/Ü/gm ;
2173                 s/\xc9\x61/ä/gm ;
2174                 s/\xc9\x6f/ö/gm ;
2175                 s/\xc9\x75/ü/gm ;
2176                 s/\xca\x41/Å/gm ;
2177                 s/\xca\x61/å/gm ;
2178                 s/\xd0\x43/Ç/gm ;
2179                 s/\xd0\x63/ç/gm ;
2180         } else {
2181                 if(/[\xc1-\xff]/) {
2182                         s/\xe1\x61/à/gm ;
2183                         s/\xe1\x65/è/gm ;
2184                         s/\xe1\x69/ì/gm ;
2185                         s/\xe1\x6f/ò/gm ;
2186                         s/\xe1\x75/ù/gm ;
2187                         s/\xe1\x41/À/gm ;
2188                         s/\xe1\x45/È/gm ;
2189                         s/\xe1\x49/Ì/gm ;
2190                         s/\xe1\x4f/Ò/gm ;
2191                         s/\xe1\x55/Ù/gm ;
2192                         s/\xe2\x41/Á/gm ;
2193                         s/\xe2\x45/É/gm ;
2194                         s/\xe2\x49/Í/gm ;
2195                         s/\xe2\x4f/Ó/gm ;
2196                         s/\xe2\x55/Ú/gm ;
2197                         s/\xe2\x59/Ý/gm ;
2198                         s/\xe2\x61/á/gm ;
2199                         s/\xe2\x65/é/gm ;
2200                         s/\xe2\x69/í/gm ;
2201                         s/\xe2\x6f/ó/gm ;
2202                         s/\xe2\x75/ú/gm ;
2203                         s/\xe2\x79/ý/gm ;
2204                         s/\xe3\x41/Â/gm ;
2205                         s/\xe3\x45/Ê/gm ;
2206                         s/\xe3\x49/Î/gm ;
2207                         s/\xe3\x4f/Ô/gm ;
2208                         s/\xe3\x55/Û/gm ;
2209                         s/\xe3\x61/â/gm ;
2210                         s/\xe3\x65/ê/gm ;
2211                         s/\xe3\x69/î/gm ;
2212                         s/\xe3\x6f/ô/gm ;
2213                         s/\xe3\x75/û/gm ;
2214                         s/\xe4\x41/Ã/gm ;
2215                         s/\xe4\x4e/Ñ/gm ;
2216                         s/\xe4\x4f/Õ/gm ;
2217                         s/\xe4\x61/ã/gm ;
2218                         s/\xe4\x6e/ñ/gm ;
2219                         s/\xe4\x6f/õ/gm ;
2220                         s/\xe8\x45/Ë/gm ;
2221                         s/\xe8\x49/Ï/gm ;
2222                         s/\xe8\x65/ë/gm ;
2223                         s/\xe8\x69/ï/gm ;
2224                         s/\xe8\x76/ÿ/gm ;
2225                         s/\xe9\x41/Ä/gm ;
2226                         s/\xe9\x4f/Ö/gm ;
2227                         s/\xe9\x55/Ü/gm ;
2228                         s/\xe9\x61/ä/gm ;
2229                         s/\xe9\x6f/ö/gm ;
2230                         s/\xe9\x75/ü/gm ;
2231                         s/\xea\x41/Å/gm ;
2232                         s/\xea\x61/å/gm ;
2233                 }
2234         }
2235         # this handles non-sorting blocks (if implementation requires this)
2236         $string = nsb_clean($_) ;
2237         return($string) ;
2238 }
2239
2240 sub nsb_clean {
2241         my $NSB = '\x88' ;              # NSB : begin Non Sorting Block
2242         my $NSE = '\x89' ;              # NSE : Non Sorting Block end
2243         # handles non sorting blocks
2244         my ($string) = @_ ;
2245         $_ = $string ;
2246         s/$NSB/(/gm ;
2247         s/[ ]{0,1}$NSE/) /gm ;
2248         $string = $_ ;
2249         return($string) ;
2250 }
2251
2252 END { }       # module clean-up code here (global destructor)
2253
2254 =back
2255
2256 =head1 AUTHOR
2257
2258 Koha Developement team <info@koha.org>
2259
2260 Paul POULAIN paul.poulain@free.fr
2261
2262 =cut
2263