C4/Biblio.pm

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