C4/Biblio.pm

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