C4/Biblio.pm

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