C4/Biblio.pm

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