C4/Biblio.pm

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