C4/Biblio.pm

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