4 # Revision 1.65 2003/10/14 09:45:29 tipaul
5 # 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)
7 # Revision 1.64 2003/10/06 15:20:51 tipaul
8 # fix for 536 (subtitle error)
10 # Revision 1.63 2003/10/01 13:25:49 tipaul
11 # seems a char encoding problem modified something in char_decode sub... changing back to something that works...
13 # Revision 1.62 2003/09/17 14:21:13 tipaul
14 # fixing bug that makes a MARC biblio disappear when using full acquisition (order => recieve ==> MARC editor).
15 # Before this 2 lines fix, the MARC biblio was deleted during recieve, and had to be entirely recreated :-(
17 # Revision 1.61 2003/09/17 10:24:39 tipaul
18 # notforloan value in itemtype was overwritting notforloan value in a given item.
19 # I changed this behaviour :
20 # if notforloan is set for a given item, and NOT for all items from this itemtype, the notforloan is kept.
21 # If notforloan is set for itemtype, it's used (and impossible to loan a specific item from this itemtype)
23 # Revision 1.60 2003/09/04 14:11:23 tipaul
24 # fix for 593 (data duplication in MARC-DB)
26 # Revision 1.58 2003/08/06 12:54:52 tipaul
27 # fix for publicationyear : extracting numeric value from MARC string, like for copyrightdate.
28 # (note that copyrightdate still extracted to get numeric format)
30 # Revision 1.57 2003/07/15 23:09:18 slef
31 # change show columns to use biblioitems bnotes too
33 # Revision 1.56 2003/07/15 11:34:52 slef
34 # fixes from paul email
36 # Revision 1.55 2003/07/15 00:02:49 slef
37 # Work on bug 515... can we do a single-side rename of notes to bnotes?
39 # Revision 1.54 2003/07/11 11:51:32 tipaul
40 # *** empty log message ***
42 # Revision 1.52 2003/07/10 10:37:19 tipaul
43 # fix for copyrightdate problem, #514
45 # Revision 1.51 2003/07/02 14:47:17 tipaul
46 # fix for #519 : items.dateaccessioned imports incorrectly
48 # Revision 1.49 2003/06/17 11:21:13 tipaul
49 # improvments/fixes for z3950 support.
50 # * Works now even on ADD, not only on MODIFY
51 # * able to search on ISBN, author, title
53 # Revision 1.48 2003/06/16 09:22:53 rangi
54 # Just added an order clause to getitemtypes
56 # Revision 1.47 2003/05/20 16:22:44 tipaul
57 # fixing typo in Biblio.pm POD
59 # Revision 1.46 2003/05/19 13:45:18 tipaul
60 # support for subtitles, additional authors, subject.
61 # 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.
62 # Note that some OLD-DB subs are strange (dummy ?) see OLDmodsubject, OLDmodsubtitle, OLDmodaddiauthor in C4/Biblio.pm
63 # 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.
65 # Revision 1.45 2003/04/29 16:50:49 tipaul
66 # really proud of this commit :-)
67 # z3950 search and import seems to works fine.
68 # Let me explain how :
69 # * a "search z3950" button is added in the addbiblio template.
70 # * when clicked, a popup appears and z3950/search.pl is called
71 # * z3950/search.pl calls addz3950search in the DB
72 # * the z3950 daemon retrieve the records and stores them in z3950results AND in marc_breeding table.
73 # * as long as there as searches pending, the popup auto refresh every 2 seconds, and says how many searches are pending.
74 # * when the user clicks on a z3950 result => the parent popup is called with the requested biblio, and auto-filled
77 # * 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.
78 # * 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.
80 # Revision 1.44 2003/04/28 13:07:14 tipaul
81 # Those fixes solves the "internal server error" with MARC::Record 1.12.
82 # It was due to an illegal contruction in Koha : we tried to retrive subfields from <10 tags.
83 # That's not possible. MARC::Record accepted this in 0.93 version, but it was fixed after.
84 # Now, the construct/retrieving is OK !
86 # Revision 1.43 2003/04/10 13:56:02 tipaul
88 # * worked in 1.9.0, but not in 1.9.1 :
89 # - modif of a biblio didn't work
90 # - 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.
92 # * did not work before :
93 # - repeatable subfields now works correctly. Enter 2 subfields separated by | and they will be splitted during saving.
94 # - dropped the last subfield of the MARC form :-(
97 # - 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.
98 # Note the MARCdelbiblio has been rewritted to enable deletion of a biblio WITHOUT deleting items.
100 # Revision 1.42 2003/04/04 08:41:11 tipaul
101 # last commits before 1.9.1
103 # Revision 1.41 2003/04/01 12:26:43 tipaul
106 # Revision 1.40 2003/03/11 15:14:03 tipaul
109 # Revision 1.39 2003/03/07 16:35:42 tipaul
110 # * moving generic functions to Koha.pm
111 # * improvement of SearchMarc.pm
115 # Revision 1.38 2003/02/27 16:51:59 tipaul
116 # * moving prepare / execute to ? form.
119 # * road to 1.9.2 => acquisition and cataloguing merging
121 # Revision 1.37 2003/02/12 11:03:03 tipaul
122 # Support for 000 -> 010 fields.
123 # Those fields doesn't have subfields.
124 # In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@".
125 # Note it's only virtual : when rebuilding the MARC::Record, the koha API handle correctly "@" subfields => the resulting MARC record has a 00x field without subfield.
127 # Revision 1.36 2003/02/12 11:01:01 tipaul
128 # Support for 000 -> 010 fields.
129 # Those fields doesn't have subfields.
130 # In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@".
131 # Note it's only virtual : when rebuilding the MARC::Record, the koha API handle correctly "@" subfields => the resulting MARC record has a 00x field without subfield.
133 # Revision 1.35 2003/02/03 18:46:00 acli
134 # Minor factoring in C4/Biblio.pm, plus change to export the per-tag
135 # 'mandatory' property to a per-subfield 'tag_mandatory' template parameter,
136 # so that addbiblio.tmpl can distinguish between mandatory subfields in a
137 # mandatory tag and mandatory subfields in an optional tag
139 # Not-minor factoring in acqui.simple/addbiblio.pl to make the if-else blocks
140 # smaller, and to add some POD; need further testing for this
142 # Added function to check if a MARC subfield name is "koha-internal" (instead
143 # of checking it for 'lib' and 'tag' everywhere); temporarily added to Koha.pm
145 # Use above function in acqui.simple/additem.pl and search.marc/search.pl
147 # Revision 1.34 2003/01/28 14:50:04 tipaul
148 # fixing MARCmodbiblio API and reindenting code
150 # Revision 1.33 2003/01/23 12:22:37 tipaul
151 # adding char_decode to decode MARC21 or UNIMARC extended chars
153 # Revision 1.32 2002/12/16 15:08:50 tipaul
154 # small but important bugfix (fixes a problem in export)
156 # Revision 1.31 2002/12/13 16:22:04 tipaul
157 # 1st draft of marc export
159 # Revision 1.30 2002/12/12 21:26:35 tipaul
160 # YAB ! (Yet Another Bugfix) => related to biblio modif
161 # (some warning cleaning too)
163 # Revision 1.29 2002/12/12 16:35:00 tipaul
164 # adding authentification with Auth.pm and
165 # MAJOR BUGFIX on marc biblio modification
167 # Revision 1.28 2002/12/10 13:30:03 tipaul
168 # fugfixes from Dombes Abbey work
170 # Revision 1.27 2002/11/19 12:36:16 tipaul
172 # various bugfixes, improvments, and migration from acquisition.pm to biblio.pm
174 # Revision 1.26 2002/11/12 15:58:43 tipaul
177 # * 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)
179 # Revision 1.25 2002/10/25 10:58:26 tipaul
181 # * bugfixes and improvements
183 # Revision 1.24 2002/10/24 12:09:01 arensb
184 # Fixed "no title" warning when generating HTML documentation from POD.
186 # Revision 1.23 2002/10/16 12:43:08 arensb
187 # Added some FIXME comments.
189 # Revision 1.22 2002/10/15 13:39:17 tipaul
190 # removing Acquisition.pm
191 # deleting unused code in biblio.pm, rewriting POD and answering most FIXME comments
193 # Revision 1.21 2002/10/13 11:34:14 arensb
194 # Replaced expressions of the form "$x = $x <op> $y" with "$x <op>= $y".
195 # Thus, $x = $x+2 becomes $x += 2, and so forth.
197 # Revision 1.20 2002/10/13 08:28:32 arensb
198 # Deleted unused variables.
199 # Removed trailing whitespace.
201 # Revision 1.19 2002/10/13 05:56:10 arensb
202 # Added some FIXME comments.
204 # Revision 1.18 2002/10/11 12:34:53 arensb
205 # Replaced &requireDBI with C4::Context->dbh
207 # Revision 1.17 2002/10/10 14:48:25 tipaul
210 # Revision 1.16 2002/10/07 14:04:26 tipaul
211 # road to 1.3.1 : viewing MARC biblio
213 # Revision 1.15 2002/10/05 09:49:25 arensb
214 # Merged with arensb-context branch: use C4::Context->dbh instead of
215 # &C4Connect, and generally prefer C4::Context over C4::Database.
217 # Revision 1.14 2002/10/03 11:28:18 tipaul
218 # Extending Context.pm to add stopword management and using it in MARC-API.
219 # First benchmarks show a medium speed improvement, which is nice as this part is heavily called.
221 # Revision 1.13 2002/10/02 16:26:44 tipaul
224 # Revision 1.12.2.4 2002/10/05 07:09:31 arensb
225 # Merged in changes from main branch.
227 # Revision 1.12.2.3 2002/10/05 06:12:10 arensb
228 # Added a whole mess of FIXME comments.
230 # Revision 1.12.2.2 2002/10/05 04:03:14 arensb
231 # Added some missing semicolons.
233 # Revision 1.12.2.1 2002/10/04 02:24:01 arensb
234 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
237 # Revision 1.12.2.3 2002/10/05 06:12:10 arensb
238 # Added a whole mess of FIXME comments.
240 # Revision 1.12.2.2 2002/10/05 04:03:14 arensb
241 # Added some missing semicolons.
243 # Revision 1.12.2.1 2002/10/04 02:24:01 arensb
244 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
247 # Revision 1.12 2002/10/01 11:48:51 arensb
248 # Added some FIXME comments, mostly marking duplicate functions.
250 # Revision 1.11 2002/09/24 13:49:26 tipaul
251 # long WAS the road to 1.3.0...
252 # coming VERY SOON NOW...
253 # modifying installer and buildrelease to update the DB
255 # Revision 1.10 2002/09/22 16:50:08 arensb
256 # Added some FIXME comments.
258 # Revision 1.9 2002/09/20 12:57:46 tipaul
259 # long is the road to 1.4.0
260 # * MARCadditem and MARCmoditem now wroks
261 # * various bugfixes in MARC management
262 # !!! 1.3.0 should be released very soon now. Be careful !!!
264 # Revision 1.8 2002/09/10 13:53:52 tipaul
265 # MARC API continued...
267 # * 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)
269 # Note : it should not be hard for marcimport and marcexport to re-link fields from internal tag/subfield to "legal" tag/subfield.
271 # Revision 1.7 2002/08/14 18:12:51 tonnesen
272 # Added copyright statement to all .pl and .pm files
274 # Revision 1.6 2002/07/25 13:40:31 tipaul
275 # pod documenting the API.
277 # Revision 1.5 2002/07/24 16:11:37 tipaul
279 # Database.pm and Output.pm are almost not modified (var test...)
281 # Biblio.pm is almost completly rewritten.
283 # WHAT DOES IT ??? ==> END of Hitchcock suspens
285 # 1st, it does... nothing...
286 # 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 ...
288 # All old-API functions have been cloned. for example, the "newbiblio" sub, now has become :
289 # * a "newbiblio" sub, with the same parameters. It just call a sub named OLDnewbiblio
290 # * 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.
291 # * 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.
292 # 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 ;-)
294 # 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.
295 # Note we have decided with steve that a old-biblio <=> a MARC-Biblio.
299 # Copyright 2000-2002 Katipo Communications
301 # This file is part of Koha.
303 # Koha is free software; you can redistribute it and/or modify it under the
304 # terms of the GNU General Public License as published by the Free Software
305 # Foundation; either version 2 of the License, or (at your option) any later
308 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
309 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
310 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
312 # You should have received a copy of the GNU General Public License along with
313 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
314 # Suite 330, Boston, MA 02111-1307 USA
322 use vars qw($VERSION @ISA @EXPORT);
324 # set the version for version checking
329 # don't forget MARCxxx subs are here only for testing purposes. Should not be used
330 # as the old-style API and the NEW one are the only public functions.
333 &updateBiblio &updateBiblioItem &updateItem
334 &itemcount &newbiblio &newbiblioitem
335 &modnote &newsubject &newsubtitle
336 &modbiblio &checkitems
337 &newitems &modbibitem
338 &modsubtitle &modsubject &modaddauthor &moditem &countitems
339 &delitem &deletebiblioitem &delbiblio
340 &getitemtypes &getbiblio
341 &getbiblioitembybiblionumber
342 &getbiblioitem &getitemsbybiblioitem
344 &newcompletebiblioitem
346 &MARCfind_oldbiblionumber_from_MARCbibid
347 &MARCfind_MARCbibid_from_oldbiblionumber
348 &MARCfind_marc_from_kohafield
352 &NEWnewbiblio &NEWnewitem
353 &NEWmodbiblio &NEWmoditem
355 &MARCaddbiblio &MARCadditem
356 &MARCmodsubfield &MARCaddsubfield
357 &MARCmodbiblio &MARCmoditem
358 &MARCkoha2marcBiblio &MARCmarc2koha
359 &MARCkoha2marcItem &MARChtml2marc
360 &MARCgetbiblio &MARCgetitem
361 &MARCaddword &MARCdelword
367 # MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC
370 # all the following subs takes a MARC::Record as parameter and manage
371 # the MARC-DB. They are called by the 1.0/1.2 xxx subs, and by the
372 # NEWxxx subs (xxx deals with old-DB parameters, the NEWxxx deals with MARC-DB parameter)
376 C4::Biblio - acquisition, catalog management functions
380 move from 1.2 to 1.4 version :
381 1.2 and previous version uses a specific API to manage biblios. This API uses old-DB style parameters.
382 In the 1.4 version, we want to do 2 differents things :
383 - keep populating the old-DB, that has a LOT less datas than MARC
384 - populate the MARC-DB
385 To populate the DBs we have 2 differents sources :
386 - the standard acquisition system (through book sellers), that does'nt use MARC data
387 - the MARC acquisition system, that uses MARC data.
389 Thus, we have 2 differents cases :
390 - 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
391 - 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
393 That's why we need 4 subs :
394 all I<subs beginning by MARC> manage only MARC tables. They manage MARC-DB with MARC::Record parameters
395 all I<subs beginning by OLD> manage only OLD-DB tables. They manage old-DB with old-DB parameters
396 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
397 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.
399 - NEW and old-style API should be used in koha to manage biblio
400 - MARCsubs are divided in 2 parts :
401 * some of them manage MARC parameters. They are heavily used in koha.
402 * some of them manage MARC biblio : they are mostly used by NEW and old-style subs.
403 - OLD are used internally only
405 all subs requires/use $dbh as 1st parameter.
407 I<NEWxxx related subs>
409 all subs requires/use $dbh as 1st parameter.
410 those subs are used by the MARC-compliant version of koha : marc import, or marc management.
412 I<OLDxxx related subs>
414 all subs requires/use $dbh as 1st parameter.
415 those subs are used by the MARC-compliant version of koha : marc import, or marc management.
417 They all are the exact copy of 1.0/1.2 version of the sub without the OLD.
418 The OLDxxx is called by the original xxx sub.
419 the 1.4 xxx sub also builds MARC::Record an calls the MARCxxx
421 WARNING : there is 1 difference between initialxxx and OLDxxx :
422 the db header $dbh is always passed as parameter to avoid over-DB connexion
428 =item @tagslib = &MARCgettagslib($dbh,1|0);
430 last param is 1 for liblibrarian and 0 for libopac
431 returns a hash with tag/subfield meaning
432 =item ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
434 finds MARC tag and subfield for a given kohafield
435 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
437 =item $biblionumber = &MARCfind_oldbiblionumber_from_MARCbibid($dbh,$MARCbibi);
439 finds a old-db biblio number for a given MARCbibid number
441 =item $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$oldbiblionumber);
443 finds a MARC bibid from a old-db biblionumber
445 =item $MARCRecord = &MARCkoha2marcBiblio($dbh,$biblionumber,biblioitemnumber);
447 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem
449 =item $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);
451 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB item
453 =item $MARCRecord = &MARCkoha2marcSubtitle($dbh,$biblionumber,$subtitle);
455 MARCkoha2marcSubtitle is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB subtitle
457 =item $olddb = &MARCmarc2koha($dbh,$MARCRecord);
459 builds a hash with old-db datas from a MARC::Record
461 =item &MARCaddbiblio($dbh,$MARC::Record,$biblionumber);
463 creates a biblio (in the MARC tables only). $biblionumber is the old-db biblionumber of the biblio
465 =item &MARCaddsubfield($dbh,$bibid,$tagid,$indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
467 adds a subfield in a biblio (in the MARC tables only).
469 =item $MARCRecord = &MARCgetbiblio($dbh,$bibid);
471 Returns a MARC::Record for the biblio $bibid.
473 =item &MARCmodbiblio($dbh,$bibid,$record,$delete);
475 MARCmodbiblio changes a biblio for a biblio,MARC::Record passed as parameter
476 It 1st delete the biblio, then recreates it.
477 WARNING : the $delete parameter is not used anymore (too much unsolvable cases).
478 =item ($subfieldid,$subfieldvalue) = &MARCmodsubfield($dbh,$subfieldid,$subfieldvalue);
480 MARCmodsubfield changes the value of a given subfield
482 =item $subfieldid = &MARCfindsubfield($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue);
484 MARCfindsubfield returns a subfield number given a bibid/tag/subfieldvalue values.
485 Returns -1 if more than 1 answer
487 =item $subfieldid = &MARCfindsubfieldid($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
489 MARCfindsubfieldid find a subfieldid for a bibid/tag/tagorder/subfield/subfieldorder
491 =item &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
493 MARCdelsubfield delete a subfield for a bibid/tag/tagorder/subfield/subfieldorder
495 =item &MARCdelbiblio($dbh,$bibid);
497 MARCdelbiblio delete biblio $bibid
499 =item &MARCkoha2marcOnefield
501 used by MARCkoha2marc and should not be useful elsewhere
503 =item &MARCmarc2kohaOnefield
505 used by MARCmarc2koha and should not be useful elsewhere
509 used to manage MARC_word table and should not be useful elsewhere
513 used to manage MARC_word table and should not be useful elsewhere
518 my ($dbh,$forlibrarian)= @_;
520 my $libfield = ($forlibrarian eq 1)? 'liblibrarian' : 'libopac';
521 $sth=$dbh->prepare("select tagfield,$libfield as lib,mandatory from marc_tag_structure order by tagfield");
523 my ($lib,$tag,$res,$tab,$mandatory,$repeatable);
524 while ( ($tag,$lib,$mandatory) = $sth->fetchrow) {
525 $res->{$tag}->{lib}=$lib;
526 $res->{$tab}->{tab}=""; # XXX
527 $res->{$tag}->{mandatory}=$mandatory;
530 $sth=$dbh->prepare("select tagfield,tagsubfield,$libfield as lib,tab, mandatory, repeatable,authorised_value,thesaurus_category,value_builder,kohafield from marc_subfield_structure order by tagfield,tagsubfield");
534 my $authorised_value;
535 my $thesaurus_category;
538 while ( ($tag, $subfield, $lib, $tab, $mandatory, $repeatable,$authorised_value,$thesaurus_category,$value_builder,$kohafield) = $sth->fetchrow) {
539 $res->{$tag}->{$subfield}->{lib}=$lib;
540 $res->{$tag}->{$subfield}->{tab}=$tab;
541 $res->{$tag}->{$subfield}->{mandatory}=$mandatory;
542 $res->{$tag}->{$subfield}->{repeatable}=$repeatable;
543 $res->{$tag}->{$subfield}->{authorised_value}=$authorised_value;
544 $res->{$tag}->{$subfield}->{thesaurus_category}=$thesaurus_category;
545 $res->{$tag}->{$subfield}->{value_builder}=$value_builder;
546 $res->{$tag}->{$subfield}->{kohafield}=$kohafield;
551 sub MARCfind_marc_from_kohafield {
552 my ($dbh,$kohafield) = @_;
553 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
554 $sth->execute($kohafield);
555 my ($tagfield,$tagsubfield) = $sth->fetchrow;
556 return ($tagfield,$tagsubfield);
559 sub MARCfind_oldbiblionumber_from_MARCbibid {
560 my ($dbh,$MARCbibid) = @_;
561 my $sth=$dbh->prepare("select biblionumber from marc_biblio where bibid=?");
562 $sth->execute($MARCbibid);
563 my ($biblionumber) = $sth->fetchrow;
564 return $biblionumber;
567 sub MARCfind_MARCbibid_from_oldbiblionumber {
568 my ($dbh,$oldbiblionumber) = @_;
569 my $sth=$dbh->prepare("select bibid from marc_biblio where biblionumber=?");
570 $sth->execute($oldbiblionumber);
571 my ($bibid) = $sth->fetchrow;
576 # pass the MARC::Record to this function, and it will create the records in the marc tables
577 my ($dbh,$record,$biblionumber,$bibid) = @_;
578 my @fields=$record->fields();
579 # warn "IN MARCaddbiblio $bibid => ".$record->as_formatted;
581 # adding main table, and retrieving bibid
582 # if bibid is sent, then it's not a true add, it's only a re-add, after a delete (ie, a mod)
583 # if bibid empty => true add, find a new bibid number
585 $dbh->do("lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ");
586 my $sth=$dbh->prepare("insert into marc_biblio (datecreated,biblionumber) values (now(),?)");
587 $sth->execute($biblionumber);
588 $sth=$dbh->prepare("select max(bibid) from marc_biblio");
590 ($bibid)=$sth->fetchrow;
594 # now, add subfields...
595 foreach my $field (@fields) {
597 if ($field->tag() <10) {
598 &MARCaddsubfield($dbh,$bibid,
607 my @subfields=$field->subfields();
608 foreach my $subfieldcount (0..$#subfields) {
609 &MARCaddsubfield($dbh,$bibid,
611 $field->indicator(1).$field->indicator(2),
613 $subfields[$subfieldcount][0],
615 $subfields[$subfieldcount][1]
620 $dbh->do("unlock tables");
625 # pass the MARC::Record to this function, and it will create the records in the marc tables
626 my ($dbh,$record,$biblionumber) = @_;
627 # warn "adding : ".$record->as_formatted();
628 # search for MARC biblionumber
629 $dbh->do("lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ");
630 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
631 my @fields=$record->fields();
632 my $sth = $dbh->prepare("select max(tagorder) from marc_subfield_table where bibid=?");
633 $sth->execute($bibid);
634 my ($fieldcount) = $sth->fetchrow;
635 # now, add subfields...
636 foreach my $field (@fields) {
637 my @subfields=$field->subfields();
639 foreach my $subfieldcount (0..$#subfields) {
640 &MARCaddsubfield($dbh,$bibid,
642 $field->indicator(1).$field->indicator(2),
644 $subfields[$subfieldcount][0],
646 $subfields[$subfieldcount][1]
650 $dbh->do("unlock tables");
654 sub MARCaddsubfield {
655 # Add a new subfield to a tag into the DB.
656 my ($dbh,$bibid,$tagid,$tag_indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalues) = @_;
657 # if not value, end of job, we do nothing
658 if (length($subfieldvalues) ==0) {
661 if (not($subfieldcode)) {
664 my @subfieldvalues = split /\|/,$subfieldvalues;
665 foreach my $subfieldvalue (@subfieldvalues) {
666 if (length($subfieldvalue)>255) {
667 $dbh->do("lock tables marc_blob_subfield WRITE, marc_subfield_table WRITE");
668 my $sth=$dbh->prepare("insert into marc_blob_subfield (subfieldvalue) values (?)");
669 $sth->execute($subfieldvalue);
670 $sth=$dbh->prepare("select max(blobidlink)from marc_blob_subfield");
672 my ($res)=$sth->fetchrow;
673 $sth=$dbh->prepare("insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,valuebloblink) values (?,?,?,?,?,?,?)");
674 $sth->execute($bibid,(sprintf "%03s",$tagid),$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$res);
676 warn "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
678 $dbh->do("unlock tables");
680 my $sth=$dbh->prepare("insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values (?,?,?,?,?,?,?)");
681 $sth->execute($bibid,(sprintf "%03s",$tagid),$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue);
683 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";
686 &MARCaddword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
691 # Returns MARC::Record of the biblio passed in parameter.
693 my $record = MARC::Record->new();
694 #---- TODO : the leader is missing
695 $record->leader(' ');
696 my $sth=$dbh->prepare("select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
697 from marc_subfield_table
698 where bibid=? order by tag,tagorder,subfieldcode
700 my $sth2=$dbh->prepare("select subfieldvalue from marc_blob_subfield where blobidlink=?");
701 $sth->execute($bibid);
705 my $field; # for >=10 tags
706 my $prevvalue; # for <10 tags
707 while (my $row=$sth->fetchrow_hashref) {
708 if ($row->{'valuebloblink'}) { #---- search blob if there is one
709 $sth2->execute($row->{'valuebloblink'});
710 my $row2=$sth2->fetchrow_hashref;
712 $row->{'subfieldvalue'}=$row2->{'subfieldvalue'};
714 if ($row->{tagorder} ne $prevtagorder || $row->{tag} ne $prevtag) {
717 $record->add_fields((sprintf "%03s",$prevtag),$prevvalue) unless $prevtag eq "XXX"; # ignore the 1st loop
719 $record->add_fields($field) unless $prevtag eq "XXX";
722 $prevtagorder=$row->{tagorder};
723 $prevtag = $row->{tag};
724 $previndicator=$row->{tag_indicator};
725 if ($row->{tag}<10) {
726 $prevvalue = $row->{subfieldvalue};
728 $field = MARC::Field->new((sprintf "%03s",$prevtag), substr($row->{tag_indicator}.' ',0,1), substr($row->{tag_indicator}.' ',1,1), $row->{'subfieldcode'}, $row->{'subfieldvalue'} );
731 if ($row->{tag} <10) {
732 $record->add_fields((sprintf "%03s",$row->{tag}), $row->{'subfieldvalue'});
734 $field->add_subfields($row->{'subfieldcode'}, $row->{'subfieldvalue'} );
736 $prevtag= $row->{tag};
737 $previndicator=$row->{tag_indicator};
740 # the last has not been included inside the loop... do it now !
742 $record->add_fields($prevtag,$prevvalue);
744 # my $field = MARC::Field->new( $prevtag, "", "", %subfieldlist);
745 $record->add_fields($field);
750 # Returns MARC::Record of the biblio passed in parameter.
751 my ($dbh,$bibid,$itemnumber)=@_;
752 my $record = MARC::Record->new();
753 # search MARC tagorder
754 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=?");
755 $sth2->execute($bibid,$itemnumber);
756 my ($tagorder) = $sth2->fetchrow_array();
757 #---- TODO : the leader is missing
758 my $sth=$dbh->prepare("select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
759 from marc_subfield_table
760 where bibid=? and tagorder=? order by subfieldcode,subfieldorder
762 $sth2=$dbh->prepare("select subfieldvalue from marc_blob_subfield where blobidlink=?");
763 $sth->execute($bibid,$tagorder);
764 while (my $row=$sth->fetchrow_hashref) {
765 if ($row->{'valuebloblink'}) { #---- search blob if there is one
766 $sth2->execute($row->{'valuebloblink'});
767 my $row2=$sth2->fetchrow_hashref;
769 $row->{'subfieldvalue'}=$row2->{'subfieldvalue'};
771 if ($record->field($row->{'tag'})) {
773 #--- this test must stay as this, because of strange behaviour of mySQL/Perl DBI with char var containing a number...
774 #--- sometimes, eliminates 0 at beginning, sometimes no ;-\\\
775 if (length($row->{'tag'}) <3) {
776 $row->{'tag'} = "0".$row->{'tag'};
778 $field =$record->field($row->{'tag'});
780 my $x = $field->add_subfields($row->{'subfieldcode'},$row->{'subfieldvalue'});
781 $record->delete_field($field);
782 $record->add_fields($field);
785 if (length($row->{'tag'}) < 3) {
786 $row->{'tag'} = "0".$row->{'tag'};
788 my $temp = MARC::Field->new($row->{'tag'}," "," ", $row->{'subfieldcode'} => $row->{'subfieldvalue'});
789 $record->add_fields($temp);
797 my ($dbh,$bibid,$record,$delete)=@_;
798 my $oldrecord=&MARCgetbiblio($dbh,$bibid);
799 if ($oldrecord eq $record) {
802 # 1st delete the biblio,
804 my $biblionumber = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
805 &MARCdelbiblio($dbh,$bibid,1);
806 &MARCaddbiblio($dbh,$record,$biblionumber,$bibid);
810 my ($dbh,$bibid,$keep_items) = @_;
811 # if the keep_item is set to 1, then all items are preserved.
812 # This flag is set when the delbiblio is called by modbiblio
813 # due to a too complex structure of MARC (repeatable fields and subfields),
814 # the best solution for a modif is to delete / recreate the record.
815 if ($keep_items eq 1) {
816 #search item field code
817 my $sth = $dbh->prepare("select tagfield from marc_subfield_structure where kohafield like 'items.%'");
819 my $itemtag = $sth->fetchrow_hashref->{tagfield};
820 $dbh->do("delete from marc_subfield_table where bibid=$bibid and tag<>$itemtag");
821 $dbh->do("delete from marc_word where bibid=$bibid and tag<>$itemtag");
823 $dbh->do("delete from marc_biblio where bibid=$bibid");
824 $dbh->do("delete from marc_subfield_table where bibid=$bibid");
825 $dbh->do("delete from marc_word where bibid=$bibid");
829 my ($dbh,$record,$bibid,$itemnumber,$delete)=@_;
830 my $oldrecord=&MARCgetitem($dbh,$bibid,$itemnumber);
831 # if nothing to change, don't waste time...
832 if ($oldrecord eq $record) {
836 # otherwise, skip through each subfield...
837 my @fields = $record->fields();
838 # search old MARC item
839 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=?");
840 $sth2->execute($bibid,$itemnumber);
841 my ($tagorder) = $sth2->fetchrow_array();
842 foreach my $field (@fields) {
843 my $oldfield = $oldrecord->field($field->tag());
844 my @subfields=$field->subfields();
846 foreach my $subfield (@subfields) {
848 # warn "compare : $oldfield".$oldfield->subfield(@$subfield[0]);
849 if ($oldfield eq 0 or (length($oldfield->subfield(@$subfield[0])) ==0) ) {
850 # just adding datas...
851 # warn "addfield : / $subfieldorder / @$subfield[0] - @$subfield[1]";
852 # warn "NEW subfield : $bibid,".$field->tag().",".$tagorder.",".@$subfield[0].",".$subfieldorder.",".@$subfield[1].")";
853 &MARCaddsubfield($dbh,$bibid,$field->tag(),$field->indicator(1).$field->indicator(2),
854 $tagorder,@$subfield[0],$subfieldorder,@$subfield[1]);
856 # warn "modfield : / $subfieldorder / @$subfield[0] - @$subfield[1]";
857 # modify he subfield if it's a different string
858 if ($oldfield->subfield(@$subfield[0]) ne @$subfield[1] ) {
859 my $subfieldid=&MARCfindsubfieldid($dbh,$bibid,$field->tag(),$tagorder,@$subfield[0],$subfieldorder);
860 # warn "changing : $subfieldid, $bibid,".$field->tag(),",$tagorder,@$subfield[0],@$subfield[1],$subfieldorder";
861 &MARCmodsubfield($dbh,$subfieldid,@$subfield[1]);
869 sub MARCmodsubfield {
870 # Subroutine changes a subfield value given a subfieldid.
871 my ($dbh, $subfieldid, $subfieldvalue )=@_;
872 $dbh->do("lock tables marc_blob_subfield WRITE,marc_subfield_table WRITE");
873 my $sth1=$dbh->prepare("select valuebloblink from marc_subfield_table where subfieldid=?");
874 $sth1->execute($subfieldid);
875 my ($oldvaluebloblink)=$sth1->fetchrow;
878 # if too long, use a bloblink
879 if (length($subfieldvalue)>255 ) {
880 # if already a bloblink, update it, otherwise, insert a new one.
881 if ($oldvaluebloblink) {
882 $sth=$dbh->prepare("update marc_blob_subfield set subfieldvalue=? where blobidlink=?");
883 $sth->execute($subfieldvalue,$oldvaluebloblink);
885 $sth=$dbh->prepare("insert into marc_blob_subfield (subfieldvalue) values (?)");
886 $sth->execute($subfieldvalue);
887 $sth=$dbh->prepare("select max(blobidlink) from marc_blob_subfield");
889 my ($res)=$sth->fetchrow;
890 $sth=$dbh->prepare("update marc_subfield_table set subfieldvalue=null, valuebloblink=$res where subfieldid=?");
891 $sth->execute($subfieldid);
894 # note this can leave orphan bloblink. Not a big problem, but we should build somewhere a orphan deleting script...
895 $sth=$dbh->prepare("update marc_subfield_table set subfieldvalue=?,valuebloblink=null where subfieldid=?");
896 $sth->execute($subfieldvalue, $subfieldid);
898 $dbh->do("unlock tables");
900 $sth=$dbh->prepare("select bibid,tag,tagorder,subfieldcode,subfieldid,subfieldorder from marc_subfield_table where subfieldid=?");
901 $sth->execute($subfieldid);
902 my ($bibid,$tagid,$tagorder,$subfieldcode,$x,$subfieldorder) = $sth->fetchrow;
904 &MARCdelword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder);
905 &MARCaddword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
906 return($subfieldid, $subfieldvalue);
909 sub MARCfindsubfield {
910 my ($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue) = @_;
914 my $query="select subfieldid from marc_subfield_table where bibid=? and tag=? and subfieldcode=?";
915 if ($subfieldvalue) {
916 $query .= " and subfieldvalue=".$dbh->quote($subfieldvalue);
918 if ($subfieldorder<1) {
921 $query .= " and subfieldorder=$subfieldorder";
923 my $sti=$dbh->prepare($query);
924 $sti->execute($bibid,$tag, $subfieldcode);
925 while (($subfieldid) = $sti->fetchrow) {
927 $lastsubfieldid=$subfieldid;
929 if ($resultcounter>1) {
930 # Error condition. Values given did not resolve into a unique record. Don't know what to edit
931 # should rarely occur (only if we use subfieldvalue with a value that exists twice, which is strange)
934 return $lastsubfieldid;
938 sub MARCfindsubfieldid {
939 my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
940 my $sth=$dbh->prepare("select subfieldid from marc_subfield_table
941 where bibid=? and tag=? and tagorder=?
942 and subfieldcode=? and subfieldorder=?");
943 $sth->execute($bibid,$tag,$tagorder,$subfield,$subfieldorder);
944 my ($res) = $sth->fetchrow;
946 $sth=$dbh->prepare("select subfieldid from marc_subfield_table
947 where bibid=? and tag=? and tagorder=?
948 and subfieldcode=?");
949 $sth->execute($bibid,$tag,$tagorder,$subfield);
950 ($res) = $sth->fetchrow;
955 sub MARCdelsubfield {
956 # delete a subfield for $bibid / tag / tagorder / subfield / subfieldorder
957 my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
958 $dbh->do("delete from marc_subfield_table where bibid='$bibid' and
959 tag='$tag' and tagorder='$tagorder'
960 and subfieldcode='$subfield' and subfieldorder='$subfieldorder
964 sub MARCkoha2marcBiblio {
965 # this function builds partial MARC::Record from the old koha-DB fields
966 my ($dbh,$biblionumber,$biblioitemnumber) = @_;
967 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
968 my $record = MARC::Record->new();
969 #--- if bibid, then retrieve old-style koha data
970 if ($biblionumber>0) {
971 my $sth2=$dbh->prepare("select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp
972 from biblio where biblionumber=?");
973 $sth2->execute($biblionumber);
974 my $row=$sth2->fetchrow_hashref;
976 foreach $code (keys %$row) {
978 &MARCkoha2marcOnefield($sth,$record,"biblio.".$code,$row->{$code});
982 #--- if biblioitem, then retrieve old-style koha data
983 if ($biblioitemnumber>0) {
984 my $sth2=$dbh->prepare(" SELECT biblioitemnumber,biblionumber,volume,number,classification,
985 itemtype,url,isbn,issn,dewey,subclass,publicationyear,publishercode,
986 volumedate,volumeddesc,timestamp,illus,pages,notes AS bnotes,size,place
988 WHERE biblioitemnumber=?
990 $sth2->execute($biblioitemnumber);
991 my $row=$sth2->fetchrow_hashref;
993 foreach $code (keys %$row) {
995 &MARCkoha2marcOnefield($sth,$record,"biblioitems.".$code,$row->{$code});
999 # other fields => additional authors, subjects, subtitles
1000 my $sth2=$dbh->prepare(" SELECT author FROM additionalauthors WHERE biblionumber=?");
1001 $sth2->execute($biblionumber);
1002 while (my $row=$sth2->fetchrow_hashref) {
1003 &MARCkoha2marcOnefield($sth,$record,"additionalauthors.author",$row->{'author'});
1005 my $sth2=$dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?");
1006 $sth2->execute($biblionumber);
1007 while (my $row=$sth2->fetchrow_hashref) {
1008 &MARCkoha2marcOnefield($sth,$record,"bibliosubject.subject",$row->{'subject'});
1010 my $sth2=$dbh->prepare(" SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?");
1011 $sth2->execute($biblionumber);
1012 while (my $row=$sth2->fetchrow_hashref) {
1013 &MARCkoha2marcOnefield($sth,$record,"bibliosubtitle.title",$row->{'subtitle'});
1018 sub MARCkoha2marcItem {
1019 # this function builds partial MARC::Record from the old koha-DB fields
1020 my ($dbh,$biblionumber,$itemnumber) = @_;
1021 # my $dbh=&C4Connect;
1022 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
1023 my $record = MARC::Record->new();
1024 #--- if item, then retrieve old-style koha data
1025 if ($itemnumber>0) {
1026 # print STDERR "prepare $biblionumber,$itemnumber\n";
1027 my $sth2=$dbh->prepare("SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned,
1028 booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
1029 datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,bulk,issues,renewals,
1030 reserves,restricted,binding,itemnotes,holdingbranch,timestamp
1032 WHERE itemnumber=?");
1033 $sth2->execute($itemnumber);
1034 my $row=$sth2->fetchrow_hashref;
1036 foreach $code (keys %$row) {
1037 if ($row->{$code}) {
1038 &MARCkoha2marcOnefield($sth,$record,"items.".$code,$row->{$code});
1045 sub MARCkoha2marcSubtitle {
1046 # this function builds partial MARC::Record from the old koha-DB fields
1047 my ($dbh,$bibnum,$subtitle) = @_;
1048 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
1049 my $record = MARC::Record->new();
1050 &MARCkoha2marcOnefield($sth,$record,"bibliosubtitle.subtitle",$subtitle);
1054 sub MARCkoha2marcOnefield {
1055 my ($sth,$record,$kohafieldname,$value)=@_;
1058 $sth->execute($kohafieldname);
1059 if (($tagfield,$tagsubfield)=$sth->fetchrow) {
1060 if ($record->field($tagfield)) {
1061 my $tag =$record->field($tagfield);
1063 $tag->add_subfields($tagsubfield,$value);
1064 $record->delete_field($tag);
1065 $record->add_fields($tag);
1068 $record->add_fields($tagfield," "," ",$tagsubfield => $value);
1075 my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
1077 my $record = MARC::Record->new();
1078 # my %subfieldlist=();
1079 my $prevvalue; # if tag <10
1080 my $field; # if tag >=10
1081 for (my $i=0; $i< @$rtags; $i++) {
1082 # rebuild MARC::Record
1083 if (@$rtags[$i] ne $prevtag) {
1084 if ($prevtag < 10) {
1086 $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
1090 $record->add_fields($field);
1093 $indicators{@$rtags[$i]}.=' ';
1094 if (@$rtags[$i] <10) {
1095 $prevvalue= @$rvalues[$i];
1097 $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
1099 $prevtag = @$rtags[$i];
1101 if (@$rtags[$i] <10) {
1102 $prevvalue=@$rvalues[$i];
1104 if (@$rvalues[$i]) {
1105 $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
1108 $prevtag= @$rtags[$i];
1111 # the last has not been included inside the loop... do it now !
1112 $record->add_fields($field);
1113 # warn $record->as_formatted;
1118 my ($dbh,$record) = @_;
1119 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
1121 my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
1124 # print STDERR $record->as_formatted;
1125 while (($field)=$sth2->fetchrow) {
1126 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result);
1128 $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
1130 while (($field)=$sth2->fetchrow) {
1131 if ($field eq 'notes') { $field = 'bnotes'; }
1132 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result);
1134 $sth2=$dbh->prepare("SHOW COLUMNS from items");
1136 while (($field)=$sth2->fetchrow) {
1137 $result = &MARCmarc2kohaOneField($sth,"items",$field,$record,$result);
1139 # additional authors : specific
1140 $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result);
1141 $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result);
1142 # modify copyrightdate to keep only the 1st year found
1143 my $temp = $result->{'copyrightdate'};
1144 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
1146 $result->{'copyrightdate'} = $1;
1147 } else { # if no cYYYY, get the 1st date.
1148 $temp =~ m/(\d\d\d\d)/;
1149 $result->{'copyrightdate'} = $1;
1151 # modify publicationyear to keep only the 1st year found
1152 my $temp = $result->{'publicationyear'};
1153 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
1155 $result->{'publicationyear'} = $1;
1156 } else { # if no cYYYY, get the 1st date.
1157 $temp =~ m/(\d\d\d\d)/;
1158 $result->{'publicationyear'} = $1;
1163 sub MARCmarc2kohaOneField {
1164 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
1165 my ($sth,$kohatable,$kohafield,$record,$result)= @_;
1166 # warn "kohatable / $kohafield / $result / ";
1170 $sth->execute($kohatable.".".$kohafield);
1171 ($tagfield,$subfield) = $sth->fetchrow;
1172 foreach my $field ($record->field($tagfield)) {
1173 if ($field->subfield($subfield)) {
1174 if ($result->{$kohafield}) {
1175 $result->{$kohafield} .= " | ".$field->subfield($subfield);
1177 $result->{$kohafield}=$field->subfield($subfield);
1185 # split a subfield string and adds it into the word table.
1187 my ($dbh,$bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$sentence) =@_;
1188 $sentence =~ s/(\.|\?|\:|\!|\'|,|\-|\"|\(|\)|\[|\]|\{|\})/ /g;
1189 my @words = split / /,$sentence;
1190 my $stopwords= C4::Context->stopwords;
1191 my $sth=$dbh->prepare("insert into marc_word (bibid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word)
1192 values (?,?,?,?,?,?,soundex(?))");
1193 foreach my $word (@words) {
1194 # we record only words longer than 2 car and not in stopwords hash
1195 if (length($word)>1 and !($stopwords->{uc($word)})) {
1196 $sth->execute($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,$word);
1198 warn "ERROR ==> insert into marc_word (bibid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word) values ($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,soundex($word))\n";
1205 # delete words. this sub deletes all the words from a sentence. a subfield modif is done by a delete then a add
1206 my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
1207 my $sth=$dbh->prepare("delete from marc_word where bibid=? and tag=? and tagorder=? and subfieldid=? and subfieldorder=?");
1208 $sth->execute($bibid,$tag,$tagorder,$subfield,$subfieldorder);
1213 # NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW
1216 # all the following subs are useful to manage MARC-DB with complete MARC records.
1217 # it's used with marcimport, and marc management tools
1221 =item ($bibid,$oldbibnum,$oldbibitemnum) = NEWnewbibilio($dbh,$MARCRecord,$oldbiblio,$oldbiblioitem);
1223 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
1224 are builded from the MARC::Record. If they are passed, they are used.
1226 =item NEWnewitem($dbh, $record,$bibid);
1228 adds an item in the db.
1233 my ($dbh, $record, $oldbiblio, $oldbiblioitem) = @_;
1234 # note $oldbiblio and $oldbiblioitem are not mandatory.
1235 # if not present, they will be builded from $record with MARCmarc2koha function
1236 if (($oldbiblio) and not($oldbiblioitem)) {
1237 print STDERR "NEWnewbiblio : missing parameter\n";
1238 print "NEWnewbiblio : missing parameter : contact koha development team\n";
1244 $oldbibnum = OLDnewbiblio($dbh,$oldbiblio);
1245 $oldbiblioitem->{'biblionumber'} = $oldbibnum;
1246 $oldbibitemnum = OLDnewbiblioitem($dbh,$oldbiblioitem);
1248 my $olddata = MARCmarc2koha($dbh,$record);
1249 $oldbibnum = OLDnewbiblio($dbh,$olddata);
1250 $olddata->{'biblionumber'} = $oldbibnum;
1251 $oldbibitemnum = OLDnewbiblioitem($dbh,$olddata);
1253 # search subtiles, addiauthors and subjects
1254 my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author");
1255 my @addiauthfields = $record->field($tagfield);
1256 foreach my $addiauthfield (@addiauthfields) {
1257 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
1258 foreach my $subfieldcount (0..$#addiauthsubfields) {
1259 OLDmodaddauthor($dbh,$oldbibnum,$addiauthsubfields[$subfieldcount]);
1262 ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.title");
1263 my @subtitlefields = $record->field($tagfield);
1264 foreach my $subtitlefield (@subtitlefields) {
1265 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
1266 foreach my $subfieldcount (0..$#subtitlesubfields) {
1267 OLDnewsubtitle($dbh,$oldbibnum,$subtitlesubfields[$subfieldcount]);
1270 ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject");
1271 my @subj = $record->field($tagfield);
1272 foreach my $subject (@subj) {
1273 my @subjsubfield = $subject->subfield($tagsubfield);
1275 foreach my $subfieldcount (0..$#subjsubfield) {
1276 push @subjects,$subjsubfield[$subfieldcount];
1278 OLDmodsubject($dbh,$oldbibnum,1,@subjects);
1280 # we must add bibnum and bibitemnum in MARC::Record...
1281 # we build the new field with biblionumber and biblioitemnumber
1282 # we drop the original field
1283 # we add the new builded field.
1284 # NOTE : Works only if the field is ONLY for biblionumber and biblioitemnumber
1285 # (steve and paul : thinks 090 is a good choice)
1286 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
1287 $sth->execute("biblio.biblionumber");
1288 (my $tagfield1, my $tagsubfield1) = $sth->fetchrow;
1289 $sth->execute("biblioitems.biblioitemnumber");
1290 (my $tagfield2, my $tagsubfield2) = $sth->fetchrow;
1291 if ($tagfield1 != $tagfield2) {
1292 warn "Error in NEWnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number";
1293 print "Content-Type: text/html\n\nError in NEWnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number";
1296 my $newfield = MARC::Field->new( $tagfield1,'','',
1297 "$tagsubfield1" => $oldbibnum,
1298 "$tagsubfield2" => $oldbibitemnum);
1299 # drop old field and create new one...
1300 my $old_field = $record->field($tagfield1);
1301 $record->delete_field($old_field);
1302 $record->add_fields($newfield);
1303 my $bibid = MARCaddbiblio($dbh,$record,$oldbibnum);
1304 return ($bibid,$oldbibnum,$oldbibitemnum );
1308 my ($dbh,$record,$bibid) =@_;
1309 &MARCmodbiblio($dbh,$bibid,$record,0);
1310 my $oldbiblio = MARCmarc2koha($dbh,$record);
1311 my $oldbiblionumber = OLDmodbiblio($dbh,$oldbiblio);
1312 OLDmodbibitem($dbh,$oldbiblio);
1313 # now, modify addi authors, subject, addititles.
1314 my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author");
1315 my @addiauthfields = $record->field($tagfield);
1316 foreach my $addiauthfield (@addiauthfields) {
1317 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
1318 foreach my $subfieldcount (0..$#addiauthsubfields) {
1319 OLDmodaddauthor($dbh,$oldbiblionumber,$addiauthsubfields[$subfieldcount]);
1322 ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle");
1323 my @subtitlefields = $record->field($tagfield);
1324 foreach my $subtitlefield (@subtitlefields) {
1325 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
1326 foreach my $subfieldcount (0..$#subtitlesubfields) {
1327 OLDmodsubtitle($dbh,$oldbiblionumber,$subtitlesubfields[$subfieldcount]);
1330 ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject");
1331 my @subj = $record->field($tagfield);
1332 foreach my $subject (@subj) {
1333 my @subjsubfield = $subject->subfield($tagsubfield);
1335 foreach my $subfieldcount (0..$#subjsubfield) {
1336 push @subjects,$subjsubfield[$subfieldcount];
1338 OLDmodsubject($dbh,$oldbiblionumber,1,@subjects);
1345 my ($dbh, $record,$bibid) = @_;
1346 # add item in old-DB
1347 my $item = &MARCmarc2koha($dbh,$record);
1348 # needs old biblionumber and biblioitemnumber
1349 $item->{'biblionumber'} = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
1350 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
1351 $sth->execute($item->{'biblionumber'});
1352 ($item->{'biblioitemnumber'}) = $sth->fetchrow;
1353 my ($itemnumber,$error) = &OLDnewitems($dbh,$item,$item->{barcode});
1354 # add itemnumber to MARC::Record before adding the item.
1355 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
1356 &MARCkoha2marcOnefield($sth,$record,"items.itemnumber",$itemnumber);
1358 my $bib = &MARCadditem($dbh,$record,$item->{'biblionumber'});
1362 my ($dbh,$record,$bibid,$itemnumber,$delete) = @_;
1363 &MARCmoditem($dbh,$record,$bibid,$itemnumber,$delete);
1364 my $olditem = MARCmarc2koha($dbh,$record);
1365 OLDmoditem($dbh,$olditem);
1370 # OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD
1374 =item $biblionumber = OLDnewbiblio($dbh,$biblio);
1376 adds a record in biblio table. Datas are in the hash $biblio.
1378 =item $biblionumber = OLDmodbiblio($dbh,$biblio);
1380 modify a record in biblio table. Datas are in the hash $biblio.
1382 =item OLDmodsubtitle($dbh,$bibnum,$subtitle);
1384 modify subtitles in bibliosubtitle table.
1386 =item OLDmodaddauthor($dbh,$bibnum,$author);
1388 adds or modify additional authors
1389 NOTE : Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
1391 =item $errors = OLDmodsubject($dbh,$bibnum, $force, @subject);
1393 modify/adds subjects
1395 =item OLDmodbibitem($dbh, $biblioitem);
1399 =item OLDmodnote($dbh,$bibitemnum,$note
1401 modify a note for a biblioitem
1403 =item OLDnewbiblioitem($dbh,$biblioitem);
1405 adds a biblioitem ($biblioitem is a hash with the values)
1407 =item OLDnewsubject($dbh,$bibnum);
1411 =item OLDnewsubtitle($dbh,$bibnum,$subtitle);
1413 create a new subtitle
1415 =item ($itemnumber,$errors)= OLDnewitems($dbh,$item,$barcode);
1417 create a item. $item is a hash and $barcode the barcode.
1419 =item OLDmoditem($dbh,$item);
1423 =item OLDdelitem($dbh,$itemnum);
1427 =item OLDdeletebiblioitem($dbh,$biblioitemnumber);
1429 deletes a biblioitem
1430 NOTE : not standard sub name. Should be OLDdelbiblioitem()
1432 =item OLDdelbiblio($dbh,$biblio);
1439 my ($dbh,$biblio) = @_;
1440 # my $dbh = &C4Connect;
1441 my $query = "Select max(biblionumber) from biblio";
1442 my $sth = $dbh->prepare($query);
1444 my $data = $sth->fetchrow_arrayref;
1445 my $bibnum = $$data[0] + 1;
1448 if ($biblio->{'seriestitle'}) { $series = 1 };
1450 $query = "insert into biblio set biblionumber = ?, title = ?, author = ?, copyrightdate = ?,
1451 serial = ?, seriestitle = ?, notes = ?, abstract = ?";
1452 $sth = $dbh->prepare($query);
1453 $sth->execute($bibnum,$biblio->{'title'},$biblio->{'author'},$biblio->{'copyright'},$series,$biblio->{'seriestitle'},$biblio->{'notes'},$biblio->{'abstract'});
1461 my ($dbh,$biblio) = @_;
1462 # my $dbh = C4Connect;
1466 $query = "Update biblio set title = ?, author = ?, abstract = ?, copyrightdate = ?,
1467 seriestitle = ?, serial = ?, unititle = ?, notes = ? where biblionumber = ?";
1468 $sth = $dbh->prepare($query);
1469 $sth->execute($biblio->{'title'},$biblio->{'author'},$biblio->{'abstract'},$biblio->{'copyrightdate'},
1470 $biblio->{'seriestitle'},$biblio->{'serial'},$biblio->{'unititle'},$biblio->{'notes'},$biblio->{'biblionumber'});
1473 return($biblio->{'biblionumber'});
1476 sub OLDmodsubtitle {
1477 my ($dbh,$bibnum, $subtitle) = @_;
1478 my $query = "update bibliosubtitle set subtitle = ? where biblionumber = ?";
1479 my $sth = $dbh->prepare($query);
1480 $sth->execute($subtitle,$bibnum);
1485 sub OLDmodaddauthor {
1486 my ($dbh,$bibnum, $author) = @_;
1487 # my $dbh = C4Connect;
1488 my $query = "Delete from additionalauthors where biblionumber = $bibnum";
1489 my $sth = $dbh->prepare($query);
1494 if ($author ne '') {
1495 $query = "Insert into additionalauthors set
1498 $sth = $dbh->prepare($query);
1500 $sth->execute($author,$bibnum);
1504 } # sub modaddauthor
1508 my ($dbh,$bibnum, $force, @subject) = @_;
1509 # my $dbh = C4Connect;
1510 my $count = @subject;
1512 for (my $i = 0; $i < $count; $i++) {
1513 $subject[$i] =~ s/^ //g;
1514 $subject[$i] =~ s/ $//g;
1515 my $query = "select * from catalogueentry where entrytype = 's' and catalogueentry = '$subject[$i]'";
1516 my $sth = $dbh->prepare($query);
1519 if (my $data = $sth->fetchrow_hashref) {
1521 if ($force eq $subject[$i] || $force eq 1) {
1522 # subject not in aut, chosen to force anway
1523 # so insert into cataloguentry so its in auth file
1524 $query = "Insert into catalogueentry (entrytype,catalogueentry) values ('s','$subject[$i]')";
1525 my $sth2 = $dbh->prepare($query);
1530 $error = "$subject[$i]\n does not exist in the subject authority file";
1531 $query = "Select * from catalogueentry where entrytype = 's' and (catalogueentry like '$subject[$i] %'
1532 or catalogueentry like '% $subject[$i] %' or catalogueentry like '% $subject[$i]')";
1533 my $sth2 = $dbh->prepare($query);
1535 while (my $data = $sth2->fetchrow_hashref) {
1536 $error .= "<br>$data->{'catalogueentry'}";
1544 my $query = "Delete from bibliosubject where biblionumber = $bibnum";
1545 my $sth = $dbh->prepare($query);
1548 for (my $i = 0; $i < $count; $i++) {
1549 $sth = $dbh->prepare("Insert into bibliosubject values ('$subject[$i]', $bibnum)");
1560 my ($dbh,$biblioitem) = @_;
1561 # my $dbh = C4Connect;
1564 $biblioitem->{'itemtype'} = $dbh->quote($biblioitem->{'itemtype'});
1565 $biblioitem->{'url'} = $dbh->quote($biblioitem->{'url'});
1566 $biblioitem->{'isbn'} = $dbh->quote($biblioitem->{'isbn'});
1567 $biblioitem->{'publishercode'} = $dbh->quote($biblioitem->{'publishercode'});
1568 $biblioitem->{'publicationyear'} = $dbh->quote($biblioitem->{'publicationyear'});
1569 $biblioitem->{'classification'} = $dbh->quote($biblioitem->{'classification'});
1570 $biblioitem->{'dewey'} = $dbh->quote($biblioitem->{'dewey'});
1571 $biblioitem->{'subclass'} = $dbh->quote($biblioitem->{'subclass'});
1572 $biblioitem->{'illus'} = $dbh->quote($biblioitem->{'illus'});
1573 $biblioitem->{'pages'} = $dbh->quote($biblioitem->{'pages'});
1574 $biblioitem->{'volumeddesc'} = $dbh->quote($biblioitem->{'volumeddesc'});
1575 $biblioitem->{'bnotes'} = $dbh->quote($biblioitem->{'bnotes'});
1576 $biblioitem->{'size'} = $dbh->quote($biblioitem->{'size'});
1577 $biblioitem->{'place'} = $dbh->quote($biblioitem->{'place'});
1579 $query = "Update biblioitems set
1580 itemtype = $biblioitem->{'itemtype'},
1581 url = $biblioitem->{'url'},
1582 isbn = $biblioitem->{'isbn'},
1583 publishercode = $biblioitem->{'publishercode'},
1584 publicationyear = $biblioitem->{'publicationyear'},
1585 classification = $biblioitem->{'classification'},
1586 dewey = $biblioitem->{'dewey'},
1587 subclass = $biblioitem->{'subclass'},
1588 illus = $biblioitem->{'illus'},
1589 pages = $biblioitem->{'pages'},
1590 volumeddesc = $biblioitem->{'volumeddesc'},
1591 notes = $biblioitem->{'bnotes'},
1592 size = $biblioitem->{'size'},
1593 place = $biblioitem->{'place'}
1594 where biblioitemnumber = $biblioitem->{'biblioitemnumber'}";
1604 my ($dbh,$bibitemnum,$note)=@_;
1605 # my $dbh=C4Connect;
1606 my $query="update biblioitems set notes='$note' where
1607 biblioitemnumber='$bibitemnum'";
1608 my $sth=$dbh->prepare($query);
1614 sub OLDnewbiblioitem {
1615 my ($dbh,$biblioitem) = @_;
1616 # my $dbh = C4Connect;
1617 my $query = "Select max(biblioitemnumber) from biblioitems";
1618 my $sth = $dbh->prepare($query);
1623 $data = $sth->fetchrow_arrayref;
1624 $bibitemnum = $$data[0] + 1;
1628 $sth = $dbh->prepare("insert into biblioitems set
1629 biblioitemnumber = ?, biblionumber = ?,
1630 volume = ?, number = ?,
1631 classification = ?, itemtype = ?,
1633 issn = ?, dewey = ?,
1634 subclass = ?, publicationyear = ?,
1635 publishercode = ?, volumedate = ?,
1636 volumeddesc = ?, illus = ?,
1637 pages = ?, notes = ?,
1639 marc = ?, place = ?");
1640 $sth->execute($bibitemnum, $biblioitem->{'biblionumber'},
1641 $biblioitem->{'volume'}, $biblioitem->{'number'},
1642 $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
1643 $biblioitem->{'url'}, $biblioitem->{'isbn'},
1644 $biblioitem->{'issn'}, $biblioitem->{'dewey'},
1645 $biblioitem->{'subclass'}, $biblioitem->{'publicationyear'},
1646 $biblioitem->{'publishercode'}, $biblioitem->{'volumedate'},
1647 $biblioitem->{'volumeddesc'}, $biblioitem->{'illus'},
1648 $biblioitem->{'pages'}, $biblioitem->{'bnotes'},
1649 $biblioitem->{'size'}, $biblioitem->{'lccn'},
1650 $biblioitem->{'marc'}, $biblioitem->{'place'});
1653 return($bibitemnum);
1657 my ($dbh,$bibnum)=@_;
1658 my $query="insert into bibliosubject (biblionumber) values ($bibnum)";
1659 my $sth=$dbh->prepare($query);
1664 sub OLDnewsubtitle {
1665 my ($dbh,$bibnum, $subtitle) = @_;
1666 my $query = "insert into bibliosubtitle set biblionumber = ?, subtitle = ?";
1667 my $sth = $dbh->prepare($query);
1668 $sth->execute($bibnum,$subtitle);
1674 my ($dbh,$item, $barcode) = @_;
1675 # my $dbh = C4Connect;
1676 my $query = "Select max(itemnumber) from items";
1677 my $sth = $dbh->prepare($query);
1683 $data = $sth->fetchrow_hashref;
1684 $itemnumber = $data->{'max(itemnumber)'} + 1;
1686 # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1687 if ($item->{'dateaccessioned'}) {
1688 $sth=$dbh->prepare("Insert into items set
1689 itemnumber = ?, biblionumber = ?,
1690 biblioitemnumber = ?, barcode = ?,
1691 booksellerid = ?, dateaccessioned = ?,
1692 homebranch = ?, holdingbranch = ?,
1693 price = ?, replacementprice = ?,
1694 replacementpricedate = NOW(), itemnotes = ?,
1697 $sth->execute($itemnumber, $item->{'biblionumber'},
1698 $item->{'biblioitemnumber'},$barcode,
1699 $item->{'booksellerid'},$item->{'dateaccessioned'},
1700 $item->{'homebranch'},$item->{'holdingbranch'},
1701 $item->{'price'},$item->{'replacementprice'},
1702 $item->{'itemnotes'},$item->{'loan'});
1704 $sth=$dbh->prepare("Insert into items set
1705 itemnumber = ?, biblionumber = ?,
1706 biblioitemnumber = ?, barcode = ?,
1707 booksellerid = ?, dateaccessioned = NOW(),
1708 homebranch = ?, holdingbranch = ?,
1709 price = ?, replacementprice = ?,
1710 replacementpricedate = NOW(), itemnotes = ?,
1713 $sth->execute($itemnumber, $item->{'biblionumber'},
1714 $item->{'biblioitemnumber'},$barcode,
1715 $item->{'booksellerid'},
1716 $item->{'homebranch'},$item->{'holdingbranch'},
1717 $item->{'price'},$item->{'replacementprice'},
1718 $item->{'itemnotes'},$item->{'loan'});
1720 if (defined $sth->errstr) {
1721 $error .= $sth->errstr;
1724 return($itemnumber,$error);
1728 my ($dbh,$item) = @_;
1729 # my ($dbh,$loan,$itemnum,$bibitemnum,$barcode,$notes,$homebranch,$lost,$wthdrawn,$replacement)=@_;
1730 # my $dbh=C4Connect;
1731 $item->{'itemnum'}=$item->{'itemnumber'} unless $item->{'itemnum'};
1732 my $query="update items set barcode='$item->{'barcode'}',itemnotes='$item->{'notes'}'
1733 where itemnumber=$item->{'itemnum'}";
1734 if ($item->{'barcode'} eq ''){
1735 $item->{'notforloan'}=0 unless $item->{'notforloan'};
1736 $query="update items set notforloan=$item->{'notforloan'} where itemnumber=$item->{'itemnum'}";
1738 if ($item->{'lost'} ne ''){
1739 $query="update items set biblioitemnumber=$item->{'bibitemnum'},
1740 barcode='$item->{'barcode'}',
1741 itemnotes='$item->{'notes'}',
1742 homebranch='$item->{'homebranch'}',
1743 itemlost='$item->{'lost'}',
1744 wthdrawn='$item->{'wthdrawn'}'
1745 where itemnumber=$item->{'itemnum'}";
1747 if ($item->{'replacement'} ne ''){
1748 $query=~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1750 my $sth=$dbh->prepare($query);
1757 my ($dbh,$itemnum)=@_;
1758 # my $dbh=C4Connect;
1759 my $query="select * from items where itemnumber=$itemnum";
1760 my $sth=$dbh->prepare($query);
1762 my @data=$sth->fetchrow_array;
1764 $query="Insert into deleteditems values (";
1765 foreach my $temp (@data){
1766 $query .= "'$temp',";
1770 $sth=$dbh->prepare($query);
1773 $query = "Delete from items where itemnumber=$itemnum";
1774 $sth=$dbh->prepare($query);
1780 sub OLDdeletebiblioitem {
1781 my ($dbh,$biblioitemnumber) = @_;
1782 # my $dbh = C4Connect;
1783 my $query = "Select * from biblioitems
1784 where biblioitemnumber = $biblioitemnumber";
1785 my $sth = $dbh->prepare($query);
1790 if (@results = $sth->fetchrow_array) {
1791 $query = "Insert into deletedbiblioitems values (";
1792 foreach my $value (@results) {
1793 $value = $dbh->quote($value);
1794 $query .= "$value,";
1797 $query =~ s/\,$/\)/;
1800 $query = "Delete from biblioitems
1801 where biblioitemnumber = $biblioitemnumber";
1805 # Now delete all the items attached to the biblioitem
1806 $query = "Select * from items where biblioitemnumber = $biblioitemnumber";
1807 $sth = $dbh->prepare($query);
1809 while (@results = $sth->fetchrow_array) {
1810 $query = "Insert into deleteditems values (";
1811 foreach my $value (@results) {
1812 $value = $dbh->quote($value);
1813 $query .= "$value,";
1815 $query =~ s/\,$/\)/;
1819 $query = "Delete from items where biblioitemnumber = $biblioitemnumber";
1822 } # sub deletebiblioitem
1825 my ($dbh,$biblio)=@_;
1826 # my $dbh=C4Connect;
1827 my $query="select * from biblio where biblionumber=$biblio";
1828 my $sth=$dbh->prepare($query);
1830 if (my @data=$sth->fetchrow_array){
1832 $query="Insert into deletedbiblio values (";
1833 foreach my $temp (@data){
1834 $temp=~ s/\'/\\\'/g;
1835 $query .= "'$temp',";
1839 $sth=$dbh->prepare($query);
1842 $query = "Delete from biblio where biblionumber=$biblio";
1843 $sth=$dbh->prepare($query);
1859 my $dbh = C4::Context->dbh;
1860 my $query="Select count(*) from items where biblionumber=$biblio";
1862 my $sth=$dbh->prepare($query);
1864 my $data=$sth->fetchrow_hashref;
1866 return($data->{'count(*)'});
1871 ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
1873 Looks up the order with the given biblionumber and biblioitemnumber.
1875 Returns a two-element array. C<$ordernumber> is the order number.
1876 C<$order> is a reference-to-hash describing the order; its keys are
1877 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
1878 tables of the Koha database.
1882 # FIXME - This is effectively identical to &C4::Catalogue::getorder.
1883 # Pick one and stick with it.
1886 my $dbh = C4::Context->dbh;
1887 my $query="Select ordernumber
1889 where biblionumber=? and biblioitemnumber=?";
1890 my $sth=$dbh->prepare($query);
1891 $sth->execute($bib,$bi);
1892 # FIXME - Use fetchrow_array(), since we're only interested in the one
1894 my $ordnum=$sth->fetchrow_hashref;
1896 my $order=getsingleorder($ordnum->{'ordernumber'});
1898 return ($order,$ordnum->{'ordernumber'});
1901 =item getsingleorder
1903 $order = &getsingleorder($ordernumber);
1905 Looks up an order by order number.
1907 Returns a reference-to-hash describing the order. The keys of
1908 C<$order> are fields from the biblio, biblioitems, aqorders, and
1909 aqorderbreakdown tables of the Koha database.
1913 # FIXME - This is effectively identical to
1914 # &C4::Catalogue::getsingleorder.
1915 # Pick one and stick with it.
1916 sub getsingleorder {
1918 my $dbh = C4::Context->dbh;
1919 my $query="Select * from biblio,biblioitems,aqorders,aqorderbreakdown
1920 where aqorders.ordernumber=?
1921 and biblio.biblionumber=aqorders.biblionumber and
1922 biblioitems.biblioitemnumber=aqorders.biblioitemnumber and
1923 aqorders.ordernumber=aqorderbreakdown.ordernumber";
1924 my $sth=$dbh->prepare($query);
1925 $sth->execute($ordnum);
1926 my $data=$sth->fetchrow_hashref;
1933 my $dbh = C4::Context->dbh;
1934 my $bibnum=OLDnewbiblio($dbh,$biblio);
1935 # finds new (MARC bibid
1936 # my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1937 my $record = &MARCkoha2marcBiblio($dbh,$bibnum);
1938 MARCaddbiblio($dbh,$record,$bibnum);
1944 $biblionumber = &modbiblio($biblio);
1946 Update a biblio record.
1948 C<$biblio> is a reference-to-hash whose keys are the fields in the
1949 biblio table in the Koha database. All fields must be present, not
1950 just the ones you wish to change.
1952 C<&modbiblio> updates the record defined by
1953 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1955 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1962 my $dbh = C4::Context->dbh;
1963 my $biblionumber=OLDmodbiblio($dbh,$biblio);
1964 my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
1965 # finds new (MARC bibid
1966 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
1967 MARCmodbiblio($dbh,$bibid,$record,0);
1968 return($biblionumber);
1973 &modsubtitle($biblionumber, $subtitle);
1975 Sets the subtitle of a book.
1977 C<$biblionumber> is the biblionumber of the book to modify.
1979 C<$subtitle> is the new subtitle.
1984 my ($bibnum, $subtitle) = @_;
1985 my $dbh = C4::Context->dbh;
1986 &OLDmodsubtitle($dbh,$bibnum,$subtitle);
1991 &modaddauthor($biblionumber, $author);
1993 Replaces all additional authors for the book with biblio number
1994 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1995 C<&modaddauthor> deletes all additional authors.
2000 my ($bibnum, $author) = @_;
2001 my $dbh = C4::Context->dbh;
2002 &OLDmodaddauthor($dbh,$bibnum,$author);
2003 } # sub modaddauthor
2007 $error = &modsubject($biblionumber, $force, @subjects);
2009 $force - a subject to force
2011 $error - Error message, or undef if successful.
2016 my ($bibnum, $force, @subject) = @_;
2017 my $dbh = C4::Context->dbh;
2018 my $error= &OLDmodsubject($dbh,$bibnum,$force, @subject);
2023 my ($biblioitem) = @_;
2024 my $dbh = C4::Context->dbh;
2025 &OLDmodbibitem($dbh,$biblioitem);
2029 my ($bibitemnum,$note)=@_;
2030 my $dbh = C4::Context->dbh;
2031 &OLDmodnote($dbh,$bibitemnum,$note);
2035 my ($biblioitem) = @_;
2036 my $dbh = C4::Context->dbh;
2037 my $bibitemnum = &OLDnewbiblioitem($dbh,$biblioitem);
2038 my $MARCbiblio= MARCkoha2marcBiblio($dbh,0,$bibitemnum); # the 0 means "do NOT retrieve biblio, only biblioitem, in the MARC record
2039 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblioitem->{biblionumber});
2040 &MARCaddbiblio($dbh,$MARCbiblio,$biblioitem->{biblionumber},$bibid);
2041 return($bibitemnum);
2046 my $dbh = C4::Context->dbh;
2047 &OLDnewsubject($dbh,$bibnum);
2051 my ($bibnum, $subtitle) = @_;
2052 my $dbh = C4::Context->dbh;
2053 &OLDnewsubtitle($dbh,$bibnum,$subtitle);
2057 my ($item, @barcodes) = @_;
2058 my $dbh = C4::Context->dbh;
2062 foreach my $barcode (@barcodes) {
2063 ($itemnumber,$error)=&OLDnewitems($dbh,$item,uc($barcode));
2065 my $MARCitem = &MARCkoha2marcItem($dbh,$item->{biblionumber},$itemnumber);
2066 &MARCadditem($dbh,$MARCitem,$item->{biblionumber});
2073 my $dbh = C4::Context->dbh;
2074 &OLDmoditem($dbh,$item);
2075 my $MARCitem = &MARCkoha2marcItem($dbh,$item->{'biblionumber'},$item->{'itemnum'});
2076 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$item->{biblionumber});
2077 &MARCmoditem($dbh,$MARCitem,$bibid,$item->{itemnum},0);
2081 my ($count,@barcodes)=@_;
2082 my $dbh = C4::Context->dbh;
2084 for (my $i=0;$i<$count;$i++){
2085 $barcodes[$i]=uc $barcodes[$i];
2086 my $query="Select * from items where barcode='$barcodes[$i]'";
2087 my $sth=$dbh->prepare($query);
2089 if (my $data=$sth->fetchrow_hashref){
2090 $error.=" Duplicate Barcode: $barcodes[$i]";
2098 my ($bibitemnum)=@_;
2099 my $dbh = C4::Context->dbh;
2100 my $query="Select count(*) from items where biblioitemnumber='$bibitemnum'";
2101 my $sth=$dbh->prepare($query);
2103 my $data=$sth->fetchrow_hashref;
2105 return($data->{'count(*)'});
2110 my $dbh = C4::Context->dbh;
2111 &OLDdelitem($dbh,$itemnum);
2114 sub deletebiblioitem {
2115 my ($biblioitemnumber) = @_;
2116 my $dbh = C4::Context->dbh;
2117 &OLDdeletebiblioitem($dbh,$biblioitemnumber);
2118 } # sub deletebiblioitem
2123 my $dbh = C4::Context->dbh;
2124 &OLDdelbiblio($dbh,$biblio);
2128 my $dbh = C4::Context->dbh;
2129 my $query = "select * from itemtypes order by description";
2130 my $sth = $dbh->prepare($query);
2131 # || die "Cannot prepare $query" . $dbh->errstr;
2136 # || die "Cannot execute $query\n" . $sth->errstr;
2137 while (my $data = $sth->fetchrow_hashref) {
2138 $results[$count] = $data;
2143 return($count, @results);
2144 } # sub getitemtypes
2147 my ($biblionumber) = @_;
2148 my $dbh = C4::Context->dbh;
2149 my $query = "Select * from biblio where biblionumber = $biblionumber";
2150 my $sth = $dbh->prepare($query);
2151 # || die "Cannot prepare $query\n" . $dbh->errstr;
2156 # || die "Cannot execute $query\n" . $sth->errstr;
2157 while (my $data = $sth->fetchrow_hashref) {
2158 $results[$count] = $data;
2163 return($count, @results);
2167 my ($biblioitemnum) = @_;
2168 my $dbh = C4::Context->dbh;
2169 my $query = "Select * from biblioitems where
2170 biblioitemnumber = $biblioitemnum";
2171 my $sth = $dbh->prepare($query);
2177 while (my $data = $sth->fetchrow_hashref) {
2178 $results[$count] = $data;
2183 return($count, @results);
2184 } # sub getbiblioitem
2186 sub getbiblioitembybiblionumber {
2187 my ($biblionumber) = @_;
2188 my $dbh = C4::Context->dbh;
2189 my $query = "Select * from biblioitems where biblionumber =
2191 my $sth = $dbh->prepare($query);
2197 while (my $data = $sth->fetchrow_hashref) {
2198 $results[$count] = $data;
2203 return($count, @results);
2206 sub getitemsbybiblioitem {
2207 my ($biblioitemnum) = @_;
2208 my $dbh = C4::Context->dbh;
2209 my $query = "Select * from items, biblio where
2210 biblio.biblionumber = items.biblionumber and biblioitemnumber
2212 my $sth = $dbh->prepare($query);
2213 # || die "Cannot prepare $query\n" . $dbh->errstr;
2218 # || die "Cannot execute $query\n" . $sth->errstr;
2219 while (my $data = $sth->fetchrow_hashref) {
2220 $results[$count] = $data;
2225 return($count, @results);
2226 } # sub getitemsbybiblioitem
2230 # Subroutine to log changes to databases
2231 # Eventually, this subroutine will be used to create a log of all changes made,
2232 # with the possibility of "undo"ing some changes
2234 if ($database eq 'kohadb') {
2240 # print STDERR "KOHA: $type $section $item $original $new\n";
2241 } elsif ($database eq 'marc') {
2243 my $Record_ID=shift;
2246 my $subfield_ID=shift;
2249 # print STDERR "MARC: $type $Record_ID $tag $mark $subfield_ID $original $new\n";
2253 #------------------------------------------------
2256 #---------------------------------------
2257 # Find a biblio entry, or create a new one if it doesn't exist.
2258 # If a "subtitle" entry is in hash, add it to subtitle table
2259 sub getoraddbiblio {
2263 # FIXME - Unused argument
2264 $biblio, # hash ref to fields
2275 $dbh = C4::Context->dbh;
2277 print "<PRE>Looking for biblio </PRE>\n" if $debug;
2278 $sth=$dbh->prepare("select biblionumber
2280 where title=? and author=?
2281 and copyrightdate=? and seriestitle=?");
2283 $biblio->{title}, $biblio->{author},
2284 $biblio->{copyright}, $biblio->{seriestitle} );
2286 ($biblionumber) = $sth->fetchrow;
2287 print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
2289 # Doesn't exist. Add new one.
2290 print "<PRE>Adding biblio</PRE>\n" if $debug;
2291 ($biblionumber,$error)=&newbiblio($biblio);
2292 if ( $biblionumber ) {
2293 print "<PRE>Added with biblio number=$biblionumber</PRE>\n" if $debug;
2294 if ( $biblio->{subtitle} ) {
2295 &newsubtitle($biblionumber,$biblio->{subtitle} );
2298 print "<PRE>Couldn't add biblio: $error</PRE>\n" if $debug;
2302 return $biblionumber,$error;
2304 } # sub getoraddbiblio
2307 # converts ISO 5426 coded string to ISO 8859-1
2308 # sloppy code : should be improved in next issue
2309 my ($string,$encoding) = @_ ;
2311 # $encoding = C4::Context->preference("marcflavour") unless $encoding;
2312 if ($encoding eq "UNIMARC") {
2374 # this handles non-sorting blocks (if implementation requires this)
2375 $string = nsb_clean($_) ;
2376 } elsif ($encoding eq "USMARC" || $encoding eq "MARC21") {
2429 # this handles non-sorting blocks (if implementation requires this)
2430 $string = nsb_clean($_) ;
2437 my $NSB = '\x88' ; # NSB : begin Non Sorting Block
2438 my $NSE = '\x89' ; # NSE : Non Sorting Block end
2439 # handles non sorting blocks
2443 s/[ ]{0,1}$NSE/) /gm ;
2448 END { } # module clean-up code here (global destructor)
2454 Koha Developement team <info@koha.org>
2456 Paul POULAIN paul.poulain@free.fr