C4/Biblio.pm

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