C4/Biblio.pm

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