4 # Revision 1.40 2003/03/11 15:14:03 tipaul
7 # Revision 1.39 2003/03/07 16:35:42 tipaul
8 # * moving generic functions to Koha.pm
9 # * improvement of SearchMarc.pm
13 # Revision 1.38 2003/02/27 16:51:59 tipaul
14 # * moving prepare / execute to ? form.
17 # * road to 1.9.2 => acquisition and cataloguing merging
19 # Revision 1.37 2003/02/12 11:03:03 tipaul
20 # Support for 000 -> 010 fields.
21 # Those fields doesn't have subfields.
22 # In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@".
23 # 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.
25 # Revision 1.36 2003/02/12 11:01:01 tipaul
26 # Support for 000 -> 010 fields.
27 # Those fields doesn't have subfields.
28 # In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@".
29 # 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.
31 # Revision 1.35 2003/02/03 18:46:00 acli
32 # Minor factoring in C4/Biblio.pm, plus change to export the per-tag
33 # 'mandatory' property to a per-subfield 'tag_mandatory' template parameter,
34 # so that addbiblio.tmpl can distinguish between mandatory subfields in a
35 # mandatory tag and mandatory subfields in an optional tag
37 # Not-minor factoring in acqui.simple/addbiblio.pl to make the if-else blocks
38 # smaller, and to add some POD; need further testing for this
40 # Added function to check if a MARC subfield name is "koha-internal" (instead
41 # of checking it for 'lib' and 'tag' everywhere); temporarily added to Koha.pm
43 # Use above function in acqui.simple/additem.pl and search.marc/search.pl
45 # Revision 1.34 2003/01/28 14:50:04 tipaul
46 # fixing MARCmodbiblio API and reindenting code
48 # Revision 1.33 2003/01/23 12:22:37 tipaul
49 # adding char_decode to decode MARC21 or UNIMARC extended chars
51 # Revision 1.32 2002/12/16 15:08:50 tipaul
52 # small but important bugfix (fixes a problem in export)
54 # Revision 1.31 2002/12/13 16:22:04 tipaul
55 # 1st draft of marc export
57 # Revision 1.30 2002/12/12 21:26:35 tipaul
58 # YAB ! (Yet Another Bugfix) => related to biblio modif
59 # (some warning cleaning too)
61 # Revision 1.29 2002/12/12 16:35:00 tipaul
62 # adding authentification with Auth.pm and
63 # MAJOR BUGFIX on marc biblio modification
65 # Revision 1.28 2002/12/10 13:30:03 tipaul
66 # fugfixes from Dombes Abbey work
68 # Revision 1.27 2002/11/19 12:36:16 tipaul
70 # various bugfixes, improvments, and migration from acquisition.pm to biblio.pm
72 # Revision 1.26 2002/11/12 15:58:43 tipaul
75 # * 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)
77 # Revision 1.25 2002/10/25 10:58:26 tipaul
79 # * bugfixes and improvements
81 # Revision 1.24 2002/10/24 12:09:01 arensb
82 # Fixed "no title" warning when generating HTML documentation from POD.
84 # Revision 1.23 2002/10/16 12:43:08 arensb
85 # Added some FIXME comments.
87 # Revision 1.22 2002/10/15 13:39:17 tipaul
88 # removing Acquisition.pm
89 # deleting unused code in biblio.pm, rewriting POD and answering most FIXME comments
91 # Revision 1.21 2002/10/13 11:34:14 arensb
92 # Replaced expressions of the form "$x = $x <op> $y" with "$x <op>= $y".
93 # Thus, $x = $x+2 becomes $x += 2, and so forth.
95 # Revision 1.20 2002/10/13 08:28:32 arensb
96 # Deleted unused variables.
97 # Removed trailing whitespace.
99 # Revision 1.19 2002/10/13 05:56:10 arensb
100 # Added some FIXME comments.
102 # Revision 1.18 2002/10/11 12:34:53 arensb
103 # Replaced &requireDBI with C4::Context->dbh
105 # Revision 1.17 2002/10/10 14:48:25 tipaul
108 # Revision 1.16 2002/10/07 14:04:26 tipaul
109 # road to 1.3.1 : viewing MARC biblio
111 # Revision 1.15 2002/10/05 09:49:25 arensb
112 # Merged with arensb-context branch: use C4::Context->dbh instead of
113 # &C4Connect, and generally prefer C4::Context over C4::Database.
115 # Revision 1.14 2002/10/03 11:28:18 tipaul
116 # Extending Context.pm to add stopword management and using it in MARC-API.
117 # First benchmarks show a medium speed improvement, which is nice as this part is heavily called.
119 # Revision 1.13 2002/10/02 16:26:44 tipaul
122 # Revision 1.12.2.4 2002/10/05 07:09:31 arensb
123 # Merged in changes from main branch.
125 # Revision 1.12.2.3 2002/10/05 06:12:10 arensb
126 # Added a whole mess of FIXME comments.
128 # Revision 1.12.2.2 2002/10/05 04:03:14 arensb
129 # Added some missing semicolons.
131 # Revision 1.12.2.1 2002/10/04 02:24:01 arensb
132 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
135 # Revision 1.12.2.3 2002/10/05 06:12:10 arensb
136 # Added a whole mess of FIXME comments.
138 # Revision 1.12.2.2 2002/10/05 04:03:14 arensb
139 # Added some missing semicolons.
141 # Revision 1.12.2.1 2002/10/04 02:24:01 arensb
142 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
145 # Revision 1.12 2002/10/01 11:48:51 arensb
146 # Added some FIXME comments, mostly marking duplicate functions.
148 # Revision 1.11 2002/09/24 13:49:26 tipaul
149 # long WAS the road to 1.3.0...
150 # coming VERY SOON NOW...
151 # modifying installer and buildrelease to update the DB
153 # Revision 1.10 2002/09/22 16:50:08 arensb
154 # Added some FIXME comments.
156 # Revision 1.9 2002/09/20 12:57:46 tipaul
157 # long is the road to 1.4.0
158 # * MARCadditem and MARCmoditem now wroks
159 # * various bugfixes in MARC management
160 # !!! 1.3.0 should be released very soon now. Be careful !!!
162 # Revision 1.8 2002/09/10 13:53:52 tipaul
163 # MARC API continued...
165 # * 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)
167 # Note : it should not be hard for marcimport and marcexport to re-link fields from internal tag/subfield to "legal" tag/subfield.
169 # Revision 1.7 2002/08/14 18:12:51 tonnesen
170 # Added copyright statement to all .pl and .pm files
172 # Revision 1.6 2002/07/25 13:40:31 tipaul
173 # pod documenting the API.
175 # Revision 1.5 2002/07/24 16:11:37 tipaul
177 # Database.pm and Output.pm are almost not modified (var test...)
179 # Biblio.pm is almost completly rewritten.
181 # WHAT DOES IT ??? ==> END of Hitchcock suspens
183 # 1st, it does... nothing...
184 # 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 ...
186 # All old-API functions have been cloned. for example, the "newbiblio" sub, now has become :
187 # * a "newbiblio" sub, with the same parameters. It just call a sub named OLDnewbiblio
188 # * 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.
189 # * 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.
190 # 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 ;-)
192 # 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.
193 # Note we have decided with steve that a old-biblio <=> a MARC-Biblio.
197 # Copyright 2000-2002 Katipo Communications
199 # This file is part of Koha.
201 # Koha is free software; you can redistribute it and/or modify it under the
202 # terms of the GNU General Public License as published by the Free Software
203 # Foundation; either version 2 of the License, or (at your option) any later
206 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
207 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
208 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
210 # You should have received a copy of the GNU General Public License along with
211 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
212 # Suite 330, Boston, MA 02111-1307 USA
220 use vars qw($VERSION @ISA @EXPORT);
222 # set the version for version checking
227 # don't forget MARCxxx subs are here only for testing purposes. Should not be used
228 # as the old-style API and the NEW one are the only public functions.
231 &updateBiblio &updateBiblioItem &updateItem
232 &itemcount &newbiblio &newbiblioitem
233 &modnote &newsubject &newsubtitle
234 &modbiblio &checkitems
235 &newitems &modbibitem
236 &modsubtitle &modsubject &modaddauthor &moditem &countitems
237 &delitem &deletebiblioitem &delbiblio
238 &getitemtypes &getbiblio
239 &getbiblioitembybiblionumber
240 &getbiblioitem &getitemsbybiblioitem
242 &newcompletebiblioitem
244 &MARCfind_oldbiblionumber_from_MARCbibid
245 &MARCfind_MARCbibid_from_oldbiblionumber
246 &MARCfind_marc_from_kohafield
250 &NEWnewbiblio &NEWnewitem
251 &NEWmodbiblio &NEWmoditem
253 &MARCaddbiblio &MARCadditem
254 &MARCmodsubfield &MARCaddsubfield
255 &MARCmodbiblio &MARCmoditem
256 &MARCkoha2marcBiblio &MARCmarc2koha
257 &MARCkoha2marcItem &MARChtml2marc
258 &MARCgetbiblio &MARCgetitem
259 &MARCaddword &MARCdelword
265 # MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC
268 # all the following subs takes a MARC::Record as parameter and manage
269 # the MARC-DB. They are called by the 1.0/1.2 xxx subs, and by the
270 # NEWxxx subs (xxx deals with old-DB parameters, the NEWxxx deals with MARC-DB parameter)
274 C4::Biblio - acquisition, catalog management functions
278 move from 1.2 to 1.4 version :
279 1.2 and previous version uses a specific API to manage biblios. This API uses old-DB style parameters.
280 In the 1.4 version, we want to do 2 differents things :
281 - keep populating the old-DB, that has a LOT less datas than MARC
282 - populate the MARC-DB
283 To populate the DBs we have 2 differents sources :
284 - the standard acquisition system (through book sellers), that does'nt use MARC data
285 - the MARC acquisition system, that uses MARC data.
287 Thus, we have 2 differents cases :
288 - 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
289 - 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
291 That's why we need 4 subs :
292 all I<subs beginning by MARC> manage only MARC tables. They manage MARC-DB with MARC::Record parameters
293 all I<subs beginning by OLD> manage only OLD-DB tables. They manage old-DB with old-DB parameters
294 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
295 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.
297 - NEW and old-style API should be used in koha to manage biblio
298 - MARCsubs are divided in 2 parts :
299 * some of them manage MARC parameters. They are heavily used in koha.
300 * some of them manage MARC biblio : they are mostly used by NEW and old-style subs.
301 - OLD are used internally only
303 all subs requires/use $dbh as 1st parameter.
305 I<NEWxxx related subs>
307 all subs requires/use $dbh as 1st parameter.
308 those subs are used by the MARC-compliant version of koha : marc import, or marc management.
310 I<OLDxxx related subs>
312 all subs requires/use $dbh as 1st parameter.
313 those subs are used by the MARC-compliant version of koha : marc import, or marc management.
315 They all are the exact copy of 1.0/1.2 version of the sub without the OLD.
316 The OLDxxx is called by the original xxx sub.
317 the 1.4 xxx sub also builds MARC::Record an calls the MARCxxx
319 WARNING : there is 1 difference between initialxxx and OLDxxx :
320 the db header $dbh is always passed as parameter to avoid over-DB connexion
326 =item @tagslib = &MARCgettagslib($dbh,1|0);
328 last param is 1 for liblibrarian and 0 for libopac
329 returns a hash with tag/subfield meaning
330 =item ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
332 finds MARC tag and subfield for a given kohafield
333 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
335 =item $biblionumber = &MARCfind_oldbiblionumber_from_MARCbibid($dbh,$MARCbibi);
337 finds a old-db biblio number for a given MARCbibid number
339 =item $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$oldbiblionumber);
341 finds a MARC bibid from a old-db biblionumber
343 =item $MARCRecord = &MARCkoha2marcBiblio($dbh,$biblionumber,biblioitemnumber);
345 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem
347 =item $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);
349 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB item
351 =item $MARCRecord = &MARCkoha2marcSubtitle($dbh,$biblionumber,$subtitle);
353 MARCkoha2marcSubtitle is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB subtitle
355 =item $olddb = &MARCmarc2koha($dbh,$MARCRecord);
357 builds a hash with old-db datas from a MARC::Record
359 =item &MARCaddbiblio($dbh,$MARC::Record,$biblionumber);
361 creates a biblio (in the MARC tables only). $biblionumber is the old-db biblionumber of the biblio
363 =item &MARCaddsubfield($dbh,$bibid,$tagid,$indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
365 adds a subfield in a biblio (in the MARC tables only).
367 =item $MARCRecord = &MARCgetbiblio($dbh,$bibid);
369 Returns a MARC::Record for the biblio $bibid.
371 =item &MARCmodbiblio($dbh,$bibid,$record,$delete);
373 MARCmodbiblio changes a biblio for a biblio,MARC::Record passed as parameter
374 if $delete == 1, every field/subfield not found is deleted in the biblio
375 otherwise, only data passed to MARCmodbiblio is managed.
376 thus, you can change only a small part of a biblio (like an item, or a subtitle, or a additionalauthor...)
378 =item ($subfieldid,$subfieldvalue) = &MARCmodsubfield($dbh,$subfieldid,$subfieldvalue);
380 MARCmodsubfield changes the value of a given subfield
382 =item $subfieldid = &MARCfindsubfield($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue);
384 MARCfindsubfield returns a subfield number given a bibid/tag/subfieldvalue values.
385 Returns -1 if more than 1 answer
387 =item $subfieldid = &MARCfindsubfieldid($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
389 MARCfindsubfieldid find a subfieldid for a bibid/tag/tagorder/subfield/subfieldorder
391 =item &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
393 MARCdelsubfield delete a subfield for a bibid/tag/tagorder/subfield/subfieldorder
395 =item &MARCdelbiblio($dbh,$bibid);
397 MARCdelbiblio delete biblio $bibid
399 =item &MARCkoha2marcOnefield
401 used by MARCkoha2marc and should not be useful elsewhere
403 =item &MARCmarc2kohaOnefield
405 used by MARCmarc2koha and should not be useful elsewhere
409 used to manage MARC_word table and should not be useful elsewhere
413 used to manage MARC_word table and should not be useful elsewhere
418 my ($dbh,$forlibrarian)= @_;
420 my $libfield = ($forlibrarian eq 1)? 'liblibrarian' : 'libopac';
421 $sth=$dbh->prepare("select tagfield,$libfield as lib,mandatory from marc_tag_structure order by tagfield");
423 my ($lib,$tag,$res,$tab,$mandatory,$repeatable);
424 while ( ($tag,$lib,$mandatory) = $sth->fetchrow) {
425 $res->{$tag}->{lib}=$lib;
426 $res->{$tab}->{tab}=""; # XXX
427 $res->{$tag}->{mandatory}=$mandatory;
430 $sth=$dbh->prepare("select tagfield,tagsubfield,$libfield as lib,tab, mandatory, repeatable,authorised_value,thesaurus_category,value_builder from marc_subfield_structure order by tagfield,tagsubfield");
434 my $authorised_value;
435 my $thesaurus_category;
437 while ( ($tag, $subfield, $lib, $tab, $mandatory, $repeatable,$authorised_value,$thesaurus_category,$value_builder) = $sth->fetchrow) {
438 $res->{$tag}->{$subfield}->{lib}=$lib;
439 $res->{$tag}->{$subfield}->{tab}=$tab;
440 $res->{$tag}->{$subfield}->{mandatory}=$mandatory;
441 $res->{$tag}->{$subfield}->{repeatable}=$repeatable;
442 $res->{$tag}->{$subfield}->{authorised_value}=$authorised_value;
443 $res->{$tag}->{$subfield}->{thesaurus_category}=$thesaurus_category;
444 $res->{$tag}->{$subfield}->{value_builder}=$value_builder;
449 sub MARCfind_marc_from_kohafield {
450 my ($dbh,$kohafield) = @_;
451 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
452 $sth->execute($kohafield);
453 my ($tagfield,$tagsubfield) = $sth->fetchrow;
454 return ($tagfield,$tagsubfield);
457 sub MARCfind_oldbiblionumber_from_MARCbibid {
458 my ($dbh,$MARCbibid) = @_;
459 my $sth=$dbh->prepare("select biblionumber from marc_biblio where bibid=?");
460 $sth->execute($MARCbibid);
461 my ($biblionumber) = $sth->fetchrow;
462 return $biblionumber;
465 sub MARCfind_MARCbibid_from_oldbiblionumber {
466 my ($dbh,$oldbiblionumber) = @_;
467 my $sth=$dbh->prepare("select bibid from marc_biblio where biblionumber=?");
468 $sth->execute($oldbiblionumber);
469 my ($bibid) = $sth->fetchrow;
474 # pass the MARC::Record to this function, and it will create the records in the marc tables
475 my ($dbh,$record,$biblionumber) = @_;
476 my @fields=$record->fields();
478 # adding main table, and retrieving bibid
479 $dbh->do("lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ");
480 my $sth=$dbh->prepare("insert into marc_biblio (datecreated,biblionumber) values (now(),?)");
481 $sth->execute($biblionumber);
482 $sth=$dbh->prepare("select max(bibid) from marc_biblio");
484 ($bibid)=$sth->fetchrow;
487 # now, add subfields...
488 foreach my $field (@fields) {
490 if ($field->tag() <10) {
491 &MARCaddsubfield($dbh,$bibid,
500 my @subfields=$field->subfields();
501 foreach my $subfieldcount (0..$#subfields) {
502 &MARCaddsubfield($dbh,$bibid,
504 $field->indicator(1).$field->indicator(2),
506 $subfields[$subfieldcount][0],
508 $subfields[$subfieldcount][1]
513 $dbh->do("unlock tables");
518 # pass the MARC::Record to this function, and it will create the records in the marc tables
519 my ($dbh,$record,$biblionumber) = @_;
520 # warn "adding : ".$record->as_formatted();
521 # search for MARC biblionumber
522 $dbh->do("lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ");
523 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
524 my @fields=$record->fields();
525 my $sth = $dbh->prepare("select max(tagorder) from marc_subfield_table where bibid=?");
526 $sth->execute($bibid);
527 my ($fieldcount) = $sth->fetchrow;
528 # now, add subfields...
529 foreach my $field (@fields) {
530 my @subfields=$field->subfields();
532 foreach my $subfieldcount (0..$#subfields) {
533 &MARCaddsubfield($dbh,$bibid,
535 $field->indicator(1).$field->indicator(2),
537 $subfields[$subfieldcount][0],
539 $subfields[$subfieldcount][1]
541 # warn "ADDING :$bibid,".
543 # $field->indicator(1).$field->indicator(2).",
545 # $subfields[$subfieldcount][0],
547 # $subfields[$subfieldcount][1]";
550 $dbh->do("unlock tables");
554 sub MARCaddsubfield {
555 # Add a new subfield to a tag into the DB.
556 my ($dbh,$bibid,$tagid,$tag_indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue) = @_;
557 # if not value, end of job, we do nothing
558 if (length($subfieldvalue) ==0) {
561 if (not($subfieldcode)) {
564 if (length($subfieldvalue)>255) {
565 # $dbh->do("lock tables marc_blob_subfield WRITE, marc_subfield_table WRITE");
566 my $sth=$dbh->prepare("insert into marc_blob_subfield (subfieldvalue) values (?)");
567 $sth->execute($subfieldvalue);
568 $sth=$dbh->prepare("select max(blobidlink)from marc_blob_subfield");
570 my ($res)=$sth->fetchrow;
571 $sth=$dbh->prepare("insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,valuebloblink) values (?,?,?,?,?,?,?)");
572 $sth->execute($bibid,(sprintf "%03s",$tagid),$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$res);
574 print STDERR "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
576 # $dbh->do("unlock tables");
578 my $sth=$dbh->prepare("insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values (?,?,?,?,?,?,?)");
579 $sth->execute($bibid,(sprintf "%03s",$tagid),$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue);
581 print STDERR "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
584 &MARCaddword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
588 # Returns MARC::Record of the biblio passed in parameter.
590 my $record = MARC::Record->new();
591 #---- TODO : the leader is missing
592 $record->leader(' ');
593 my $sth=$dbh->prepare("select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
594 from marc_subfield_table
595 where bibid=? order by tag,tagorder,subfieldcode
597 my $sth2=$dbh->prepare("select subfieldvalue from marc_blob_subfield where blobidlink=?");
598 $sth->execute($bibid);
603 while (my $row=$sth->fetchrow_hashref) {
604 if ($row->{'valuebloblink'}) { #---- search blob if there is one
605 $sth2->execute($row->{'valuebloblink'});
606 my $row2=$sth2->fetchrow_hashref;
608 $row->{'subfieldvalue'}=$row2->{'subfieldvalue'};
610 # warn "prev : $prevtag . ".$row->{tag}." => ".$row->{subfieldvalue};
611 if ($row->{tagorder} ne $prevtagorder || $row->{tag} ne $prevtag) {
615 $record->add_fields((sprintf "%03s",$prevtag),%subfieldlist->{'@'});
617 $field = MARC::Field->new( (sprintf "%03s",$prevtag), substr($previndicator,0,1), substr($previndicator,1,1), %subfieldlist);
618 $record->add_fields($field);
621 $prevtagorder=$row->{tagorder};
622 $prevtag = $row->{tag};
623 $previndicator=$row->{tag_indicator};
625 %subfieldlist->{$row->{'subfieldcode'}} = $row->{'subfieldvalue'};
627 %subfieldlist->{$row->{'subfieldcode'}} .= $row->{'subfieldvalue'};
628 $prevtag= $row->{tag};
629 $previndicator=$row->{tag_indicator};
632 # the last has not been included inside the loop... do it now !
634 $record->add_fields($prevtag,%subfieldlist->{'@'});
636 my $field = MARC::Field->new( $prevtag, "", "", %subfieldlist);
637 $record->add_fields($field);
642 # Returns MARC::Record of the biblio passed in parameter.
643 my ($dbh,$bibid,$itemnumber)=@_;
644 my $record = MARC::Record->new();
645 # search MARC tagorder
646 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=?");
647 $sth2->execute($bibid,$itemnumber);
648 my ($tagorder) = $sth2->fetchrow_array();
649 #---- TODO : the leader is missing
650 my $sth=$dbh->prepare("select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
651 from marc_subfield_table
652 where bibid=? and tagorder=? order by subfieldcode,subfieldorder
654 $sth2=$dbh->prepare("select subfieldvalue from marc_blob_subfield where blobidlink=?");
655 $sth->execute($bibid,$tagorder);
656 while (my $row=$sth->fetchrow_hashref) {
657 if ($row->{'valuebloblink'}) { #---- search blob if there is one
658 $sth2->execute($row->{'valuebloblink'});
659 my $row2=$sth2->fetchrow_hashref;
661 $row->{'subfieldvalue'}=$row2->{'subfieldvalue'};
663 if ($record->field($row->{'tag'})) {
665 #--- this test must stay as this, because of strange behaviour of mySQL/Perl DBI with char var containing a number...
666 #--- sometimes, eliminates 0 at beginning, sometimes no ;-\\\
667 if (length($row->{'tag'}) <3) {
668 $row->{'tag'} = "0".$row->{'tag'};
670 $field =$record->field($row->{'tag'});
672 my $x = $field->add_subfields($row->{'subfieldcode'},$row->{'subfieldvalue'});
673 $record->delete_field($field);
674 $record->add_fields($field);
677 if (length($row->{'tag'}) < 3) {
678 $row->{'tag'} = "0".$row->{'tag'};
680 my $temp = MARC::Field->new($row->{'tag'}," "," ", $row->{'subfieldcode'} => $row->{'subfieldvalue'});
681 $record->add_fields($temp);
689 my ($dbh,$bibid,$record,$delete)=@_;
690 my $oldrecord=&MARCgetbiblio($dbh,$bibid);
691 if ($oldrecord eq $record) {
694 # otherwise, skip through each subfield...
695 my @fields = $record->fields();
697 foreach my $field (@fields) {
698 my $oldfield = $oldrecord->field($field->tag());
699 my @subfields=$field->subfields();
702 if ($field->tag() <10) {
703 if ($oldfield eq 0 or (! $oldfield->data()) ) {
704 &MARCaddsubfield($dbh,$bibid,$field->tag(),'',
705 1,'@',1,$field->data());
707 my $subfieldid=&MARCfindsubfieldid($dbh,$bibid,$field->tag(),$tagorder,'@',$subfieldorder);
708 &MARCmodsubfield($dbh,$subfieldid,$field->data());
711 foreach my $subfield (@subfields) {
713 if ($oldfield eq 0 or (! $oldfield->subfield(@$subfield[0])) ) {
714 # just adding datas...
715 &MARCaddsubfield($dbh,$bibid,$field->tag(),$field->indicator(1).$field->indicator(2),
716 1,@$subfield[0],$subfieldorder,@$subfield[1]);
718 # modify the subfield if it's a different string
719 if ($oldfield->subfield(@$subfield[0]) ne @$subfield[1] ) {
720 my $subfieldid=&MARCfindsubfieldid($dbh,$bibid,$field->tag(),$tagorder,@$subfield[0],$subfieldorder);
721 &MARCmodsubfield($dbh,$subfieldid,@$subfield[1]);
729 my ($dbh,$record,$bibid,$itemnumber,$delete)=@_;
730 my $oldrecord=&MARCgetitem($dbh,$bibid,$itemnumber);
731 # if nothing to change, don't waste time...
732 if ($oldrecord eq $record) {
733 # warn "nothing to change";
736 # warn "MARCmoditem : ".$record->as_formatted;
737 # warn "OLD : ".$oldrecord->as_formatted;
739 # otherwise, skip through each subfield...
740 my @fields = $record->fields();
741 # search old MARC item
742 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=?");
743 $sth2->execute($bibid,$itemnumber);
744 my ($tagorder) = $sth2->fetchrow_array();
745 foreach my $field (@fields) {
746 my $oldfield = $oldrecord->field($field->tag());
747 my @subfields=$field->subfields();
749 foreach my $subfield (@subfields) {
751 # warn "compare : $oldfield".$oldfield->subfield(@$subfield[0]);
752 if ($oldfield eq 0 or (length($oldfield->subfield(@$subfield[0])) ==0) ) {
753 # just adding datas...
754 # warn "addfield : / $subfieldorder / @$subfield[0] - @$subfield[1]";
755 # warn "NEW subfield : $bibid,".$field->tag().",".$tagorder.",".@$subfield[0].",".$subfieldorder.",".@$subfield[1].")";
756 &MARCaddsubfield($dbh,$bibid,$field->tag(),$field->indicator(1).$field->indicator(2),
757 $tagorder,@$subfield[0],$subfieldorder,@$subfield[1]);
759 # warn "modfield : / $subfieldorder / @$subfield[0] - @$subfield[1]";
760 # modify he subfield if it's a different string
761 if ($oldfield->subfield(@$subfield[0]) ne @$subfield[1] ) {
762 my $subfieldid=&MARCfindsubfieldid($dbh,$bibid,$field->tag(),$tagorder,@$subfield[0],$subfieldorder);
763 # warn "changing : $subfieldid, $bibid,".$field->tag(),",$tagorder,@$subfield[0],@$subfield[1],$subfieldorder";
764 &MARCmodsubfield($dbh,$subfieldid,@$subfield[1]);
772 sub MARCmodsubfield {
773 # Subroutine changes a subfield value given a subfieldid.
774 my ($dbh, $subfieldid, $subfieldvalue )=@_;
775 $dbh->do("lock tables marc_blob_subfield WRITE,marc_subfield_table WRITE");
776 my $sth1=$dbh->prepare("select valuebloblink from marc_subfield_table where subfieldid=?");
777 $sth1->execute($subfieldid);
778 my ($oldvaluebloblink)=$sth1->fetchrow;
781 # if too long, use a bloblink
782 if (length($subfieldvalue)>255 ) {
783 # if already a bloblink, update it, otherwise, insert a new one.
784 if ($oldvaluebloblink) {
785 $sth=$dbh->prepare("update marc_blob_subfield set subfieldvalue=? where blobidlink=?");
786 $sth->execute($subfieldvalue,$oldvaluebloblink);
788 $sth=$dbh->prepare("insert into marc_blob_subfield (subfieldvalue) values (?)");
789 $sth->execute($subfieldvalue);
790 $sth=$dbh->prepare("select max(blobidlink) from marc_blob_subfield");
792 my ($res)=$sth->fetchrow;
793 $sth=$dbh->prepare("update marc_subfield_table set subfieldvalue=null, valuebloblink=$res where subfieldid=?");
794 $sth->execute($subfieldid);
797 # note this can leave orphan bloblink. Not a big problem, but we should build somewhere a orphan deleting script...
798 $sth=$dbh->prepare("update marc_subfield_table set subfieldvalue=?,valuebloblink=null where subfieldid=?");
799 $sth->execute($subfieldvalue, $subfieldid);
801 $dbh->do("unlock tables");
803 $sth=$dbh->prepare("select bibid,tag,tagorder,subfieldcode,subfieldid,subfieldorder from marc_subfield_table where subfieldid=?");
804 $sth->execute($subfieldid);
805 my ($bibid,$tagid,$tagorder,$subfieldcode,$x,$subfieldorder) = $sth->fetchrow;
807 &MARCdelword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder);
808 &MARCaddword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
809 return($subfieldid, $subfieldvalue);
812 sub MARCfindsubfield {
813 my ($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue) = @_;
817 my $query="select subfieldid from marc_subfield_table where bibid=? and tag=? and subfieldcode=?";
818 if ($subfieldvalue) {
819 $query .= " and subfieldvalue=".$dbh->quote($subfieldvalue);
821 if ($subfieldorder<1) {
824 $query .= " and subfieldorder=$subfieldorder";
826 my $sti=$dbh->prepare($query);
827 $sti->execute($bibid,$tag, $subfieldcode);
828 while (($subfieldid) = $sti->fetchrow) {
830 $lastsubfieldid=$subfieldid;
832 if ($resultcounter>1) {
833 # Error condition. Values given did not resolve into a unique record. Don't know what to edit
834 # should rarely occur (only if we use subfieldvalue with a value that exists twice, which is strange)
837 return $lastsubfieldid;
841 sub MARCfindsubfieldid {
842 my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
843 my $sth=$dbh->prepare("select subfieldid from marc_subfield_table
844 where bibid=? and tag=? and tagorder=?
845 and subfieldcode=? and subfieldorder=?");
846 $sth->execute($bibid,$tag,$tagorder,$subfield,$subfieldorder);
847 my ($res) = $sth->fetchrow;
849 $sth=$dbh->prepare("select subfieldid from marc_subfield_table
850 where bibid=? and tag=? and tagorder=?
851 and subfieldcode=?");
852 $sth->execute($bibid,$tag,$tagorder,$subfield);
853 ($res) = $sth->fetchrow;
858 sub MARCdelsubfield {
859 # delete a subfield for $bibid / tag / tagorder / subfield / subfieldorder
860 my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
861 $dbh->do("delete from marc_subfield_table where bibid='$bibid' and
862 tag='$tag' and tagorder='$tagorder'
863 and subfieldcode='$subfield' and subfieldorder='$subfieldorder
868 # delete a biblio for a $bibid
869 my ($dbh,$bibid) = @_;
870 $dbh->do("delete from marc_subfield_table where bibid='$bibid'");
871 $dbh->do("delete from marc_biblio where bibid='$bibid'");
874 sub MARCkoha2marcBiblio {
875 # this function builds partial MARC::Record from the old koha-DB fields
876 my ($dbh,$biblionumber,$biblioitemnumber) = @_;
877 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
878 my $record = MARC::Record->new();
879 #--- if bibid, then retrieve old-style koha data
880 if ($biblionumber>0) {
881 my $sth2=$dbh->prepare("select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp
882 from biblio where biblionumber=?");
883 $sth2->execute($biblionumber);
884 my $row=$sth2->fetchrow_hashref;
886 foreach $code (keys %$row) {
888 &MARCkoha2marcOnefield($sth,$record,"biblio.".$code,$row->{$code});
892 #--- if biblioitem, then retrieve old-style koha data
893 if ($biblioitemnumber>0) {
894 my $sth2=$dbh->prepare(" SELECT biblioitemnumber,biblionumber,volume,number,classification,
895 itemtype,url,isbn,issn,dewey,subclass,publicationyear,publishercode,
896 volumedate,volumeddesc,timestamp,illus,pages,notes,size,place
898 WHERE biblionumber=? and biblioitemnumber=?
900 $sth2->execute($biblionumber,$biblioitemnumber);
901 my $row=$sth2->fetchrow_hashref;
903 foreach $code (keys %$row) {
905 &MARCkoha2marcOnefield($sth,$record,"biblioitems.".$code,$row->{$code});
910 # TODO : retrieve notes, additionalauthors
913 sub MARCkoha2marcItem {
914 # this function builds partial MARC::Record from the old koha-DB fields
915 my ($dbh,$biblionumber,$itemnumber) = @_;
916 # my $dbh=&C4Connect;
917 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
918 my $record = MARC::Record->new();
919 #--- if item, then retrieve old-style koha data
921 # print STDERR "prepare $biblionumber,$itemnumber\n";
922 my $sth2=$dbh->prepare("SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned,
923 booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
924 datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,bulk,issues,renewals,
925 reserves,restricted,binding,itemnotes,holdingbranch,timestamp
927 WHERE itemnumber=?");
928 $sth2->execute($itemnumber);
929 my $row=$sth2->fetchrow_hashref;
931 foreach $code (keys %$row) {
933 &MARCkoha2marcOnefield($sth,$record,"items.".$code,$row->{$code});
938 # TODO : retrieve notes, additionalauthors
941 sub MARCkoha2marcSubtitle {
942 # this function builds partial MARC::Record from the old koha-DB fields
943 my ($dbh,$bibnum,$subtitle) = @_;
944 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
945 my $record = MARC::Record->new();
946 &MARCkoha2marcOnefield($sth,$record,"bibliosubtitle.subtitle",$subtitle);
950 sub MARCkoha2marcOnefield {
951 my ($sth,$record,$kohafieldname,$value)=@_;
954 $sth->execute($kohafieldname);
955 if (($tagfield,$tagsubfield)=$sth->fetchrow) {
956 if ($record->field($tagfield)) {
957 my $tag =$record->field($tagfield);
959 $tag->add_subfields($tagsubfield,$value);
960 $record->delete_field($tag);
961 $record->add_fields($tag);
964 $record->add_fields($tagfield," "," ",$tagsubfield => $value);
971 my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
972 my $prevtag = @$rtags[0];
973 my $record = MARC::Record->new();
975 for (my $i=0; $i< @$rtags; $i++) {
976 # rebuild MARC::Record
977 if (@$rtags[$i] ne $prevtag) {
981 $indicators{$prevtag}.=' ';
983 $record->add_fields((sprintf "%03s",$prevtag),%subfieldlist->{'@'});
985 my $field = MARC::Field->new( (sprintf "%03s",$prevtag), substr($indicators{$prevtag},0,1),substr($indicators{$prevtag},1,1), %subfieldlist);
986 $record->add_fields($field);
988 $prevtag = @$rtags[$i];
990 %subfieldlist->{@$rsubfields[$i]} = @$rvalues[$i];
992 if (%subfieldlist->{@$rsubfields[$i]}) {
993 %subfieldlist->{@$rsubfields[$i]} .= '|';
995 %subfieldlist->{@$rsubfields[$i]} .=@$rvalues[$i];
996 $prevtag= @$rtags[$i];
999 # the last has not been included inside the loop... do it now !
1000 my $field = MARC::Field->new( $prevtag, "", "", %subfieldlist);
1001 $record->add_fields($field);
1006 my ($dbh,$record) = @_;
1007 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
1009 my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
1012 # print STDERR $record->as_formatted;
1013 while (($field)=$sth2->fetchrow) {
1014 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result);
1016 $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
1018 while (($field)=$sth2->fetchrow) {
1019 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result);
1021 $sth2=$dbh->prepare("SHOW COLUMNS from items");
1023 while (($field)=$sth2->fetchrow) {
1024 $result = &MARCmarc2kohaOneField($sth,"items",$field,$record,$result);
1026 # additional authors : specific
1027 $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result);
1031 sub MARCmarc2kohaOneField {
1032 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
1033 my ($sth,$kohatable,$kohafield,$record,$result)= @_;
1034 # warn "kohatable / $kohafield / $result / ";
1038 $sth->execute($kohatable.".".$kohafield);
1039 ($tagfield,$subfield) = $sth->fetchrow;
1040 foreach my $field ($record->field($tagfield)) {
1041 if ($field->subfield($subfield)) {
1042 if ($result->{$kohafield}) {
1043 $result->{$kohafield} .= " | ".$field->subfield($subfield);
1045 $result->{$kohafield}=$field->subfield($subfield);
1053 # split a subfield string and adds it into the word table.
1055 my ($dbh,$bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$sentence) =@_;
1056 $sentence =~ s/(\.|\?|\:|\!|\'|,|\-)/ /g;
1057 my @words = split / /,$sentence;
1058 my $stopwords= C4::Context->stopwords;
1059 my $sth=$dbh->prepare("insert into marc_word (bibid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word)
1060 values (?,?,?,?,?,?,soundex(?))");
1061 foreach my $word (@words) {
1062 # we record only words longer than 2 car and not in stopwords hash
1063 if (length($word)>1 and !($stopwords->{uc($word)})) {
1064 $sth->execute($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,$word);
1066 print STDERR "ERROR ==> insert into marc_word (bibid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word) values ($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,soundex($word))\n";
1073 # delete words. this sub deletes all the words from a sentence. a subfield modif is done by a delete then a add
1074 my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
1075 my $sth=$dbh->prepare("delete from marc_word where bibid=? and tag=? and tagorder=? and subfieldid=? and subfieldorder=?");
1076 $sth->execute($bibid,$tag,$tagorder,$subfield,$subfieldorder);
1081 # NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW
1084 # all the following subs are useful to manage MARC-DB with complete MARC records.
1085 # it's used with marcimport, and marc management tools
1089 =item (oldbibnum,$oldbibitemnum) = NEWnewbibilio($dbh,$MARCRecord,$oldbiblio,$oldbiblioitem);
1091 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
1092 are builded from the MARC::Record. If they are passed, they are used.
1094 =item NEWnewitem($dbh, $record,$bibid);
1096 adds an item in the db.
1101 my ($dbh, $record, $oldbiblio, $oldbiblioitem) = @_;
1102 # note $oldbiblio and $oldbiblioitem are not mandatory.
1103 # if not present, they will be builded from $record with MARCmarc2koha function
1104 if (($oldbiblio) and not($oldbiblioitem)) {
1105 print STDERR "NEWnewbiblio : missing parameter\n";
1106 print "NEWnewbiblio : missing parameter : contact koha development team\n";
1112 $oldbibnum = OLDnewbiblio($dbh,$oldbiblio);
1113 $oldbiblioitem->{'biblionumber'} = $oldbibnum;
1114 $oldbibitemnum = OLDnewbiblioitem($dbh,$oldbiblioitem);
1116 my $olddata = MARCmarc2koha($dbh,$record);
1117 $oldbibnum = OLDnewbiblio($dbh,$olddata);
1118 $olddata->{'biblionumber'} = $oldbibnum;
1119 $oldbibitemnum = OLDnewbiblioitem($dbh,$olddata);
1121 # we must add bibnum and bibitemnum in MARC::Record...
1122 # we build the new field with biblionumber and biblioitemnumber
1123 # we drop the original field
1124 # we add the new builded field.
1125 # NOTE : Works only if the field is ONLY for biblionumber and biblioitemnumber
1126 # (steve and paul : thinks 090 is a good choice)
1127 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
1128 $sth->execute("biblio.biblionumber");
1129 (my $tagfield1, my $tagsubfield1) = $sth->fetchrow;
1130 $sth->execute("biblioitems.biblioitemnumber");
1131 (my $tagfield2, my $tagsubfield2) = $sth->fetchrow;
1132 if ($tagfield1 != $tagfield2) {
1133 print STDERR "Error in NEWnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number";
1134 print "Content-Type: text/html\n\nError in NEWnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number";
1137 my $newfield = MARC::Field->new( $tagfield1,'','',
1138 "$tagsubfield1" => $oldbibnum,
1139 "$tagsubfield2" => $oldbibitemnum);
1140 # drop old field and create new one...
1141 my $old_field = $record->field($tagfield1);
1142 $record->delete_field($old_field);
1143 $record->add_fields($newfield);
1144 my $bibid = MARCaddbiblio($dbh,$record,$oldbibnum);
1145 return ($bibid,$oldbibnum,$oldbibitemnum );
1149 my ($dbh,$record,$bibid) =@_;
1150 &MARCmodbiblio($dbh,$bibid,$record,0);
1151 my $oldbiblio = MARCmarc2koha($dbh,$record);
1152 my $oldbiblionumber = OLDmodbiblio($dbh,$oldbiblio);
1153 OLDmodbibitem($dbh,$oldbiblio);
1159 my ($dbh, $record,$bibid) = @_;
1160 # add item in old-DB
1161 my $item = &MARCmarc2koha($dbh,$record);
1162 # needs old biblionumber and biblioitemnumber
1163 $item->{'biblionumber'} = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
1164 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
1165 $sth->execute($item->{'biblionumber'});
1166 ($item->{'biblioitemnumber'}) = $sth->fetchrow;
1167 my ($itemnumber,$error) = &OLDnewitems($dbh,$item,$item->{barcode});
1168 # add itemnumber to MARC::Record before adding the item.
1169 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
1170 &MARCkoha2marcOnefield($sth,$record,"items.itemnumber",$itemnumber);
1172 my $bib = &MARCadditem($dbh,$record,$item->{'biblionumber'});
1176 my ($dbh,$record,$bibid,$itemnumber,$delete) = @_;
1177 &MARCmoditem($dbh,$record,$bibid,$itemnumber,$delete);
1178 my $olditem = MARCmarc2koha($dbh,$record);
1179 OLDmoditem($dbh,$olditem);
1184 # OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD
1188 =item $biblionumber = OLDnewbiblio($dbh,$biblio);
1190 adds a record in biblio table. Datas are in the hash $biblio.
1192 =item $biblionumber = OLDmodbiblio($dbh,$biblio);
1194 modify a record in biblio table. Datas are in the hash $biblio.
1196 =item OLDmodsubtitle($dbh,$bibnum,$subtitle);
1198 modify subtitles in bibliosubtitle table.
1200 =item OLDmodaddauthor($dbh,$bibnum,$author);
1202 adds or modify additional authors
1203 NOTE : Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
1205 =item $errors = OLDmodsubject($dbh,$bibnum, $force, @subject);
1207 modify/adds subjects
1209 =item OLDmodbibitem($dbh, $biblioitem);
1213 =item OLDmodnote($dbh,$bibitemnum,$note
1215 modify a note for a biblioitem
1217 =item OLDnewbiblioitem($dbh,$biblioitem);
1219 adds a biblioitem ($biblioitem is a hash with the values)
1221 =item OLDnewsubject($dbh,$bibnum);
1225 =item OLDnewsubtitle($dbh,$bibnum,$subtitle);
1227 create a new subtitle
1229 =item ($itemnumber,$errors)= OLDnewitems($dbh,$item,$barcode);
1231 create a item. $item is a hash and $barcode the barcode.
1233 =item OLDmoditem($dbh,$item);
1237 =item OLDdelitem($dbh,$itemnum);
1241 =item OLDdeletebiblioitem($dbh,$biblioitemnumber);
1243 deletes a biblioitem
1244 NOTE : not standard sub name. Should be OLDdelbiblioitem()
1246 =item OLDdelbiblio($dbh,$biblio);
1253 my ($dbh,$biblio) = @_;
1254 # my $dbh = &C4Connect;
1255 my $query = "Select max(biblionumber) from biblio";
1256 my $sth = $dbh->prepare($query);
1258 my $data = $sth->fetchrow_arrayref;
1259 my $bibnum = $$data[0] + 1;
1262 if ($biblio->{'seriestitle'}) { $series = 1 };
1264 $query = "insert into biblio set biblionumber = ?, title = ?, author = ?, copyrightdate = ?,
1265 serial = ?, seriestitle = ?, notes = ?, abstract = ?";
1266 $sth = $dbh->prepare($query);
1267 $sth->execute($bibnum,$biblio->{'title'},$biblio->{'author'},$biblio->{'copyright'},$series,$biblio->{'seriestitle'},$biblio->{'notes'},$biblio->{'abstract'});
1275 my ($dbh,$biblio) = @_;
1276 # my $dbh = C4Connect;
1280 $query = "Update biblio set title = ?, author = ?, abstract = ?, copyrightdate = ?,
1281 seriestitle = ?, serial = ?, unititle = ?, notes = ? where biblionumber = ?";
1282 $sth = $dbh->prepare($query);
1283 $sth->execute($biblio->{'title'},$biblio->{'author'},$biblio->{'abstract'},$biblio->{'copyrightdate'},
1284 $biblio->{'seriestitle'},$biblio->{'serial'},$biblio->{'unititle'},$biblio->{'notes'},$biblio->{'biblionumber'});
1287 return($biblio->{'biblionumber'});
1290 sub OLDmodsubtitle {
1291 my ($dbh,$bibnum, $subtitle) = @_;
1292 my $query = "update bibliosubtitle set subtitle = ? where biblionumber = ?";
1293 my $sth = $dbh->prepare($query);
1294 $sth->execute($subtitle,$bibnum);
1299 sub OLDmodaddauthor {
1300 my ($dbh,$bibnum, $author) = @_;
1301 # my $dbh = C4Connect;
1302 my $query = "Delete from additionalauthors where biblionumber = $bibnum";
1303 my $sth = $dbh->prepare($query);
1308 if ($author ne '') {
1309 $query = "Insert into additionalauthors set
1312 $sth = $dbh->prepare($query);
1314 $sth->execute($author,$bibnum);
1318 } # sub modaddauthor
1322 my ($dbh,$bibnum, $force, @subject) = @_;
1323 # my $dbh = C4Connect;
1324 my $count = @subject;
1326 for (my $i = 0; $i < $count; $i++) {
1327 $subject[$i] =~ s/^ //g;
1328 $subject[$i] =~ s/ $//g;
1329 my $query = "select * from catalogueentry
1330 where entrytype = 's'
1331 and catalogueentry = '$subject[$i]'";
1332 my $sth = $dbh->prepare($query);
1335 if (my $data = $sth->fetchrow_hashref) {
1337 if ($force eq $subject[$i]) {
1338 # subject not in aut, chosen to force anway
1339 # so insert into cataloguentry so its in auth file
1340 $query = "Insert into catalogueentry
1341 (entrytype,catalogueentry)
1342 values ('s','$subject[$i]')";
1343 my $sth2 = $dbh->prepare($query);
1348 $error = "$subject[$i]\n does not exist in the subject authority file";
1349 $query = "Select * from catalogueentry
1350 where entrytype = 's'
1351 and (catalogueentry like '$subject[$i] %'
1352 or catalogueentry like '% $subject[$i] %'
1353 or catalogueentry like '% $subject[$i]')";
1354 my $sth2 = $dbh->prepare($query);
1357 while (my $data = $sth2->fetchrow_hashref) {
1358 $error .= "<br>$data->{'catalogueentry'}";
1366 my $query = "Delete from bibliosubject where biblionumber = $bibnum";
1367 my $sth = $dbh->prepare($query);
1370 for (my $i = 0; $i < $count; $i++) {
1371 $sth = $dbh->prepare("Insert into bibliosubject
1372 values ('$subject[$i]', $bibnum)");
1384 my ($dbh,$biblioitem) = @_;
1385 # my $dbh = C4Connect;
1388 $biblioitem->{'itemtype'} = $dbh->quote($biblioitem->{'itemtype'});
1389 $biblioitem->{'url'} = $dbh->quote($biblioitem->{'url'});
1390 $biblioitem->{'isbn'} = $dbh->quote($biblioitem->{'isbn'});
1391 $biblioitem->{'publishercode'} = $dbh->quote($biblioitem->{'publishercode'});
1392 $biblioitem->{'publicationyear'} = $dbh->quote($biblioitem->{'publicationyear'});
1393 $biblioitem->{'classification'} = $dbh->quote($biblioitem->{'classification'});
1394 $biblioitem->{'dewey'} = $dbh->quote($biblioitem->{'dewey'});
1395 $biblioitem->{'subclass'} = $dbh->quote($biblioitem->{'subclass'});
1396 $biblioitem->{'illus'} = $dbh->quote($biblioitem->{'illus'});
1397 $biblioitem->{'pages'} = $dbh->quote($biblioitem->{'pages'});
1398 $biblioitem->{'volumeddesc'} = $dbh->quote($biblioitem->{'volumeddesc'});
1399 $biblioitem->{'notes'} = $dbh->quote($biblioitem->{'notes'});
1400 $biblioitem->{'size'} = $dbh->quote($biblioitem->{'size'});
1401 $biblioitem->{'place'} = $dbh->quote($biblioitem->{'place'});
1403 $query = "Update biblioitems set
1404 itemtype = $biblioitem->{'itemtype'},
1405 url = $biblioitem->{'url'},
1406 isbn = $biblioitem->{'isbn'},
1407 publishercode = $biblioitem->{'publishercode'},
1408 publicationyear = $biblioitem->{'publicationyear'},
1409 classification = $biblioitem->{'classification'},
1410 dewey = $biblioitem->{'dewey'},
1411 subclass = $biblioitem->{'subclass'},
1412 illus = $biblioitem->{'illus'},
1413 pages = $biblioitem->{'pages'},
1414 volumeddesc = $biblioitem->{'volumeddesc'},
1415 notes = $biblioitem->{'notes'},
1416 size = $biblioitem->{'size'},
1417 place = $biblioitem->{'place'}
1418 where biblioitemnumber = $biblioitem->{'biblioitemnumber'}";
1426 my ($dbh,$bibitemnum,$note)=@_;
1427 # my $dbh=C4Connect;
1428 my $query="update biblioitems set notes='$note' where
1429 biblioitemnumber='$bibitemnum'";
1430 my $sth=$dbh->prepare($query);
1436 sub OLDnewbiblioitem {
1437 my ($dbh,$biblioitem) = @_;
1438 # my $dbh = C4Connect;
1439 my $query = "Select max(biblioitemnumber) from biblioitems";
1440 my $sth = $dbh->prepare($query);
1445 $data = $sth->fetchrow_arrayref;
1446 $bibitemnum = $$data[0] + 1;
1450 $sth = $dbh->prepare("insert into biblioitems set
1451 biblioitemnumber = ?, biblionumber = ?,
1452 volume = ?, number = ?,
1453 classification = ?, itemtype = ?,
1455 issn = ?, dewey = ?,
1456 subclass = ?, publicationyear = ?,
1457 publishercode = ?, volumedate = ?,
1458 volumeddesc = ?, illus = ?,
1459 pages = ?, notes = ?,
1461 marc = ?, place = ?");
1462 $sth->execute($bibitemnum, $biblioitem->{'biblionumber'},
1463 $biblioitem->{'volume'}, $biblioitem->{'number'},
1464 $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
1465 $biblioitem->{'url'}, $biblioitem->{'isbn'},
1466 $biblioitem->{'issn'}, $biblioitem->{'dewey'},
1467 $biblioitem->{'subclass'}, $biblioitem->{'publicationyear'},
1468 $biblioitem->{'publishercode'}, $biblioitem->{'volumedate'},
1469 $biblioitem->{'volumeddesc'}, $biblioitem->{'illus'},
1470 $biblioitem->{'pages'}, $biblioitem->{'notes'},
1471 $biblioitem->{'size'}, $biblioitem->{'lccn'},
1472 $biblioitem->{'marc'}, $biblioitem->{'place'});
1475 return($bibitemnum);
1479 my ($dbh,$bibnum)=@_;
1480 # my $dbh=C4Connect;
1481 my $query="insert into bibliosubject (biblionumber) values
1483 my $sth=$dbh->prepare($query);
1490 sub OLDnewsubtitle {
1491 my ($dbh,$bibnum, $subtitle) = @_;
1492 # my $dbh = C4Connect;
1493 my $query = "insert into bibliosubtitle set
1496 my $sth = $dbh->prepare($query);
1498 $sth->execute($bibnum,$subtitle);
1506 my ($dbh,$item, $barcode) = @_;
1507 # my $dbh = C4Connect;
1508 my $query = "Select max(itemnumber) from items";
1509 my $sth = $dbh->prepare($query);
1515 $data = $sth->fetchrow_hashref;
1516 $itemnumber = $data->{'max(itemnumber)'} + 1;
1519 $sth=$dbh->prepare("Insert into items set
1520 itemnumber = ?, biblionumber = ?,
1521 biblioitemnumber = ?, barcode = ?,
1522 booksellerid = ?, dateaccessioned = NOW(),
1523 homebranch = ?, holdingbranch = ?,
1524 price = ?, replacementprice = ?,
1525 replacementpricedate = NOW(), itemnotes = ?,
1528 $sth->execute($itemnumber, $item->{'biblionumber'},
1529 $item->{'biblioitemnumber'},$barcode,
1530 $item->{'booksellerid'},
1531 $item->{'homebranch'},$item->{'homebranch'},
1532 $item->{'price'},$item->{'replacementprice'},
1533 $item->{'itemnotes'},$item->{'loan'});
1534 if (defined $sth->errstr) {
1535 $error .= $sth->errstr;
1538 return($itemnumber,$error);
1542 my ($dbh,$item) = @_;
1543 # my ($dbh,$loan,$itemnum,$bibitemnum,$barcode,$notes,$homebranch,$lost,$wthdrawn,$replacement)=@_;
1544 # my $dbh=C4Connect;
1545 $item->{'itemnum'}=$item->{'itemnumber'} unless $item->{'itemnum'};
1546 my $query="update items set barcode='$item->{'barcode'}',itemnotes='$item->{'notes'}'
1547 where itemnumber=$item->{'itemnum'}";
1548 if ($item->{'barcode'} eq ''){
1549 $query="update items set notforloan=$item->{'loan'} where itemnumber=$item->{'itemnum'}";
1551 if ($item->{'lost'} ne ''){
1552 $query="update items set biblioitemnumber=$item->{'bibitemnum'},
1553 barcode='$item->{'barcode'}',
1554 itemnotes='$item->{'notes'}',
1555 homebranch='$item->{'homebranch'}',
1556 itemlost='$item->{'lost'}',
1557 wthdrawn='$item->{'wthdrawn'}'
1558 where itemnumber=$item->{'itemnum'}";
1560 if ($item->{'replacement'} ne ''){
1561 $query=~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1563 my $sth=$dbh->prepare($query);
1570 my ($dbh,$itemnum)=@_;
1571 # my $dbh=C4Connect;
1572 my $query="select * from items where itemnumber=$itemnum";
1573 my $sth=$dbh->prepare($query);
1575 my @data=$sth->fetchrow_array;
1577 $query="Insert into deleteditems values (";
1578 foreach my $temp (@data){
1579 $query .= "'$temp',";
1583 $sth=$dbh->prepare($query);
1586 $query = "Delete from items where itemnumber=$itemnum";
1587 $sth=$dbh->prepare($query);
1593 sub OLDdeletebiblioitem {
1594 my ($dbh,$biblioitemnumber) = @_;
1595 # my $dbh = C4Connect;
1596 my $query = "Select * from biblioitems
1597 where biblioitemnumber = $biblioitemnumber";
1598 my $sth = $dbh->prepare($query);
1603 if (@results = $sth->fetchrow_array) {
1604 $query = "Insert into deletedbiblioitems values (";
1605 foreach my $value (@results) {
1606 $value = $dbh->quote($value);
1607 $query .= "$value,";
1610 $query =~ s/\,$/\)/;
1613 $query = "Delete from biblioitems
1614 where biblioitemnumber = $biblioitemnumber";
1618 # Now delete all the items attached to the biblioitem
1619 $query = "Select * from items where biblioitemnumber = $biblioitemnumber";
1620 $sth = $dbh->prepare($query);
1622 while (@results = $sth->fetchrow_array) {
1623 $query = "Insert into deleteditems values (";
1624 foreach my $value (@results) {
1625 $value = $dbh->quote($value);
1626 $query .= "$value,";
1628 $query =~ s/\,$/\)/;
1632 $query = "Delete from items where biblioitemnumber = $biblioitemnumber";
1635 } # sub deletebiblioitem
1638 my ($dbh,$biblio)=@_;
1639 # my $dbh=C4Connect;
1640 my $query="select * from biblio where biblionumber=$biblio";
1641 my $sth=$dbh->prepare($query);
1643 if (my @data=$sth->fetchrow_array){
1645 $query="Insert into deletedbiblio values (";
1646 foreach my $temp (@data){
1647 $temp=~ s/\'/\\\'/g;
1648 $query .= "'$temp',";
1652 $sth=$dbh->prepare($query);
1655 $query = "Delete from biblio where biblionumber=$biblio";
1656 $sth=$dbh->prepare($query);
1672 my $dbh = C4::Context->dbh;
1673 my $query="Select count(*) from items where biblionumber=$biblio";
1675 my $sth=$dbh->prepare($query);
1677 my $data=$sth->fetchrow_hashref;
1679 return($data->{'count(*)'});
1684 ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
1686 Looks up the order with the given biblionumber and biblioitemnumber.
1688 Returns a two-element array. C<$ordernumber> is the order number.
1689 C<$order> is a reference-to-hash describing the order; its keys are
1690 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
1691 tables of the Koha database.
1695 # FIXME - This is effectively identical to &C4::Catalogue::getorder.
1696 # Pick one and stick with it.
1699 my $dbh = C4::Context->dbh;
1700 my $query="Select ordernumber
1702 where biblionumber=? and biblioitemnumber=?";
1703 my $sth=$dbh->prepare($query);
1704 $sth->execute($bib,$bi);
1705 # FIXME - Use fetchrow_array(), since we're only interested in the one
1707 my $ordnum=$sth->fetchrow_hashref;
1709 my $order=getsingleorder($ordnum->{'ordernumber'});
1711 return ($order,$ordnum->{'ordernumber'});
1714 =item getsingleorder
1716 $order = &getsingleorder($ordernumber);
1718 Looks up an order by order number.
1720 Returns a reference-to-hash describing the order. The keys of
1721 C<$order> are fields from the biblio, biblioitems, aqorders, and
1722 aqorderbreakdown tables of the Koha database.
1726 # FIXME - This is effectively identical to
1727 # &C4::Catalogue::getsingleorder.
1728 # Pick one and stick with it.
1729 sub getsingleorder {
1731 my $dbh = C4::Context->dbh;
1732 my $query="Select * from biblio,biblioitems,aqorders,aqorderbreakdown
1733 where aqorders.ordernumber=?
1734 and biblio.biblionumber=aqorders.biblionumber and
1735 biblioitems.biblioitemnumber=aqorders.biblioitemnumber and
1736 aqorders.ordernumber=aqorderbreakdown.ordernumber";
1737 my $sth=$dbh->prepare($query);
1738 $sth->execute($ordnum);
1739 my $data=$sth->fetchrow_hashref;
1746 my $dbh = C4::Context->dbh;
1747 my $bibnum=OLDnewbiblio($dbh,$biblio);
1754 $biblionumber = &modbiblio($biblio);
1756 Update a biblio record.
1758 C<$biblio> is a reference-to-hash whose keys are the fields in the
1759 biblio table in the Koha database. All fields must be present, not
1760 just the ones you wish to change.
1762 C<&modbiblio> updates the record defined by
1763 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1765 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1772 my $dbh = C4::Context->dbh;
1773 my $biblionumber=OLDmodbiblio($dbh,$biblio);
1774 return($biblionumber);
1780 &modsubtitle($biblionumber, $subtitle);
1782 Sets the subtitle of a book.
1784 C<$biblionumber> is the biblionumber of the book to modify.
1786 C<$subtitle> is the new subtitle.
1791 my ($bibnum, $subtitle) = @_;
1792 my $dbh = C4::Context->dbh;
1793 &OLDmodsubtitle($dbh,$bibnum,$subtitle);
1798 &modaddauthor($biblionumber, $author);
1800 Replaces all additional authors for the book with biblio number
1801 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1802 C<&modaddauthor> deletes all additional authors.
1807 my ($bibnum, $author) = @_;
1808 my $dbh = C4::Context->dbh;
1809 &OLDmodaddauthor($dbh,$bibnum,$author);
1810 } # sub modaddauthor
1814 $error = &modsubject($biblionumber, $force, @subjects);
1816 $force - a subject to force
1818 $error - Error message, or undef if successful.
1823 my ($bibnum, $force, @subject) = @_;
1824 my $dbh = C4::Context->dbh;
1825 my $error= &OLDmodsubject($dbh,$bibnum,$force, @subject);
1830 my ($biblioitem) = @_;
1831 my $dbh = C4::Context->dbh;
1832 &OLDmodbibitem($dbh,$biblioitem);
1833 my $MARCbibitem = MARCkoha2marcBiblio($dbh,$biblioitem);
1834 &MARCmodbiblio($dbh,$biblioitem->{biblionumber},$MARCbibitem,0);
1838 my ($bibitemnum,$note)=@_;
1839 my $dbh = C4::Context->dbh;
1840 &OLDmodnote($dbh,$bibitemnum,$note);
1844 my ($biblioitem) = @_;
1845 my $dbh = C4::Context->dbh;
1846 my $bibitemnum = &OLDnewbiblioitem($dbh,$biblioitem);
1847 # print STDERR "bibitemnum : $bibitemnum\n";
1848 my $MARCbiblio= MARCkoha2marcBiblio($dbh,$biblioitem->{biblionumber},$bibitemnum);
1849 # print STDERR $MARCbiblio->as_formatted();
1850 &MARCaddbiblio($dbh,$MARCbiblio,$biblioitem->{biblionumber});
1851 return($bibitemnum);
1856 my $dbh = C4::Context->dbh;
1857 &OLDnewsubject($dbh,$bibnum);
1861 my ($bibnum, $subtitle) = @_;
1862 my $dbh = C4::Context->dbh;
1863 &OLDnewsubtitle($dbh,$bibnum,$subtitle);
1867 my ($item, @barcodes) = @_;
1868 my $dbh = C4::Context->dbh;
1872 foreach my $barcode (@barcodes) {
1873 ($itemnumber,$error)=&OLDnewitems($dbh,$item,uc($barcode));
1875 my $MARCitem = &MARCkoha2marcItem($dbh,$item->{biblionumber},$itemnumber);
1876 &MARCadditem($dbh,$MARCitem,$item->{biblionumber});
1883 my $dbh = C4::Context->dbh;
1884 &OLDmoditem($dbh,$item);
1885 my $MARCitem = &MARCkoha2marcItem($dbh,$item->{'biblionumber'},$item->{'itemnum'});
1886 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$item->{biblionumber});
1887 &MARCmoditem($dbh,$MARCitem,$bibid,$item->{itemnum},0);
1891 my ($count,@barcodes)=@_;
1892 my $dbh = C4::Context->dbh;
1894 for (my $i=0;$i<$count;$i++){
1895 $barcodes[$i]=uc $barcodes[$i];
1896 my $query="Select * from items where barcode='$barcodes[$i]'";
1897 my $sth=$dbh->prepare($query);
1899 if (my $data=$sth->fetchrow_hashref){
1900 $error.=" Duplicate Barcode: $barcodes[$i]";
1908 my ($bibitemnum)=@_;
1909 my $dbh = C4::Context->dbh;
1910 my $query="Select count(*) from items where biblioitemnumber='$bibitemnum'";
1911 my $sth=$dbh->prepare($query);
1913 my $data=$sth->fetchrow_hashref;
1915 return($data->{'count(*)'});
1920 my $dbh = C4::Context->dbh;
1921 &OLDdelitem($dbh,$itemnum);
1924 sub deletebiblioitem {
1925 my ($biblioitemnumber) = @_;
1926 my $dbh = C4::Context->dbh;
1927 &OLDdeletebiblioitem($dbh,$biblioitemnumber);
1928 } # sub deletebiblioitem
1933 my $dbh = C4::Context->dbh;
1934 &OLDdelbiblio($dbh,$biblio);
1938 my $dbh = C4::Context->dbh;
1939 my $query = "select * from itemtypes";
1940 my $sth = $dbh->prepare($query);
1941 # || die "Cannot prepare $query" . $dbh->errstr;
1946 # || die "Cannot execute $query\n" . $sth->errstr;
1947 while (my $data = $sth->fetchrow_hashref) {
1948 $results[$count] = $data;
1953 return($count, @results);
1954 } # sub getitemtypes
1957 my ($biblionumber) = @_;
1958 my $dbh = C4::Context->dbh;
1959 my $query = "Select * from biblio where biblionumber = $biblionumber";
1960 my $sth = $dbh->prepare($query);
1961 # || die "Cannot prepare $query\n" . $dbh->errstr;
1966 # || die "Cannot execute $query\n" . $sth->errstr;
1967 while (my $data = $sth->fetchrow_hashref) {
1968 $results[$count] = $data;
1973 return($count, @results);
1977 my ($biblioitemnum) = @_;
1978 my $dbh = C4::Context->dbh;
1979 my $query = "Select * from biblioitems where
1980 biblioitemnumber = $biblioitemnum";
1981 my $sth = $dbh->prepare($query);
1987 while (my $data = $sth->fetchrow_hashref) {
1988 $results[$count] = $data;
1993 return($count, @results);
1994 } # sub getbiblioitem
1996 sub getbiblioitembybiblionumber {
1997 my ($biblionumber) = @_;
1998 my $dbh = C4::Context->dbh;
1999 my $query = "Select * from biblioitems where biblionumber =
2001 my $sth = $dbh->prepare($query);
2007 while (my $data = $sth->fetchrow_hashref) {
2008 $results[$count] = $data;
2013 return($count, @results);
2016 sub getitemsbybiblioitem {
2017 my ($biblioitemnum) = @_;
2018 my $dbh = C4::Context->dbh;
2019 my $query = "Select * from items, biblio where
2020 biblio.biblionumber = items.biblionumber and biblioitemnumber
2022 my $sth = $dbh->prepare($query);
2023 # || die "Cannot prepare $query\n" . $dbh->errstr;
2028 # || die "Cannot execute $query\n" . $sth->errstr;
2029 while (my $data = $sth->fetchrow_hashref) {
2030 $results[$count] = $data;
2035 return($count, @results);
2036 } # sub getitemsbybiblioitem
2040 # Subroutine to log changes to databases
2041 # Eventually, this subroutine will be used to create a log of all changes made,
2042 # with the possibility of "undo"ing some changes
2044 if ($database eq 'kohadb') {
2050 # print STDERR "KOHA: $type $section $item $original $new\n";
2051 } elsif ($database eq 'marc') {
2053 my $Record_ID=shift;
2056 my $subfield_ID=shift;
2059 # print STDERR "MARC: $type $Record_ID $tag $mark $subfield_ID $original $new\n";
2063 #------------------------------------------------
2066 #---------------------------------------
2067 # Find a biblio entry, or create a new one if it doesn't exist.
2068 # If a "subtitle" entry is in hash, add it to subtitle table
2069 sub getoraddbiblio {
2073 # FIXME - Unused argument
2074 $biblio, # hash ref to fields
2085 $dbh = C4::Context->dbh;
2087 print "<PRE>Looking for biblio </PRE>\n" if $debug;
2088 $sth=$dbh->prepare("select biblionumber
2090 where title=? and author=?
2091 and copyrightdate=? and seriestitle=?");
2093 $biblio->{title}, $biblio->{author},
2094 $biblio->{copyright}, $biblio->{seriestitle} );
2096 ($biblionumber) = $sth->fetchrow;
2097 print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
2099 # Doesn't exist. Add new one.
2100 print "<PRE>Adding biblio</PRE>\n" if $debug;
2101 ($biblionumber,$error)=&newbiblio($biblio);
2102 if ( $biblionumber ) {
2103 print "<PRE>Added with biblio number=$biblionumber</PRE>\n" if $debug;
2104 if ( $biblio->{subtitle} ) {
2105 &newsubtitle($biblionumber,$biblio->{subtitle} );
2108 print "<PRE>Couldn't add biblio: $error</PRE>\n" if $debug;
2112 return $biblionumber,$error;
2114 } # sub getoraddbiblio
2117 # converts ISO 5426 coded string to ISO 8859-1
2118 # sloppy code : should be improved in next issue
2121 if (C4::Context->preference("marcflavour") eq "UNIMARC") {
2238 # this handles non-sorting blocks (if implementation requires this)
2239 $string = nsb_clean($_) ;
2244 my $NSB = '\x88' ; # NSB : begin Non Sorting Block
2245 my $NSE = '\x89' ; # NSE : Non Sorting Block end
2246 # handles non sorting blocks
2250 s/[ ]{0,1}$NSE/) /gm ;
2255 END { } # module clean-up code here (global destructor)
2261 Koha Developement team <info@koha.org>
2263 Paul POULAIN paul.poulain@free.fr