C4/Biblio.pm

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