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

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