koha-dev.rot13.org Git - koha_fer/blob - C4/Biblio.pm

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