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

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