C4/Biblio.pm

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