C4/Biblio.pm

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