C4/Biblio.pm

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