C4/Biblio.pm

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