C4/Biblio.pm

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