C4/Biblio.pm

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