C4/Biblio.pm

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