4 # Revision 1.23 2002/10/16 12:43:08 arensb
5 # Added some FIXME comments.
7 # Revision 1.22 2002/10/15 13:39:17 tipaul
8 # removing Acquisition.pm
9 # deleting unused code in biblio.pm, rewriting POD and answering most FIXME comments
11 # Revision 1.21 2002/10/13 11:34:14 arensb
12 # Replaced expressions of the form "$x = $x <op> $y" with "$x <op>= $y".
13 # Thus, $x = $x+2 becomes $x += 2, and so forth.
15 # Revision 1.20 2002/10/13 08:28:32 arensb
16 # Deleted unused variables.
17 # Removed trailing whitespace.
19 # Revision 1.19 2002/10/13 05:56:10 arensb
20 # Added some FIXME comments.
22 # Revision 1.18 2002/10/11 12:34:53 arensb
23 # Replaced &requireDBI with C4::Context->dbh
25 # Revision 1.17 2002/10/10 14:48:25 tipaul
28 # Revision 1.16 2002/10/07 14:04:26 tipaul
29 # road to 1.3.1 : viewing MARC biblio
31 # Revision 1.15 2002/10/05 09:49:25 arensb
32 # Merged with arensb-context branch: use C4::Context->dbh instead of
33 # &C4Connect, and generally prefer C4::Context over C4::Database.
35 # Revision 1.14 2002/10/03 11:28:18 tipaul
36 # Extending Context.pm to add stopword management and using it in MARC-API.
37 # First benchmarks show a medium speed improvement, which is nice as this part is heavily called.
39 # Revision 1.13 2002/10/02 16:26:44 tipaul
42 # Revision 1.12.2.4 2002/10/05 07:09:31 arensb
43 # Merged in changes from main branch.
45 # Revision 1.12.2.3 2002/10/05 06:12:10 arensb
46 # Added a whole mess of FIXME comments.
48 # Revision 1.12.2.2 2002/10/05 04:03:14 arensb
49 # Added some missing semicolons.
51 # Revision 1.12.2.1 2002/10/04 02:24:01 arensb
52 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
55 # Revision 1.12.2.3 2002/10/05 06:12:10 arensb
56 # Added a whole mess of FIXME comments.
58 # Revision 1.12.2.2 2002/10/05 04:03:14 arensb
59 # Added some missing semicolons.
61 # Revision 1.12.2.1 2002/10/04 02:24:01 arensb
62 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
65 # Revision 1.12 2002/10/01 11:48:51 arensb
66 # Added some FIXME comments, mostly marking duplicate functions.
68 # Revision 1.11 2002/09/24 13:49:26 tipaul
69 # long WAS the road to 1.3.0...
70 # coming VERY SOON NOW...
71 # modifying installer and buildrelease to update the DB
73 # Revision 1.10 2002/09/22 16:50:08 arensb
74 # Added some FIXME comments.
76 # Revision 1.9 2002/09/20 12:57:46 tipaul
77 # long is the road to 1.4.0
78 # * MARCadditem and MARCmoditem now wroks
79 # * various bugfixes in MARC management
80 # !!! 1.3.0 should be released very soon now. Be careful !!!
82 # Revision 1.8 2002/09/10 13:53:52 tipaul
83 # MARC API continued...
85 # * 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)
87 # Note : it should not be hard for marcimport and marcexport to re-link fields from internal tag/subfield to "legal" tag/subfield.
89 # Revision 1.7 2002/08/14 18:12:51 tonnesen
90 # Added copyright statement to all .pl and .pm files
92 # Revision 1.6 2002/07/25 13:40:31 tipaul
93 # pod documenting the API.
95 # Revision 1.5 2002/07/24 16:11:37 tipaul
97 # Database.pm and Output.pm are almost not modified (var test...)
99 # Biblio.pm is almost completly rewritten.
101 # WHAT DOES IT ??? ==> END of Hitchcock suspens
103 # 1st, it does... nothing...
104 # 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 ...
106 # All old-API functions have been cloned. for example, the "newbiblio" sub, now has become :
107 # * a "newbiblio" sub, with the same parameters. It just call a sub named OLDnewbiblio
108 # * 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.
109 # * 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.
110 # 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 "ALLxxx" : 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 ;-)
112 # 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.
113 # Note we have decided with steve that a old-biblio <=> a MARC-Biblio.
117 # move from 1.2 to 1.4 version :
118 # 1.2 and previous version uses a specific API to manage biblios. This API uses old-DB style parameters.
119 # In the 1.4 version, we want to do 2 differents things :
120 # - keep populating the old-DB, that has a LOT less datas than MARC
121 # - populate the MARC-DB
122 # To populate the DBs we have 2 differents sources :
123 # - the standard acquisition system (through book sellers), that does'nt use MARC data
124 # - the MARC acquisition system, that uses MARC data.
126 # thus, we have 2 differents cases :
127 # - 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
128 # - 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.
129 # we MUST have an API for true MARC data, that populate MARC-DB then old-DB
131 # That's why we need 4 subs :
132 # all subs beginning by MARC manage only MARC tables. They manage MARC-DB with MARC::Record parameters
133 # all subs beginning by OLD manage only OLD-DB tables. They manage old-DB with old-DB parameters
134 # all subs beginning by ALL 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
135 # all subs beginning by seomething else are the old-style API. They use old-DB as parameter, then call internally the OLD and MARC subs.
137 # only ALL and old-style API should be used in koha. MARC and OLD is used internally only
139 # Thus, we assume a nice translation to future versions : if we want in a 1.6 release completly forget old-DB, we can do it easily.
140 # in 1.4 version, the translations will be nicer, as we have NOTHING to do in code. Everything has to be done in Biblio.pm ;-)
144 # Copyright 2000-2002 Katipo Communications
146 # This file is part of Koha.
148 # Koha is free software; you can redistribute it and/or modify it under the
149 # terms of the GNU General Public License as published by the Free Software
150 # Foundation; either version 2 of the License, or (at your option) any later
153 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
154 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
155 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
157 # You should have received a copy of the GNU General Public License along with
158 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
159 # Suite 330, Boston, MA 02111-1307 USA
167 use vars qw($VERSION @ISA @EXPORT);
169 # set the version for version checking
174 # don't forget MARCxxx subs are here only for testing purposes. Should not be used
175 # as the old-style API and the ALL one are the only public functions.
178 &updateBiblio &updateBiblioItem &updateItem
179 &itemcount &newbiblio &newbiblioitem
180 &modnote &newsubject &newsubtitle
181 &modbiblio &checkitems
182 &newitems &modbibitem
183 &modsubtitle &modsubject &modaddauthor &moditem &countitems
184 &delitem &deletebiblioitem &delbiblio
185 &getitemtypes &getbiblio
186 &getbiblioitembybiblionumber
187 &getbiblioitem &getitemsbybiblioitem &isbnsearch
189 &newcompletebiblioitem
191 &MARCfind_oldbiblionumber_from_MARCbibid
192 &MARCfind_MARCbibid_from_oldbiblionumber
194 &ALLnewbiblio &ALLnewitem
197 &MARCaddbiblio &MARCadditem
198 &MARCmodsubfield &MARCaddsubfield
199 &MARCmodbiblio &MARCmoditem
201 &MARCkoha2marcBiblio &MARCmarc2koha &MARCkoha2marcItem
202 &MARCgetbiblio &MARCgetitem
203 &MARCaddword &MARCdelword
208 # MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC
211 # all the following subs takes a MARC::Record as parameter and manage
212 # the MARC-DB. They are called by the 1.0/1.2 xxx subs, and by the
213 # ALLxxx subs (xxx deals with old-DB parameters, the ALLxxx deals with MARC-DB parameter)
217 C4::Biblio : acquisition, catalog management functions
222 all subs requires/use $dbh as 1st parameter.
223 NOTE : all those subs are private and must be used only inside Biblio.pm (called by a old API sub, or the ALLsub)
227 I<@tagslib = &MARCgettagslib($dbh,1|0);>
229 last param is 1 for liblibrarian and 0 for libopac
230 returns a hash with tag/subfield meaning
232 I<($tagfield,$tagsubfield) = &MARCfindmarc_from_kohafield($dbh,$kohafield);>
234 finds MARC tag and subfield for a given kohafield
235 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
237 I<$biblionumber = &MARCfind_oldbiblionumber_from_MARCbibid($dbh,$MARCbibi);>
239 finds a old-db biblio number for a given MARCbibid number
241 I<$bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$oldbiblionumber);>
243 finds a MARC bibid from a old-db biblionumber
245 I<&MARCaddbiblio($dbh,$MARC::Record,$biblionumber);>
247 creates a biblio (in the MARC tables only). $biblionumber is the old-db biblionumber of the biblio
249 I<&MARCaddsubfield($dbh,$bibid,$tagid,$indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);>
251 adds a subfield in a biblio (in the MARC tables only).
253 I<$MARCRecord = &MARCgetbiblio($dbh,$bibid);>
255 Returns a MARC::Record for the biblio $bibid.
257 I<&MARCmodbiblio($dbh,$bibid,$delete,$record);>
259 MARCmodbiblio changes a biblio for a biblio,MARC::Record passed as parameter
260 if $delete == 1, every field/subfield not found is deleted in the biblio
261 otherwise, only data passed to MARCmodbiblio is managed.
262 thus, you can change only a small part of a biblio (like an item, or a subtitle, or a additionalauthor...)
264 I<($subfieldid,$subfieldvalue) = &MARCmodsubfield($dbh,$subfieldid,$subfieldvalue);>
266 MARCmodsubfield changes the value of a given subfield
268 I<$subfieldid = &MARCfindsubfield($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue);>
270 MARCfindsubfield returns a subfield number given a bibid/tag/subfieldvalue values.
271 Returns -1 if more than 1 answer
273 I<$subfieldid = &MARCfindsubfieldid($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);>
275 MARCfindsubfieldid find a subfieldid for a bibid/tag/tagorder/subfield/subfieldorder
277 I<&MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);>
279 MARCdelsubfield delete a subfield for a bibid/tag/tagorder/subfield/subfieldorder
281 I<&MARCdelbiblio($dbh,$bibid);>
283 MARCdelbiblio delete biblio $bibid
285 I<$MARCRecord = &MARCkoha2marcBiblio($dbh,$biblionumber,biblioitemnumber);>
287 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem
289 I<$MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);>
291 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB item
293 I<$MARCRecord = &MARCkoha2marcSubtitle($dbh,$biblionumber,$subtitle);>
295 MARCkoha2marcSubtitle is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB subtitle
297 I<&MARCkoha2marcOnefield => used by MARCkoha2marc and should not be useful elsewhere>
299 I<$olddb = &MARCmarc2koha($dbh,$MARCRecord);>
301 builds a hash with old-db datas from a MARC::Record
303 I<&MARCmarc2kohaOnefield => used by MARCmarc2koha and should not be useful elsewhere>
305 I<MARCaddword => used to manage MARC_word table and should not be useful elsewhere>
307 I<MARCdelword => used to manage MARC_word table and should not be useful elsewhere>
311 Paul POULAIN paul.poulain@free.fr
316 my ($dbh,$forlibrarian)= @_;
318 if ($forlibrarian eq 1) {
319 $sth=$dbh->prepare("select tagfield,liblibrarian as lib from marc_tag_structure");
321 $sth=$dbh->prepare("select tagfield,libopac as lib from marc_tag_structure");
324 my ($lib,$tag,$res,$tab);
325 while ( ($tag,$lib,$tab) = $sth->fetchrow) {
326 $res->{$tag}->{lib}=$lib;
327 $res->{$tab}->{tab}="";
330 if ($forlibrarian eq 1) {
331 $sth=$dbh->prepare("select tagfield,tagsubfield,liblibrarian as lib,tab from marc_subfield_structure");
333 $sth=$dbh->prepare("select tagfield,tagsubfield,libopac as lib,tab from marc_subfield_structure");
338 while ( ($tag,$subfield,$lib,$tab) = $sth->fetchrow) {
339 $res->{$tag}->{$subfield}->{lib}=$lib;
340 $res->{$tag}->{$subfield}->{tab}=$tab;
345 sub MARCfind_marc_from_kohafield {
346 my ($dbh,$kohafield) = @_;
347 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
348 $sth->execute($kohafield);
349 my ($tagfield,$tagsubfield) = $sth->fetchrow;
350 return ($tagfield,$tagsubfield);
353 sub MARCfind_oldbiblionumber_from_MARCbibid {
354 my ($dbh,$MARCbibid) = @_;
355 my $sth=$dbh->prepare("select biblionumber from marc_biblio where bibid=?");
356 $sth->execute($MARCbibid);
357 my ($biblionumber) = $sth->fetchrow;
358 return $biblionumber;
361 sub MARCfind_MARCbibid_from_oldbiblionumber {
362 my ($dbh,$oldbiblionumber) = @_;
363 my $sth=$dbh->prepare("select bibid from marc_biblio where biblionumber=?");
364 $sth->execute($oldbiblionumber);
365 my ($bibid) = $sth->fetchrow;
370 # pass the MARC::Record to this function, and it will create the records in the marc tables
371 my ($dbh,$record,$biblionumber) = @_;
372 my @fields=$record->fields();
374 # adding main table, and retrieving bibid
375 $dbh->do("lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ");
376 my $sth=$dbh->prepare("insert into marc_biblio (datecreated,biblionumber) values (now(),?)");
377 $sth->execute($biblionumber);
378 $sth=$dbh->prepare("select max(bibid) from marc_biblio");
380 ($bibid)=$sth->fetchrow;
383 # now, add subfields...
384 foreach my $field (@fields) {
385 my @subfields=$field->subfields();
387 foreach my $subfieldcount (0..$#subfields) {
388 &MARCaddsubfield($dbh,$bibid,
390 $field->indicator(1).$field->indicator(2),
392 $subfields[$subfieldcount][0],
394 $subfields[$subfieldcount][1]
398 $dbh->do("unlock tables");
403 # pass the MARC::Record to this function, and it will create the records in the marc tables
404 my ($dbh,$record,$biblionumber) = @_;
405 # search for MARC biblionumber
406 $dbh->do("lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ");
407 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
408 my @fields=$record->fields();
409 my $sth = $dbh->prepare("select max(tagorder) from marc_subfield_table where bibid=?");
410 $sth->execute($bibid);
411 my ($fieldcount) = $sth->fetchrow;
412 # now, add subfields...
413 foreach my $field (@fields) {
414 my @subfields=$field->subfields();
416 foreach my $subfieldcount (0..$#subfields) {
417 &MARCaddsubfield($dbh,$bibid,
419 $field->indicator(1).$field->indicator(2),
421 $subfields[$subfieldcount][0],
423 $subfields[$subfieldcount][1]
427 $dbh->do("unlock tables");
431 sub MARCaddsubfield {
432 # Add a new subfield to a tag into the DB.
433 my ($dbh,$bibid,$tagid,$indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue) = @_;
434 # if not value, end of job, we do nothing
435 if (not($subfieldvalue)) {
438 if (not($subfieldcode)) {
441 if (length($subfieldvalue)>255) {
442 # $dbh->do("lock tables marc_blob_subfield WRITE, marc_subfield_table WRITE");
443 my $sth=$dbh->prepare("insert into marc_blob_subfield (subfieldvalue) values (?)");
444 $sth->execute($subfieldvalue);
445 $sth=$dbh->prepare("select max(blobidlink)from marc_blob_subfield");
447 my ($res)=$sth->fetchrow;
448 $sth=$dbh->prepare("insert into marc_subfield_table (bibid,tag,tagorder,subfieldcode,subfieldorder,valuebloblink) values (?,?,?,?,?,?)");
450 $sth->execute($bibid,'0'.$tagid,$tagorder,$subfieldcode,$subfieldorder,$res);
452 $sth->execute($bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$res);
455 print STDERR "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
457 # $dbh->do("unlock tables");
459 my $sth=$dbh->prepare("insert into marc_subfield_table (bibid,tag,tagorder,subfieldcode,subfieldorder,subfieldvalue) values (?,?,?,?,?,?)");
460 $sth->execute($bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
462 print STDERR "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
465 &MARCaddword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
470 # Returns MARC::Record of the biblio passed in parameter.
472 my $record = MARC::Record->new();
473 #---- TODO : the leader is missing
474 my $sth=$dbh->prepare("select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
475 from marc_subfield_table
476 where bibid=? order by tagorder,subfieldorder
478 my $sth2=$dbh->prepare("select subfieldvalue from marc_blob_subfield where blobidlink=?");
479 $sth->execute($bibid);
483 while (my $row=$sth->fetchrow_hashref) {
484 if ($row->{'valuebloblink'}) { #---- search blob if there is one
485 $sth2->execute($row->{'valuebloblink'});
486 my $row2=$sth2->fetchrow_hashref;
488 $row->{'subfieldvalue'}=$row2->{'subfieldvalue'};
490 if ($row->{tagorder} ne $prevtagorder) {
491 my $field = MARC::Field->new( $prevtag, "", "", %subfieldlist);
492 $record->add_fields($field);
493 $prevtagorder=$row->{tagorder};
494 $prevtag = $row->{tag};
496 %subfieldlist->{$row->{'subfieldcode'}} = $row->{'subfieldvalue'};
498 %subfieldlist->{$row->{'subfieldcode'}} = $row->{'subfieldvalue'};
499 $prevtag= $row->{tag};
502 # the last has not been included inside the loop... do it now !
503 my $field = MARC::Field->new( $prevtag, "", "", %subfieldlist);
504 $record->add_fields($field);
508 # Returns MARC::Record of the biblio passed in parameter.
509 my ($dbh,$bibid,$itemnumber)=@_;
510 my $record = MARC::Record->new();
511 # search MARC tagorder
512 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=?");
513 $sth2->execute($bibid,$itemnumber);
514 my ($tagorder) = $sth2->fetchrow_array();
515 #---- TODO : the leader is missing
516 my $sth=$dbh->prepare("select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
517 from marc_subfield_table
518 where bibid=? and tagorder=? order by subfieldorder
520 $sth2=$dbh->prepare("select subfieldvalue from marc_blob_subfield where blobidlink=?");
521 $sth->execute($bibid,$tagorder);
522 while (my $row=$sth->fetchrow_hashref) {
523 if ($row->{'valuebloblink'}) { #---- search blob if there is one
524 $sth2->execute($row->{'valuebloblink'});
525 my $row2=$sth2->fetchrow_hashref;
527 $row->{'subfieldvalue'}=$row2->{'subfieldvalue'};
529 if ($record->field($row->{'tag'})) {
531 #--- this test must stay as this, because of strange behaviour of mySQL/Perl DBI with char var containing a number...
532 #--- sometimes, eliminates 0 at beginning, sometimes no ;-\\\
533 if (length($row->{'tag'}) <3) {
534 $row->{'tag'} = "0".$row->{'tag'};
536 $field =$record->field($row->{'tag'});
538 my $x = $field->add_subfields($row->{'subfieldcode'},$row->{'subfieldvalue'});
539 $record->delete_field($field);
540 $record->add_fields($field);
543 if (length($row->{'tag'}) < 3) {
544 $row->{'tag'} = "0".$row->{'tag'};
546 my $temp = MARC::Field->new($row->{'tag'}," "," ", $row->{'subfieldcode'} => $row->{'subfieldvalue'});
547 $record->add_fields($temp);
555 my ($dbh,$record,$bibid,$itemnumber,$delete)=@_;
556 my $oldrecord=&MARCgetbiblio($dbh,$bibid);
557 # if nothing to change, don't waste time...
558 if ($oldrecord eq $record) {
561 # otherwise, skip through each subfield...
562 my @fields = $record->fields();
564 foreach my $field (@fields) {
565 my $oldfield = $oldrecord->field($field->tag());
566 my @subfields=$field->subfields();
569 foreach my $subfield (@subfields) {
571 if ($oldfield eq 0 or (! $oldfield->subfield(@$subfield[0])) ) {
572 # just adding datas...
573 &MARCaddsubfield($dbh,$bibid,$field->tag(),$field->indicator(1).$field->indicator(2),
574 1,@$subfield[0],$subfieldorder,@$subfield[1]);
576 # modify he subfield if it's a different string
577 if ($oldfield->subfield(@$subfield[0]) ne @$subfield[1] ) {
578 my $subfieldid=&MARCfindsubfieldid($dbh,$bibid,$field->tag(),$tagorder,@$subfield[0],$subfieldorder);
579 &MARCmodsubfield($dbh,$subfieldid,@$subfield[1]);
587 my ($dbh,$record,$bibid,$itemnumber,$delete)=@_;
588 my $oldrecord=&MARCgetitem($dbh,$bibid,$itemnumber);
589 # if nothing to change, don't waste time...
590 if ($oldrecord eq $record) {
593 # otherwise, skip through each subfield...
594 my @fields = $record->fields();
595 # search old MARC item
596 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=?");
597 $sth2->execute($bibid,$itemnumber);
598 my ($tagorder) = $sth2->fetchrow_array();
599 foreach my $field (@fields) {
600 my $oldfield = $oldrecord->field($field->tag());
601 my @subfields=$field->subfields();
603 foreach my $subfield (@subfields) {
605 if ($oldfield eq 0 or (! $oldfield->subfield(@$subfield[0])) ) {
606 # just adding datas...
607 &MARCaddsubfield($dbh,$bibid,$field->tag(),$field->indicator(1).$field->indicator(2),
608 $tagorder,@$subfield[0],$subfieldorder,@$subfield[1]);
610 # modify he subfield if it's a different string
611 if ($oldfield->subfield(@$subfield[0]) ne @$subfield[1] ) {
612 my $subfieldid=&MARCfindsubfieldid($dbh,$bibid,$field->tag(),$tagorder,@$subfield[0],$subfieldorder);
613 &MARCmodsubfield($dbh,$subfieldid,@$subfield[1]);
622 sub MARCmodsubfield {
623 # Subroutine changes a subfield value given a subfieldid.
624 my ($dbh, $subfieldid, $subfieldvalue )=@_;
625 $dbh->do("lock tables marc_blob_subfield WRITE,marc_subfield_table WRITE");
626 my $sth1=$dbh->prepare("select valuebloblink from marc_subfield_table where subfieldid=?");
627 $sth1->execute($subfieldid);
628 my ($oldvaluebloblink)=$sth1->fetchrow;
631 # if too long, use a bloblink
632 if (length($subfieldvalue)>255 ) {
633 # if already a bloblink, update it, otherwise, insert a new one.
634 if ($oldvaluebloblink) {
635 $sth=$dbh->prepare("update marc_blob_subfield set subfieldvalue=? where blobidlink=?");
636 $sth->execute($subfieldvalue,$oldvaluebloblink);
638 $sth=$dbh->prepare("insert into marc_blob_subfield (subfieldvalue) values (?)");
639 $sth->execute($subfieldvalue);
640 $sth=$dbh->prepare("select max(blobidlink) from marc_blob_subfield");
642 my ($res)=$sth->fetchrow;
643 $sth=$dbh->prepare("update marc_subfield_table set subfieldvalue=null, valuebloblink=$res where subfieldid=?");
644 $sth->execute($subfieldid);
647 # note this can leave orphan bloblink. Not a big problem, but we should build somewhere a orphan deleting script...
648 $sth=$dbh->prepare("update marc_subfield_table set subfieldvalue=?,valuebloblink=null where subfieldid=?");
649 $sth->execute($subfieldvalue, $subfieldid);
651 $dbh->do("unlock tables");
653 $sth=$dbh->prepare("select bibid,tag,tagorder,subfieldcode,subfieldid,subfieldorder from marc_subfield_table where subfieldid=?");
654 $sth->execute($subfieldid);
655 my ($bibid,$tagid,$tagorder,$subfieldcode,$x,$subfieldorder) = $sth->fetchrow;
657 &MARCdelword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder);
658 &MARCaddword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
659 return($subfieldid, $subfieldvalue);
662 sub MARCfindsubfield {
663 my ($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue) = @_;
667 my $query="select subfieldid from marc_subfield_table where bibid=? and tag=? and subfieldcode=?";
668 if ($subfieldvalue) {
669 $query .= " and subfieldvalue=".$dbh->quote($subfieldvalue);
671 if ($subfieldorder<1) {
674 $query .= " and subfieldorder=$subfieldorder";
676 my $sti=$dbh->prepare($query);
677 $sti->execute($bibid,$tag, $subfieldcode);
678 while (($subfieldid) = $sti->fetchrow) {
680 $lastsubfieldid=$subfieldid;
682 if ($resultcounter>1) {
683 # Error condition. Values given did not resolve into a unique record. Don't know what to edit
684 # should rarely occur (only if we use subfieldvalue with a value that exists twice, which is strange)
687 return $lastsubfieldid;
691 sub MARCfindsubfieldid {
692 my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
693 my $sth=$dbh->prepare("select subfieldid from marc_subfield_table
694 where bibid=? and tag=? and tagorder=?
695 and subfieldcode=? and subfieldorder=?");
696 $sth->execute($bibid,$tag,$tagorder,$subfield,$subfieldorder);
697 my ($res) = $sth->fetchrow;
701 sub MARCdelsubfield {
702 # delete a subfield for $bibid / tag / tagorder / subfield / subfieldorder
703 my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
704 $dbh->do("delete from marc_subfield_table where bibid='$bibid' and
705 tag='$tag' and tagorder='$tagorder'
706 and subfieldcode='$subfield' and subfieldorder='$subfieldorder
711 # delete a biblio for a $bibid
712 my ($dbh,$bibid) = @_;
713 $dbh->do("delete from marc_subfield_table where bibid='$bibid'");
714 $dbh->do("delete from marc_biblio where bibid='$bibid'");
717 sub MARCkoha2marcBiblio {
718 # this function builds partial MARC::Record from the old koha-DB fields
719 my ($dbh,$biblionumber,$biblioitemnumber) = @_;
720 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
721 my $record = MARC::Record->new();
722 #--- if bibid, then retrieve old-style koha data
723 if ($biblionumber>0) {
724 my $sth2=$dbh->prepare("select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp
725 from biblio where biblionumber=?");
726 $sth2->execute($biblionumber);
727 my $row=$sth2->fetchrow_hashref;
729 foreach $code (keys %$row) {
731 &MARCkoha2marcOnefield($sth,$record,"biblio.".$code,$row->{$code});
735 #--- if biblioitem, then retrieve old-style koha data
736 if ($biblioitemnumber>0) {
737 my $sth2=$dbh->prepare(" SELECT biblioitemnumber,biblionumber,volume,number,classification,
738 itemtype,url,isbn,issn,dewey,subclass,publicationyear,publishercode,
739 volumedate,volumeddesc,timestamp,illus,pages,notes,size,place
741 WHERE biblionumber=? and biblioitemnumber=?
743 $sth2->execute($biblionumber,$biblioitemnumber);
744 my $row=$sth2->fetchrow_hashref;
746 foreach $code (keys %$row) {
748 &MARCkoha2marcOnefield($sth,$record,"biblioitems.".$code,$row->{$code});
753 # TODO : retrieve notes, additionalauthors
756 sub MARCkoha2marcItem {
757 # this function builds partial MARC::Record from the old koha-DB fields
758 my ($dbh,$biblionumber,$itemnumber) = @_;
759 # my $dbh=&C4Connect;
760 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
761 my $record = MARC::Record->new();
762 #--- if item, then retrieve old-style koha data
764 # print STDERR "prepare $biblionumber,$itemnumber\n";
765 my $sth2=$dbh->prepare("SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned,
766 booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
767 datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,bulk,issues,renewals,
768 reserves,restricted,binding,itemnotes,holdingbranch,timestamp
770 WHERE itemnumber=?");
771 $sth2->execute($itemnumber);
772 my $row=$sth2->fetchrow_hashref;
774 foreach $code (keys %$row) {
776 &MARCkoha2marcOnefield($sth,$record,"items.".$code,$row->{$code});
781 # TODO : retrieve notes, additionalauthors
784 sub MARCkoha2marcSubtitle {
785 # this function builds partial MARC::Record from the old koha-DB fields
786 my ($dbh,$bibnum,$subtitle) = @_;
787 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
788 my $record = MARC::Record->new();
789 &MARCkoha2marcOnefield($sth,$record,"bibliosubtitle.subtitle",$subtitle);
793 sub MARCkoha2marcOnefield {
794 my ($sth,$record,$kohafieldname,$value)=@_;
797 $sth->execute($kohafieldname);
798 if (($tagfield,$tagsubfield)=$sth->fetchrow) {
799 if ($record->field($tagfield)) {
800 my $tag =$record->field($tagfield);
802 $tag->add_subfields($tagsubfield,$value);
803 $record->delete_field($tag);
804 $record->add_fields($tag);
807 $record->add_fields($tagfield," "," ",$tagsubfield => $value);
814 my ($dbh,$record) = @_;
815 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
817 my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
820 # print STDERR $record->as_formatted;
821 while (($field)=$sth2->fetchrow) {
822 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result);
824 $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
826 while (($field)=$sth2->fetchrow) {
827 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result);
829 $sth2=$dbh->prepare("SHOW COLUMNS from items");
831 while (($field)=$sth2->fetchrow) {
832 $result = &MARCmarc2kohaOneField($sth,"items",$field,$record,$result);
834 # additional authors : specific
835 $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result);
839 sub MARCmarc2kohaOneField {
840 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
841 my ($sth,$kohatable,$kohafield,$record,$result)= @_;
845 $sth->execute($kohatable.".".$kohafield);
846 ($tagfield,$subfield) = $sth->fetchrow;
847 foreach my $field ($record->field($tagfield)) {
848 if ($field->subfield($subfield)) {
849 if ($result->{$kohafield}) {
850 $result->{$kohafield} .= " | ".$field->subfield($subfield);
852 $result->{$kohafield}=$field->subfield($subfield);
860 # split a subfield string and adds it into the word table.
862 my ($dbh,$bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$sentence) =@_;
863 $sentence =~ s/(\.|\?|\:|\!|\'|,|\-)/ /g;
864 my @words = split / /,$sentence;
865 my $stopwords= C4::Context->stopwords;
866 my $sth=$dbh->prepare("insert into marc_word (bibid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word)
867 values (?,?,?,?,?,?,soundex(?))");
868 foreach my $word (@words) {
869 # we record only words longer than 2 car and not in stopwords hash
870 if (length($word)>1 and !($stopwords->{uc($word)})) {
871 $sth->execute($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,$word);
873 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";
880 # delete words. this sub deletes all the words from a sentence. a subfield modif is done by a delete then a add
881 my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
882 my $sth=$dbh->prepare("delete from marc_word where bibid=? and tag=? and tagorder=? and subfieldid=? and subfieldorder=?");
883 $sth->execute($bibid,$tag,$tagorder,$subfield,$subfieldorder);
888 # ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL
891 # all the following subs are useful to manage MARC-DB with complete MARC records.
892 # it's used with marcimport, and marc management tools
897 all subs requires/use $dbh as 1st parameter.
898 those subs are used by the MARC-compliant version of koha : marc import, or marc management.
902 I<(oldbibnum,$oldbibitemnum) = ALLnewbibilio($dbh,$MARCRecord,$oldbiblio,$oldbiblioitem);>
904 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
905 are builded from the MARC::Record. If they are passed, they are used.
907 I<ALLnewitem($dbh,$olditem);>
909 adds an item in the db. $olditem is a old-db hash.
913 Paul POULAIN paul.poulain@free.fr
918 my ($dbh, $record, $oldbiblio, $oldbiblioitem) = @_;
919 # note $oldbiblio and $oldbiblioitem are not mandatory.
920 # if not present, they will be builded from $record with MARCmarc2koha function
921 if (($oldbiblio) and not($oldbiblioitem)) {
922 print STDERR "ALLnewbiblio : missing parameter\n";
923 print "ALLnewbiblio : missing parameter : contact koha development team\n";
929 $oldbibnum = OLDnewbiblio($dbh,$oldbiblio);
930 $oldbiblioitem->{'biblionumber'} = $oldbibnum;
931 $oldbibitemnum = OLDnewbiblioitem($dbh,$oldbiblioitem);
933 my $olddata = MARCmarc2koha($dbh,$record);
934 $oldbibnum = OLDnewbiblio($dbh,$olddata);
935 $oldbibitemnum = OLDnewbiblioitem($dbh,$olddata);
937 # we must add bibnum and bibitemnum in MARC::Record...
938 # we build the new field with biblionumber and biblioitemnumber
939 # we drop the original field
940 # we add the new builded field.
941 # NOTE : Works only if the field is ONLY for biblionumber and biblioitemnumber
942 # (steve and paul : thinks 090 is a good choice)
943 my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
944 $sth->execute("biblio.biblionumber");
945 (my $tagfield1, my $tagsubfield1) = $sth->fetchrow;
946 $sth->execute("biblioitems.biblioitemnumber");
947 (my $tagfield2, my $tagsubfield2) = $sth->fetchrow;
948 if ($tagsubfield1 != $tagsubfield2) {
949 print STDERR "Error in ALLnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number";
950 print "Error in ALLnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number";
953 my $newfield = MARC::Field->new( $tagfield1,'','',
954 "$tagsubfield1" => $oldbibnum,
955 "$tagsubfield2" => $oldbibitemnum);
956 # drop old field and create new one...
957 my $old_field = $record->field($tagfield1);
958 $record->delete_field($old_field);
959 $record->add_fields($newfield);
960 my $bibid = MARCaddbiblio($dbh,$record,$oldbibnum);
961 return ( $oldbibnum,$oldbibitemnum );
965 my ($dbh, $item) = @_;
968 ($itemnumber,$error) = &OLDnewitems($dbh,$item,$item->{'barcode'});
969 # search MARC biblionumber
970 my $bibid=&MARCfind_MARCbibid_from_oldbiblionumber($dbh,$item->{'biblionumber'});
972 my $sth = $dbh->prepare("select max(tagorder) from marc_subfield_table where bibid=?");
973 $sth->execute($bibid);
974 my ($tagorder) = $sth->fetchrow;
977 # for each field, find MARC tag and subfield, and call the proper MARC sub
978 foreach my $itemkey (keys %$item) {
981 if ($itemkey eq "biblionumber" || $itemkey eq "biblioitemnumber") {
982 ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"biblio.".$itemkey);
984 ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"items.".$itemkey);
986 if ($tagfield && $item->{$itemkey} ne 'NULL') {
988 &MARCaddsubfield($dbh,
1004 # OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD
1011 all subs requires/use $dbh as 1st parameter.
1012 those subs are used by the MARC-compliant version of koha : marc import, or marc management.
1014 They all are the exact copy of 1.0/1.2 version of the sub
1015 without the OLD. The OLDxxx is called by the original xxx sub.
1016 the 1.4 xxx sub also builds MARC::Record an calls the MARCxxx
1018 WARNING : there is 1 difference between initialxxx and OLDxxx :
1019 the db header $dbh is always passed as parameter
1020 to avoid over-DB connexion
1024 I<$biblionumber = OLDnewbiblio($dbh,$biblio);>
1026 adds a record in biblio table. Datas are in the hash $biblio.
1028 I<$biblionumber = OLDmodbiblio($dbh,$biblio);>
1030 modify a record in biblio table. Datas are in the hash $biblio.
1032 I<OLDmodsubtitle($dbh,$bibnum,$subtitle);>
1034 modify subtitles in bibliosubtitle table.
1036 I<OLDmodaddauthor($dbh,$bibnum,$author);>
1038 adds or modify additional authors
1039 NOTE : Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
1041 I<$errors = OLDmodsubject($dbh,$bibnum, $force, @subject);>
1043 modify/adds subjects
1045 I<OLDmodbibitem($dbh, $biblioitem);>
1049 I<OLDmodnote($dbh,$bibitemnum,$note>
1051 modify a note for a biblioitem
1053 I<OLDnewbiblioitem($dbh,$biblioitem);>
1055 adds a biblioitem ($biblioitem is a hash with the values)
1057 I<OLDnewsubject($dbh,$bibnum);>
1061 I<OLDnewsubtitle($dbh,$bibnum,$subtitle);>
1063 create a new subtitle
1065 I<($itemnumber,$errors)= OLDnewitems($dbh,$item,$barcode);>
1067 create a item. $item is a hash and $barcode the barcode.
1069 I<OLDmoditem($dbh,$item);>
1073 I<OLDdelitem($dbh,$itemnum);>
1077 I<OLDdeletebiblioitem($dbh,$biblioitemnumber);>
1079 deletes a biblioitem
1080 NOTE : not standard sub name. Should be OLDdelbiblioitem()
1082 I<OLDdelbiblio($dbh,$biblio);>
1088 Paul POULAIN paul.poulain@free.fr
1093 my ($dbh,$biblio) = @_;
1094 # my $dbh = &C4Connect;
1095 my $query = "Select max(biblionumber) from biblio";
1096 my $sth = $dbh->prepare($query);
1098 my $data = $sth->fetchrow_arrayref;
1099 my $bibnum = $$data[0] + 1;
1102 $biblio->{'title'} = $dbh->quote($biblio->{'title'});
1103 $biblio->{'author'} = $dbh->quote($biblio->{'author'});
1104 $biblio->{'copyright'} = $dbh->quote($biblio->{'copyright'});
1105 $biblio->{'seriestitle'} = $dbh->quote($biblio->{'seriestitle'});
1106 $biblio->{'notes'} = $dbh->quote($biblio->{'notes'});
1107 $biblio->{'abstract'} = $dbh->quote($biblio->{'abstract'});
1108 if ($biblio->{'seriestitle'}) { $series = 1 };
1111 $query = "insert into biblio set
1112 biblionumber = $bibnum,
1113 title = $biblio->{'title'},
1114 author = $biblio->{'author'},
1115 copyrightdate = $biblio->{'copyright'},
1117 seriestitle = $biblio->{'seriestitle'},
1118 notes = $biblio->{'notes'},
1119 abstract = $biblio->{'abstract'}";
1121 $sth = $dbh->prepare($query);
1130 my ($dbh,$biblio) = @_;
1131 # my $dbh = C4Connect;
1135 $biblio->{'title'} = $dbh->quote($biblio->{'title'});
1136 $biblio->{'author'} = $dbh->quote($biblio->{'author'});
1137 $biblio->{'abstract'} = $dbh->quote($biblio->{'abstract'});
1138 $biblio->{'copyrightdate'} = $dbh->quote($biblio->{'copyrightdate'});
1139 $biblio->{'seriestitle'} = $dbh->quote($biblio->{'serirestitle'});
1140 $biblio->{'serial'} = $dbh->quote($biblio->{'serial'});
1141 $biblio->{'unititle'} = $dbh->quote($biblio->{'unititle'});
1142 $biblio->{'notes'} = $dbh->quote($biblio->{'notes'});
1144 $query = "Update biblio set
1145 title = $biblio->{'title'},
1146 author = $biblio->{'author'},
1147 abstract = $biblio->{'abstract'},
1148 copyrightdate = $biblio->{'copyrightdate'},
1149 seriestitle = $biblio->{'seriestitle'},
1150 serial = $biblio->{'serial'},
1151 unititle = $biblio->{'unititle'},
1152 notes = $biblio->{'notes'}
1153 where biblionumber = $biblio->{'biblionumber'}";
1154 $sth = $dbh->prepare($query);
1159 return($biblio->{'biblionumber'});
1162 sub OLDmodsubtitle {
1163 my ($dbh,$bibnum, $subtitle) = @_;
1164 # my $dbh = C4Connect;
1165 my $query = "update bibliosubtitle set
1166 subtitle = '$subtitle'
1167 where biblionumber = $bibnum";
1168 my $sth = $dbh->prepare($query);
1176 sub OLDmodaddauthor {
1177 my ($dbh,$bibnum, $author) = @_;
1178 # my $dbh = C4Connect;
1179 my $query = "Delete from additionalauthors where biblionumber = $bibnum";
1180 my $sth = $dbh->prepare($query);
1185 if ($author ne '') {
1186 $query = "Insert into additionalauthors set
1188 biblionumber = '$bibnum'";
1189 $sth = $dbh->prepare($query);
1195 } # sub modaddauthor
1199 my ($dbh,$bibnum, $force, @subject) = @_;
1200 # my $dbh = C4Connect;
1201 my $count = @subject;
1203 for (my $i = 0; $i < $count; $i++) {
1204 $subject[$i] =~ s/^ //g;
1205 $subject[$i] =~ s/ $//g;
1206 my $query = "select * from catalogueentry
1207 where entrytype = 's'
1208 and catalogueentry = '$subject[$i]'";
1209 my $sth = $dbh->prepare($query);
1212 if (my $data = $sth->fetchrow_hashref) {
1214 if ($force eq $subject[$i]) {
1215 # subject not in aut, chosen to force anway
1216 # so insert into cataloguentry so its in auth file
1217 $query = "Insert into catalogueentry
1218 (entrytype,catalogueentry)
1219 values ('s','$subject[$i]')";
1220 my $sth2 = $dbh->prepare($query);
1225 $error = "$subject[$i]\n does not exist in the subject authority file";
1226 $query = "Select * from catalogueentry
1227 where entrytype = 's'
1228 and (catalogueentry like '$subject[$i] %'
1229 or catalogueentry like '% $subject[$i] %'
1230 or catalogueentry like '% $subject[$i]')";
1231 my $sth2 = $dbh->prepare($query);
1234 while (my $data = $sth2->fetchrow_hashref) {
1235 $error .= "<br>$data->{'catalogueentry'}";
1243 my $query = "Delete from bibliosubject where biblionumber = $bibnum";
1244 my $sth = $dbh->prepare($query);
1247 for (my $i = 0; $i < $count; $i++) {
1248 $sth = $dbh->prepare("Insert into bibliosubject
1249 values ('$subject[$i]', $bibnum)");
1261 my ($dbh,$biblioitem) = @_;
1262 # my $dbh = C4Connect;
1265 $biblioitem->{'itemtype'} = $dbh->quote($biblioitem->{'itemtype'});
1266 $biblioitem->{'url'} = $dbh->quote($biblioitem->{'url'});
1267 $biblioitem->{'isbn'} = $dbh->quote($biblioitem->{'isbn'});
1268 $biblioitem->{'publishercode'} = $dbh->quote($biblioitem->{'publishercode'});
1269 $biblioitem->{'publicationyear'} = $dbh->quote($biblioitem->{'publicationyear'});
1270 $biblioitem->{'classification'} = $dbh->quote($biblioitem->{'classification'});
1271 $biblioitem->{'dewey'} = $dbh->quote($biblioitem->{'dewey'});
1272 $biblioitem->{'subclass'} = $dbh->quote($biblioitem->{'subclass'});
1273 $biblioitem->{'illus'} = $dbh->quote($biblioitem->{'illus'});
1274 $biblioitem->{'pages'} = $dbh->quote($biblioitem->{'pages'});
1275 $biblioitem->{'volumeddesc'} = $dbh->quote($biblioitem->{'volumeddesc'});
1276 $biblioitem->{'notes'} = $dbh->quote($biblioitem->{'notes'});
1277 $biblioitem->{'size'} = $dbh->quote($biblioitem->{'size'});
1278 $biblioitem->{'place'} = $dbh->quote($biblioitem->{'place'});
1280 $query = "Update biblioitems set
1281 itemtype = $biblioitem->{'itemtype'},
1282 url = $biblioitem->{'url'},
1283 isbn = $biblioitem->{'isbn'},
1284 publishercode = $biblioitem->{'publishercode'},
1285 publicationyear = $biblioitem->{'publicationyear'},
1286 classification = $biblioitem->{'classification'},
1287 dewey = $biblioitem->{'dewey'},
1288 subclass = $biblioitem->{'subclass'},
1289 illus = $biblioitem->{'illus'},
1290 pages = $biblioitem->{'pages'},
1291 volumeddesc = $biblioitem->{'volumeddesc'},
1292 notes = $biblioitem->{'notes'},
1293 size = $biblioitem->{'size'},
1294 place = $biblioitem->{'place'}
1295 where biblioitemnumber = $biblioitem->{'biblioitemnumber'}";
1303 my ($dbh,$bibitemnum,$note)=@_;
1304 # my $dbh=C4Connect;
1305 my $query="update biblioitems set notes='$note' where
1306 biblioitemnumber='$bibitemnum'";
1307 my $sth=$dbh->prepare($query);
1313 sub OLDnewbiblioitem {
1314 my ($dbh,$biblioitem) = @_;
1315 # my $dbh = C4Connect;
1316 my $query = "Select max(biblioitemnumber) from biblioitems";
1317 my $sth = $dbh->prepare($query);
1321 $biblioitem->{'volume'} = $dbh->quote($biblioitem->{'volume'});
1322 $biblioitem->{'number'} = $dbh->quote($biblioitem->{'number'});
1323 $biblioitem->{'classification'} = $dbh->quote($biblioitem->{'classification'});
1324 $biblioitem->{'itemtype'} = $dbh->quote($biblioitem->{'itemtype'});
1325 $biblioitem->{'url'} = $dbh->quote($biblioitem->{'url'});
1326 $biblioitem->{'isbn'} = $dbh->quote($biblioitem->{'isbn'});
1327 $biblioitem->{'issn'} = $dbh->quote($biblioitem->{'issn'});
1328 $biblioitem->{'dewey'} = $dbh->quote($biblioitem->{'dewey'});
1329 $biblioitem->{'subclass'} = $dbh->quote($biblioitem->{'subclass'});
1330 $biblioitem->{'publicationyear'} = $dbh->quote($biblioitem->{'publicationyear'});
1331 $biblioitem->{'publishercode'} = $dbh->quote($biblioitem->{'publishercode'});
1332 $biblioitem->{'volumedate'} = $dbh->quote($biblioitem->{'volumedate'});
1333 $biblioitem->{'volumeddesc'} = $dbh->quote($biblioitem->{'volumeddesc'}); $biblioitem->{'illus'} = $dbh->quote($biblioitem->{'illus'});
1334 $biblioitem->{'illus'} = $dbh->quote($biblioitem->{'illus'});
1335 $biblioitem->{'pages'} = $dbh->quote($biblioitem->{'pages'});
1336 $biblioitem->{'notes'} = $dbh->quote($biblioitem->{'notes'});
1337 $biblioitem->{'size'} = $dbh->quote($biblioitem->{'size'});
1338 $biblioitem->{'place'} = $dbh->quote($biblioitem->{'place'});
1339 $biblioitem->{'lccn'} = $dbh->quote($biblioitem->{'lccn'});
1340 $biblioitem->{'marc'} = $dbh->quote($biblioitem->{'marc'});
1343 $data = $sth->fetchrow_arrayref;
1344 $bibitemnum = $$data[0] + 1;
1348 $query = "insert into biblioitems set
1349 biblioitemnumber = $bibitemnum,
1350 biblionumber = $biblioitem->{'biblionumber'},
1351 volume = $biblioitem->{'volume'},
1352 number = $biblioitem->{'number'},
1353 classification = $biblioitem->{'classification'},
1354 itemtype = $biblioitem->{'itemtype'},
1355 url = $biblioitem->{'url'},
1356 isbn = $biblioitem->{'isbn'},
1357 issn = $biblioitem->{'issn'},
1358 dewey = $biblioitem->{'dewey'},
1359 subclass = $biblioitem->{'subclass'},
1360 publicationyear = $biblioitem->{'publicationyear'},
1361 publishercode = $biblioitem->{'publishercode'},
1362 volumedate = $biblioitem->{'volumedate'},
1363 volumeddesc = $biblioitem->{'volumeddesc'},
1364 illus = $biblioitem->{'illus'},
1365 pages = $biblioitem->{'pages'},
1366 notes = $biblioitem->{'notes'},
1367 size = $biblioitem->{'size'},
1368 lccn = $biblioitem->{'lccn'},
1369 marc = $biblioitem->{'marc'},
1370 place = $biblioitem->{'place'}";
1372 $sth = $dbh->prepare($query);
1376 return($bibitemnum);
1380 my ($dbh,$bibnum)=@_;
1381 # my $dbh=C4Connect;
1382 my $query="insert into bibliosubject (biblionumber) values
1384 my $sth=$dbh->prepare($query);
1391 sub OLDnewsubtitle {
1392 my ($dbh,$bibnum, $subtitle) = @_;
1393 # my $dbh = C4Connect;
1394 $subtitle = $dbh->quote($subtitle);
1395 my $query = "insert into bibliosubtitle set
1396 biblionumber = $bibnum,
1397 subtitle = $subtitle";
1398 my $sth = $dbh->prepare($query);
1408 my ($dbh,$item, $barcode) = @_;
1409 # my $dbh = C4Connect;
1410 my $query = "Select max(itemnumber) from items";
1411 my $sth = $dbh->prepare($query);
1417 $data = $sth->fetchrow_hashref;
1418 $itemnumber = $data->{'max(itemnumber)'} + 1;
1421 $item->{'booksellerid'} = $dbh->quote($item->{'booksellerid'});
1422 $item->{'homebranch'} = $dbh->quote($item->{'homebranch'});
1423 $item->{'price'} = $dbh->quote($item->{'price'});
1424 $item->{'replacementprice'} = $dbh->quote($item->{'replacementprice'});
1425 $item->{'itemnotes'} = $dbh->quote($item->{'itemnotes'});
1427 # foreach my $barcode (@barcodes) {
1428 # $barcode = uc($barcode);
1429 $barcode = $dbh->quote($barcode);
1430 $query = "Insert into items set
1431 itemnumber = $itemnumber,
1432 biblionumber = $item->{'biblionumber'},
1433 biblioitemnumber = $item->{'biblioitemnumber'},
1435 booksellerid = $item->{'booksellerid'},
1436 dateaccessioned = NOW(),
1437 homebranch = $item->{'homebranch'},
1438 holdingbranch = $item->{'homebranch'},
1439 price = $item->{'price'},
1440 replacementprice = $item->{'replacementprice'},
1441 replacementpricedate = NOW(),
1442 itemnotes = $item->{'itemnotes'}";
1443 if ($item->{'loan'}) {
1444 $query .= ",notforloan = $item->{'loan'}";
1447 $sth = $dbh->prepare($query);
1449 if (defined $sth->errstr) {
1450 $error .= $sth->errstr;
1455 return($itemnumber,$error);
1459 my ($dbh,$item) = @_;
1460 # my ($dbh,$loan,$itemnum,$bibitemnum,$barcode,$notes,$homebranch,$lost,$wthdrawn,$replacement)=@_;
1461 # my $dbh=C4Connect;
1462 my $query="update items set biblioitemnumber=$item->{'bibitemnum'},
1463 barcode='$item->{'barcode'}',itemnotes='$item->{'notes'}'
1464 where itemnumber=$item->{'itemnum'}";
1465 if ($item->{'barcode'} eq ''){
1466 $query="update items set biblioitemnumber=$item->{'bibitemnum'},notforloan=$item->{'loan'} where itemnumber=$item->{'itemnum'}";
1468 if ($item->{'lost'} ne ''){
1469 $query="update items set biblioitemnumber=$item->{'bibitemnum'},
1470 barcode='$item->{'barcode'}',
1471 itemnotes='$item->{'notes'}',
1472 homebranch='$item->{'homebranch'}',
1473 itemlost='$item->{'lost'}',
1474 wthdrawn='$item->{'wthdrawn'}'
1475 where itemnumber=$item->{'itemnum'}";
1477 if ($item->{'replacement'} ne ''){
1478 $query=~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1481 my $sth=$dbh->prepare($query);
1488 my ($dbh,$itemnum)=@_;
1489 # my $dbh=C4Connect;
1490 my $query="select * from items where itemnumber=$itemnum";
1491 my $sth=$dbh->prepare($query);
1493 my @data=$sth->fetchrow_array;
1495 $query="Insert into deleteditems values (";
1496 foreach my $temp (@data){
1497 $query .= "'$temp',";
1501 $sth=$dbh->prepare($query);
1504 $query = "Delete from items where itemnumber=$itemnum";
1505 $sth=$dbh->prepare($query);
1511 sub OLDdeletebiblioitem {
1512 my ($dbh,$biblioitemnumber) = @_;
1513 # my $dbh = C4Connect;
1514 my $query = "Select * from biblioitems
1515 where biblioitemnumber = $biblioitemnumber";
1516 my $sth = $dbh->prepare($query);
1521 if (@results = $sth->fetchrow_array) {
1522 $query = "Insert into deletedbiblioitems values (";
1523 foreach my $value (@results) {
1524 $value = $dbh->quote($value);
1525 $query .= "$value,";
1528 $query =~ s/\,$/\)/;
1531 $query = "Delete from biblioitems
1532 where biblioitemnumber = $biblioitemnumber";
1536 # Now delete all the items attached to the biblioitem
1537 $query = "Select * from items where biblioitemnumber = $biblioitemnumber";
1538 $sth = $dbh->prepare($query);
1540 while (@results = $sth->fetchrow_array) {
1541 $query = "Insert into deleteditems values (";
1542 foreach my $value (@results) {
1543 $value = $dbh->quote($value);
1544 $query .= "$value,";
1546 $query =~ s/\,$/\)/;
1550 $query = "Delete from items where biblioitemnumber = $biblioitemnumber";
1553 } # sub deletebiblioitem
1556 my ($dbh,$biblio)=@_;
1557 # my $dbh=C4Connect;
1558 my $query="select * from biblio where biblionumber=$biblio";
1559 my $sth=$dbh->prepare($query);
1561 if (my @data=$sth->fetchrow_array){
1563 $query="Insert into deletedbiblio values (";
1564 foreach my $temp (@data){
1565 $temp=~ s/\'/\\\'/g;
1566 $query .= "'$temp',";
1570 $sth=$dbh->prepare($query);
1573 $query = "Delete from biblio where biblionumber=$biblio";
1574 $sth=$dbh->prepare($query);
1590 my $dbh = C4::Context->dbh;
1591 my $query="Select count(*) from items where biblionumber=$biblio";
1593 my $sth=$dbh->prepare($query);
1595 my $data=$sth->fetchrow_hashref;
1597 return($data->{'count(*)'});
1602 ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
1604 Looks up the order with the given biblionumber and biblioitemnumber.
1606 Returns a two-element array. C<$ordernumber> is the order number.
1607 C<$order> is a reference-to-hash describing the order; its keys are
1608 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
1609 tables of the Koha database.
1613 # FIXME - This is effectively identical to &C4::Catalogue::getorder.
1614 # Pick one and stick with it.
1617 my $dbh = C4::Context->dbh;
1618 my $query="Select ordernumber
1620 where biblionumber=? and biblioitemnumber=?";
1621 my $sth=$dbh->prepare($query);
1622 $sth->execute($bib,$bi);
1623 # FIXME - Use fetchrow_array(), since we're only interested in the one
1625 my $ordnum=$sth->fetchrow_hashref;
1627 my $order=getsingleorder($ordnum->{'ordernumber'});
1629 return ($order,$ordnum->{'ordernumber'});
1632 =item getsingleorder
1634 $order = &getsingleorder($ordernumber);
1636 Looks up an order by order number.
1638 Returns a reference-to-hash describing the order. The keys of
1639 C<$order> are fields from the biblio, biblioitems, aqorders, and
1640 aqorderbreakdown tables of the Koha database.
1644 # FIXME - This is effectively identical to
1645 # &C4::Catalogue::getsingleorder.
1646 # Pick one and stick with it.
1647 sub getsingleorder {
1649 my $dbh = C4::Context->dbh;
1650 my $query="Select * from biblio,biblioitems,aqorders,aqorderbreakdown
1651 where aqorders.ordernumber=?
1652 and biblio.biblionumber=aqorders.biblionumber and
1653 biblioitems.biblioitemnumber=aqorders.biblioitemnumber and
1654 aqorders.ordernumber=aqorderbreakdown.ordernumber";
1655 my $sth=$dbh->prepare($query);
1656 $sth->execute($ordnum);
1657 my $data=$sth->fetchrow_hashref;
1664 my $dbh = C4::Context->dbh;
1665 my $bibnum=OLDnewbiblio($dbh,$biblio);
1672 $biblionumber = &modbiblio($biblio);
1674 Update a biblio record.
1676 C<$biblio> is a reference-to-hash whose keys are the fields in the
1677 biblio table in the Koha database. All fields must be present, not
1678 just the ones you wish to change.
1680 C<&modbiblio> updates the record defined by
1681 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1683 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1690 my $dbh = C4::Context->dbh;
1691 my $biblionumber=OLDmodbiblio($dbh,$biblio);
1692 return($biblionumber);
1697 &modsubtitle($biblionumber, $subtitle);
1699 Sets the subtitle of a book.
1701 C<$biblionumber> is the biblionumber of the book to modify.
1703 C<$subtitle> is the new subtitle.
1708 my ($bibnum, $subtitle) = @_;
1709 my $dbh = C4::Context->dbh;
1710 &OLDmodsubtitle($dbh,$bibnum,$subtitle);
1715 &modaddauthor($biblionumber, $author);
1717 Replaces all additional authors for the book with biblio number
1718 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1719 C<&modaddauthor> deletes all additional authors.
1724 my ($bibnum, $author) = @_;
1725 my $dbh = C4::Context->dbh;
1726 &OLDmodaddauthor($dbh,$bibnum,$author);
1727 } # sub modaddauthor
1731 $error = &modsubject($biblionumber, $force, @subjects);
1733 $force - a subject to force
1735 $error - Error message, or undef if successful.
1740 my ($bibnum, $force, @subject) = @_;
1741 my $dbh = C4::Context->dbh;
1742 my $error= &OLDmodsubject($dbh,$bibnum,$force, @subject);
1747 my ($biblioitem) = @_;
1748 my $dbh = C4::Context->dbh;
1749 &OLDmodbibitem($dbh,$biblioitem);
1750 my $MARCbibitem = MARCkoha2marcBiblio($dbh,$biblioitem);
1751 &MARCmodbiblio($dbh,$biblioitem->{biblionumber},0,$MARCbibitem);
1755 my ($bibitemnum,$note)=@_;
1756 my $dbh = C4::Context->dbh;
1757 &OLDmodnote($dbh,$bibitemnum,$note);
1761 my ($biblioitem) = @_;
1762 my $dbh = C4::Context->dbh;
1763 my $bibitemnum = &OLDnewbiblioitem($dbh,$biblioitem);
1764 # print STDERR "bibitemnum : $bibitemnum\n";
1765 my $MARCbiblio= MARCkoha2marcBiblio($dbh,$biblioitem->{biblionumber},$bibitemnum);
1766 # print STDERR $MARCbiblio->as_formatted();
1767 &MARCaddbiblio($dbh,$MARCbiblio,$biblioitem->{biblionumber});
1768 return($bibitemnum);
1773 my $dbh = C4::Context->dbh;
1774 &OLDnewsubject($dbh,$bibnum);
1778 my ($bibnum, $subtitle) = @_;
1779 my $dbh = C4::Context->dbh;
1780 &OLDnewsubtitle($dbh,$bibnum,$subtitle);
1784 my ($item, @barcodes) = @_;
1785 my $dbh = C4::Context->dbh;
1789 foreach my $barcode (@barcodes) {
1790 ($itemnumber,$error)=&OLDnewitems($dbh,$item,uc($barcode));
1792 my $MARCitem = &MARCkoha2marcItem($dbh,$item->{biblionumber},$itemnumber);
1793 &MARCadditem($dbh,$MARCitem,$item->{biblionumber});
1800 my $dbh = C4::Context->dbh;
1801 &OLDmoditem($dbh,$item);
1802 my $MARCitem = &MARCkoha2marcItem($dbh,$item->{'biblionumber'},$item->{'itemnum'});
1803 my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$item->{biblionumber});
1804 &MARCmoditem($dbh,$MARCitem,$bibid,$item->{itemnum},0);
1808 my ($count,@barcodes)=@_;
1809 my $dbh = C4::Context->dbh;
1811 for (my $i=0;$i<$count;$i++){
1812 $barcodes[$i]=uc $barcodes[$i];
1813 my $query="Select * from items where barcode='$barcodes[$i]'";
1814 my $sth=$dbh->prepare($query);
1816 if (my $data=$sth->fetchrow_hashref){
1817 $error.=" Duplicate Barcode: $barcodes[$i]";
1825 my ($bibitemnum)=@_;
1826 my $dbh = C4::Context->dbh;
1827 my $query="Select count(*) from items where biblioitemnumber='$bibitemnum'";
1828 my $sth=$dbh->prepare($query);
1830 my $data=$sth->fetchrow_hashref;
1832 return($data->{'count(*)'});
1837 my $dbh = C4::Context->dbh;
1838 &OLDdelitem($dbh,$itemnum);
1841 sub deletebiblioitem {
1842 my ($biblioitemnumber) = @_;
1843 my $dbh = C4::Context->dbh;
1844 &OLDdeletebiblioitem($dbh,$biblioitemnumber);
1845 } # sub deletebiblioitem
1850 my $dbh = C4::Context->dbh;
1851 &OLDdelbiblio($dbh,$biblio);
1855 my $dbh = C4::Context->dbh;
1856 my $query = "select * from itemtypes";
1857 my $sth = $dbh->prepare($query);
1858 # || die "Cannot prepare $query" . $dbh->errstr;
1863 # || die "Cannot execute $query\n" . $sth->errstr;
1864 while (my $data = $sth->fetchrow_hashref) {
1865 $results[$count] = $data;
1870 return($count, @results);
1871 } # sub getitemtypes
1874 my ($biblionumber) = @_;
1875 my $dbh = C4::Context->dbh;
1876 my $query = "Select * from biblio where biblionumber = $biblionumber";
1877 my $sth = $dbh->prepare($query);
1878 # || die "Cannot prepare $query\n" . $dbh->errstr;
1883 # || die "Cannot execute $query\n" . $sth->errstr;
1884 while (my $data = $sth->fetchrow_hashref) {
1885 $results[$count] = $data;
1890 return($count, @results);
1894 my ($biblioitemnum) = @_;
1895 my $dbh = C4::Context->dbh;
1896 my $query = "Select * from biblioitems where
1897 biblioitemnumber = $biblioitemnum";
1898 my $sth = $dbh->prepare($query);
1904 while (my $data = $sth->fetchrow_hashref) {
1905 $results[$count] = $data;
1910 return($count, @results);
1911 } # sub getbiblioitem
1913 sub getbiblioitembybiblionumber {
1914 my ($biblionumber) = @_;
1915 my $dbh = C4::Context->dbh;
1916 my $query = "Select * from biblioitems where biblionumber =
1918 my $sth = $dbh->prepare($query);
1924 while (my $data = $sth->fetchrow_hashref) {
1925 $results[$count] = $data;
1930 return($count, @results);
1933 sub getitemsbybiblioitem {
1934 my ($biblioitemnum) = @_;
1935 my $dbh = C4::Context->dbh;
1936 my $query = "Select * from items, biblio where
1937 biblio.biblionumber = items.biblionumber and biblioitemnumber
1939 my $sth = $dbh->prepare($query);
1940 # || die "Cannot prepare $query\n" . $dbh->errstr;
1945 # || die "Cannot execute $query\n" . $sth->errstr;
1946 while (my $data = $sth->fetchrow_hashref) {
1947 $results[$count] = $data;
1952 return($count, @results);
1953 } # sub getitemsbybiblioitem
1957 my $dbh = C4::Context->dbh;
1963 $isbn = $dbh->quote($isbn);
1964 $query = "Select distinct biblio.* from biblio, biblioitems where
1965 biblio.biblionumber = biblioitems.biblionumber
1967 $sth = $dbh->prepare($query);
1970 while (my $data = $sth->fetchrow_hashref) {
1971 $results[$count] = $data;
1976 return($count, @results);
1980 # At the moment this is just a straight copy of the subject code. Needs heavy
1981 # modification to work for additional authors, obviously.
1982 # Check for additional author changes
1984 # my $newadditionalauthor='';
1985 # my $additionalauthors;
1986 # foreach $newadditionalauthor (@{$biblio->{'additionalauthor'}}) {
1987 # $additionalauthors->{$newadditionalauthor}=1;
1988 # if ($origadditionalauthors->{$newadditionalauthor}) {
1989 # $additionalauthors->{$newadditionalauthor}=2;
1991 # my $q_newadditionalauthor=$dbh->quote($newadditionalauthor);
1992 # my $sth=$dbh->prepare("insert into biblioadditionalauthors (additionalauthor,biblionumber) values ($q_newadditionalauthor, $biblionumber)");
1994 # logchange('kohadb', 'add', 'biblio', 'additionalauthor', $newadditionalauthor);
1996 # $subfields->{1}->{'Subfield_Mark'}='a';
1997 # $subfields->{1}->{'Subfield_Value'}=$newadditionalauthor;
2000 # foreach $Record_ID (@marcrecords) {
2001 # addTag($env, $Record_ID, $tag, ' ', ' ', $subfields);
2002 # logchange('marc', 'add', $Record_ID, '650', 'a', $newadditionalauthor);
2006 # my $origadditionalauthor;
2007 # foreach $origadditionalauthor (keys %$origadditionalauthors) {
2008 # if ($additionalauthors->{$origadditionalauthor} == 1) {
2009 # my $q_origadditionalauthor=$dbh->quote($origadditionalauthor);
2010 # logchange('kohadb', 'delete', 'biblio', '$biblionumber', 'additionalauthor', $origadditionalauthor);
2011 # my $sth=$dbh->prepare("delete from biblioadditionalauthors where biblionumber=$biblionumber and additionalauthor=$q_origadditionalauthor");
2021 # Subroutine to log changes to databases
2022 # Eventually, this subroutine will be used to create a log of all changes made,
2023 # with the possibility of "undo"ing some changes
2025 if ($database eq 'kohadb') {
2031 # print STDERR "KOHA: $type $section $item $original $new\n";
2032 } elsif ($database eq 'marc') {
2034 my $Record_ID=shift;
2037 my $subfield_ID=shift;
2040 # print STDERR "MARC: $type $Record_ID $tag $mark $subfield_ID $original $new\n";
2044 #------------------------------------------------
2047 #---------------------------------------
2048 # Find a biblio entry, or create a new one if it doesn't exist.
2049 # If a "subtitle" entry is in hash, add it to subtitle table
2050 sub getoraddbiblio {
2054 # FIXME - Unused argument
2055 $biblio, # hash ref to fields
2066 $dbh = C4::Context->dbh;
2068 print "<PRE>Looking for biblio </PRE>\n" if $debug;
2069 $sth=$dbh->prepare("select biblionumber
2071 where title=? and author=?
2072 and copyrightdate=? and seriestitle=?");
2074 $biblio->{title}, $biblio->{author},
2075 $biblio->{copyright}, $biblio->{seriestitle} );
2077 ($biblionumber) = $sth->fetchrow;
2078 print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
2080 # Doesn't exist. Add new one.
2081 print "<PRE>Adding biblio</PRE>\n" if $debug;
2082 ($biblionumber,$error)=&newbiblio($biblio);
2083 if ( $biblionumber ) {
2084 print "<PRE>Added with biblio number=$biblionumber</PRE>\n" if $debug;
2085 if ( $biblio->{subtitle} ) {
2086 &newsubtitle($biblionumber,$biblio->{subtitle} );
2089 print "<PRE>Couldn't add biblio: $error</PRE>\n" if $debug;
2093 return $biblionumber,$error;
2095 } # sub getoraddbiblio
2097 END { } # module clean-up code here (global destructor)
2103 Koha Developement team <info@koha.org>