C4/Biblio.pm

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