C4/Biblio.pm

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