C4/Biblio.pm

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