C4/Biblio.pm

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