C4/Biblio.pm

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