C4/Biblio.pm

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