C4/Biblio.pm

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