4 # Revision 1.35 2003/02/03 18:46:00 acli
5 # Minor factoring in C4/Biblio.pm, plus change to export the per-tag
6 # 'mandatory' property to a per-subfield 'tag_mandatory' template parameter,
7 # so that addbiblio.tmpl can distinguish between mandatory subfields in a
8 # mandatory tag and mandatory subfields in an optional tag
10 # Not-minor factoring in acqui.simple/addbiblio.pl to make the if-else blocks
11 # smaller, and to add some POD; need further testing for this
13 # Added function to check if a MARC subfield name is "koha-internal" (instead
14 # of checking it for 'lib' and 'tag' everywhere); temporarily added to Koha.pm
16 # Use above function in acqui.simple/additem.pl and search.marc/search.pl
18 # Revision 1.34 2003/01/28 14:50:04 tipaul
19 # fixing MARCmodbiblio API and reindenting code
21 # Revision 1.33 2003/01/23 12:22:37 tipaul
22 # adding char_decode to decode MARC21 or UNIMARC extended chars
24 # Revision 1.32 2002/12/16 15:08:50 tipaul
25 # small but important bugfix (fixes a problem in export)
27 # Revision 1.31 2002/12/13 16:22:04 tipaul
28 # 1st draft of marc export
30 # Revision 1.30 2002/12/12 21:26:35 tipaul
31 # YAB ! (Yet Another Bugfix) => related to biblio modif
32 # (some warning cleaning too)
34 # Revision 1.29 2002/12/12 16:35:00 tipaul
35 # adding authentification with Auth.pm and
36 # MAJOR BUGFIX on marc biblio modification
38 # Revision 1.28 2002/12/10 13:30:03 tipaul
39 # fugfixes from Dombes Abbey work
41 # Revision 1.27 2002/11/19 12:36:16 tipaul
43 # various bugfixes, improvments, and migration from acquisition.pm to biblio.pm
45 # Revision 1.26 2002/11/12 15:58:43 tipaul
48 # * 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)
50 # Revision 1.25 2002/10/25 10:58:26 tipaul
52 # * bugfixes and improvements
54 # Revision 1.24 2002/10/24 12:09:01 arensb
55 # Fixed "no title" warning when generating HTML documentation from POD.
57 # Revision 1.23 2002/10/16 12:43:08 arensb
58 # Added some FIXME comments.
60 # Revision 1.22 2002/10/15 13:39:17 tipaul
61 # removing Acquisition.pm
62 # deleting unused code in biblio.pm, rewriting POD and answering most FIXME comments
64 # Revision 1.21 2002/10/13 11:34:14 arensb
65 # Replaced expressions of the form "$x = $x <op> $y" with "$x <op>= $y".
66 # Thus, $x = $x+2 becomes $x += 2, and so forth.
68 # Revision 1.20 2002/10/13 08:28:32 arensb
69 # Deleted unused variables.
70 # Removed trailing whitespace.
72 # Revision 1.19 2002/10/13 05:56:10 arensb
73 # Added some FIXME comments.
75 # Revision 1.18 2002/10/11 12:34:53 arensb
76 # Replaced &requireDBI with C4::Context->dbh
78 # Revision 1.17 2002/10/10 14:48:25 tipaul
81 # Revision 1.16 2002/10/07 14:04:26 tipaul
82 # road to 1.3.1 : viewing MARC biblio
84 # Revision 1.15 2002/10/05 09:49:25 arensb
85 # Merged with arensb-context branch: use C4::Context->dbh instead of
86 # &C4Connect, and generally prefer C4::Context over C4::Database.
88 # Revision 1.14 2002/10/03 11:28:18 tipaul
89 # Extending Context.pm to add stopword management and using it in MARC-API.
90 # First benchmarks show a medium speed improvement, which is nice as this part is heavily called.
92 # Revision 1.13 2002/10/02 16:26:44 tipaul
95 # Revision 1.12.2.4 2002/10/05 07:09:31 arensb
96 # Merged in changes from main branch.
98 # Revision 1.12.2.3 2002/10/05 06:12:10 arensb
99 # Added a whole mess of FIXME comments.
101 # Revision 1.12.2.2 2002/10/05 04:03:14 arensb
102 # Added some missing semicolons.
104 # Revision 1.12.2.1 2002/10/04 02:24:01 arensb
105 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
108 # Revision 1.12.2.3 2002/10/05 06:12:10 arensb
109 # Added a whole mess of FIXME comments.
111 # Revision 1.12.2.2 2002/10/05 04:03:14 arensb
112 # Added some missing semicolons.
114 # Revision 1.12.2.1 2002/10/04 02:24:01 arensb
115 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
118 # Revision 1.12 2002/10/01 11:48:51 arensb
119 # Added some FIXME comments, mostly marking duplicate functions.
121 # Revision 1.11 2002/09/24 13:49:26 tipaul
122 # long WAS the road to 1.3.0...
123 # coming VERY SOON NOW...
124 # modifying installer and buildrelease to update the DB
126 # Revision 1.10 2002/09/22 16:50:08 arensb
127 # Added some FIXME comments.
129 # Revision 1.9 2002/09/20 12:57:46 tipaul
130 # long is the road to 1.4.0
131 # * MARCadditem and MARCmoditem now wroks
132 # * various bugfixes in MARC management
133 # !!! 1.3.0 should be released very soon now. Be careful !!!
135 # Revision 1.8 2002/09/10 13:53:52 tipaul
136 # MARC API continued...
138 # * 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)
140 # Note : it should not be hard for marcimport and marcexport to re-link fields from internal tag/subfield to "legal" tag/subfield.
142 # Revision 1.7 2002/08/14 18:12:51 tonnesen
143 # Added copyright statement to all .pl and .pm files
145 # Revision 1.6 2002/07/25 13:40:31 tipaul
146 # pod documenting the API.
148 # Revision 1.5 2002/07/24 16:11:37 tipaul
150 # Database.pm and Output.pm are almost not modified (var test...)
152 # Biblio.pm is almost completly rewritten.
154 # WHAT DOES IT ??? ==> END of Hitchcock suspens
156 # 1st, it does... nothing...
157 # 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 ...
159 # All old-API functions have been cloned. for example, the "newbiblio" sub, now has become :
160 # * a "newbiblio" sub, with the same parameters. It just call a sub named OLDnewbiblio
161 # * 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.
162 # * 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.
163 # 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 ;-)
165 # 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.
166 # Note we have decided with steve that a old-biblio <=> a MARC-Biblio.
170 # Copyright 2000-2002 Katipo Communications
172 # This file is part of Koha.
174 # Koha is free software; you can redistribute it and/or modify it under the
175 # terms of the GNU General Public License as published by the Free Software
176 # Foundation; either version 2 of the License, or (at your option) any later
179 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
180 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
181 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
183 # You should have received a copy of the GNU General Public License along with
184 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
185 # Suite 330, Boston, MA 02111-1307 USA
193 use vars qw($VERSION @ISA @EXPORT);
195 # set the version for version checking
200 # don't forget MARCxxx subs are here only for testing purposes. Should not be used
201 # as the old-style API and the NEW one are the only public functions.
204 &updateBiblio &updateBiblioItem &updateItem
205 &itemcount &newbiblio &newbiblioitem
206 &modnote &newsubject &newsubtitle
207 &modbiblio &checkitems
208 &newitems &modbibitem
209 &modsubtitle &modsubject &modaddauthor &moditem &countitems
210 &delitem &deletebiblioitem &delbiblio
211 &getitemtypes &getbiblio
212 &getbiblioitembybiblionumber
213 &getbiblioitem &getitemsbybiblioitem
215 &newcompletebiblioitem
217 &MARCfind_oldbiblionumber_from_MARCbibid
218 &MARCfind_MARCbibid_from_oldbiblionumber
219 &MARCfind_marc_from_kohafield
223 &NEWnewbiblio &NEWnewitem
224 &NEWmodbiblio &NEWmoditem
226 &MARCaddbiblio &MARCadditem
227 &MARCmodsubfield &MARCaddsubfield
228 &MARCmodbiblio &MARCmoditem
229 &MARCkoha2marcBiblio &MARCmarc2koha
230 &MARCkoha2marcItem &MARChtml2marc
231 &MARCgetbiblio &MARCgetitem
232 &MARCaddword &MARCdelword
238 # MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC
241 # all the following subs takes a MARC::Record as parameter and manage
242 # the MARC-DB. They are called by the 1.0/1.2 xxx subs, and by the
243 # NEWxxx subs (xxx deals with old-DB parameters, the NEWxxx deals with MARC-DB parameter)
247 C4::Biblio - acquisition, catalog management functions
251 move from 1.2 to 1.4 version :
252 1.2 and previous version uses a specific API to manage biblios. This API uses old-DB style parameters.
253 In the 1.4 version, we want to do 2 differents things :
254 - keep populating the old-DB, that has a LOT less datas than MARC
255 - populate the MARC-DB
256 To populate the DBs we have 2 differents sources :
257 - the standard acquisition system (through book sellers), that does'nt use MARC data
258 - the MARC acquisition system, that uses MARC data.
260 Thus, we have 2 differents cases :
261 - 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
262 - 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
264 That's why we need 4 subs :
265 all I<subs beginning by MARC> manage only MARC tables. They manage MARC-DB with MARC::Record parameters
266 all I<subs beginning by OLD> manage only OLD-DB tables. They manage old-DB with old-DB parameters
267 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
268 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.
270 - NEW and old-style API should be used in koha to manage biblio
271 - MARCsubs are divided in 2 parts :
272 * some of them manage MARC parameters. They are heavily used in koha.
273 * some of them manage MARC biblio : they are mostly used by NEW and old-style subs.
274 - OLD are used internally only
276 all subs requires/use $dbh as 1st parameter.
278 I<NEWxxx related subs>
280 all subs requires/use $dbh as 1st parameter.
281 those subs are used by the MARC-compliant version of koha : marc import, or marc management.
283 I<OLDxxx related subs>
285 all subs requires/use $dbh as 1st parameter.
286 those subs are used by the MARC-compliant version of koha : marc import, or marc management.
288 They all are the exact copy of 1.0/1.2 version of the sub without the OLD.
289 The OLDxxx is called by the original xxx sub.
290 the 1.4 xxx sub also builds MARC::Record an calls the MARCxxx
292 WARNING : there is 1 difference between initialxxx and OLDxxx :
293 the db header $dbh is always passed as parameter to avoid over-DB connexion
299 =item @tagslib = &MARCgettagslib($dbh,1|0);
301 last param is 1 for liblibrarian and 0 for libopac
302 returns a hash with tag/subfield meaning
303 =item ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
305 finds MARC tag and subfield for a given kohafield
306 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
308 =item $biblionumber = &MARCfind_oldbiblionumber_from_MARCbibid($dbh,$MARCbibi);
310 finds a old-db biblio number for a given MARCbibid number
312 =item $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$oldbiblionumber);
314 finds a MARC bibid from a old-db biblionumber
316 =item $MARCRecord = &MARCkoha2marcBiblio($dbh,$biblionumber,biblioitemnumber);
318 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem
320 =item $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);
322 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB item
324 =item $MARCRecord = &MARCkoha2marcSubtitle($dbh,$biblionumber,$subtitle);
326 MARCkoha2marcSubtitle is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB subtitle
328 =item $olddb = &MARCmarc2koha($dbh,$MARCRecord);
330 builds a hash with old-db datas from a MARC::Record
332 =item &MARCaddbiblio($dbh,$MARC::Record,$biblionumber);
334 creates a biblio (in the MARC tables only). $biblionumber is the old-db biblionumber of the biblio
336 =item &MARCaddsubfield($dbh,$bibid,$tagid,$indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
338 adds a subfield in a biblio (in the MARC tables only).
340 =item $MARCRecord = &MARCgetbiblio($dbh,$bibid);
342 Returns a MARC::Record for the biblio $bibid.
344 =item &MARCmodbiblio($dbh,$bibid,$record,$delete);
346 MARCmodbiblio changes a biblio for a biblio,MARC::Record passed as parameter
347 if $delete == 1, every field/subfield not found is deleted in the biblio
348 otherwise, only data passed to MARCmodbiblio is managed.
349 thus, you can change only a small part of a biblio (like an item, or a subtitle, or a additionalauthor...)
351 =item ($subfieldid,$subfieldvalue) = &MARCmodsubfield($dbh,$subfieldid,$subfieldvalue);
353 MARCmodsubfield changes the value of a given subfield
355 =item $subfieldid = &MARCfindsubfield($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue);
357 MARCfindsubfield returns a subfield number given a bibid/tag/subfieldvalue values.
358 Returns -1 if more than 1 answer
360 =item $subfieldid = &MARCfindsubfieldid($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
362 MARCfindsubfieldid find a subfieldid for a bibid/tag/tagorder/subfield/subfieldorder
364 =item &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
366 MARCdelsubfield delete a subfield for a bibid/tag/tagorder/subfield/subfieldorder
368 =item &MARCdelbiblio($dbh,$bibid);
370 MARCdelbiblio delete biblio $bibid
372 =item &MARCkoha2marcOnefield
374 used by MARCkoha2marc and should not be useful elsewhere
376 =item &MARCmarc2kohaOnefield
378 used by MARCmarc2koha and should not be useful elsewhere
382 used to manage MARC_word table and should not be useful elsewhere
386 used to manage MARC_word table and should not be useful elsewhere
391 my ($dbh,$forlibrarian)= @_;
393 my $libfield = ($forlibrarian eq 1)? 'liblibrarian' : 'libopac';
394 $sth=$dbh->prepare("select tagfield,$libfield as lib,mandatory from marc_tag_structure order by tagfield");
396 my ($lib,$tag,$res,$tab,$mandatory,$repeatable);
397 while ( ($tag,$lib,$mandatory) = $sth->fetchrow) {
398 $res->{$tag}->{lib}=$lib;
399 $res->{$tab}->{tab}=""; # XXX
400 $res->{$tag}->{mandatory}=$mandatory;
403 $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");
407 my $authorised_value;
408 my $thesaurus_category;
410 while ( ($tag, $subfield, $lib, $tab, $mandatory, $repeatable,$authorised_value,$thesaurus_category,$value_builder) = $sth->fetchrow) {
411 $res->{$tag}->{$subfield}->{lib}=$lib;
412 $res->{$tag}->{$subfield}->{tab}=$tab;
413 $res->{$tag}->{$subfield}->{mandatory}=$mandatory;
414 $res->{$tag}->{$subfield}->{repeatable}=$repeatable;
415 $res->{$tag}->{$subfield}->{authorised_value}=$authorised_value;
416 $res->{$tag}->{$subfield}->{thesaurus_category}=$thesaurus_category;
417 $res->{$tag}->{$subfield}->{value_builder}=$value_builder;
422 sub MARCfind_marc_from_kohafield {
423 my ($dbh,$kohafield) = @_;
424 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
425 $sth->execute($kohafield);
426 my ($tagfield,$tagsubfield) = $sth->fetchrow;
427 return ($tagfield,$tagsubfield);
430 sub MARCfind_oldbiblionumber_from_MARCbibid {
431 my ($dbh,$MARCbibid) = @_;
432 my $sth=$dbh->prepare("select biblionumber from marc_biblio where bibid=?");
433 $sth->execute($MARCbibid);
434 my ($biblionumber) = $sth->fetchrow;
435 return $biblionumber;
438 sub MARCfind_MARCbibid_from_oldbiblionumber {
439 my ($dbh,$oldbiblionumber) = @_;
440 my $sth=$dbh->prepare("select bibid from marc_biblio where biblionumber=?");
441 $sth->execute($oldbiblionumber);
442 my ($bibid) = $sth->fetchrow;
447 # pass the MARC::Record to this function, and it will create the records in the marc tables
448 my ($dbh,$record,$biblionumber) = @_;
449 my @fields=$record->fields();
451 # adding main table, and retrieving bibid
452 $dbh->do("lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ");
453 my $sth=$dbh->prepare("insert into marc_biblio (datecreated,biblionumber) values (now(),?)");
454 $sth->execute($biblionumber);
455 $sth=$dbh->prepare("select max(bibid) from marc_biblio");
457 ($bibid)=$sth->fetchrow;
460 # now, add subfields...
461 foreach my $field (@fields) {
462 my @subfields=$field->subfields();
464 foreach my $subfieldcount (0..$#subfields) {
465 &MARCaddsubfield($dbh,$bibid,
467 $field->indicator(1).$field->indicator(2),
469 $subfields[$subfieldcount][0],
471 $subfields[$subfieldcount][1]
475 $dbh->do("unlock tables");
480 # pass the MARC::Record to this function, and it will create the records in the marc tables
481 my ($dbh,$record,$biblionumber) = @_;
482 # warn "adding : ".$record->as_formatted();
483 # search for MARC biblionumber
484 $dbh->do("lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ");
485 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
486 my @fields=$record->fields();
487 my $sth = $dbh->prepare("select max(tagorder) from marc_subfield_table where bibid=?");
488 $sth->execute($bibid);
489 my ($fieldcount) = $sth->fetchrow;
490 # now, add subfields...
491 foreach my $field (@fields) {
492 my @subfields=$field->subfields();
494 foreach my $subfieldcount (0..$#subfields) {
495 &MARCaddsubfield($dbh,$bibid,
497 $field->indicator(1).$field->indicator(2),
499 $subfields[$subfieldcount][0],
501 $subfields[$subfieldcount][1]
503 # warn "ADDING :$bibid,".
505 $field->indicator(1).$field->indicator(2).",
507 $subfields[$subfieldcount][0],
509 $subfields[$subfieldcount][1]";
512 $dbh->do("unlock tables");
516 sub MARCaddsubfield {
517 # Add a new subfield to a tag into the DB.
518 my ($dbh,$bibid,$tagid,$tag_indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue) = @_;
519 # if not value, end of job, we do nothing
520 if (length($subfieldvalue) ==0) {
523 if (not($subfieldcode)) {
526 if (length($subfieldvalue)>255) {
527 # $dbh->do("lock tables marc_blob_subfield WRITE, marc_subfield_table WRITE");
528 my $sth=$dbh->prepare("insert into marc_blob_subfield (subfieldvalue) values (?)");
529 $sth->execute($subfieldvalue);
530 $sth=$dbh->prepare("select max(blobidlink)from marc_blob_subfield");
532 my ($res)=$sth->fetchrow;
533 $sth=$dbh->prepare("insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,valuebloblink) values (?,?,?,?,?,?,?)");
535 $sth->execute($bibid,'0'.$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$res);
537 $sth->execute($bibid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$res);
540 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";
542 # $dbh->do("unlock tables");
544 my $sth=$dbh->prepare("insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values (?,?,?,?,?,?,?)");
545 $sth->execute($bibid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue);
547 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";
550 &MARCaddword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
554 # Returns MARC::Record of the biblio passed in parameter.
556 my $record = MARC::Record->new();
557 #---- TODO : the leader is missing
558 $record->leader(' ');
559 my $sth=$dbh->prepare("select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
560 from marc_subfield_table
561 where bibid=? order by tag,tagorder,subfieldcode
563 my $sth2=$dbh->prepare("select subfieldvalue from marc_blob_subfield where blobidlink=?");
564 $sth->execute($bibid);
569 while (my $row=$sth->fetchrow_hashref) {
570 if ($row->{'valuebloblink'}) { #---- search blob if there is one
571 $sth2->execute($row->{'valuebloblink'});
572 my $row2=$sth2->fetchrow_hashref;
574 $row->{'subfieldvalue'}=$row2->{'subfieldvalue'};
576 if ($row->{tagorder} ne $prevtagorder || $row->{tag} ne $prevtag) {
577 if (length($prevtag) <3) {
578 $prevtag = "0".$prevtag;
581 my $field = MARC::Field->new( $prevtag, substr($previndicator,0,1), substr($previndicator,1,1), %subfieldlist);
583 $record->add_fields($field);
584 $prevtagorder=$row->{tagorder};
585 $prevtag = $row->{tag};
586 $previndicator=$row->{tag_indicator};
588 %subfieldlist->{$row->{'subfieldcode'}} = $row->{'subfieldvalue'};
590 %subfieldlist->{$row->{'subfieldcode'}} .= $row->{'subfieldvalue'};
591 $prevtag= $row->{tag};
592 $previndicator=$row->{tag_indicator};
595 # the last has not been included inside the loop... do it now !
596 my $field = MARC::Field->new( $prevtag, "", "", %subfieldlist);
597 $record->add_fields($field);
601 # Returns MARC::Record of the biblio passed in parameter.
602 my ($dbh,$bibid,$itemnumber)=@_;
603 my $record = MARC::Record->new();
604 # search MARC tagorder
605 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=?");
606 $sth2->execute($bibid,$itemnumber);
607 my ($tagorder) = $sth2->fetchrow_array();
608 #---- TODO : the leader is missing
609 my $sth=$dbh->prepare("select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
610 from marc_subfield_table
611 where bibid=? and tagorder=? order by subfieldcode,subfieldorder
613 $sth2=$dbh->prepare("select subfieldvalue from marc_blob_subfield where blobidlink=?");
614 $sth->execute($bibid,$tagorder);
615 while (my $row=$sth->fetchrow_hashref) {
616 if ($row->{'valuebloblink'}) { #---- search blob if there is one
617 $sth2->execute($row->{'valuebloblink'});
618 my $row2=$sth2->fetchrow_hashref;
620 $row->{'subfieldvalue'}=$row2->{'subfieldvalue'};
622 if ($record->field($row->{'tag'})) {
624 #--- this test must stay as this, because of strange behaviour of mySQL/Perl DBI with char var containing a number...
625 #--- sometimes, eliminates 0 at beginning, sometimes no ;-\\\
626 if (length($row->{'tag'}) <3) {
627 $row->{'tag'} = "0".$row->{'tag'};
629 $field =$record->field($row->{'tag'});
631 my $x = $field->add_subfields($row->{'subfieldcode'},$row->{'subfieldvalue'});
632 $record->delete_field($field);
633 $record->add_fields($field);
636 if (length($row->{'tag'}) < 3) {
637 $row->{'tag'} = "0".$row->{'tag'};
639 my $temp = MARC::Field->new($row->{'tag'}," "," ", $row->{'subfieldcode'} => $row->{'subfieldvalue'});
640 $record->add_fields($temp);
648 my ($dbh,$bibid,$record,$delete)=@_;
649 # my ($dbh,$record,$bibid,$itemnumber,$delete)=@_;
650 my $oldrecord=&MARCgetbiblio($dbh,$bibid);
651 # warn "OLD : ".$oldrecord->as_formatted();
652 # warn "----------------------------------\nNEW : ".$record->as_formatted();
654 # if nothing to change, don't waste time...
655 if ($oldrecord eq $record) {
656 # warn "NOTHING TO CHANGE";
659 # otherwise, skip through each subfield...
660 my @fields = $record->fields();
662 foreach my $field (@fields) {
663 my $oldfield = $oldrecord->field($field->tag());
664 my @subfields=$field->subfields();
667 foreach my $subfield (@subfields) {
669 if ($oldfield eq 0 or (! $oldfield->subfield(@$subfield[0])) ) {
670 # just adding datas...
671 &MARCaddsubfield($dbh,$bibid,$field->tag(),$field->indicator(1).$field->indicator(2),
672 1,@$subfield[0],$subfieldorder,@$subfield[1]);
674 # modify the subfield if it's a different string
675 if ($oldfield->subfield(@$subfield[0]) ne @$subfield[1] ) {
676 my $subfieldid=&MARCfindsubfieldid($dbh,$bibid,$field->tag(),$tagorder,@$subfield[0],$subfieldorder);
677 &MARCmodsubfield($dbh,$subfieldid,@$subfield[1]);
686 my ($dbh,$record,$bibid,$itemnumber,$delete)=@_;
687 my $oldrecord=&MARCgetitem($dbh,$bibid,$itemnumber);
688 # if nothing to change, don't waste time...
689 if ($oldrecord eq $record) {
690 # warn "nothing to change";
693 # warn "MARCmoditem : ".$record->as_formatted;
694 # warn "OLD : ".$oldrecord->as_formatted;
696 # otherwise, skip through each subfield...
697 my @fields = $record->fields();
698 # search old MARC item
699 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=?");
700 $sth2->execute($bibid,$itemnumber);
701 my ($tagorder) = $sth2->fetchrow_array();
702 foreach my $field (@fields) {
703 my $oldfield = $oldrecord->field($field->tag());
704 my @subfields=$field->subfields();
706 foreach my $subfield (@subfields) {
708 # warn "compare : $oldfield".$oldfield->subfield(@$subfield[0]);
709 if ($oldfield eq 0 or (length($oldfield->subfield(@$subfield[0])) ==0) ) {
710 # just adding datas...
711 # warn "addfield : / $subfieldorder / @$subfield[0] - @$subfield[1]";
712 # warn "NEW subfield : $bibid,".$field->tag().",".$tagorder.",".@$subfield[0].",".$subfieldorder.",".@$subfield[1].")";
713 &MARCaddsubfield($dbh,$bibid,$field->tag(),$field->indicator(1).$field->indicator(2),
714 $tagorder,@$subfield[0],$subfieldorder,@$subfield[1]);
716 # warn "modfield : / $subfieldorder / @$subfield[0] - @$subfield[1]";
717 # modify he subfield if it's a different string
718 if ($oldfield->subfield(@$subfield[0]) ne @$subfield[1] ) {
719 my $subfieldid=&MARCfindsubfieldid($dbh,$bibid,$field->tag(),$tagorder,@$subfield[0],$subfieldorder);
720 # warn "changing : $subfieldid, $bibid,".$field->tag(),",$tagorder,@$subfield[0],@$subfield[1],$subfieldorder";
721 &MARCmodsubfield($dbh,$subfieldid,@$subfield[1]);
724 warn "nothing to change : ".$oldfield->subfield(@$subfield[0]);
732 sub MARCmodsubfield {
733 # Subroutine changes a subfield value given a subfieldid.
734 my ($dbh, $subfieldid, $subfieldvalue )=@_;
735 $dbh->do("lock tables marc_blob_subfield WRITE,marc_subfield_table WRITE");
736 my $sth1=$dbh->prepare("select valuebloblink from marc_subfield_table where subfieldid=?");
737 $sth1->execute($subfieldid);
738 my ($oldvaluebloblink)=$sth1->fetchrow;
741 # if too long, use a bloblink
742 if (length($subfieldvalue)>255 ) {
743 # if already a bloblink, update it, otherwise, insert a new one.
744 if ($oldvaluebloblink) {
745 $sth=$dbh->prepare("update marc_blob_subfield set subfieldvalue=? where blobidlink=?");
746 $sth->execute($subfieldvalue,$oldvaluebloblink);
748 $sth=$dbh->prepare("insert into marc_blob_subfield (subfieldvalue) values (?)");
749 $sth->execute($subfieldvalue);
750 $sth=$dbh->prepare("select max(blobidlink) from marc_blob_subfield");
752 my ($res)=$sth->fetchrow;
753 $sth=$dbh->prepare("update marc_subfield_table set subfieldvalue=null, valuebloblink=$res where subfieldid=?");
754 $sth->execute($subfieldid);
757 # note this can leave orphan bloblink. Not a big problem, but we should build somewhere a orphan deleting script...
758 $sth=$dbh->prepare("update marc_subfield_table set subfieldvalue=?,valuebloblink=null where subfieldid=?");
759 $sth->execute($subfieldvalue, $subfieldid);
761 $dbh->do("unlock tables");
763 $sth=$dbh->prepare("select bibid,tag,tagorder,subfieldcode,subfieldid,subfieldorder from marc_subfield_table where subfieldid=?");
764 $sth->execute($subfieldid);
765 my ($bibid,$tagid,$tagorder,$subfieldcode,$x,$subfieldorder) = $sth->fetchrow;
767 &MARCdelword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder);
768 &MARCaddword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
769 return($subfieldid, $subfieldvalue);
772 sub MARCfindsubfield {
773 my ($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue) = @_;
777 my $query="select subfieldid from marc_subfield_table where bibid=? and tag=? and subfieldcode=?";
778 if ($subfieldvalue) {
779 $query .= " and subfieldvalue=".$dbh->quote($subfieldvalue);
781 if ($subfieldorder<1) {
784 $query .= " and subfieldorder=$subfieldorder";
786 my $sti=$dbh->prepare($query);
787 $sti->execute($bibid,$tag, $subfieldcode);
788 while (($subfieldid) = $sti->fetchrow) {
790 $lastsubfieldid=$subfieldid;
792 if ($resultcounter>1) {
793 # Error condition. Values given did not resolve into a unique record. Don't know what to edit
794 # should rarely occur (only if we use subfieldvalue with a value that exists twice, which is strange)
797 return $lastsubfieldid;
801 sub MARCfindsubfieldid {
802 my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
803 my $sth=$dbh->prepare("select subfieldid from marc_subfield_table
804 where bibid=? and tag=? and tagorder=?
805 and subfieldcode=? and subfieldorder=?");
806 $sth->execute($bibid,$tag,$tagorder,$subfield,$subfieldorder);
807 my ($res) = $sth->fetchrow;
809 $sth=$dbh->prepare("select subfieldid from marc_subfield_table
810 where bibid=? and tag=? and tagorder=?
811 and subfieldcode=?");
812 $sth->execute($bibid,$tag,$tagorder,$subfield);
813 ($res) = $sth->fetchrow;
818 sub MARCdelsubfield {
819 # delete a subfield for $bibid / tag / tagorder / subfield / subfieldorder
820 my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
821 $dbh->do("delete from marc_subfield_table where bibid='$bibid' and
822 tag='$tag' and tagorder='$tagorder'
823 and subfieldcode='$subfield' and subfieldorder='$subfieldorder
828 # delete a biblio for a $bibid
829 my ($dbh,$bibid) = @_;
830 $dbh->do("delete from marc_subfield_table where bibid='$bibid'");
831 $dbh->do("delete from marc_biblio where bibid='$bibid'");
834 sub MARCkoha2marcBiblio {
835 # this function builds partial MARC::Record from the old koha-DB fields
836 my ($dbh,$biblionumber,$biblioitemnumber) = @_;
837 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
838 my $record = MARC::Record->new();
839 #--- if bibid, then retrieve old-style koha data
840 if ($biblionumber>0) {
841 my $sth2=$dbh->prepare("select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp
842 from biblio where biblionumber=?");
843 $sth2->execute($biblionumber);
844 my $row=$sth2->fetchrow_hashref;
846 foreach $code (keys %$row) {
848 &MARCkoha2marcOnefield($sth,$record,"biblio.".$code,$row->{$code});
852 #--- if biblioitem, then retrieve old-style koha data
853 if ($biblioitemnumber>0) {
854 my $sth2=$dbh->prepare(" SELECT biblioitemnumber,biblionumber,volume,number,classification,
855 itemtype,url,isbn,issn,dewey,subclass,publicationyear,publishercode,
856 volumedate,volumeddesc,timestamp,illus,pages,notes,size,place
858 WHERE biblionumber=? and biblioitemnumber=?
860 $sth2->execute($biblionumber,$biblioitemnumber);
861 my $row=$sth2->fetchrow_hashref;
863 foreach $code (keys %$row) {
865 &MARCkoha2marcOnefield($sth,$record,"biblioitems.".$code,$row->{$code});
870 # TODO : retrieve notes, additionalauthors
873 sub MARCkoha2marcItem {
874 # this function builds partial MARC::Record from the old koha-DB fields
875 my ($dbh,$biblionumber,$itemnumber) = @_;
876 # my $dbh=&C4Connect;
877 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
878 my $record = MARC::Record->new();
879 #--- if item, then retrieve old-style koha data
881 # print STDERR "prepare $biblionumber,$itemnumber\n";
882 my $sth2=$dbh->prepare("SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned,
883 booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
884 datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,bulk,issues,renewals,
885 reserves,restricted,binding,itemnotes,holdingbranch,timestamp
887 WHERE itemnumber=?");
888 $sth2->execute($itemnumber);
889 my $row=$sth2->fetchrow_hashref;
891 foreach $code (keys %$row) {
893 &MARCkoha2marcOnefield($sth,$record,"items.".$code,$row->{$code});
898 # TODO : retrieve notes, additionalauthors
901 sub MARCkoha2marcSubtitle {
902 # this function builds partial MARC::Record from the old koha-DB fields
903 my ($dbh,$bibnum,$subtitle) = @_;
904 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
905 my $record = MARC::Record->new();
906 &MARCkoha2marcOnefield($sth,$record,"bibliosubtitle.subtitle",$subtitle);
910 sub MARCkoha2marcOnefield {
911 my ($sth,$record,$kohafieldname,$value)=@_;
914 $sth->execute($kohafieldname);
915 if (($tagfield,$tagsubfield)=$sth->fetchrow) {
916 if ($record->field($tagfield)) {
917 my $tag =$record->field($tagfield);
919 $tag->add_subfields($tagsubfield,$value);
920 $record->delete_field($tag);
921 $record->add_fields($tag);
924 $record->add_fields($tagfield," "," ",$tagsubfield => $value);
931 my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
932 my $prevtag = @$rtags[0];
933 my $record = MARC::Record->new();
935 for (my $i=0; $i< @$rtags; $i++) {
936 # rebuild MARC::Record
937 if (@$rtags[$i] ne $prevtag) {
941 $indicators{$prevtag}.=' ';
942 my $field = MARC::Field->new( $prevtag, substr($indicators{$prevtag},0,1),substr($indicators{$prevtag},1,1), %subfieldlist);
943 $record->add_fields($field);
944 $prevtag = @$rtags[$i];
946 %subfieldlist->{@$rsubfields[$i]} = @$rvalues[$i];
948 # if (%subfieldlist->{@$rsubfields[$i]}) {
949 # %subfieldlist->{@$rsubfields[$i]} .= '|';
951 %subfieldlist->{@$rsubfields[$i]} .=@$rvalues[$i];
952 $prevtag= @$rtags[$i];
955 # the last has not been included inside the loop... do it now !
956 my $field = MARC::Field->new( $prevtag, "", "", %subfieldlist);
957 $record->add_fields($field);
962 my ($dbh,$record) = @_;
963 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
965 my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
968 # print STDERR $record->as_formatted;
969 while (($field)=$sth2->fetchrow) {
970 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result);
972 $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
974 while (($field)=$sth2->fetchrow) {
975 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result);
977 $sth2=$dbh->prepare("SHOW COLUMNS from items");
979 while (($field)=$sth2->fetchrow) {
980 $result = &MARCmarc2kohaOneField($sth,"items",$field,$record,$result);
982 # additional authors : specific
983 $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result);
987 sub MARCmarc2kohaOneField {
988 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
989 my ($sth,$kohatable,$kohafield,$record,$result)= @_;
990 # warn "kohatable / $kohafield / $result / ";
994 $sth->execute($kohatable.".".$kohafield);
995 ($tagfield,$subfield) = $sth->fetchrow;
996 foreach my $field ($record->field($tagfield)) {
997 if ($field->subfield($subfield)) {
998 if ($result->{$kohafield}) {
999 $result->{$kohafield} .= " | ".$field->subfield($subfield);
1001 $result->{$kohafield}=$field->subfield($subfield);
1009 # split a subfield string and adds it into the word table.
1011 my ($dbh,$bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$sentence) =@_;
1012 $sentence =~ s/(\.|\?|\:|\!|\'|,|\-)/ /g;
1013 my @words = split / /,$sentence;
1014 my $stopwords= C4::Context->stopwords;
1015 my $sth=$dbh->prepare("insert into marc_word (bibid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word)
1016 values (?,?,?,?,?,?,soundex(?))");
1017 foreach my $word (@words) {
1018 # we record only words longer than 2 car and not in stopwords hash
1019 if (length($word)>1 and !($stopwords->{uc($word)})) {
1020 $sth->execute($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,$word);
1022 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";
1029 # delete words. this sub deletes all the words from a sentence. a subfield modif is done by a delete then a add
1030 my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
1031 my $sth=$dbh->prepare("delete from marc_word where bibid=? and tag=? and tagorder=? and subfieldid=? and subfieldorder=?");
1032 $sth->execute($bibid,$tag,$tagorder,$subfield,$subfieldorder);
1037 # NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW
1040 # all the following subs are useful to manage MARC-DB with complete MARC records.
1041 # it's used with marcimport, and marc management tools
1045 =item (oldbibnum,$oldbibitemnum) = NEWnewbibilio($dbh,$MARCRecord,$oldbiblio,$oldbiblioitem);
1047 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
1048 are builded from the MARC::Record. If they are passed, they are used.
1050 =item NEWnewitem($dbh,$olditem);
1052 adds an item in the db. $olditem is a old-db hash.
1057 my ($dbh, $record, $oldbiblio, $oldbiblioitem) = @_;
1058 # note $oldbiblio and $oldbiblioitem are not mandatory.
1059 # if not present, they will be builded from $record with MARCmarc2koha function
1060 if (($oldbiblio) and not($oldbiblioitem)) {
1061 print STDERR "NEWnewbiblio : missing parameter\n";
1062 print "NEWnewbiblio : missing parameter : contact koha development team\n";
1068 $oldbibnum = OLDnewbiblio($dbh,$oldbiblio);
1069 $oldbiblioitem->{'biblionumber'} = $oldbibnum;
1070 $oldbibitemnum = OLDnewbiblioitem($dbh,$oldbiblioitem);
1072 my $olddata = MARCmarc2koha($dbh,$record);
1073 $oldbibnum = OLDnewbiblio($dbh,$olddata);
1074 $olddata->{'biblionumber'} = $oldbibnum;
1075 $oldbibitemnum = OLDnewbiblioitem($dbh,$olddata);
1077 # we must add bibnum and bibitemnum in MARC::Record...
1078 # we build the new field with biblionumber and biblioitemnumber
1079 # we drop the original field
1080 # we add the new builded field.
1081 # NOTE : Works only if the field is ONLY for biblionumber and biblioitemnumber
1082 # (steve and paul : thinks 090 is a good choice)
1083 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
1084 $sth->execute("biblio.biblionumber");
1085 (my $tagfield1, my $tagsubfield1) = $sth->fetchrow;
1086 $sth->execute("biblioitems.biblioitemnumber");
1087 (my $tagfield2, my $tagsubfield2) = $sth->fetchrow;
1088 if ($tagfield1 != $tagfield2) {
1089 print STDERR "Error in NEWnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number";
1090 print "Content-Type: text/html\n\nError in NEWnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number";
1093 my $newfield = MARC::Field->new( $tagfield1,'','',
1094 "$tagsubfield1" => $oldbibnum,
1095 "$tagsubfield2" => $oldbibitemnum);
1096 # drop old field and create new one...
1097 my $old_field = $record->field($tagfield1);
1098 $record->delete_field($old_field);
1099 $record->add_fields($newfield);
1100 my $bibid = MARCaddbiblio($dbh,$record,$oldbibnum);
1101 return ($bibid,$oldbibnum,$oldbibitemnum );
1105 my ($dbh,$record,$bibid) =@_;
1106 &MARCmodbiblio($dbh,$bibid,$record,0);
1107 my $oldbiblio = MARCmarc2koha($dbh,$record);
1108 my $oldbiblionumber = OLDmodbiblio($dbh,$oldbiblio);
1109 OLDmodbibitem($dbh,$oldbiblio);
1115 my ($dbh, $record,$bibid) = @_;
1116 # add item in old-DB
1117 my $item = &MARCmarc2koha($dbh,$record);
1118 # needs old biblionumber and biblioitemnumber
1119 $item->{'biblionumber'} = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
1120 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
1121 $sth->execute($item->{'biblionumber'});
1122 ($item->{'biblioitemnumber'}) = $sth->fetchrow;
1123 my ($itemnumber,$error) = &OLDnewitems($dbh,$item,$item->{barcode});
1124 # add itemnumber to MARC::Record before adding the item.
1125 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
1126 &MARCkoha2marcOnefield($sth,$record,"items.itemnumber",$itemnumber);
1128 my $bib = &MARCadditem($dbh,$record,$item->{'biblionumber'});
1132 my ($dbh,$record,$bibid,$itemnumber,$delete) = @_;
1133 &MARCmoditem($dbh,$record,$bibid,$itemnumber,$delete);
1134 my $olditem = MARCmarc2koha($dbh,$record);
1135 OLDmoditem($dbh,$olditem);
1140 # OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD
1144 =item $biblionumber = OLDnewbiblio($dbh,$biblio);
1146 adds a record in biblio table. Datas are in the hash $biblio.
1148 =item $biblionumber = OLDmodbiblio($dbh,$biblio);
1150 modify a record in biblio table. Datas are in the hash $biblio.
1152 =item OLDmodsubtitle($dbh,$bibnum,$subtitle);
1154 modify subtitles in bibliosubtitle table.
1156 =item OLDmodaddauthor($dbh,$bibnum,$author);
1158 adds or modify additional authors
1159 NOTE : Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
1161 =item $errors = OLDmodsubject($dbh,$bibnum, $force, @subject);
1163 modify/adds subjects
1165 =item OLDmodbibitem($dbh, $biblioitem);
1169 =item OLDmodnote($dbh,$bibitemnum,$note
1171 modify a note for a biblioitem
1173 =item OLDnewbiblioitem($dbh,$biblioitem);
1175 adds a biblioitem ($biblioitem is a hash with the values)
1177 =item OLDnewsubject($dbh,$bibnum);
1181 =item OLDnewsubtitle($dbh,$bibnum,$subtitle);
1183 create a new subtitle
1185 =item ($itemnumber,$errors)= OLDnewitems($dbh,$item,$barcode);
1187 create a item. $item is a hash and $barcode the barcode.
1189 =item OLDmoditem($dbh,$item);
1193 =item OLDdelitem($dbh,$itemnum);
1197 =item OLDdeletebiblioitem($dbh,$biblioitemnumber);
1199 deletes a biblioitem
1200 NOTE : not standard sub name. Should be OLDdelbiblioitem()
1202 =item OLDdelbiblio($dbh,$biblio);
1209 my ($dbh,$biblio) = @_;
1210 # my $dbh = &C4Connect;
1211 my $query = "Select max(biblionumber) from biblio";
1212 my $sth = $dbh->prepare($query);
1214 my $data = $sth->fetchrow_arrayref;
1215 my $bibnum = $$data[0] + 1;
1218 $biblio->{'title'} = $dbh->quote($biblio->{'title'});
1219 $biblio->{'author'} = $dbh->quote($biblio->{'author'});
1220 $biblio->{'copyright'} = $dbh->quote($biblio->{'copyright'});
1221 $biblio->{'seriestitle'} = $dbh->quote($biblio->{'seriestitle'});
1222 $biblio->{'notes'} = $dbh->quote($biblio->{'notes'});
1223 $biblio->{'abstract'} = $dbh->quote($biblio->{'abstract'});
1224 if ($biblio->{'seriestitle'}) { $series = 1 };
1227 $query = "insert into biblio set
1228 biblionumber = $bibnum,
1229 title = $biblio->{'title'},
1230 author = $biblio->{'author'},
1231 copyrightdate = $biblio->{'copyright'},
1233 seriestitle = $biblio->{'seriestitle'},
1234 notes = $biblio->{'notes'},
1235 abstract = $biblio->{'abstract'}";
1237 $sth = $dbh->prepare($query);
1246 my ($dbh,$biblio) = @_;
1247 # my $dbh = C4Connect;
1251 $biblio->{'title'} = $dbh->quote($biblio->{'title'});
1252 $biblio->{'author'} = $dbh->quote($biblio->{'author'});
1253 $biblio->{'abstract'} = $dbh->quote($biblio->{'abstract'});
1254 $biblio->{'copyrightdate'} = $dbh->quote($biblio->{'copyrightdate'});
1255 $biblio->{'seriestitle'} = $dbh->quote($biblio->{'serirestitle'});
1256 $biblio->{'serial'} = $dbh->quote($biblio->{'serial'});
1257 $biblio->{'unititle'} = $dbh->quote($biblio->{'unititle'});
1258 $biblio->{'notes'} = $dbh->quote($biblio->{'notes'});
1260 $query = "Update biblio set title = ?, author = ?, abstract = ?, copyrightdate = ?,
1261 seriestitle = ?, serial = ?, unititle = ?, notes = ? where biblionumber = ?";
1262 $sth = $dbh->prepare($query);
1263 $sth->execute($biblio->{'title'},$biblio->{'author'},$biblio->{'abstract'},$biblio->{'copyrightdate'},
1264 $biblio->{'seriestitle'},$biblio->{'serial'},$biblio->{'unititle'},$biblio->{'notes'},$biblio->{'biblionumber'});
1267 return($biblio->{'biblionumber'});
1270 sub OLDmodsubtitle {
1271 my ($dbh,$bibnum, $subtitle) = @_;
1272 # my $dbh = C4Connect;
1273 my $query = "update bibliosubtitle set
1274 subtitle = '$subtitle'
1275 where biblionumber = $bibnum";
1276 my $sth = $dbh->prepare($query);
1284 sub OLDmodaddauthor {
1285 my ($dbh,$bibnum, $author) = @_;
1286 # my $dbh = C4Connect;
1287 my $query = "Delete from additionalauthors where biblionumber = $bibnum";
1288 my $sth = $dbh->prepare($query);
1293 if ($author ne '') {
1294 $query = "Insert into additionalauthors set
1296 biblionumber = '$bibnum'";
1297 $sth = $dbh->prepare($query);
1303 } # sub modaddauthor
1307 my ($dbh,$bibnum, $force, @subject) = @_;
1308 # my $dbh = C4Connect;
1309 my $count = @subject;
1311 for (my $i = 0; $i < $count; $i++) {
1312 $subject[$i] =~ s/^ //g;
1313 $subject[$i] =~ s/ $//g;
1314 my $query = "select * from catalogueentry
1315 where entrytype = 's'
1316 and catalogueentry = '$subject[$i]'";
1317 my $sth = $dbh->prepare($query);
1320 if (my $data = $sth->fetchrow_hashref) {
1322 if ($force eq $subject[$i]) {
1323 # subject not in aut, chosen to force anway
1324 # so insert into cataloguentry so its in auth file
1325 $query = "Insert into catalogueentry
1326 (entrytype,catalogueentry)
1327 values ('s','$subject[$i]')";
1328 my $sth2 = $dbh->prepare($query);
1333 $error = "$subject[$i]\n does not exist in the subject authority file";
1334 $query = "Select * from catalogueentry
1335 where entrytype = 's'
1336 and (catalogueentry like '$subject[$i] %'
1337 or catalogueentry like '% $subject[$i] %'
1338 or catalogueentry like '% $subject[$i]')";
1339 my $sth2 = $dbh->prepare($query);
1342 while (my $data = $sth2->fetchrow_hashref) {
1343 $error .= "<br>$data->{'catalogueentry'}";
1351 my $query = "Delete from bibliosubject where biblionumber = $bibnum";
1352 my $sth = $dbh->prepare($query);
1355 for (my $i = 0; $i < $count; $i++) {
1356 $sth = $dbh->prepare("Insert into bibliosubject
1357 values ('$subject[$i]', $bibnum)");
1369 my ($dbh,$biblioitem) = @_;
1370 # my $dbh = C4Connect;
1373 $biblioitem->{'itemtype'} = $dbh->quote($biblioitem->{'itemtype'});
1374 $biblioitem->{'url'} = $dbh->quote($biblioitem->{'url'});
1375 $biblioitem->{'isbn'} = $dbh->quote($biblioitem->{'isbn'});
1376 $biblioitem->{'publishercode'} = $dbh->quote($biblioitem->{'publishercode'});
1377 $biblioitem->{'publicationyear'} = $dbh->quote($biblioitem->{'publicationyear'});
1378 $biblioitem->{'classification'} = $dbh->quote($biblioitem->{'classification'});
1379 $biblioitem->{'dewey'} = $dbh->quote($biblioitem->{'dewey'});
1380 $biblioitem->{'subclass'} = $dbh->quote($biblioitem->{'subclass'});
1381 $biblioitem->{'illus'} = $dbh->quote($biblioitem->{'illus'});
1382 $biblioitem->{'pages'} = $dbh->quote($biblioitem->{'pages'});
1383 $biblioitem->{'volumeddesc'} = $dbh->quote($biblioitem->{'volumeddesc'});
1384 $biblioitem->{'notes'} = $dbh->quote($biblioitem->{'notes'});
1385 $biblioitem->{'size'} = $dbh->quote($biblioitem->{'size'});
1386 $biblioitem->{'place'} = $dbh->quote($biblioitem->{'place'});
1388 $query = "Update biblioitems set
1389 itemtype = $biblioitem->{'itemtype'},
1390 url = $biblioitem->{'url'},
1391 isbn = $biblioitem->{'isbn'},
1392 publishercode = $biblioitem->{'publishercode'},
1393 publicationyear = $biblioitem->{'publicationyear'},
1394 classification = $biblioitem->{'classification'},
1395 dewey = $biblioitem->{'dewey'},
1396 subclass = $biblioitem->{'subclass'},
1397 illus = $biblioitem->{'illus'},
1398 pages = $biblioitem->{'pages'},
1399 volumeddesc = $biblioitem->{'volumeddesc'},
1400 notes = $biblioitem->{'notes'},
1401 size = $biblioitem->{'size'},
1402 place = $biblioitem->{'place'}
1403 where biblioitemnumber = $biblioitem->{'biblioitemnumber'}";
1411 my ($dbh,$bibitemnum,$note)=@_;
1412 # my $dbh=C4Connect;
1413 my $query="update biblioitems set notes='$note' where
1414 biblioitemnumber='$bibitemnum'";
1415 my $sth=$dbh->prepare($query);
1421 sub OLDnewbiblioitem {
1422 my ($dbh,$biblioitem) = @_;
1423 # my $dbh = C4Connect;
1424 my $query = "Select max(biblioitemnumber) from biblioitems";
1425 my $sth = $dbh->prepare($query);
1430 $data = $sth->fetchrow_arrayref;
1431 $bibitemnum = $$data[0] + 1;
1435 $sth = $dbh->prepare("insert into biblioitems set
1436 biblioitemnumber = ?, biblionumber = ?,
1437 volume = ?, number = ?,
1438 classification = ?, itemtype = ?,
1440 issn = ?, dewey = ?,
1441 subclass = ?, publicationyear = ?,
1442 publishercode = ?, volumedate = ?,
1443 volumeddesc = ?, illus = ?,
1444 pages = ?, notes = ?,
1446 marc = ?, place = ?");
1447 $sth->execute($bibitemnum, $biblioitem->{'biblionumber'},
1448 $biblioitem->{'volume'}, $biblioitem->{'number'},
1449 $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
1450 $biblioitem->{'url'}, $biblioitem->{'isbn'},
1451 $biblioitem->{'issn'}, $biblioitem->{'dewey'},
1452 $biblioitem->{'subclass'}, $biblioitem->{'publicationyear'},
1453 $biblioitem->{'publishercode'}, $biblioitem->{'volumedate'},
1454 $biblioitem->{'volumeddesc'}, $biblioitem->{'illus'},
1455 $biblioitem->{'pages'}, $biblioitem->{'notes'},
1456 $biblioitem->{'size'}, $biblioitem->{'lccn'},
1457 $biblioitem->{'marc'}, $biblioitem->{'place'});
1460 return($bibitemnum);
1464 my ($dbh,$bibnum)=@_;
1465 # my $dbh=C4Connect;
1466 my $query="insert into bibliosubject (biblionumber) values
1468 my $sth=$dbh->prepare($query);
1475 sub OLDnewsubtitle {
1476 my ($dbh,$bibnum, $subtitle) = @_;
1477 # my $dbh = C4Connect;
1478 $subtitle = $dbh->quote($subtitle);
1479 my $query = "insert into bibliosubtitle set
1480 biblionumber = $bibnum,
1481 subtitle = $subtitle";
1482 my $sth = $dbh->prepare($query);
1492 my ($dbh,$item, $barcode) = @_;
1493 # my $dbh = C4Connect;
1494 my $query = "Select max(itemnumber) from items";
1495 my $sth = $dbh->prepare($query);
1501 $data = $sth->fetchrow_hashref;
1502 $itemnumber = $data->{'max(itemnumber)'} + 1;
1505 $sth=$dbh->prepare("Insert into items set
1506 itemnumber = ?, biblionumber = ?,
1507 biblioitemnumber = ?, barcode = ?,
1508 booksellerid = ?, dateaccessioned = NOW(),
1509 homebranch = ?, holdingbranch = ?,
1510 price = ?, replacementprice = ?,
1511 replacementpricedate = NOW(), itemnotes = ?,
1514 $sth->execute($itemnumber, $item->{'biblionumber'},
1515 $item->{'biblioitemnumber'},$barcode,
1516 $item->{'booksellerid'},
1517 $item->{'homebranch'},$item->{'homebranch'},
1518 $item->{'price'},$item->{'replacementprice'},
1519 $item->{'itemnotes'},$item->{'loan'});
1522 if (defined $sth->errstr) {
1523 $error .= $sth->errstr;
1528 return($itemnumber,$error);
1532 my ($dbh,$item) = @_;
1533 # my ($dbh,$loan,$itemnum,$bibitemnum,$barcode,$notes,$homebranch,$lost,$wthdrawn,$replacement)=@_;
1534 # my $dbh=C4Connect;
1535 $item->{'itemnum'}=$item->{'itemnumber'} unless $item->{'itemnum'};
1536 my $query="update items set barcode='$item->{'barcode'}',itemnotes='$item->{'notes'}'
1537 where itemnumber=$item->{'itemnum'}";
1538 if ($item->{'barcode'} eq ''){
1539 $query="update items set notforloan=$item->{'loan'} where itemnumber=$item->{'itemnum'}";
1541 if ($item->{'lost'} ne ''){
1542 $query="update items set biblioitemnumber=$item->{'bibitemnum'},
1543 barcode='$item->{'barcode'}',
1544 itemnotes='$item->{'notes'}',
1545 homebranch='$item->{'homebranch'}',
1546 itemlost='$item->{'lost'}',
1547 wthdrawn='$item->{'wthdrawn'}'
1548 where itemnumber=$item->{'itemnum'}";
1550 if ($item->{'replacement'} ne ''){
1551 $query=~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1553 my $sth=$dbh->prepare($query);
1560 my ($dbh,$itemnum)=@_;
1561 # my $dbh=C4Connect;
1562 my $query="select * from items where itemnumber=$itemnum";
1563 my $sth=$dbh->prepare($query);
1565 my @data=$sth->fetchrow_array;
1567 $query="Insert into deleteditems values (";
1568 foreach my $temp (@data){
1569 $query .= "'$temp',";
1573 $sth=$dbh->prepare($query);
1576 $query = "Delete from items where itemnumber=$itemnum";
1577 $sth=$dbh->prepare($query);
1583 sub OLDdeletebiblioitem {
1584 my ($dbh,$biblioitemnumber) = @_;
1585 # my $dbh = C4Connect;
1586 my $query = "Select * from biblioitems
1587 where biblioitemnumber = $biblioitemnumber";
1588 my $sth = $dbh->prepare($query);
1593 if (@results = $sth->fetchrow_array) {
1594 $query = "Insert into deletedbiblioitems values (";
1595 foreach my $value (@results) {
1596 $value = $dbh->quote($value);
1597 $query .= "$value,";
1600 $query =~ s/\,$/\)/;
1603 $query = "Delete from biblioitems
1604 where biblioitemnumber = $biblioitemnumber";
1608 # Now delete all the items attached to the biblioitem
1609 $query = "Select * from items where biblioitemnumber = $biblioitemnumber";
1610 $sth = $dbh->prepare($query);
1612 while (@results = $sth->fetchrow_array) {
1613 $query = "Insert into deleteditems values (";
1614 foreach my $value (@results) {
1615 $value = $dbh->quote($value);
1616 $query .= "$value,";
1618 $query =~ s/\,$/\)/;
1622 $query = "Delete from items where biblioitemnumber = $biblioitemnumber";
1625 } # sub deletebiblioitem
1628 my ($dbh,$biblio)=@_;
1629 # my $dbh=C4Connect;
1630 my $query="select * from biblio where biblionumber=$biblio";
1631 my $sth=$dbh->prepare($query);
1633 if (my @data=$sth->fetchrow_array){
1635 $query="Insert into deletedbiblio values (";
1636 foreach my $temp (@data){
1637 $temp=~ s/\'/\\\'/g;
1638 $query .= "'$temp',";
1642 $sth=$dbh->prepare($query);
1645 $query = "Delete from biblio where biblionumber=$biblio";
1646 $sth=$dbh->prepare($query);
1662 my $dbh = C4::Context->dbh;
1663 my $query="Select count(*) from items where biblionumber=$biblio";
1665 my $sth=$dbh->prepare($query);
1667 my $data=$sth->fetchrow_hashref;
1669 return($data->{'count(*)'});
1674 ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
1676 Looks up the order with the given biblionumber and biblioitemnumber.
1678 Returns a two-element array. C<$ordernumber> is the order number.
1679 C<$order> is a reference-to-hash describing the order; its keys are
1680 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
1681 tables of the Koha database.
1685 # FIXME - This is effectively identical to &C4::Catalogue::getorder.
1686 # Pick one and stick with it.
1689 my $dbh = C4::Context->dbh;
1690 my $query="Select ordernumber
1692 where biblionumber=? and biblioitemnumber=?";
1693 my $sth=$dbh->prepare($query);
1694 $sth->execute($bib,$bi);
1695 # FIXME - Use fetchrow_array(), since we're only interested in the one
1697 my $ordnum=$sth->fetchrow_hashref;
1699 my $order=getsingleorder($ordnum->{'ordernumber'});
1701 return ($order,$ordnum->{'ordernumber'});
1704 =item getsingleorder
1706 $order = &getsingleorder($ordernumber);
1708 Looks up an order by order number.
1710 Returns a reference-to-hash describing the order. The keys of
1711 C<$order> are fields from the biblio, biblioitems, aqorders, and
1712 aqorderbreakdown tables of the Koha database.
1716 # FIXME - This is effectively identical to
1717 # &C4::Catalogue::getsingleorder.
1718 # Pick one and stick with it.
1719 sub getsingleorder {
1721 my $dbh = C4::Context->dbh;
1722 my $query="Select * from biblio,biblioitems,aqorders,aqorderbreakdown
1723 where aqorders.ordernumber=?
1724 and biblio.biblionumber=aqorders.biblionumber and
1725 biblioitems.biblioitemnumber=aqorders.biblioitemnumber and
1726 aqorders.ordernumber=aqorderbreakdown.ordernumber";
1727 my $sth=$dbh->prepare($query);
1728 $sth->execute($ordnum);
1729 my $data=$sth->fetchrow_hashref;
1736 my $dbh = C4::Context->dbh;
1737 my $bibnum=OLDnewbiblio($dbh,$biblio);
1744 $biblionumber = &modbiblio($biblio);
1746 Update a biblio record.
1748 C<$biblio> is a reference-to-hash whose keys are the fields in the
1749 biblio table in the Koha database. All fields must be present, not
1750 just the ones you wish to change.
1752 C<&modbiblio> updates the record defined by
1753 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1755 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1762 my $dbh = C4::Context->dbh;
1763 my $biblionumber=OLDmodbiblio($dbh,$biblio);
1764 return($biblionumber);
1770 &modsubtitle($biblionumber, $subtitle);
1772 Sets the subtitle of a book.
1774 C<$biblionumber> is the biblionumber of the book to modify.
1776 C<$subtitle> is the new subtitle.
1781 my ($bibnum, $subtitle) = @_;
1782 my $dbh = C4::Context->dbh;
1783 &OLDmodsubtitle($dbh,$bibnum,$subtitle);
1788 &modaddauthor($biblionumber, $author);
1790 Replaces all additional authors for the book with biblio number
1791 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1792 C<&modaddauthor> deletes all additional authors.
1797 my ($bibnum, $author) = @_;
1798 my $dbh = C4::Context->dbh;
1799 &OLDmodaddauthor($dbh,$bibnum,$author);
1800 } # sub modaddauthor
1804 $error = &modsubject($biblionumber, $force, @subjects);
1806 $force - a subject to force
1808 $error - Error message, or undef if successful.
1813 my ($bibnum, $force, @subject) = @_;
1814 my $dbh = C4::Context->dbh;
1815 my $error= &OLDmodsubject($dbh,$bibnum,$force, @subject);
1820 my ($biblioitem) = @_;
1821 my $dbh = C4::Context->dbh;
1822 &OLDmodbibitem($dbh,$biblioitem);
1823 my $MARCbibitem = MARCkoha2marcBiblio($dbh,$biblioitem);
1824 &MARCmodbiblio($dbh,$biblioitem->{biblionumber},$MARCbibitem,0);
1828 my ($bibitemnum,$note)=@_;
1829 my $dbh = C4::Context->dbh;
1830 &OLDmodnote($dbh,$bibitemnum,$note);
1834 my ($biblioitem) = @_;
1835 my $dbh = C4::Context->dbh;
1836 my $bibitemnum = &OLDnewbiblioitem($dbh,$biblioitem);
1837 # print STDERR "bibitemnum : $bibitemnum\n";
1838 my $MARCbiblio= MARCkoha2marcBiblio($dbh,$biblioitem->{biblionumber},$bibitemnum);
1839 # print STDERR $MARCbiblio->as_formatted();
1840 &MARCaddbiblio($dbh,$MARCbiblio,$biblioitem->{biblionumber});
1841 return($bibitemnum);
1846 my $dbh = C4::Context->dbh;
1847 &OLDnewsubject($dbh,$bibnum);
1851 my ($bibnum, $subtitle) = @_;
1852 my $dbh = C4::Context->dbh;
1853 &OLDnewsubtitle($dbh,$bibnum,$subtitle);
1857 my ($item, @barcodes) = @_;
1858 my $dbh = C4::Context->dbh;
1862 foreach my $barcode (@barcodes) {
1863 ($itemnumber,$error)=&OLDnewitems($dbh,$item,uc($barcode));
1865 my $MARCitem = &MARCkoha2marcItem($dbh,$item->{biblionumber},$itemnumber);
1866 &MARCadditem($dbh,$MARCitem,$item->{biblionumber});
1873 my $dbh = C4::Context->dbh;
1874 &OLDmoditem($dbh,$item);
1875 my $MARCitem = &MARCkoha2marcItem($dbh,$item->{'biblionumber'},$item->{'itemnum'});
1876 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$item->{biblionumber});
1877 &MARCmoditem($dbh,$MARCitem,$bibid,$item->{itemnum},0);
1881 my ($count,@barcodes)=@_;
1882 my $dbh = C4::Context->dbh;
1884 for (my $i=0;$i<$count;$i++){
1885 $barcodes[$i]=uc $barcodes[$i];
1886 my $query="Select * from items where barcode='$barcodes[$i]'";
1887 my $sth=$dbh->prepare($query);
1889 if (my $data=$sth->fetchrow_hashref){
1890 $error.=" Duplicate Barcode: $barcodes[$i]";
1898 my ($bibitemnum)=@_;
1899 my $dbh = C4::Context->dbh;
1900 my $query="Select count(*) from items where biblioitemnumber='$bibitemnum'";
1901 my $sth=$dbh->prepare($query);
1903 my $data=$sth->fetchrow_hashref;
1905 return($data->{'count(*)'});
1910 my $dbh = C4::Context->dbh;
1911 &OLDdelitem($dbh,$itemnum);
1914 sub deletebiblioitem {
1915 my ($biblioitemnumber) = @_;
1916 my $dbh = C4::Context->dbh;
1917 &OLDdeletebiblioitem($dbh,$biblioitemnumber);
1918 } # sub deletebiblioitem
1923 my $dbh = C4::Context->dbh;
1924 &OLDdelbiblio($dbh,$biblio);
1928 my $dbh = C4::Context->dbh;
1929 my $query = "select * from itemtypes";
1930 my $sth = $dbh->prepare($query);
1931 # || die "Cannot prepare $query" . $dbh->errstr;
1936 # || die "Cannot execute $query\n" . $sth->errstr;
1937 while (my $data = $sth->fetchrow_hashref) {
1938 $results[$count] = $data;
1943 return($count, @results);
1944 } # sub getitemtypes
1947 my ($biblionumber) = @_;
1948 my $dbh = C4::Context->dbh;
1949 my $query = "Select * from biblio where biblionumber = $biblionumber";
1950 my $sth = $dbh->prepare($query);
1951 # || die "Cannot prepare $query\n" . $dbh->errstr;
1956 # || die "Cannot execute $query\n" . $sth->errstr;
1957 while (my $data = $sth->fetchrow_hashref) {
1958 $results[$count] = $data;
1963 return($count, @results);
1967 my ($biblioitemnum) = @_;
1968 my $dbh = C4::Context->dbh;
1969 my $query = "Select * from biblioitems where
1970 biblioitemnumber = $biblioitemnum";
1971 my $sth = $dbh->prepare($query);
1977 while (my $data = $sth->fetchrow_hashref) {
1978 $results[$count] = $data;
1983 return($count, @results);
1984 } # sub getbiblioitem
1986 sub getbiblioitembybiblionumber {
1987 my ($biblionumber) = @_;
1988 my $dbh = C4::Context->dbh;
1989 my $query = "Select * from biblioitems where biblionumber =
1991 my $sth = $dbh->prepare($query);
1997 while (my $data = $sth->fetchrow_hashref) {
1998 $results[$count] = $data;
2003 return($count, @results);
2006 sub getitemsbybiblioitem {
2007 my ($biblioitemnum) = @_;
2008 my $dbh = C4::Context->dbh;
2009 my $query = "Select * from items, biblio where
2010 biblio.biblionumber = items.biblionumber and biblioitemnumber
2012 my $sth = $dbh->prepare($query);
2013 # || die "Cannot prepare $query\n" . $dbh->errstr;
2018 # || die "Cannot execute $query\n" . $sth->errstr;
2019 while (my $data = $sth->fetchrow_hashref) {
2020 $results[$count] = $data;
2025 return($count, @results);
2026 } # sub getitemsbybiblioitem
2030 # Subroutine to log changes to databases
2031 # Eventually, this subroutine will be used to create a log of all changes made,
2032 # with the possibility of "undo"ing some changes
2034 if ($database eq 'kohadb') {
2040 # print STDERR "KOHA: $type $section $item $original $new\n";
2041 } elsif ($database eq 'marc') {
2043 my $Record_ID=shift;
2046 my $subfield_ID=shift;
2049 # print STDERR "MARC: $type $Record_ID $tag $mark $subfield_ID $original $new\n";
2053 #------------------------------------------------
2056 #---------------------------------------
2057 # Find a biblio entry, or create a new one if it doesn't exist.
2058 # If a "subtitle" entry is in hash, add it to subtitle table
2059 sub getoraddbiblio {
2063 # FIXME - Unused argument
2064 $biblio, # hash ref to fields
2075 $dbh = C4::Context->dbh;
2077 print "<PRE>Looking for biblio </PRE>\n" if $debug;
2078 $sth=$dbh->prepare("select biblionumber
2080 where title=? and author=?
2081 and copyrightdate=? and seriestitle=?");
2083 $biblio->{title}, $biblio->{author},
2084 $biblio->{copyright}, $biblio->{seriestitle} );
2086 ($biblionumber) = $sth->fetchrow;
2087 print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
2089 # Doesn't exist. Add new one.
2090 print "<PRE>Adding biblio</PRE>\n" if $debug;
2091 ($biblionumber,$error)=&newbiblio($biblio);
2092 if ( $biblionumber ) {
2093 print "<PRE>Added with biblio number=$biblionumber</PRE>\n" if $debug;
2094 if ( $biblio->{subtitle} ) {
2095 &newsubtitle($biblionumber,$biblio->{subtitle} );
2098 print "<PRE>Couldn't add biblio: $error</PRE>\n" if $debug;
2102 return $biblionumber,$error;
2104 } # sub getoraddbiblio
2107 # converts ISO 5426 coded string to ISO 8859-1
2108 # sloppy code : should be improved in next issue
2111 if (C4::Context->preference("marcflavour") eq "UNIMARC") {
2228 # this handles non-sorting blocks (if implementation requires this)
2229 $string = nsb_clean($_) ;
2234 my $NSB = '\x88' ; # NSB : begin Non Sorting Block
2235 my $NSE = '\x89' ; # NSE : Non Sorting Block end
2236 # handles non sorting blocks
2240 s/[ ]{0,1}$NSE/) /gm ;
2245 END { } # module clean-up code here (global destructor)
2251 Koha Developement team <info@koha.org>
2253 Paul POULAIN paul.poulain@free.fr