C4/Biblio.pm

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