C4/Biblio.pm

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