koha-dev.rot13.org Git - srvgit/blob - C4/Biblio.pm

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