C4/Biblio.pm

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