1st commit to go to zebra.
[koha.git] / C4 / Biblio.pm
1 package C4::Biblio;
2
3 # Copyright 2000-2002 Katipo Communications
4 #
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
10 # version.
11 #
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA  02111-1307 USA
19
20 use strict;
21 require Exporter;
22 use C4::Context;
23 use C4::Database;
24 use MARC::Record;
25 use MARC::File::USMARC;
26
27 use vars qw($VERSION @ISA @EXPORT);
28
29 # set the version for version checking
30 $VERSION = 0.01;
31
32 @ISA = qw(Exporter);
33
34 #
35 # don't forget MARCxxx subs are exported only for testing purposes. Should not be used
36 # as the old-style API and the NEW one are the only public functions.
37 #
38 @EXPORT = qw(
39   &updateBiblio &updateBiblioItem &updateItem
40   &itemcount &newbiblio &newbiblioitem
41   &modnote &newsubject &newsubtitle
42   &modbiblio &checkitems
43   &newitems &modbibitem
44   &modsubtitle &modsubject &modaddauthor &moditem &countitems
45   &delitem &deletebiblioitem &delbiblio
46   &getbiblio
47   &getbiblioitembybiblionumber
48   &getbiblioitem &getitemsbybiblioitem
49   &skip &getitemtypes
50   &newcompletebiblioitem
51
52   &MARCfind_oldbiblionumber_from_MARCbibid
53   &MARCfind_MARCbibid_from_oldbiblionumber
54   &MARCfind_marc_from_kohafield
55   &MARCfindsubfield
56   &MARCfind_frameworkcode
57   &MARCgettagslib
58
59   &NEWnewbiblio &NEWnewitem
60   &NEWmodbiblio &NEWmoditem
61   &NEWdelbiblio &NEWdelitem
62   &NEWmodbiblioframework
63
64   &MARCaddbiblio &MARCadditem
65   &MARCmodsubfield &MARCaddsubfield
66   &MARCmodbiblio &MARCmoditem
67   &MARCkoha2marcBiblio &MARCmarc2koha
68   &MARCkoha2marcItem &MARChtml2marc
69   &MARCgetbiblio &MARCgetitem
70   &MARCaddword &MARCdelword
71   &MARCdelsubfield
72   &char_decode
73   
74   &FindDuplicate
75   &DisplayISBN
76 );
77
78 #
79 #
80 # MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC
81 #
82 #
83 # all the following subs takes a MARC::Record as parameter and manage
84 # the MARC-DB. They are called by the 1.0/1.2 xxx subs, and by the
85 # NEWxxx subs (xxx deals with old-DB parameters, the NEWxxx deals with MARC-DB parameter)
86
87 =head1 NAME
88
89 C4::Biblio - acquisition, catalog  management functions
90
91 =head1 SYNOPSIS
92
93 move from 1.2 to 1.4 version :
94 1.2 and previous version uses a specific API to manage biblios. This API uses old-DB style parameters.
95 In the 1.4 version, we want to do 2 differents things :
96  - keep populating the old-DB, that has a LOT less datas than MARC
97  - populate the MARC-DB
98 To populate the DBs we have 2 differents sources :
99  - the standard acquisition system (through book sellers), that does'nt use MARC data
100  - the MARC acquisition system, that uses MARC data.
101
102 Thus, we have 2 differents cases :
103 - 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
104 - 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
105
106 That's why we need 4 subs :
107 all I<subs beginning by MARC> manage only MARC tables. They manage MARC-DB with MARC::Record parameters
108 all I<subs beginning by OLD> manage only OLD-DB tables. They manage old-DB with old-DB parameters
109 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
110 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.
111
112 - NEW and old-style API should be used in koha to manage biblio
113 - MARCsubs are divided in 2 parts :
114 * some of them manage MARC parameters. They are heavily used in koha.
115 * some of them manage MARC biblio : they are mostly used by NEW and old-style subs.
116 - OLD are used internally only
117
118 all subs requires/use $dbh as 1st parameter.
119
120 I<NEWxxx related subs>
121
122 all subs requires/use $dbh as 1st parameter.
123 those subs are used by the MARC-compliant version of koha : marc import, or marc management.
124
125 I<OLDxxx related subs>
126
127 all subs requires/use $dbh as 1st parameter.
128 those subs are used by the MARC-compliant version of koha : marc import, or marc management.
129
130 They all are the exact copy of 1.0/1.2 version of the sub without the OLD.
131 The OLDxxx is called by the original xxx sub.
132 the 1.4 xxx sub also builds MARC::Record an calls the MARCxxx
133
134 WARNING : there is 1 difference between initialxxx and OLDxxx :
135 the db header $dbh is always passed as parameter to avoid over-DB connexion
136
137 =head1 DESCRIPTION
138
139 =over 4
140
141 =item @tagslib = &MARCgettagslib($dbh,1|0,$itemtype);
142
143 last param is 1 for liblibrarian and 0 for libopac
144 $itemtype contains the itemtype framework reference. If empty or does not exist, the default one is used
145 returns a hash with tag/subfield meaning
146 =item ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
147
148 finds MARC tag and subfield for a given kohafield
149 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
150
151 =item $biblionumber = &MARCfind_oldbiblionumber_from_MARCbibid($dbh,$MARCbibi);
152
153 finds a old-db biblio number for a given MARCbibid number
154
155 =item $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$oldbiblionumber);
156
157 finds a MARC bibid from a old-db biblionumber
158
159 =item $MARCRecord = &MARCkoha2marcBiblio($dbh,$biblionumber,biblioitemnumber);
160
161 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem
162
163 =item $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);
164
165 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB item
166
167 =item $MARCRecord = &MARCkoha2marcSubtitle($dbh,$biblionumber,$subtitle);
168
169 MARCkoha2marcSubtitle is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB subtitle
170
171 =item $olddb = &MARCmarc2koha($dbh,$MARCRecord);
172
173 builds a hash with old-db datas from a MARC::Record
174
175 =item &MARCaddbiblio($dbh,$MARC::Record,$biblionumber);
176
177 creates a biblio (in the MARC tables only). $biblionumber is the old-db biblionumber of the biblio
178
179 =item &MARCaddsubfield($dbh,$bibid,$tagid,$indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
180
181 adds a subfield in a biblio (in the MARC tables only).
182
183 =item $MARCRecord = &MARCgetbiblio($dbh,$bibid);
184
185 Returns a MARC::Record for the biblio $bibid.
186
187 =item &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,$delete);
188
189 MARCmodbiblio changes a biblio for a biblio,MARC::Record passed as parameter
190 It 1st delete the biblio, then recreates it.
191 WARNING : the $delete parameter is not used anymore (too much unsolvable cases).
192 =item ($subfieldid,$subfieldvalue) = &MARCmodsubfield($dbh,$subfieldid,$subfieldvalue);
193
194 MARCmodsubfield changes the value of a given subfield
195
196 =item $subfieldid = &MARCfindsubfield($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue);
197
198 MARCfindsubfield returns a subfield number given a bibid/tag/subfieldvalue values.
199 Returns -1 if more than 1 answer
200
201 =item $subfieldid = &MARCfindsubfieldid($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
202
203 MARCfindsubfieldid find a subfieldid for a bibid/tag/tagorder/subfield/subfieldorder
204
205 =item &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
206
207 MARCdelsubfield delete a subfield for a bibid/tag/tagorder/subfield/subfieldorder
208 If $subfieldorder is not set, delete all the $tag$subfield subfields 
209
210 =item &MARCdelbiblio($dbh,$bibid);
211
212 MARCdelbiblio delete biblio $bibid
213
214 =item &MARCkoha2marcOnefield
215
216 used by MARCkoha2marc and should not be useful elsewhere
217
218 =item &MARCmarc2kohaOnefield
219
220 used by MARCmarc2koha and should not be useful elsewhere
221
222 =item MARCaddword
223
224 used to manage MARC_word table and should not be useful elsewhere
225
226 =item MARCdelword
227
228 used to manage MARC_word table and should not be useful elsewhere
229
230 =cut
231
232 sub MARCgettagslib {
233     my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
234     $frameworkcode = "" unless $frameworkcode;
235     my $sth;
236     my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
237
238     # check that framework exists
239     $sth =
240       $dbh->prepare(
241         "select count(*) from marc_tag_structure where frameworkcode=?");
242     $sth->execute($frameworkcode);
243     my ($total) = $sth->fetchrow;
244     $frameworkcode = "" unless ( $total > 0 );
245     $sth =
246       $dbh->prepare(
247 "select tagfield,liblibrarian,libopac,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield"
248     );
249     $sth->execute($frameworkcode);
250     my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
251
252     while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
253         $res->{$tag}->{lib}        = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
254         $res->{$tab}->{tab}        = "";            # XXX
255         $res->{$tag}->{mandatory}  = $mandatory;
256         $res->{$tag}->{repeatable} = $repeatable;
257     }
258
259     $sth =
260       $dbh->prepare(
261 "select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link from marc_subfield_structure where frameworkcode=? order by tagfield,tagsubfield"
262     );
263     $sth->execute($frameworkcode);
264
265     my $subfield;
266     my $authorised_value;
267     my $authtypecode;
268     my $value_builder;
269     my $kohafield;
270     my $seealso;
271     my $hidden;
272     my $isurl;
273         my $link;
274
275     while (
276         ( $tag,         $subfield,   $liblibrarian,   , $libopac,      $tab,
277         $mandatory,     $repeatable, $authorised_value, $authtypecode,
278         $value_builder, $kohafield,  $seealso,          $hidden,
279         $isurl,                 $link )
280         = $sth->fetchrow
281       )
282     {
283         $res->{$tag}->{$subfield}->{lib}              = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
284         $res->{$tag}->{$subfield}->{tab}              = $tab;
285         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
286         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
287         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
288         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
289         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
290         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
291         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
292         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
293         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
294         $res->{$tag}->{$subfield}->{link}            = $link;
295     }
296     return $res;
297 }
298
299 sub MARCfind_marc_from_kohafield {
300     my ( $dbh, $kohafield,$frameworkcode ) = @_;
301     return 0, 0 unless $kohafield;
302         my $relations = C4::Context->marcfromkohafield;
303         return ($relations->{$frameworkcode}->{$kohafield}->[0],$relations->{$frameworkcode}->{$kohafield}->[1]);
304 }
305
306 sub MARCfind_oldbiblionumber_from_MARCbibid {
307     my ( $dbh, $MARCbibid ) = @_;
308     my $sth =
309       $dbh->prepare("select biblionumber from marc_biblio where bibid=?");
310     $sth->execute($MARCbibid);
311     my ($biblionumber) = $sth->fetchrow;
312     return $biblionumber;
313 }
314
315 sub MARCfind_MARCbibid_from_oldbiblionumber {
316     my ( $dbh, $oldbiblionumber ) = @_;
317     my $sth =
318       $dbh->prepare("select bibid from marc_biblio where biblionumber=?");
319     $sth->execute($oldbiblionumber);
320     my ($bibid) = $sth->fetchrow;
321     return $bibid;
322 }
323
324 sub MARCaddbiblio {
325
326 # pass the MARC::Record to this function, and it will create the records in the marc tables
327         my ($dbh,$record,$biblionumber,$frameworkcode,$bibid) = @_;
328         my @fields=$record->fields();
329 # my $bibid;
330 # adding main table, and retrieving bibid
331 # if bibid is sent, then it's not a true add, it's only a re-add, after a delete (ie, a mod)
332     # if bibid empty => true add, find a new bibid number
333     unless ($bibid) {
334         $dbh->do(
335 "lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ"
336         );
337         my $sth =
338           $dbh->prepare(
339 "insert into marc_biblio (datecreated,biblionumber,frameworkcode) values (now(),?,?)"
340         );
341         $sth->execute( $biblionumber, $frameworkcode );
342         $sth = $dbh->prepare("select max(bibid) from marc_biblio");
343         $sth->execute;
344         ($bibid) = $sth->fetchrow;
345         $sth->finish;
346     }
347     my $fieldcount = 0;
348
349     # now, add subfields...
350     foreach my $field (@fields) {
351         $fieldcount++;
352         if ( $field->tag() < 10 ) {
353             &MARCaddsubfield( $dbh, $bibid, $field->tag(), '', $fieldcount, '',
354                 1, $field->data() );
355         }
356         else {
357             my @subfields = $field->subfields();
358             foreach my $subfieldcount ( 0 .. $#subfields ) {
359                 &MARCaddsubfield(
360                     $dbh,
361                     $bibid,
362                     $field->tag(),
363                     $field->indicator(1) . $field->indicator(2),
364                     $fieldcount,
365                     $subfields[$subfieldcount][0],
366                     $subfieldcount + 1,
367                     $subfields[$subfieldcount][1]
368                 );
369             }
370         }
371     }
372         # save leader
373         &MARCaddsubfield($dbh,$bibid,'000','',$fieldcount+1,'',1,$record->leader);
374     $dbh->do("unlock tables");
375     return $bibid;
376 }
377
378 sub MARCadditem {
379
380 # pass the MARC::Record to this function, and it will create the records in the marc tables
381     my ($dbh,$record,$biblionumber) = @_;
382 # search for MARC biblionumber
383     $dbh->do("lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ");
384     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
385     my @fields=$record->fields();
386     my $sth = $dbh->prepare("select max(tagorder) from marc_subfield_table where bibid=?");
387     $sth->execute($bibid);
388     my ($fieldcount) = $sth->fetchrow;
389
390     # now, add subfields...
391     foreach my $field (@fields) {
392         my @subfields = $field->subfields();
393         $fieldcount++;
394         foreach my $subfieldcount ( 0 .. $#subfields ) {
395             &MARCaddsubfield(
396                 $dbh,
397                 $bibid,
398                 $field->tag(),
399                 $field->indicator(1) . $field->indicator(2),
400                 $fieldcount,
401                 $subfields[$subfieldcount][0],
402                 $subfieldcount + 1,
403                 $subfields[$subfieldcount][1]
404             );
405         }
406     }
407     $dbh->do("unlock tables");
408     return $bibid;
409 }
410
411 sub MARCaddsubfield {
412
413     # Add a new subfield to a tag into the DB.
414     my (
415         $dbh,      $bibid,        $tagid,         $tag_indicator,
416         $tagorder, $subfieldcode, $subfieldorder, $subfieldvalues
417       )
418       = @_;
419           return unless $subfieldvalues;
420 # warn "$tagid / $subfieldcode / $subfieldvalues";
421     # if not value, end of job, we do nothing
422 #     if ( length($subfieldvalues) == 0 ) {
423 #         return;
424 #     }
425     if ( not($subfieldcode) ) {
426         $subfieldcode = ' ';
427     }
428     my @subfieldvalues = split /\||#/, $subfieldvalues;
429     foreach my $subfieldvalue (@subfieldvalues) {
430         if ( length($subfieldvalue) > 255 ) {
431             $dbh->do(
432 "lock tables marc_blob_subfield WRITE, marc_subfield_table WRITE"
433             );
434             my $sth =
435               $dbh->prepare(
436                 "insert into marc_blob_subfield (subfieldvalue) values (?)");
437             $sth->execute($subfieldvalue);
438             $sth =
439               $dbh->prepare("select max(blobidlink)from marc_blob_subfield");
440             $sth->execute;
441             my ($res) = $sth->fetchrow;
442             $sth =
443               $dbh->prepare(
444 "insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,valuebloblink) values (?,?,?,?,?,?,?)"
445             );
446             $sth->execute( $bibid, ( sprintf "%03s", $tagid ), $tagorder,
447                 $tag_indicator, $subfieldcode, $subfieldorder, $res );
448
449             if ( $sth->errstr ) {
450                 warn
451 "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
452             }
453             $dbh->do("unlock tables");
454         }
455         else {
456             my $sth =
457               $dbh->prepare(
458 "insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values (?,?,?,?,?,?,?)"
459             );
460             $sth->execute(
461                 $bibid,        ( sprintf "%03s", $tagid ),
462                 $tagorder,     $tag_indicator,
463                 $subfieldcode, $subfieldorder,
464                 $subfieldvalue
465             );
466             if ( $sth->errstr ) {
467                 warn
468 "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
469             }
470         }
471         &MARCaddword(
472             $dbh,          $bibid,         $tagid,       $tagorder,
473             $subfieldcode, $subfieldorder, $subfieldvalue
474         );
475     }
476 }
477
478 sub MARCgetbiblio {
479
480     # Returns MARC::Record of the biblio passed in parameter.
481     my ( $dbh, $biblionumber ) = @_;
482         my $sth = $dbh->prepare('select marc from biblioitems where biblionumber=?');
483         $sth->execute($biblionumber);
484         my ($marc) = $sth->fetchrow;
485         my $record = MARC::File::USMARC::decode($marc);
486         warn "$biblionumber => $marc = ".$record->as_usmarc();
487     return $record;
488 }
489
490 sub MARCgetitem {
491
492     # Returns MARC::Record of the biblio passed in parameter.
493     my ( $dbh, $bibid, $itemnumber ) = @_;
494     my $record = MARC::Record->new();
495
496     # search MARC tagorder
497     my $sth2 =
498       $dbh->prepare(
499 "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=?"
500     );
501     $sth2->execute( $bibid, $itemnumber );
502     my ($tagorder) = $sth2->fetchrow_array();
503
504     #---- TODO : the leader is missing
505     my $sth =
506       $dbh->prepare(
507 "select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
508                                  from marc_subfield_table
509                                  where bibid=? and tagorder=? order by subfieldcode,subfieldorder
510                          "
511     );
512     $sth2 =
513       $dbh->prepare(
514         "select subfieldvalue from marc_blob_subfield where blobidlink=?");
515     $sth->execute( $bibid, $tagorder );
516     while ( my $row = $sth->fetchrow_hashref ) {
517         if ( $row->{'valuebloblink'} ) {    #---- search blob if there is one
518             $sth2->execute( $row->{'valuebloblink'} );
519             my $row2 = $sth2->fetchrow_hashref;
520             $sth2->finish;
521             $row->{'subfieldvalue'} = $row2->{'subfieldvalue'};
522         }
523         if ( $record->field( $row->{'tag'} ) ) {
524             my $field;
525
526 #--- this test must stay as this, because of strange behaviour of mySQL/Perl DBI with char var containing a number...
527             #--- sometimes, eliminates 0 at beginning, sometimes no ;-\\\
528             if ( length( $row->{'tag'} ) < 3 ) {
529                 $row->{'tag'} = "0" . $row->{'tag'};
530             }
531             $field = $record->field( $row->{'tag'} );
532             if ($field) {
533                 my $x =
534                   $field->add_subfields( $row->{'subfieldcode'},
535                     $row->{'subfieldvalue'} );
536                 $record->delete_field($field);
537                 $record->add_fields($field);
538             }
539         }
540         else {
541             if ( length( $row->{'tag'} ) < 3 ) {
542                 $row->{'tag'} = "0" . $row->{'tag'};
543             }
544             my $temp =
545               MARC::Field->new( $row->{'tag'}, " ", " ",
546                 $row->{'subfieldcode'} => $row->{'subfieldvalue'} );
547             $record->add_fields($temp);
548         }
549
550     }
551     return $record;
552 }
553
554 sub MARCmodbiblio {
555         my ($dbh,$bibid,$record,$frameworkcode,$delete)=@_;
556 # 1st delete the biblio,
557 # 2nd recreate it
558         my $biblionumber = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
559         &MARCdelbiblio($dbh,$bibid,1);
560         &MARCaddbiblio($dbh,$record,$biblionumber,$frameworkcode,$bibid);
561 }
562
563 sub MARCdelbiblio {
564     my ( $dbh, $bibid, $keep_items ) = @_;
565
566     # if the keep_item is set to 1, then all items are preserved.
567     # This flag is set when the delbiblio is called by modbiblio
568     # due to a too complex structure of MARC (repeatable fields and subfields),
569     # the best solution for a modif is to delete / recreate the record.
570
571 # 1st of all, copy the MARC::Record to deletedbiblio table => if a true deletion, MARC data will be kept.
572 # if deletion called before MARCmodbiblio => won't do anything, as the oldbiblionumber doesn't
573     # exist in deletedbiblio table
574     my $record = MARCgetbiblio( $dbh, $bibid );
575     my $oldbiblionumber =
576       MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
577     my $copy2deleted =
578       $dbh->prepare("update deletedbiblio set marc=? where biblionumber=?");
579     $copy2deleted->execute( $record->as_usmarc(), $oldbiblionumber );
580
581     # now, delete in MARC tables.
582     if ( $keep_items eq 1 ) {
583
584         #search item field code
585         my $sth =
586           $dbh->prepare(
587 "select tagfield from marc_subfield_structure where kohafield like 'items.%'"
588         );
589         $sth->execute;
590         my $itemtag = $sth->fetchrow_hashref->{tagfield};
591         $dbh->do(
592 "delete from marc_subfield_table where bibid=$bibid and tag<>$itemtag"
593         );
594         $dbh->do(
595 "delete from marc_word where bibid=$bibid and not (tagsubfield like \"$itemtag%\")"
596         );
597     }
598     else {
599         $dbh->do("delete from marc_biblio where bibid=$bibid");
600         $dbh->do("delete from marc_subfield_table where bibid=$bibid");
601         $dbh->do("delete from marc_word where bibid=$bibid");
602     }
603 }
604
605 sub MARCdelitem {
606
607     # delete the item passed in parameter in MARC tables.
608     my ( $dbh, $bibid, $itemnumber ) = @_;
609
610     #    my $record = MARC::Record->new();
611     # search MARC tagorder
612     my $record = MARCgetitem( $dbh, $bibid, $itemnumber );
613     my $copy2deleted =
614       $dbh->prepare("update deleteditems set marc=? where itemnumber=?");
615     $copy2deleted->execute( $record->as_usmarc(), $itemnumber );
616
617     my $sth2 =
618       $dbh->prepare(
619 "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=?"
620     );
621     $sth2->execute( $bibid, $itemnumber );
622     my ($tagorder) = $sth2->fetchrow_array();
623     my $sth =
624       $dbh->prepare(
625         "delete from marc_subfield_table where bibid=? and tagorder=?");
626     $sth->execute( $bibid, $tagorder );
627 }
628
629 sub MARCmoditem {
630         my ($dbh,$record,$bibid,$itemnumber,$delete)=@_;
631         my $biblionumber = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
632         &MARCdelitem($dbh,$bibid,$itemnumber);
633         &MARCadditem($dbh,$record,$biblionumber);
634 }
635
636 sub MARCmodsubfield {
637
638     # Subroutine changes a subfield value given a subfieldid.
639     my ( $dbh, $subfieldid, $subfieldvalue ) = @_;
640     $dbh->do("lock tables marc_blob_subfield WRITE,marc_subfield_table WRITE");
641     my $sth1 =
642       $dbh->prepare(
643         "select valuebloblink from marc_subfield_table where subfieldid=?");
644     $sth1->execute($subfieldid);
645     my ($oldvaluebloblink) = $sth1->fetchrow;
646     $sth1->finish;
647     my $sth;
648
649     # if too long, use a bloblink
650     if ( length($subfieldvalue) > 255 ) {
651
652         # if already a bloblink, update it, otherwise, insert a new one.
653         if ($oldvaluebloblink) {
654             $sth =
655               $dbh->prepare(
656 "update marc_blob_subfield set subfieldvalue=? where blobidlink=?"
657             );
658             $sth->execute( $subfieldvalue, $oldvaluebloblink );
659         }
660         else {
661             $sth =
662               $dbh->prepare(
663                 "insert into marc_blob_subfield (subfieldvalue) values (?)");
664             $sth->execute($subfieldvalue);
665             $sth =
666               $dbh->prepare("select max(blobidlink) from marc_blob_subfield");
667             $sth->execute;
668             my ($res) = $sth->fetchrow;
669             $sth =
670               $dbh->prepare(
671 "update marc_subfield_table set subfieldvalue=null, valuebloblink=? where subfieldid=?"
672             );
673             $sth->execute( $res, $subfieldid );
674         }
675     }
676     else {
677
678 # note this can leave orphan bloblink. Not a big problem, but we should build somewhere a orphan deleting script...
679         $sth =
680           $dbh->prepare(
681 "update marc_subfield_table set subfieldvalue=?,valuebloblink=null where subfieldid=?"
682         );
683         $sth->execute( $subfieldvalue, $subfieldid );
684     }
685     $dbh->do("unlock tables");
686     $sth->finish;
687     $sth =
688       $dbh->prepare(
689 "select bibid,tag,tagorder,subfieldcode,subfieldid,subfieldorder from marc_subfield_table where subfieldid=?"
690     );
691     $sth->execute($subfieldid);
692     my ( $bibid, $tagid, $tagorder, $subfieldcode, $x, $subfieldorder ) =
693       $sth->fetchrow;
694     $subfieldid = $x;
695     &MARCdelword( $dbh, $bibid, $tagid, $tagorder, $subfieldcode,
696         $subfieldorder );
697     &MARCaddword(
698         $dbh,          $bibid,         $tagid,       $tagorder,
699         $subfieldcode, $subfieldorder, $subfieldvalue
700     );
701     return ( $subfieldid, $subfieldvalue );
702 }
703
704 sub MARCfindsubfield {
705     my ( $dbh, $bibid, $tag, $subfieldcode, $subfieldorder, $subfieldvalue ) =
706       @_;
707     my $resultcounter = 0;
708     my $subfieldid;
709     my $lastsubfieldid;
710     my $query =
711 "select subfieldid from marc_subfield_table where bibid=? and tag=? and subfieldcode=?";
712     my @bind_values = ( $bibid, $tag, $subfieldcode );
713     if ($subfieldvalue) {
714         $query .= " and subfieldvalue=?";
715         push ( @bind_values, $subfieldvalue );
716     }
717     else {
718         if ( $subfieldorder < 1 ) {
719             $subfieldorder = 1;
720         }
721         $query .= " and subfieldorder=?";
722         push ( @bind_values, $subfieldorder );
723     }
724     my $sti = $dbh->prepare($query);
725     $sti->execute(@bind_values);
726     while ( ($subfieldid) = $sti->fetchrow ) {
727         $resultcounter++;
728         $lastsubfieldid = $subfieldid;
729     }
730     if ( $resultcounter > 1 ) {
731
732 # Error condition.  Values given did not resolve into a unique record.  Don't know what to edit
733 # should rarely occur (only if we use subfieldvalue with a value that exists twice, which is strange)
734         return -1;
735     }
736     else {
737         return $lastsubfieldid;
738     }
739 }
740
741 sub MARCfindsubfieldid {
742     my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_;
743     my $sth = $dbh->prepare( "select subfieldid from marc_subfield_table
744                                 where bibid=? and tag=? and tagorder=?
745                                         and subfieldcode=? and subfieldorder=?"
746     );
747     $sth->execute( $bibid, $tag, $tagorder, $subfield, $subfieldorder );
748     my ($res) = $sth->fetchrow;
749     unless ($res) {
750         $sth = $dbh->prepare( "select subfieldid from marc_subfield_table
751                                 where bibid=? and tag=? and tagorder=?
752                                         and subfieldcode=?"
753         );
754         $sth->execute( $bibid, $tag, $tagorder, $subfield );
755         ($res) = $sth->fetchrow;
756     }
757     return $res;
758 }
759
760 sub MARCfind_frameworkcode {
761     my ( $dbh, $biblionumber ) = @_;
762     my $sth =
763       $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
764     $sth->execute($biblionumber);
765     my ($frameworkcode) = $sth->fetchrow;
766     return $frameworkcode;
767 }
768
769 sub MARCdelsubfield {
770
771     # delete a subfield for $bibid / tag / tagorder / subfield / subfieldorder
772     my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_;
773         if ($subfieldorder) {
774                 $dbh->do( "delete from marc_subfield_table where bibid='$bibid' and
775                                 tag='$tag' and tagorder='$tagorder'
776                                 and subfieldcode='$subfield' and subfieldorder='$subfieldorder'
777                                 "
778                 );
779                 $dbh->do( "delete from marc_word where bibid='$bibid' and
780                                 tagsubfield='$tag$subfield' and tagorder='$tagorder'
781                                 and subfieldorder='$subfieldorder'
782                                 "
783                 );
784         } else {
785                 $dbh->do( "delete from marc_subfield_table where bibid='$bibid' and
786                                 tag='$tag' and tagorder='$tagorder'
787                                 and subfieldcode='$subfield'"
788                 );
789                 $dbh->do( "delete from marc_word where bibid='$bibid' and
790                                 tagsubfield='$tag$subfield' and tagorder='$tagorder'"
791                 );
792         }
793 }
794
795 sub MARCkoha2marcBiblio {
796
797     # this function builds partial MARC::Record from the old koha-DB fields
798     my ( $dbh, $biblionumber, $biblioitemnumber ) = @_;
799     my $sth =
800       $dbh->prepare(
801 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
802     );
803     my $record = MARC::Record->new();
804
805     #--- if bibid, then retrieve old-style koha data
806     if ( $biblionumber > 0 ) {
807         my $sth2 =
808           $dbh->prepare(
809 "select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp
810                 from biblio where biblionumber=?"
811         );
812         $sth2->execute($biblionumber);
813         my $row = $sth2->fetchrow_hashref;
814         my $code;
815         foreach $code ( keys %$row ) {
816             if ( $row->{$code} ) {
817                 &MARCkoha2marcOnefield( $sth, $record, "biblio." . $code,
818                     $row->{$code}, '');
819             }
820         }
821     }
822
823     #--- if biblioitem, then retrieve old-style koha data
824     if ( $biblioitemnumber > 0 ) {
825         my $sth2 =
826           $dbh->prepare(
827             " SELECT biblioitemnumber,biblionumber,volume,number,classification,
828                                                 itemtype,url,isbn,issn,dewey,subclass,publicationyear,publishercode,
829                                                 volumedate,volumeddesc,timestamp,illus,pages,notes AS bnotes,size,place
830                                         FROM biblioitems
831                                         WHERE biblioitemnumber=?
832                                         "
833         );
834         $sth2->execute($biblioitemnumber);
835         my $row = $sth2->fetchrow_hashref;
836         my $code;
837         foreach $code ( keys %$row ) {
838             if ( $row->{$code} ) {
839                 &MARCkoha2marcOnefield( $sth, $record, "biblioitems." . $code,
840                     $row->{$code},'' );
841             }
842         }
843     }
844
845     # other fields => additional authors, subjects, subtitles
846     my $sth2 =
847       $dbh->prepare(
848         " SELECT author FROM additionalauthors WHERE biblionumber=?");
849     $sth2->execute($biblionumber);
850     while ( my $row = $sth2->fetchrow_hashref ) {
851         &MARCkoha2marcOnefield( $sth, $record, "additionalauthors.author",
852             $row->{'author'},'' );
853     }
854     $sth2 =
855       $dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?");
856     $sth2->execute($biblionumber);
857     while ( my $row = $sth2->fetchrow_hashref ) {
858         &MARCkoha2marcOnefield( $sth, $record, "bibliosubject.subject",
859             $row->{'subject'},'' );
860     }
861     $sth2 =
862       $dbh->prepare(
863         " SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?");
864     $sth2->execute($biblionumber);
865     while ( my $row = $sth2->fetchrow_hashref ) {
866         &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle",
867             $row->{'subtitle'},'' );
868     }
869     return $record;
870 }
871
872 sub MARCkoha2marcItem {
873
874     # this function builds partial MARC::Record from the old koha-DB fields
875     my ( $dbh, $biblionumber, $itemnumber ) = @_;
876
877     #    my $dbh=&C4Connect;
878     my $sth =
879       $dbh->prepare(
880 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
881     );
882     my $record = MARC::Record->new();
883
884     #--- if item, then retrieve old-style koha data
885     if ( $itemnumber > 0 ) {
886
887         #       print STDERR "prepare $biblionumber,$itemnumber\n";
888         my $sth2 =
889           $dbh->prepare(
890 "SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned,
891                                                 booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
892                                                 datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,itemcallnumber,issues,renewals,
893                                         reserves,restricted,binding,itemnotes,holdingbranch,timestamp
894                                         FROM items
895                                         WHERE itemnumber=?"
896         );
897         $sth2->execute($itemnumber);
898         my $row = $sth2->fetchrow_hashref;
899         my $code;
900         foreach $code ( keys %$row ) {
901             if ( $row->{$code} ) {
902                 &MARCkoha2marcOnefield( $sth, $record, "items." . $code,
903                     $row->{$code},'' );
904             }
905         }
906     }
907     return $record;
908 }
909
910 sub MARCkoha2marcSubtitle {
911
912     # this function builds partial MARC::Record from the old koha-DB fields
913     my ( $dbh, $bibnum, $subtitle ) = @_;
914     my $sth =
915       $dbh->prepare(
916 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
917     );
918     my $record = MARC::Record->new();
919     &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle",
920         $subtitle,'' );
921     return $record;
922 }
923
924 sub MARCkoha2marcOnefield {
925     my ( $sth, $record, $kohafieldname, $value,$frameworkcode ) = @_;
926     my $tagfield;
927     my $tagsubfield;
928     $sth->execute($frameworkcode,$kohafieldname);
929     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
930         if ( $record->field($tagfield) ) {
931             my $tag = $record->field($tagfield);
932             if ($tag) {
933                 $tag->add_subfields( $tagsubfield, $value );
934                 $record->delete_field($tag);
935                 $record->add_fields($tag);
936             }
937         }
938         else {
939             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
940         }
941     }
942     return $record;
943 }
944
945 sub MARChtml2marc {
946         my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
947         my $prevtag = -1;
948         my $record = MARC::Record->new();
949 #       my %subfieldlist=();
950         my $prevvalue; # if tag <10
951         my $field; # if tag >=10
952         for (my $i=0; $i< @$rtags; $i++) {
953                 # rebuild MARC::Record
954 #                       warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
955                 if (@$rtags[$i] ne $prevtag) {
956                         if ($prevtag < 10) {
957                                 if ($prevvalue) {
958                                         if ($prevtag ne '000') {
959                                                 $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
960                                         } else {
961                                                 $record->leader($prevvalue);
962                                         }
963                                 }
964                         } else {
965                                 if ($field) {
966                                         $record->add_fields($field);
967                                 }
968                         }
969                         $indicators{@$rtags[$i]}.='  ';
970                         if (@$rtags[$i] <10) {
971                                 $prevvalue= @$rvalues[$i];
972                                 undef $field;
973                         } else {
974                                 undef $prevvalue;
975                                 $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
976 #                       warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
977                         }
978                         $prevtag = @$rtags[$i];
979                 } else {
980                         if (@$rtags[$i] <10) {
981                                 $prevvalue=@$rvalues[$i];
982                         } else {
983                                 if (length(@$rvalues[$i])>0) {
984                                         $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
985 #                       warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
986                                 }
987                         }
988                         $prevtag= @$rtags[$i];
989                 }
990         }
991         # the last has not been included inside the loop... do it now !
992         $record->add_fields($field) if $field;
993 #       warn "HTML2MARC=".$record->as_formatted;
994         return $record;
995 }
996
997 sub MARCmarc2koha {
998         my ($dbh,$record,$frameworkcode) = @_;
999         my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
1000         my $result;
1001         my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
1002         $sth2->execute;
1003         my $field;
1004         while (($field)=$sth2->fetchrow) {
1005                 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result,$frameworkcode);
1006         }
1007         $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
1008         $sth2->execute;
1009         while (($field)=$sth2->fetchrow) {
1010                 if ($field eq 'notes') { $field = 'bnotes'; }
1011                 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result,$frameworkcode);
1012         }
1013         $sth2=$dbh->prepare("SHOW COLUMNS from items");
1014         $sth2->execute;
1015         while (($field)=$sth2->fetchrow) {
1016                 $result=&MARCmarc2kohaOneField($sth,"items",$field,$record,$result,$frameworkcode);
1017         }
1018         # additional authors : specific
1019         $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result,$frameworkcode);
1020         $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result,$frameworkcode);
1021 # modify copyrightdate to keep only the 1st year found
1022         my $temp = $result->{'copyrightdate'};
1023         $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
1024         if ($1>0) {
1025                 $result->{'copyrightdate'} = $1;
1026         } else { # if no cYYYY, get the 1st date.
1027                 $temp =~ m/(\d\d\d\d)/;
1028                 $result->{'copyrightdate'} = $1;
1029         }
1030 # modify publicationyear to keep only the 1st year found
1031         $temp = $result->{'publicationyear'};
1032         $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
1033         if ($1>0) {
1034                 $result->{'publicationyear'} = $1;
1035         } else { # if no cYYYY, get the 1st date.
1036                 $temp =~ m/(\d\d\d\d)/;
1037                 $result->{'publicationyear'} = $1;
1038         }
1039         return $result;
1040 }
1041
1042 sub MARCmarc2kohaOneField {
1043
1044 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
1045     my ( $sth, $kohatable, $kohafield, $record, $result,$frameworkcode ) = @_;
1046     #    warn "kohatable / $kohafield / $result / ";
1047     my $res = "";
1048     my $tagfield;
1049     my $subfield;
1050     ( $tagfield, $subfield ) = MARCfind_marc_from_kohafield("",$kohatable.".".$kohafield,$frameworkcode);
1051     foreach my $field ( $record->field($tagfield) ) {
1052                 if ($field->tag()<10) {
1053                         if ($result->{$kohafield}) {
1054                                 $result->{$kohafield} .= " | ".$field->data();
1055                         } else {
1056                                 $result->{$kohafield} = $field->data();
1057                         }
1058                 } else {
1059                         if ( $field->subfields ) {
1060                                 my @subfields = $field->subfields();
1061                                 foreach my $subfieldcount ( 0 .. $#subfields ) {
1062                                         if ($subfields[$subfieldcount][0] eq $subfield) {
1063                                                 if ( $result->{$kohafield} ) {
1064                                                         $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
1065                                                 }
1066                                                 else {
1067                                                         $result->{$kohafield} = $subfields[$subfieldcount][1];
1068                                                 }
1069                                         }
1070                                 }
1071                         }
1072                 }
1073     }
1074 #       warn "OneField for $kohatable.$kohafield and $frameworkcode=> $tagfield, $subfield";
1075     return $result;
1076 }
1077
1078 sub MARCaddword {
1079
1080     # split a subfield string and adds it into the word table.
1081     # removes stopwords
1082     my (
1083         $dbh,        $bibid,         $tag,    $tagorder,
1084         $subfieldid, $subfieldorder, $sentence
1085       )
1086       = @_;
1087     $sentence =~ s/(\.|\?|\:|\!|\'|,|\-|\"|\(|\)|\[|\]|\{|\}|\/)/ /g;
1088     my @words = split / /, $sentence;
1089     my $stopwords = C4::Context->stopwords;
1090     my $sth       =
1091       $dbh->prepare(
1092 "insert into marc_word (bibid, tagsubfield, tagorder, subfieldorder, word, sndx_word)
1093                         values (?,concat(?,?),?,?,?,soundex(?))"
1094     );
1095     foreach my $word (@words) {
1096 # we record only words one char long and not in stopwords hash
1097         if (length($word)>=1 and !($stopwords->{uc($word)})) {
1098             $sth->execute($bibid,$tag,$subfieldid,$tagorder,$subfieldorder,$word,$word);
1099             if ($sth->err()) {
1100                 warn "ERROR ==> insert into marc_word (bibid, tagsubfield, tagorder, subfieldorder, word, sndx_word) values ($bibid,concat($tag,$subfieldid),$tagorder,$subfieldorder,$word,soundex($word))\n";
1101             }
1102         }
1103     }
1104 }
1105
1106 sub MARCdelword {
1107
1108 # delete words. this sub deletes all the words from a sentence. a subfield modif is done by a delete then a add
1109     my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_;
1110     my $sth =
1111       $dbh->prepare(
1112 "delete from marc_word where bibid=? and tagsubfield=concat(?,?) and tagorder=? and subfieldorder=?"
1113     );
1114     $sth->execute( $bibid, $tag, $subfield, $tagorder, $subfieldorder );
1115 }
1116
1117 #
1118 #
1119 # NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW
1120 #
1121 #
1122 # all the following subs are useful to manage MARC-DB with complete MARC records.
1123 # it's used with marcimport, and marc management tools
1124 #
1125
1126 =item ($bibid,$oldbibnum,$oldbibitemnum) = NEWnewbibilio($dbh,$MARCRecord,$oldbiblio,$oldbiblioitem);
1127
1128 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
1129 are builded from the MARC::Record. If they are passed, they are used.
1130
1131 =item NEWnewitem($dbh, $record,$bibid);
1132
1133 adds an item in the db.
1134
1135 =cut
1136
1137 sub NEWnewbiblio {
1138     my ( $dbh, $record, $frameworkcode ) = @_;
1139     my $oldbibnum;
1140     my $oldbibitemnum;
1141     my $olddata = MARCmarc2koha( $dbh, $record,$frameworkcode );
1142     $oldbibnum = OLDnewbiblio( $dbh, $olddata );
1143         $olddata->{'biblionumber'} = $oldbibnum;
1144     $oldbibitemnum = OLDnewbiblioitem( $dbh, $olddata );
1145
1146     # search subtiles, addiauthors and subjects
1147     my ( $tagfield, $tagsubfield ) =
1148       MARCfind_marc_from_kohafield( $dbh, "additionalauthors.author",$frameworkcode );
1149     my @addiauthfields = $record->field($tagfield);
1150     foreach my $addiauthfield (@addiauthfields) {
1151         my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
1152         foreach my $subfieldcount ( 0 .. $#addiauthsubfields ) {
1153             OLDmodaddauthor( $dbh, $oldbibnum,
1154                 $addiauthsubfields[$subfieldcount] );
1155         }
1156     }
1157     ( $tagfield, $tagsubfield ) =
1158       MARCfind_marc_from_kohafield( $dbh, "bibliosubtitle.subtitle",$frameworkcode );
1159     my @subtitlefields = $record->field($tagfield);
1160     foreach my $subtitlefield (@subtitlefields) {
1161         my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
1162         foreach my $subfieldcount ( 0 .. $#subtitlesubfields ) {
1163             OLDnewsubtitle( $dbh, $oldbibnum,
1164                 $subtitlesubfields[$subfieldcount] );
1165         }
1166     }
1167     ( $tagfield, $tagsubfield ) =
1168       MARCfind_marc_from_kohafield( $dbh, "bibliosubject.subject",$frameworkcode );
1169     my @subj = $record->field($tagfield);
1170     my @subjects;
1171     foreach my $subject (@subj) {
1172         my @subjsubfield = $subject->subfield($tagsubfield);
1173         foreach my $subfieldcount ( 0 .. $#subjsubfield ) {
1174             push @subjects, $subjsubfield[$subfieldcount];
1175         }
1176     }
1177     OLDmodsubject( $dbh, $oldbibnum, 1, @subjects );
1178
1179     # we must add bibnum and bibitemnum in MARC::Record...
1180     # we build the new field with biblionumber and biblioitemnumber
1181     # we drop the original field
1182     # we add the new builded field.
1183 # NOTE : Works only if the field is ONLY for biblionumber and biblioitemnumber
1184     # (steve and paul : thinks 090 is a good choice)
1185     my $sth =
1186       $dbh->prepare(
1187 "select tagfield,tagsubfield from marc_subfield_structure where kohafield=?"
1188     );
1189     $sth->execute("biblio.biblionumber");
1190     ( my $tagfield1, my $tagsubfield1 ) = $sth->fetchrow;
1191     $sth->execute("biblioitems.biblioitemnumber");
1192     ( my $tagfield2, my $tagsubfield2 ) = $sth->fetchrow;
1193         my $newfield;
1194         # biblionumber & biblioitemnumber are in different fields
1195     if ( $tagfield1 != $tagfield2 ) {
1196                 # deal with biblionumber
1197                 if ($tagfield1<10) {
1198                         $newfield = MARC::Field->new(
1199                                 $tagfield1, $oldbibnum,
1200                         );
1201                 } else {
1202                         $newfield = MARC::Field->new(
1203                                 $tagfield1, '', '', "$tagsubfield1" => $oldbibnum,
1204                         );
1205                 }
1206                 # drop old field and create new one...
1207                 my $old_field = $record->field($tagfield1);
1208                 $record->delete_field($old_field);
1209                 $record->add_fields($newfield);
1210                 # deal with biblioitemnumber
1211                 if ($tagfield2<10) {
1212                         $newfield = MARC::Field->new(
1213                                 $tagfield2, $oldbibitemnum,
1214                         );
1215                 } else {
1216                         $newfield = MARC::Field->new(
1217                                 $tagfield2, '', '', "$tagsubfield2" => $oldbibitemnum,
1218                         );
1219                 }
1220                 # drop old field and create new one...
1221                 $old_field = $record->field($tagfield2);
1222                 $record->delete_field($old_field);
1223                 $record->add_fields($newfield);
1224         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
1225         } else {
1226                 my $newfield = MARC::Field->new(
1227                         $tagfield1, '', '', "$tagsubfield1" => $oldbibnum,
1228                         "$tagsubfield2" => $oldbibitemnum
1229                 );
1230                 # drop old field and create new one...
1231                 my $old_field = $record->field($tagfield1);
1232                 $record->delete_field($old_field);
1233                 $record->add_fields($newfield);
1234         }
1235 #       warn "REC : ".$record->as_formatted;
1236     my $bibid = MARCaddbiblio( $dbh, $record, $oldbibnum, $frameworkcode );
1237     return ( $bibid, $oldbibnum, $oldbibitemnum );
1238 }
1239
1240 sub NEWmodbiblioframework {
1241         my ($dbh,$bibid,$frameworkcode) =@_;
1242         my $sth = $dbh->prepare("Update marc_biblio SET frameworkcode=? WHERE bibid=$bibid");
1243         $sth->execute($frameworkcode);
1244         return 1;
1245 }
1246 sub NEWmodbiblio {
1247         my ($dbh,$record,$bibid,$frameworkcode) =@_;
1248         $frameworkcode="" unless $frameworkcode;
1249         &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,0);
1250         my $oldbiblio = MARCmarc2koha($dbh,$record,$frameworkcode);
1251         my $oldbiblionumber = OLDmodbiblio($dbh,$oldbiblio);
1252         OLDmodbibitem($dbh,$oldbiblio);
1253         # now, modify addi authors, subject, addititles.
1254         my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author",$frameworkcode);
1255         my @addiauthfields = $record->field($tagfield);
1256         foreach my $addiauthfield (@addiauthfields) {
1257                 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
1258                 foreach my $subfieldcount (0..$#addiauthsubfields) {
1259                         OLDmodaddauthor($dbh,$oldbiblionumber,$addiauthsubfields[$subfieldcount]);
1260                 }
1261         }
1262         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle",$frameworkcode);
1263         my @subtitlefields = $record->field($tagfield);
1264         foreach my $subtitlefield (@subtitlefields) {
1265                 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
1266                 # delete & create subtitle again because OLDmodsubtitle can't handle new subtitles
1267                 # between 2 modifs
1268                 $dbh->do("delete from bibliosubtitle where biblionumber=$oldbiblionumber");
1269                 foreach my $subfieldcount (0..$#subtitlesubfields) {
1270                         foreach my $subtit(split /\||#/,$subtitlesubfields[$subfieldcount]) {
1271                                 OLDnewsubtitle($dbh,$oldbiblionumber,$subtit);
1272                         }
1273                 }
1274         }
1275         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject",$frameworkcode);
1276         my @subj = $record->field($tagfield);
1277         my @subjects;
1278         foreach my $subject (@subj) {
1279                 my @subjsubfield = $subject->subfield($tagsubfield);
1280                 foreach my $subfieldcount (0..$#subjsubfield) {
1281                         push @subjects,$subjsubfield[$subfieldcount];
1282                 }
1283         }
1284         OLDmodsubject($dbh,$oldbiblionumber,1,@subjects);
1285         return 1;
1286 }
1287
1288 sub NEWdelbiblio {
1289     my ( $dbh, $bibid ) = @_;
1290     my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
1291     &OLDdelbiblio( $dbh, $biblio );
1292     my $sth =
1293       $dbh->prepare(
1294         "select biblioitemnumber from biblioitems where biblionumber=?");
1295     $sth->execute($biblio);
1296     while ( my ($biblioitemnumber) = $sth->fetchrow ) {
1297         OLDdeletebiblioitem( $dbh, $biblioitemnumber );
1298     }
1299     &MARCdelbiblio( $dbh, $bibid, 0 );
1300 }
1301
1302 sub NEWnewitem {
1303     my ( $dbh, $record, $bibid ) = @_;
1304
1305     # add item in old-DB
1306         my $frameworkcode=MARCfind_frameworkcode($dbh,$bibid);
1307     my $item = &MARCmarc2koha( $dbh, $record,$frameworkcode );
1308     # needs old biblionumber and biblioitemnumber
1309     $item->{'biblionumber'} =
1310       MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
1311     my $sth =
1312       $dbh->prepare(
1313         "select biblioitemnumber from biblioitems where biblionumber=?");
1314     $sth->execute( $item->{'biblionumber'} );
1315     ( $item->{'biblioitemnumber'} ) = $sth->fetchrow;
1316     my ( $itemnumber, $error ) = &OLDnewitems( $dbh, $item, $item->{barcode} );
1317
1318     # add itemnumber to MARC::Record before adding the item.
1319     $sth =
1320       $dbh->prepare(
1321 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
1322     );
1323     &MARCkoha2marcOnefield( $sth, $record, "items.itemnumber", $itemnumber,$frameworkcode );
1324
1325     # add the item
1326     my $bib = &MARCadditem( $dbh, $record, $item->{'biblionumber'} );
1327 }
1328
1329 sub NEWmoditem {
1330     my ( $dbh, $record, $bibid, $itemnumber, $delete ) = @_;
1331     
1332         &MARCmoditem( $dbh, $record, $bibid, $itemnumber, $delete );
1333         my $frameworkcode=MARCfind_frameworkcode($dbh,$bibid);
1334     my $olditem = MARCmarc2koha( $dbh, $record,$frameworkcode );
1335     OLDmoditem( $dbh, $olditem );
1336 }
1337
1338 sub NEWdelitem {
1339     my ( $dbh, $bibid, $itemnumber ) = @_;
1340     my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
1341     &OLDdelitem( $dbh, $itemnumber );
1342     &MARCdelitem( $dbh, $bibid, $itemnumber );
1343 }
1344
1345 #
1346 #
1347 # OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD
1348 #
1349 #
1350
1351 =item $biblionumber = OLDnewbiblio($dbh,$biblio);
1352
1353 adds a record in biblio table. Datas are in the hash $biblio.
1354
1355 =item $biblionumber = OLDmodbiblio($dbh,$biblio);
1356
1357 modify a record in biblio table. Datas are in the hash $biblio.
1358
1359 =item OLDmodsubtitle($dbh,$bibnum,$subtitle);
1360
1361 modify subtitles in bibliosubtitle table.
1362
1363 =item OLDmodaddauthor($dbh,$bibnum,$author);
1364
1365 adds or modify additional authors
1366 NOTE :  Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
1367
1368 =item $errors = OLDmodsubject($dbh,$bibnum, $force, @subject);
1369
1370 modify/adds subjects
1371
1372 =item OLDmodbibitem($dbh, $biblioitem);
1373
1374 modify a biblioitem
1375
1376 =item OLDmodnote($dbh,$bibitemnum,$note
1377
1378 modify a note for a biblioitem
1379
1380 =item OLDnewbiblioitem($dbh,$biblioitem);
1381
1382 adds a biblioitem ($biblioitem is a hash with the values)
1383
1384 =item OLDnewsubject($dbh,$bibnum);
1385
1386 adds a subject
1387
1388 =item OLDnewsubtitle($dbh,$bibnum,$subtitle);
1389
1390 create a new subtitle
1391
1392 =item ($itemnumber,$errors)= OLDnewitems($dbh,$item,$barcode);
1393
1394 create a item. $item is a hash and $barcode the barcode.
1395
1396 =item OLDmoditem($dbh,$item);
1397
1398 modify item
1399
1400 =item OLDdelitem($dbh,$itemnum);
1401
1402 delete item
1403
1404 =item OLDdeletebiblioitem($dbh,$biblioitemnumber);
1405
1406 deletes a biblioitem
1407 NOTE : not standard sub name. Should be OLDdelbiblioitem()
1408
1409 =item OLDdelbiblio($dbh,$biblio);
1410
1411 delete a biblio
1412
1413 =cut
1414
1415 sub OLDnewbiblio {
1416     my ( $dbh, $biblio ) = @_;
1417
1418     #  my $dbh    = &C4Connect;
1419     my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
1420     $sth->execute;
1421     my $data   = $sth->fetchrow_arrayref;
1422     my $bibnum = $$data[0] + 1;
1423     my $series = 0;
1424
1425     if ( $biblio->{'seriestitle'} ) { $series = 1 }
1426     $sth->finish;
1427     $sth =
1428       $dbh->prepare(
1429 "insert into biblio set biblionumber  = ?, title = ?, author = ?, copyrightdate = ?, serial = ?, seriestitle = ?, notes = ?, abstract = ?, unititle = ?"
1430     );
1431     $sth->execute(
1432         $bibnum,             $biblio->{'title'},
1433         $biblio->{'author'}, $biblio->{'copyrightdate'},
1434         $biblio->{'serial'},             $biblio->{'seriestitle'},
1435         $biblio->{'notes'},  $biblio->{'abstract'},
1436                 $biblio->{'unititle'},
1437     );
1438
1439     $sth->finish;
1440
1441     #  $dbh->disconnect;
1442     return ($bibnum);
1443 }
1444
1445 sub OLDmodbiblio {
1446     my ( $dbh, $biblio ) = @_;
1447
1448     #  my $dbh   = C4Connect;
1449     my $query;
1450     my $sth;
1451
1452     $query = "";
1453     $sth   =
1454       $dbh->prepare(
1455 "Update biblio set title = ?, author = ?, abstract = ?, copyrightdate = ?, seriestitle = ?, serial = ?, unititle = ?, notes = ? where biblionumber = ?"
1456     );
1457     $sth->execute(
1458         $biblio->{'title'},       $biblio->{'author'},
1459         $biblio->{'abstract'},    $biblio->{'copyrightdate'},
1460         $biblio->{'seriestitle'}, $biblio->{'serial'},
1461         $biblio->{'unititle'},    $biblio->{'notes'},
1462         $biblio->{'biblionumber'}
1463     );
1464
1465     $sth->finish;
1466     return ( $biblio->{'biblionumber'} );
1467 }    # sub modbiblio
1468
1469 sub OLDmodsubtitle {
1470     my ( $dbh, $bibnum, $subtitle ) = @_;
1471     my $sth =
1472       $dbh->prepare(
1473         "update bibliosubtitle set subtitle = ? where biblionumber = ?");
1474     $sth->execute( $subtitle, $bibnum );
1475     $sth->finish;
1476 }    # sub modsubtitle
1477
1478 sub OLDmodaddauthor {
1479     my ( $dbh, $bibnum, @authors ) = @_;
1480
1481     #    my $dbh   = C4Connect;
1482     my $sth =
1483       $dbh->prepare("Delete from additionalauthors where biblionumber = ?");
1484
1485     $sth->execute($bibnum);
1486     $sth->finish;
1487     foreach my $author (@authors) {
1488         if ( $author ne '' ) {
1489             $sth =
1490               $dbh->prepare(
1491                 "Insert into additionalauthors set author = ?, biblionumber = ?"
1492             );
1493
1494             $sth->execute( $author, $bibnum );
1495
1496             $sth->finish;
1497         }    # if
1498     }
1499 }    # sub modaddauthor
1500
1501 sub OLDmodsubject {
1502     my ( $dbh, $bibnum, $force, @subject ) = @_;
1503
1504     #  my $dbh   = C4Connect;
1505     my $count = @subject;
1506     my $error;
1507     for ( my $i = 0 ; $i < $count ; $i++ ) {
1508         $subject[$i] =~ s/^ //g;
1509         $subject[$i] =~ s/ $//g;
1510         my $sth =
1511           $dbh->prepare(
1512 "select * from catalogueentry where entrytype = 's' and catalogueentry = ?"
1513         );
1514         $sth->execute( $subject[$i] );
1515
1516         if ( my $data = $sth->fetchrow_hashref ) {
1517         }
1518         else {
1519             if ( $force eq $subject[$i] || $force == 1 ) {
1520
1521                 # subject not in aut, chosen to force anway
1522                 # so insert into cataloguentry so its in auth file
1523                 my $sth2 =
1524                   $dbh->prepare(
1525 "Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)"
1526                 );
1527
1528                 $sth2->execute( $subject[$i] ) if ( $subject[$i] );
1529                 $sth2->finish;
1530             }
1531             else {
1532                 $error =
1533                   "$subject[$i]\n does not exist in the subject authority file";
1534                 my $sth2 =
1535                   $dbh->prepare(
1536 "Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)"
1537                 );
1538                 $sth2->execute( "$subject[$i] %", "% $subject[$i] %",
1539                     "% $subject[$i]" );
1540                 while ( my $data = $sth2->fetchrow_hashref ) {
1541                     $error .= "<br>$data->{'catalogueentry'}";
1542                 }    # while
1543                 $sth2->finish;
1544             }    # else
1545         }    # else
1546         $sth->finish;
1547     }    # else
1548     if ( $error eq '' ) {
1549         my $sth =
1550           $dbh->prepare("Delete from bibliosubject where biblionumber = ?");
1551         $sth->execute($bibnum);
1552         $sth->finish;
1553         $sth =
1554           $dbh->prepare(
1555             "Insert into bibliosubject (subject,biblionumber) values (?,?)");
1556         my $query;
1557         foreach $query (@subject) {
1558             $sth->execute( $query, $bibnum ) if ( $query && $bibnum );
1559         }    # foreach
1560         $sth->finish;
1561     }    # if
1562
1563     #  $dbh->disconnect;
1564     return ($error);
1565 }    # sub modsubject
1566
1567 sub OLDmodbibitem {
1568     my ( $dbh, $biblioitem ) = @_;
1569     my $query;
1570
1571     $biblioitem->{'itemtype'}      = $dbh->quote( $biblioitem->{'itemtype'} );
1572     $biblioitem->{'url'}           = $dbh->quote( $biblioitem->{'url'} );
1573     $biblioitem->{'isbn'}          = $dbh->quote( $biblioitem->{'isbn'} );
1574     $biblioitem->{'issn'}          = $dbh->quote( $biblioitem->{'issn'} );
1575     $biblioitem->{'publishercode'} =
1576       $dbh->quote( $biblioitem->{'publishercode'} );
1577     $biblioitem->{'publicationyear'} =
1578       $dbh->quote( $biblioitem->{'publicationyear'} );
1579     $biblioitem->{'classification'} =
1580       $dbh->quote( $biblioitem->{'classification'} );
1581     $biblioitem->{'dewey'}       = $dbh->quote( $biblioitem->{'dewey'} );
1582     $biblioitem->{'subclass'}    = $dbh->quote( $biblioitem->{'subclass'} );
1583     $biblioitem->{'illus'}       = $dbh->quote( $biblioitem->{'illus'} );
1584     $biblioitem->{'pages'}       = $dbh->quote( $biblioitem->{'pages'} );
1585     $biblioitem->{'volumeddesc'} = $dbh->quote( $biblioitem->{'volumeddesc'} );
1586     $biblioitem->{'bnotes'}      = $dbh->quote( $biblioitem->{'bnotes'} );
1587     $biblioitem->{'size'}        = $dbh->quote( $biblioitem->{'size'} );
1588     $biblioitem->{'place'}       = $dbh->quote( $biblioitem->{'place'} );
1589
1590     $query = "Update biblioitems set
1591 itemtype        = $biblioitem->{'itemtype'},
1592 url             = $biblioitem->{'url'},
1593 isbn            = $biblioitem->{'isbn'},
1594 issn            = $biblioitem->{'issn'},
1595 publishercode   = $biblioitem->{'publishercode'},
1596 publicationyear = $biblioitem->{'publicationyear'},
1597 classification  = $biblioitem->{'classification'},
1598 dewey           = $biblioitem->{'dewey'},
1599 subclass        = $biblioitem->{'subclass'},
1600 illus           = $biblioitem->{'illus'},
1601 pages           = $biblioitem->{'pages'},
1602 volumeddesc     = $biblioitem->{'volumeddesc'},
1603 notes           = $biblioitem->{'bnotes'},
1604 size            = $biblioitem->{'size'},
1605 place           = $biblioitem->{'place'}
1606 where biblioitemnumber = $biblioitem->{'biblioitemnumber'}";
1607
1608     $dbh->do($query);
1609     if ( $dbh->errstr ) {
1610         warn "$query";
1611     }
1612 }    # sub modbibitem
1613
1614 sub OLDmodnote {
1615     my ( $dbh, $bibitemnum, $note ) = @_;
1616
1617     #  my $dbh=C4Connect;
1618     my $query = "update biblioitems set notes='$note' where
1619   biblioitemnumber='$bibitemnum'";
1620     my $sth = $dbh->prepare($query);
1621     $sth->execute;
1622     $sth->finish;
1623
1624     #  $dbh->disconnect;
1625 }
1626
1627 sub OLDnewbiblioitem {
1628     my ( $dbh, $biblioitem ) = @_;
1629
1630     #  my $dbh   = C4Connect;
1631     my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems");
1632     my $data;
1633     my $bibitemnum;
1634
1635     $sth->execute;
1636     $data       = $sth->fetchrow_arrayref;
1637     $bibitemnum = $$data[0] + 1;
1638
1639     $sth->finish;
1640
1641     $sth = $dbh->prepare( "insert into biblioitems set
1642                                                                         biblioitemnumber = ?,           biblionumber     = ?,
1643                                                                         volume           = ?,                   number           = ?,
1644                                                                         classification  = ?,                    itemtype         = ?,
1645                                                                         url              = ?,                           isbn             = ?,
1646                                                                         issn             = ?,                           dewey            = ?,
1647                                                                         subclass         = ?,                           publicationyear  = ?,
1648                                                                         publishercode    = ?,           volumedate       = ?,
1649                                                                         volumeddesc      = ?,           illus            = ?,
1650                                                                         pages            = ?,                           notes            = ?,
1651                                                                         size             = ?,                           lccn             = ?,
1652                                                                         marc             = ?,                           place            = ?"
1653     );
1654     $sth->execute(
1655         $bibitemnum,                     $biblioitem->{'biblionumber'},
1656         $biblioitem->{'volume'},         $biblioitem->{'number'},
1657         $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
1658         $biblioitem->{'url'},            $biblioitem->{'isbn'},
1659         $biblioitem->{'issn'},           $biblioitem->{'dewey'},
1660         $biblioitem->{'subclass'},       $biblioitem->{'publicationyear'},
1661         $biblioitem->{'publishercode'},  $biblioitem->{'volumedate'},
1662         $biblioitem->{'volumeddesc'},    $biblioitem->{'illus'},
1663         $biblioitem->{'pages'},          $biblioitem->{'bnotes'},
1664         $biblioitem->{'size'},           $biblioitem->{'lccn'},
1665         $biblioitem->{'marc'},           $biblioitem->{'place'}
1666     );
1667     $sth->finish;
1668
1669     #    $dbh->disconnect;
1670     return ($bibitemnum);
1671 }
1672
1673 sub OLDnewsubject {
1674     my ( $dbh, $bibnum ) = @_;
1675     my $sth =
1676       $dbh->prepare("insert into bibliosubject (biblionumber) values (?)");
1677     $sth->execute($bibnum);
1678     $sth->finish;
1679 }
1680
1681 sub OLDnewsubtitle {
1682     my ( $dbh, $bibnum, $subtitle ) = @_;
1683     my $sth =
1684       $dbh->prepare(
1685         "insert into bibliosubtitle set biblionumber = ?, subtitle = ?");
1686     $sth->execute( $bibnum, $subtitle ) if $subtitle;
1687     $sth->finish;
1688 }
1689
1690 sub OLDnewitems {
1691     my ( $dbh, $item, $barcode ) = @_;
1692
1693     #  my $dbh   = C4Connect;
1694     my $sth = $dbh->prepare("Select max(itemnumber) from items");
1695     my $data;
1696     my $itemnumber;
1697     my $error = "";
1698
1699     $sth->execute;
1700     $data       = $sth->fetchrow_hashref;
1701     $itemnumber = $data->{'max(itemnumber)'} + 1;
1702     $sth->finish;
1703
1704 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
1705     if ( $item->{'loan'} ) {
1706         $item->{'notforloan'} = $item->{'loan'};
1707     }
1708
1709     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1710     if ( $item->{'dateaccessioned'} ) {
1711         $sth = $dbh->prepare( "Insert into items set
1712                                                         itemnumber           = ?,                       biblionumber         = ?,
1713                                                         multivolumepart      = ?,
1714                                                         biblioitemnumber     = ?,                       barcode              = ?,
1715                                                         booksellerid         = ?,                       dateaccessioned      = ?,
1716                                                         homebranch           = ?,                       holdingbranch        = ?,
1717                                                         price                = ?,                       replacementprice     = ?,
1718                                                         replacementpricedate = NOW(),           datelastseen            = NOW(),
1719                                                         multivolume                     = ?,                    stack                           = ?,
1720                                                         itemlost                        = ?,                    wthdrawn                        = ?,
1721                                                         paidfor                         = ?,                    itemnotes            = ?,
1722                                                         itemcallnumber  =?,                                                     notforloan = ?,
1723                                                         location = ?
1724                                                         "
1725         );
1726         $sth->execute(
1727                         $itemnumber,                            $item->{'biblionumber'},
1728                         $item->{'multivolumepart'},
1729                         $item->{'biblioitemnumber'},$barcode,
1730                         $item->{'booksellerid'},        $item->{'dateaccessioned'},
1731                         $item->{'homebranch'},          $item->{'holdingbranch'},
1732                         $item->{'price'},                       $item->{'replacementprice'},
1733                         $item->{multivolume},           $item->{stack},
1734                         $item->{itemlost},                      $item->{wthdrawn},
1735                         $item->{paidfor},                       $item->{'itemnotes'},
1736                         $item->{'itemcallnumber'},      $item->{'notforloan'},
1737                         $item->{'location'}
1738         );
1739     }
1740     else {
1741         $sth = $dbh->prepare( "Insert into items set
1742                                                         itemnumber           = ?,                       biblionumber         = ?,
1743                                                         multivolumepart      = ?,
1744                                                         biblioitemnumber     = ?,                       barcode              = ?,
1745                                                         booksellerid         = ?,                       dateaccessioned      = NOW(),
1746                                                         homebranch           = ?,                       holdingbranch        = ?,
1747                                                         price                = ?,                       replacementprice     = ?,
1748                                                         replacementpricedate = NOW(),           datelastseen            = NOW(),
1749                                                         multivolume                     = ?,                    stack                           = ?,
1750                                                         itemlost                        = ?,                    wthdrawn                        = ?,
1751                                                         paidfor                         = ?,                    itemnotes            = ?,
1752                                                         itemcallnumber  =?,                                                     notforloan = ?,
1753                                                         location = ?
1754                                                         "
1755         );
1756         $sth->execute(
1757                         $itemnumber,                            $item->{'biblionumber'},
1758                         $item->{'multivolumepart'},
1759                         $item->{'biblioitemnumber'},$barcode,
1760                         $item->{'booksellerid'},
1761                         $item->{'homebranch'},          $item->{'holdingbranch'},
1762                         $item->{'price'},                       $item->{'replacementprice'},
1763                         $item->{multivolume},           $item->{stack},
1764                         $item->{itemlost},                      $item->{wthdrawn},
1765                         $item->{paidfor},                       $item->{'itemnotes'},
1766                         $item->{'itemcallnumber'},      $item->{'notforloan'},
1767                         $item->{'location'}
1768         );
1769     }
1770     if ( defined $sth->errstr ) {
1771         $error .= $sth->errstr;
1772     }
1773     $sth->finish;
1774     return ( $itemnumber, $error );
1775 }
1776
1777 sub OLDmoditem {
1778     my ( $dbh, $item ) = @_;
1779     $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
1780     my $query = "update items set  barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1781     my @bind = (
1782         $item->{'barcode'},                     $item->{'notes'},
1783         $item->{'itemcallnumber'},      $item->{'notforloan'},
1784         $item->{'location'},            $item->{multivolumepart},
1785                 $item->{multivolume},           $item->{stack},
1786                 $item->{wthdrawn},
1787     );
1788     if ( $item->{'lost'} ne '' ) {
1789         $query = "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
1790                                                         itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
1791                                                         location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1792         @bind = (
1793             $item->{'bibitemnum'},     $item->{'barcode'},
1794             $item->{'notes'},          $item->{'homebranch'},
1795             $item->{'lost'},           $item->{'wthdrawn'},
1796             $item->{'itemcallnumber'}, $item->{'notforloan'},
1797             $item->{'location'},                $item->{multivolumepart},
1798                         $item->{multivolume},           $item->{stack},
1799                         $item->{wthdrawn},
1800         );
1801                 if ($item->{homebranch}) {
1802                         $query.=",homebranch=?";
1803                         push @bind, $item->{homebranch};
1804                 }
1805                 if ($item->{holdingbranch}) {
1806                         $query.=",holdingbranch=?";
1807                         push @bind, $item->{holdingbranch};
1808                 }
1809     }
1810         $query.=" where itemnumber=?";
1811         push @bind,$item->{'itemnum'};
1812    if ( $item->{'replacement'} ne '' ) {
1813         $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1814     }
1815     my $sth = $dbh->prepare($query);
1816     $sth->execute(@bind);
1817     $sth->finish;
1818
1819     #  $dbh->disconnect;
1820 }
1821
1822 sub OLDdelitem {
1823     my ( $dbh, $itemnum ) = @_;
1824
1825     #  my $dbh=C4Connect;
1826     my $sth = $dbh->prepare("select * from items where itemnumber=?");
1827     $sth->execute($itemnum);
1828     my $data = $sth->fetchrow_hashref;
1829     $sth->finish;
1830     my $query = "Insert into deleteditems set ";
1831     my @bind  = ();
1832     foreach my $temp ( keys %$data ) {
1833         $query .= "$temp = ?,";
1834         push ( @bind, $data->{$temp} );
1835     }
1836     $query =~ s/\,$//;
1837
1838     #  print $query;
1839     $sth = $dbh->prepare($query);
1840     $sth->execute(@bind);
1841     $sth->finish;
1842     $sth = $dbh->prepare("Delete from items where itemnumber=?");
1843     $sth->execute($itemnum);
1844     $sth->finish;
1845
1846     #  $dbh->disconnect;
1847 }
1848
1849 sub OLDdeletebiblioitem {
1850     my ( $dbh, $biblioitemnumber ) = @_;
1851
1852     #    my $dbh   = C4Connect;
1853     my $sth = $dbh->prepare( "Select * from biblioitems
1854 where biblioitemnumber = ?"
1855     );
1856     my $results;
1857
1858     $sth->execute($biblioitemnumber);
1859
1860     if ( $results = $sth->fetchrow_hashref ) {
1861         $sth->finish;
1862         $sth =
1863           $dbh->prepare(
1864 "Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
1865                                         isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
1866                                         pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
1867         );
1868
1869         $sth->execute(
1870             $results->{biblioitemnumber}, $results->{biblionumber},
1871             $results->{volume},           $results->{number},
1872             $results->{classification},   $results->{itemtype},
1873             $results->{isbn},             $results->{issn},
1874             $results->{dewey},            $results->{subclass},
1875             $results->{publicationyear},  $results->{publishercode},
1876             $results->{volumedate},       $results->{volumeddesc},
1877             $results->{timestamp},        $results->{illus},
1878             $results->{pages},            $results->{notes},
1879             $results->{size},             $results->{url},
1880             $results->{lccn}
1881         );
1882         my $sth2 =
1883           $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?");
1884         $sth2->execute($biblioitemnumber);
1885         $sth2->finish();
1886     }    # if
1887     $sth->finish;
1888
1889     # Now delete all the items attached to the biblioitem
1890     $sth = $dbh->prepare("Select * from items where biblioitemnumber = ?");
1891     $sth->execute($biblioitemnumber);
1892     my @results;
1893     while ( my $data = $sth->fetchrow_hashref ) {
1894         my $query = "Insert into deleteditems set ";
1895         my @bind  = ();
1896         foreach my $temp ( keys %$data ) {
1897             $query .= "$temp = ?,";
1898             push ( @bind, $data->{$temp} );
1899         }
1900         $query =~ s/\,$//;
1901         my $sth2 = $dbh->prepare($query);
1902         $sth2->execute(@bind);
1903     }    # while
1904     $sth->finish;
1905     $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
1906     $sth->execute($biblioitemnumber);
1907     $sth->finish();
1908
1909     #    $dbh->disconnect;
1910 }    # sub deletebiblioitem
1911
1912 sub OLDdelbiblio {
1913     my ( $dbh, $biblio ) = @_;
1914     my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
1915     $sth->execute($biblio);
1916     if ( my $data = $sth->fetchrow_hashref ) {
1917         $sth->finish;
1918         my $query = "Insert into deletedbiblio set ";
1919         my @bind  = ();
1920         foreach my $temp ( keys %$data ) {
1921             $query .= "$temp = ?,";
1922             push ( @bind, $data->{$temp} );
1923         }
1924
1925         #replacing the last , by ",?)"
1926         $query =~ s/\,$//;
1927         $sth = $dbh->prepare($query);
1928         $sth->execute(@bind);
1929         $sth->finish;
1930         $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
1931         $sth->execute($biblio);
1932         $sth->finish;
1933     }
1934     $sth->finish;
1935 }
1936
1937 #
1938 #
1939 # old functions
1940 #
1941 #
1942
1943 sub itemcount {
1944     my ($biblio) = @_;
1945     my $dbh = C4::Context->dbh;
1946
1947     #  print $query;
1948     my $sth = $dbh->prepare("Select count(*) from items where biblionumber=?");
1949     $sth->execute($biblio);
1950     my $data = $sth->fetchrow_hashref;
1951     $sth->finish;
1952     return ( $data->{'count(*)'} );
1953 }
1954
1955 sub newbiblio {
1956     my ($biblio) = @_;
1957     my $dbh    = C4::Context->dbh;
1958     my $bibnum = OLDnewbiblio( $dbh, $biblio );
1959     # finds new (MARC bibid
1960     #   my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1961     my $record = &MARCkoha2marcBiblio( $dbh, $bibnum );
1962     MARCaddbiblio( $dbh, $record, $bibnum,'' );
1963     return ($bibnum);
1964 }
1965
1966 =item modbiblio
1967
1968   $biblionumber = &modbiblio($biblio);
1969
1970 Update a biblio record.
1971
1972 C<$biblio> is a reference-to-hash whose keys are the fields in the
1973 biblio table in the Koha database. All fields must be present, not
1974 just the ones you wish to change.
1975
1976 C<&modbiblio> updates the record defined by
1977 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1978
1979 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1980 successful or not.
1981
1982 =cut
1983
1984 sub modbiblio {
1985         my ($biblio) = @_;
1986         my $dbh  = C4::Context->dbh;
1987         my $biblionumber=OLDmodbiblio($dbh,$biblio);
1988         my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
1989         # finds new (MARC bibid
1990         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
1991         MARCmodbiblio($dbh,$bibid,$record,"",0);
1992         return($biblionumber);
1993 } # sub modbiblio
1994
1995 =item modsubtitle
1996
1997   &modsubtitle($biblionumber, $subtitle);
1998
1999 Sets the subtitle of a book.
2000
2001 C<$biblionumber> is the biblionumber of the book to modify.
2002
2003 C<$subtitle> is the new subtitle.
2004
2005 =cut
2006
2007 sub modsubtitle {
2008     my ( $bibnum, $subtitle ) = @_;
2009     my $dbh = C4::Context->dbh;
2010     &OLDmodsubtitle( $dbh, $bibnum, $subtitle );
2011 }    # sub modsubtitle
2012
2013 =item modaddauthor
2014
2015   &modaddauthor($biblionumber, $author);
2016
2017 Replaces all additional authors for the book with biblio number
2018 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
2019 C<&modaddauthor> deletes all additional authors.
2020
2021 =cut
2022
2023 sub modaddauthor {
2024     my ( $bibnum, @authors ) = @_;
2025     my $dbh = C4::Context->dbh;
2026     &OLDmodaddauthor( $dbh, $bibnum, @authors );
2027 }    # sub modaddauthor
2028
2029 =item modsubject
2030
2031   $error = &modsubject($biblionumber, $force, @subjects);
2032
2033 $force - a subject to force
2034
2035 $error - Error message, or undef if successful.
2036
2037 =cut
2038
2039 sub modsubject {
2040     my ( $bibnum, $force, @subject ) = @_;
2041     my $dbh = C4::Context->dbh;
2042     my $error = &OLDmodsubject( $dbh, $bibnum, $force, @subject );
2043     if ($error eq ''){
2044                 # When MARC is off, ensures that the MARC biblio table gets updated with new
2045                 # subjects, of course, it deletes the biblio in marc, and then recreates.
2046                 # This check is to ensure that no MARC data exists to lose.
2047                 if (C4::Context->preference("MARC") eq '0'){
2048                         my $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibnum);
2049                         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
2050                         &MARCmodbiblio($dbh,$bibid, $MARCRecord);
2051                 }
2052         }
2053         return ($error);
2054 }    # sub modsubject
2055
2056 sub modbibitem {
2057     my ($biblioitem) = @_;
2058     my $dbh = C4::Context->dbh;
2059     &OLDmodbibitem( $dbh, $biblioitem );
2060 }    # sub modbibitem
2061
2062 sub modnote {
2063     my ( $bibitemnum, $note ) = @_;
2064     my $dbh = C4::Context->dbh;
2065     &OLDmodnote( $dbh, $bibitemnum, $note );
2066 }
2067
2068 sub newbiblioitem {
2069     my ($biblioitem) = @_;
2070     my $dbh        = C4::Context->dbh;
2071     my $bibitemnum = &OLDnewbiblioitem( $dbh, $biblioitem );
2072
2073     my $MARCbiblio =
2074       MARCkoha2marcBiblio( $dbh, 0, $bibitemnum )
2075       ; # the 0 means "do NOT retrieve biblio, only biblioitem, in the MARC record
2076     my $bibid =
2077       &MARCfind_MARCbibid_from_oldbiblionumber( $dbh,
2078         $biblioitem->{biblionumber} );
2079     &MARCaddbiblio( $dbh, $MARCbiblio, $biblioitem->{biblionumber}, '',$bibid );
2080     return ($bibitemnum);
2081 }
2082
2083 sub newsubject {
2084     my ($bibnum) = @_;
2085     my $dbh = C4::Context->dbh;
2086     &OLDnewsubject( $dbh, $bibnum );
2087 }
2088
2089 sub newsubtitle {
2090     my ( $bibnum, $subtitle ) = @_;
2091     my $dbh = C4::Context->dbh;
2092     &OLDnewsubtitle( $dbh, $bibnum, $subtitle );
2093 }
2094
2095 sub newitems {
2096     my ( $item, @barcodes ) = @_;
2097     my $dbh = C4::Context->dbh;
2098     my $errors;
2099     my $itemnumber;
2100     my $error;
2101     foreach my $barcode (@barcodes) {
2102         ( $itemnumber, $error ) = &OLDnewitems( $dbh, $item, uc($barcode) );
2103         $errors .= $error;
2104         my $MARCitem =
2105           &MARCkoha2marcItem( $dbh, $item->{biblionumber}, $itemnumber );
2106         &MARCadditem( $dbh, $MARCitem, $item->{biblionumber} );
2107     }
2108     return ($errors);
2109 }
2110
2111 sub moditem {
2112     my ($item) = @_;
2113     my $dbh = C4::Context->dbh;
2114     &OLDmoditem( $dbh, $item );
2115     my $MARCitem =
2116       &MARCkoha2marcItem( $dbh, $item->{'biblionumber'}, $item->{'itemnum'} );
2117     my $bibid =
2118       &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $item->{biblionumber} );
2119     &MARCmoditem( $dbh, $MARCitem, $bibid, $item->{itemnum}, 0 );
2120 }
2121
2122 sub checkitems {
2123     my ( $count, @barcodes ) = @_;
2124     my $dbh = C4::Context->dbh;
2125     my $error;
2126     my $sth = $dbh->prepare("Select * from items where barcode=?");
2127     for ( my $i = 0 ; $i < $count ; $i++ ) {
2128         $barcodes[$i] = uc $barcodes[$i];
2129         $sth->execute( $barcodes[$i] );
2130         if ( my $data = $sth->fetchrow_hashref ) {
2131             $error .= " Duplicate Barcode: $barcodes[$i]";
2132         }
2133     }
2134     $sth->finish;
2135     return ($error);
2136 }
2137
2138 sub countitems {
2139     my ($bibitemnum) = @_;
2140     my $dbh   = C4::Context->dbh;
2141     my $query = "";
2142     my $sth   =
2143       $dbh->prepare("Select count(*) from items where biblioitemnumber=?");
2144     $sth->execute($bibitemnum);
2145     my $data = $sth->fetchrow_hashref;
2146     $sth->finish;
2147     return ( $data->{'count(*)'} );
2148 }
2149
2150 sub delitem {
2151     my ($itemnum) = @_;
2152     my $dbh = C4::Context->dbh;
2153     &OLDdelitem( $dbh, $itemnum );
2154 }
2155
2156 sub deletebiblioitem {
2157     my ($biblioitemnumber) = @_;
2158     my $dbh = C4::Context->dbh;
2159     &OLDdeletebiblioitem( $dbh, $biblioitemnumber );
2160 }    # sub deletebiblioitem
2161
2162 sub delbiblio {
2163     my ($biblio) = @_;
2164     my $dbh = C4::Context->dbh;
2165     &OLDdelbiblio( $dbh, $biblio );
2166     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio );
2167     &MARCdelbiblio( $dbh, $bibid, 0 );
2168 }
2169
2170 sub getbiblio {
2171     my ($biblionumber) = @_;
2172     my $dbh = C4::Context->dbh;
2173     my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
2174
2175     # || die "Cannot prepare $query\n" . $dbh->errstr;
2176     my $count = 0;
2177     my @results;
2178
2179     $sth->execute($biblionumber);
2180
2181     # || die "Cannot execute $query\n" . $sth->errstr;
2182     while ( my $data = $sth->fetchrow_hashref ) {
2183         $results[$count] = $data;
2184         $count++;
2185     }    # while
2186
2187     $sth->finish;
2188     return ( $count, @results );
2189 }    # sub getbiblio
2190
2191 sub getbiblioitem {
2192     my ($biblioitemnum) = @_;
2193     my $dbh = C4::Context->dbh;
2194     my $sth = $dbh->prepare( "Select * from biblioitems where
2195 biblioitemnumber = ?"
2196     );
2197     my $count = 0;
2198     my @results;
2199
2200     $sth->execute($biblioitemnum);
2201
2202     while ( my $data = $sth->fetchrow_hashref ) {
2203         $results[$count] = $data;
2204         $count++;
2205     }    # while
2206
2207     $sth->finish;
2208     return ( $count, @results );
2209 }    # sub getbiblioitem
2210
2211 sub getbiblioitembybiblionumber {
2212     my ($biblionumber) = @_;
2213     my $dbh = C4::Context->dbh;
2214     my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
2215     my $count = 0;
2216     my @results;
2217
2218     $sth->execute($biblionumber);
2219
2220     while ( my $data = $sth->fetchrow_hashref ) {
2221         $results[$count] = $data;
2222         $count++;
2223     }    # while
2224
2225     $sth->finish;
2226     return ( $count, @results );
2227 }    # sub
2228
2229 sub getitemtypes {
2230     my $dbh   = C4::Context->dbh;
2231     my $query = "select * from itemtypes order by description";
2232     my $sth   = $dbh->prepare($query);
2233
2234     # || die "Cannot prepare $query" . $dbh->errstr;      
2235     my $count = 0;
2236     my @results;
2237
2238     $sth->execute;
2239
2240     # || die "Cannot execute $query\n" . $sth->errstr;
2241     while ( my $data = $sth->fetchrow_hashref ) {
2242         $results[$count] = $data;
2243         $count++;
2244     }    # while
2245
2246     $sth->finish;
2247     return ( $count, @results );
2248 }    # sub getitemtypes
2249
2250 sub getitemsbybiblioitem {
2251     my ($biblioitemnum) = @_;
2252     my $dbh = C4::Context->dbh;
2253     my $sth = $dbh->prepare( "Select * from items, biblio where
2254 biblio.biblionumber = items.biblionumber and biblioitemnumber
2255 = ?"
2256     );
2257
2258     # || die "Cannot prepare $query\n" . $dbh->errstr;
2259     my $count = 0;
2260     my @results;
2261
2262     $sth->execute($biblioitemnum);
2263
2264     # || die "Cannot execute $query\n" . $sth->errstr;
2265     while ( my $data = $sth->fetchrow_hashref ) {
2266         $results[$count] = $data;
2267         $count++;
2268     }    # while
2269
2270     $sth->finish;
2271     return ( $count, @results );
2272 }    # sub getitemsbybiblioitem
2273
2274 sub logchange {
2275
2276     # Subroutine to log changes to databases
2277 # Eventually, this subroutine will be used to create a log of all changes made,
2278     # with the possibility of "undo"ing some changes
2279     my $database = shift;
2280     if ( $database eq 'kohadb' ) {
2281         my $type     = shift;
2282         my $section  = shift;
2283         my $item     = shift;
2284         my $original = shift;
2285         my $new      = shift;
2286
2287         #       print STDERR "KOHA: $type $section $item $original $new\n";
2288     }
2289     elsif ( $database eq 'marc' ) {
2290         my $type        = shift;
2291         my $Record_ID   = shift;
2292         my $tag         = shift;
2293         my $mark        = shift;
2294         my $subfield_ID = shift;
2295         my $original    = shift;
2296         my $new         = shift;
2297
2298 #       print STDERR "MARC: $type $Record_ID $tag $mark $subfield_ID $original $new\n";
2299     }
2300 }
2301
2302 #------------------------------------------------
2303
2304 #---------------------------------------
2305 # Find a biblio entry, or create a new one if it doesn't exist.
2306 #  If a "subtitle" entry is in hash, add it to subtitle table
2307 sub getoraddbiblio {
2308
2309     # input params
2310     my (
2311         $dbh,       # db handle
2312                     # FIXME - Unused argument
2313         $biblio,    # hash ref to fields
2314     ) = @_;
2315
2316     # return
2317     my $biblionumber;
2318
2319     my $debug = 0;
2320     my $sth;
2321     my $error;
2322
2323     #-----
2324     $dbh = C4::Context->dbh;
2325
2326     print "<PRE>Looking for biblio </PRE>\n" if $debug;
2327     $sth = $dbh->prepare( "select biblionumber
2328                 from biblio
2329                 where title=? and author=?
2330                   and copyrightdate=? and seriestitle=?"
2331     );
2332     $sth->execute(
2333         $biblio->{title},     $biblio->{author},
2334         $biblio->{copyright}, $biblio->{seriestitle}
2335     );
2336     if ( $sth->rows ) {
2337         ($biblionumber) = $sth->fetchrow;
2338         print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
2339     }
2340     else {
2341
2342         # Doesn't exist.  Add new one.
2343         print "<PRE>Adding biblio</PRE>\n" if $debug;
2344         ( $biblionumber, $error ) = &newbiblio($biblio);
2345         if ($biblionumber) {
2346             print "<PRE>Added with biblio number=$biblionumber</PRE>\n"
2347               if $debug;
2348             if ( $biblio->{subtitle} ) {
2349                 &newsubtitle( $biblionumber, $biblio->{subtitle} );
2350             }    # if subtitle
2351         }
2352         else {
2353             print "<PRE>Couldn't add biblio: $error</PRE>\n" if $debug;
2354         }    # if added
2355     }
2356
2357     return $biblionumber, $error;
2358
2359 }    # sub getoraddbiblio
2360
2361 sub char_decode {
2362
2363     # converts ISO 5426 coded string to ISO 8859-1
2364     # sloppy code : should be improved in next issue
2365     my ( $string, $encoding ) = @_;
2366     $_ = $string;
2367
2368     #   $encoding = C4::Context->preference("marcflavour") unless $encoding;
2369     if ( $encoding eq "UNIMARC" ) {
2370 #         s/\xe1/Æ/gm;
2371         s/\xe2/Ð/gm;
2372         s/\xe9/Ø/gm;
2373         s/\xec/þ/gm;
2374         s/\xf1/æ/gm;
2375         s/\xf3/ð/gm;
2376         s/\xf9/ø/gm;
2377         s/\xfb/ß/gm;
2378         s/\xc1\x61/à/gm;
2379         s/\xc1\x65/è/gm;
2380         s/\xc1\x69/ì/gm;
2381         s/\xc1\x6f/ò/gm;
2382         s/\xc1\x75/ù/gm;
2383         s/\xc1\x41/À/gm;
2384         s/\xc1\x45/È/gm;
2385         s/\xc1\x49/Ì/gm;
2386         s/\xc1\x4f/Ò/gm;
2387         s/\xc1\x55/Ù/gm;
2388         s/\xc2\x41/Á/gm;
2389         s/\xc2\x45/É/gm;
2390         s/\xc2\x49/Í/gm;
2391         s/\xc2\x4f/Ó/gm;
2392         s/\xc2\x55/Ú/gm;
2393         s/\xc2\x59/Ý/gm;
2394         s/\xc2\x61/á/gm;
2395         s/\xc2\x65/é/gm;
2396         s/\xc2\x69/í/gm;
2397         s/\xc2\x6f/ó/gm;
2398         s/\xc2\x75/ú/gm;
2399         s/\xc2\x79/ý/gm;
2400         s/\xc3\x41/Â/gm;
2401         s/\xc3\x45/Ê/gm;
2402         s/\xc3\x49/Î/gm;
2403         s/\xc3\x4f/Ô/gm;
2404         s/\xc3\x55/Û/gm;
2405         s/\xc3\x61/â/gm;
2406         s/\xc3\x65/ê/gm;
2407         s/\xc3\x69/î/gm;
2408         s/\xc3\x6f/ô/gm;
2409         s/\xc3\x75/û/gm;
2410         s/\xc4\x41/Ã/gm;
2411         s/\xc4\x4e/Ñ/gm;
2412         s/\xc4\x4f/Õ/gm;
2413         s/\xc4\x61/ã/gm;
2414         s/\xc4\x6e/ñ/gm;
2415         s/\xc4\x6f/õ/gm;
2416         s/\xc8\x41/Ä/gm;
2417         s/\xc8\x45/Ë/gm;
2418         s/\xc8\x49/Ï/gm;
2419         s/\xc8\x61/ä/gm;
2420         s/\xc8\x65/ë/gm;
2421         s/\xc8\x69/ï/gm;
2422         s/\xc8\x6F/ö/gm;
2423         s/\xc8\x75/ü/gm;
2424         s/\xc8\x76/ÿ/gm;
2425         s/\xc9\x41/Ä/gm;
2426         s/\xc9\x45/Ë/gm;
2427         s/\xc9\x49/Ï/gm;
2428         s/\xc9\x4f/Ö/gm;
2429         s/\xc9\x55/Ü/gm;
2430         s/\xc9\x61/ä/gm;
2431         s/\xc9\x6f/ö/gm;
2432         s/\xc9\x75/ü/gm;
2433         s/\xca\x41/Å/gm;
2434         s/\xca\x61/å/gm;
2435         s/\xd0\x43/Ç/gm;
2436         s/\xd0\x63/ç/gm;
2437
2438         # this handles non-sorting blocks (if implementation requires this)
2439         $string = nsb_clean($_);
2440     }
2441     elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2442         if (/[\xc1-\xff]/) {
2443             s/\xe1\x61/à/gm;
2444             s/\xe1\x65/è/gm;
2445             s/\xe1\x69/ì/gm;
2446             s/\xe1\x6f/ò/gm;
2447             s/\xe1\x75/ù/gm;
2448             s/\xe1\x41/À/gm;
2449             s/\xe1\x45/È/gm;
2450             s/\xe1\x49/Ì/gm;
2451             s/\xe1\x4f/Ò/gm;
2452             s/\xe1\x55/Ù/gm;
2453             s/\xe2\x41/Á/gm;
2454             s/\xe2\x45/É/gm;
2455             s/\xe2\x49/Í/gm;
2456             s/\xe2\x4f/Ó/gm;
2457             s/\xe2\x55/Ú/gm;
2458             s/\xe2\x59/Ý/gm;
2459             s/\xe2\x61/á/gm;
2460             s/\xe2\x65/é/gm;
2461             s/\xe2\x69/í/gm;
2462             s/\xe2\x6f/ó/gm;
2463             s/\xe2\x75/ú/gm;
2464             s/\xe2\x79/ý/gm;
2465             s/\xe3\x41/Â/gm;
2466             s/\xe3\x45/Ê/gm;
2467             s/\xe3\x49/Î/gm;
2468             s/\xe3\x4f/Ô/gm;
2469             s/\xe3\x55/Û/gm;
2470             s/\xe3\x61/â/gm;
2471             s/\xe3\x65/ê/gm;
2472             s/\xe3\x69/î/gm;
2473             s/\xe3\x6f/ô/gm;
2474             s/\xe3\x75/û/gm;
2475             s/\xe4\x41/Ã/gm;
2476             s/\xe4\x4e/Ñ/gm;
2477             s/\xe4\x4f/Õ/gm;
2478             s/\xe4\x61/ã/gm;
2479             s/\xe4\x6e/ñ/gm;
2480             s/\xe4\x6f/õ/gm;
2481             s/\xe8\x45/Ë/gm;
2482             s/\xe8\x49/Ï/gm;
2483             s/\xe8\x65/ë/gm;
2484             s/\xe8\x69/ï/gm;
2485             s/\xe8\x76/ÿ/gm;
2486             s/\xe9\x41/Ä/gm;
2487             s/\xe9\x4f/Ö/gm;
2488             s/\xe9\x55/Ü/gm;
2489             s/\xe9\x61/ä/gm;
2490             s/\xe9\x6f/ö/gm;
2491             s/\xe9\x75/ü/gm;
2492             s/\xea\x41/Å/gm;
2493             s/\xea\x61/å/gm;
2494
2495             # this handles non-sorting blocks (if implementation requires this)
2496             $string = nsb_clean($_);
2497         }
2498     }
2499     return ($string);
2500 }
2501
2502 sub nsb_clean {
2503     my $NSB = '\x88';    # NSB : begin Non Sorting Block
2504     my $NSE = '\x89';    # NSE : Non Sorting Block end
2505                          # handles non sorting blocks
2506     my ($string) = @_;
2507     $_ = $string;
2508     s/$NSB/(/gm;
2509     s/[ ]{0,1}$NSE/) /gm;
2510     $string = $_;
2511     return ($string);
2512 }
2513
2514 sub FindDuplicate {
2515         my ($record)=@_;
2516         my $dbh = C4::Context->dbh;
2517         my $result = MARCmarc2koha($dbh,$record,'');
2518         my $sth;
2519         my ($biblionumber,$bibid,$title);
2520         # search duplicate on ISBN, easy and fast...
2521         if ($result->{isbn}) {
2522                 $sth = $dbh->prepare("select biblio.biblionumber,bibid,title from biblio,biblioitems,marc_biblio where biblio.biblionumber=biblioitems.biblionumber and marc_biblio.biblionumber=biblioitems.biblionumber and isbn=?");
2523                 $sth->execute($result->{'isbn'});
2524                 ($biblionumber,$bibid,$title) = $sth->fetchrow;
2525                 return $biblionumber,$bibid,$title if ($biblionumber);
2526         }
2527         # a more complex search : build a request for SearchMarc::catalogsearch()
2528         my (@tags, @and_or, @excluding, @operator, @value, $offset,$length);
2529         # search on biblio.title
2530         my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.title","");
2531         if ($record->field($tag)) {
2532                 if ($record->field($tag)->subfields($subfield)) {
2533                         push @tags, "'".$tag.$subfield."'";
2534                         push @and_or, "and";
2535                         push @excluding, "";
2536                         push @operator, "contains";
2537                         push @value, $record->field($tag)->subfield($subfield);
2538 #                       warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2539                 }
2540         }
2541         # ... and on biblio.author
2542         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.author","");
2543         if ($record->field($tag)) {
2544                 if ($record->field($tag)->subfields($subfield)) {
2545                         push @tags, "'".$tag.$subfield."'";
2546                         push @and_or, "and";
2547                         push @excluding, "";
2548                         push @operator, "contains";
2549                         push @value, $record->field($tag)->subfield($subfield);
2550 #                       warn "for author, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2551                 }
2552         }
2553         # ... and on publicationyear.
2554         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publicationyear","");
2555         if ($record->field($tag)) {
2556                 if ($record->field($tag)->subfields($subfield)) {
2557                         push @tags, "'".$tag.$subfield."'";
2558                         push @and_or, "and";
2559                         push @excluding, "";
2560                         push @operator, "=";
2561                         push @value, $record->field($tag)->subfield($subfield);
2562 #                       warn "for publicationyear, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2563                 }
2564         }
2565         # ... and on size.
2566         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.size","");
2567         if ($record->field($tag)) {
2568                 if ($record->field($tag)->subfields($subfield)) {
2569                         push @tags, "'".$tag.$subfield."'";
2570                         push @and_or, "and";
2571                         push @excluding, "";
2572                         push @operator, "=";
2573                         push @value, $record->field($tag)->subfield($subfield);
2574 #                       warn "for size, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2575                 }
2576         }
2577         # ... and on publisher.
2578         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publishercode","");
2579         if ($record->field($tag)) {
2580                 if ($record->field($tag)->subfields($subfield)) {
2581                         push @tags, "'".$tag.$subfield."'";
2582                         push @and_or, "and";
2583                         push @excluding, "";
2584                         push @operator, "=";
2585                         push @value, $record->field($tag)->subfield($subfield);
2586 #                       warn "for publishercode, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2587                 }
2588         }
2589         # ... and on volume.
2590         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.volume","");
2591         if ($record->field($tag)) {
2592                 if ($record->field($tag)->subfields($subfield)) {
2593                         push @tags, "'".$tag.$subfield."'";
2594                         push @and_or, "and";
2595                         push @excluding, "";
2596                         push @operator, "=";
2597                         push @value, $record->field($tag)->subfield($subfield);
2598 #                       warn "for volume, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2599                 }
2600         }
2601
2602         my ($finalresult,$nbresult) = C4::SearchMarc::catalogsearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10);
2603         # there is at least 1 result => return the 1st one
2604         if ($nbresult) {
2605 #               warn "$nbresult => ".@$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2606                 return @$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2607         }
2608         # no result, returns nothing
2609         return;
2610 }
2611
2612 sub DisplayISBN {
2613         my ($isbn)=@_;
2614         my $seg1;
2615         if(substr($isbn, 0, 1) <=7) {
2616                 $seg1 = substr($isbn, 0, 1);
2617         } elsif(substr($isbn, 0, 2) <= 94) {
2618                 $seg1 = substr($isbn, 0, 2);
2619         } elsif(substr($isbn, 0, 3) <= 995) {
2620                 $seg1 = substr($isbn, 0, 3);
2621         } elsif(substr($isbn, 0, 4) <= 9989) {
2622                 $seg1 = substr($isbn, 0, 4);
2623         } else {
2624                 $seg1 = substr($isbn, 0, 5);
2625         }
2626         my $x = substr($isbn, length($seg1));
2627         my $seg2;
2628         if(substr($x, 0, 2) <= 19) {
2629 #               if(sTmp2 < 10) sTmp2 = "0" sTmp2;
2630                 $seg2 = substr($x, 0, 2);
2631         } elsif(substr($x, 0, 3) <= 699) {
2632                 $seg2 = substr($x, 0, 3);
2633         } elsif(substr($x, 0, 4) <= 8399) {
2634                 $seg2 = substr($x, 0, 4);
2635         } elsif(substr($x, 0, 5) <= 89999) {
2636                 $seg2 = substr($x, 0, 5);
2637         } elsif(substr($x, 0, 6) <= 9499999) {
2638                 $seg2 = substr($x, 0, 6);
2639         } else {
2640                 $seg2 = substr($x, 0, 7);
2641         }
2642         my $seg3=substr($x,length($seg2));
2643         $seg3=substr($seg3,0,length($seg3)-1) ;
2644         my $seg4 = substr($x, -1, 1);
2645         return "$seg1-$seg2-$seg3-$seg4";
2646 }
2647
2648
2649 END { }    # module clean-up code here (global destructor)
2650
2651 =back
2652
2653 =head1 AUTHOR
2654
2655 Koha Developement team <info@koha.org>
2656
2657 Paul POULAIN paul.poulain@free.fr
2658
2659 =cut
2660
2661 # $Id$
2662 # $Log$
2663 # Revision 1.123  2005/08/09 14:10:28  tipaul
2664 # 1st commit to go to zebra.
2665 # don't update your cvs if you want to have a working head...
2666 #
2667 # this commit contains :
2668 # * updater/updatedatabase : get rid with marc_* tables, but DON'T remove them. As a lot of things uses them, it would not be a good idea for instance to drop them. If you really want to play, you can rename them to test head without them but being still able to reintroduce them...
2669 # * Biblio.pm : modify MARCgetbiblio to find the raw marc record in biblioitems.marc field, not from marc_subfield_table, modify MARCfindframeworkcode to find frameworkcode in biblio.frameworkcode, modify some other subs to use biblio.biblionumber & get rid of bibid.
2670 # * other files : get rid of bibid and use biblionumber instead.
2671 #
2672 # What is broken :
2673 # * does not do anything on zebra yet.
2674 # * if you rename marc_subfield_table, you can't search anymore.
2675 # * you can view a biblio & bibliodetails, go to MARC editor, but NOT save any modif.
2676 # * don't try to add a biblio, it would add data poorly... (don't try to delete either, it may work, but that would be a surprise ;-) )
2677 #
2678 # IMPORTANT NOTE : you need MARC::XML package (http://search.cpan.org/~esummers/MARC-XML-0.7/lib/MARC/File/XML.pm), that requires a recent version of MARC::Record
2679 # Updatedatabase stores the iso2709 data in biblioitems.marc field & an xml version in biblioitems.marcxml Not sure we will keep it when releasing the stable version, but I think it's a good idea to have something readable in sql, at least for development stage.
2680 #
2681 # Revision 1.122  2005/08/04 13:27:48  tipaul
2682 # synch'ing 2.2 and head
2683 #
2684 # Revision 1.115.2.18  2005/08/02 07:45:44  tipaul
2685 # fix for bug http://bugs.koha.org/cgi-bin/bugzilla/show_bug.cgi?id=1009
2686 # (Not all items fields mapped to MARC)
2687 #
2688 # Revision 1.115.2.17  2005/08/01 15:15:43  tipaul
2689 # adding decoder for Ä string
2690 #
2691 # Revision 1.115.2.16  2005/07/28 19:56:15  tipaul
2692 # * removing a useless & CPU consuming call to MARCgetbiblio
2693 # * Leader management.
2694 # If you create a MARC tag "000", with a subfield '@', it will be managed as the leader.
2695 # Seems to work correctly.
2696 #
2697 # Now going to create a plugin for leader()
2698 #
2699 # Revision 1.115.2.15  2005/07/19 15:25:40  tipaul
2700 # * fixing a bug in subfield order when MARCgetbiblio
2701 # * getting rid with the limit "biblionumber & biblioitemnumber must be in the same tag". So, we can put biblionumber in 001 (field that has no subfields, so we can't put biblioitemnumber in this field), and use biblionumber as identifier in the MARC biblio too. Still to be deeply tested.
2702 # * adding some diacritic decoding (Ä, Ü...)
2703 #
2704 # Revision 1.115.2.14  2005/06/27 23:24:06  hdl
2705 # Display dashed ISBN
2706 #
2707 # Revision 1.115.2.13  2005/05/31 12:44:26  tipaul
2708 # patch from Genji (Waylon R.) to update subjects in MARC tables when systempref has MARC=OFF
2709 #
2710 # Revision 1.115.2.12  2005/05/30 11:22:41  tipaul
2711 # fixing a bug : when a field was repeated, the last field was also repeated. (Was due to the "empty" field in html between fields : to separate fields, in html, an empty field is automatically added. in MARChtml2marc, this empty field was not discarded correctly)
2712 #
2713 # Revision 1.115.2.11  2005/05/25 15:48:43  tipaul
2714 # * removing my for variables already declared
2715 # * updating biblio.unititle  field as well as other fields in biblio table
2716 #
2717 # Revision 1.115.2.10  2005/05/25 09:30:50  hdl
2718 # Adding NEWmodbiblioframework feature
2719 # Used by addbiblio.pl when modifying a framework selection.
2720 #
2721 # Revision 1.115.2.9  2005/04/07 10:05:25  tipaul
2722 # adding / to the list of symbols that are replace by spaces for searches
2723 #
2724 # Revision 1.115.2.8  2005/03/25 16:23:49  tipaul
2725 # some improvements :
2726 # * return immediatly when a subfield is empty
2727 # * search duplicate on isbn must be done only when there is an isbn ;-)
2728 #
2729 # Revision 1.115.2.7  2005/03/10 15:52:28  tipaul
2730 # * adding glass to opac marc detail.
2731 # * changing glasses behaviour : It now appears only on subfields that have a "link" value. Avoid useless glasses and removes nothing. **** WARNING **** : if you don't change you MARC parameters, glasses DISAPPEAR, because no subfields have a link value. So you MUST "reactivate" them manually. If you want to enable the search glass on field 225$a (collection in UNIMARC), just put 225a to "link" field (Koha >> parameters >> framework >> 225 field >> subfield >> modify $a >> enter 225a in link input field (without quotes or anything else)
2732 # * fixing bug with libopac
2733 #
2734 # Revision 1.115.2.6  2005/03/09 15:56:01  tipaul
2735 # Changing MARCmoditem to be like MARCmodbiblio : a modif is a delete & create.
2736 # Longer, but solves problems with repeated subfields.
2737 #
2738 # The previous version was not buggy except under certain circumstances (a repeated subfield, that does not exist usually in items)
2739 #
2740 # Revision 1.115.2.5  2005/02/24 13:54:04  tipaul
2741 # exporting MARCdelsubfield sub. It's used in authority merging.
2742 # Modifying it too to enable deletion of all subfields from a given tag/subfield or just one.
2743 #
2744 # Revision 1.115.2.4  2005/02/17 12:44:25  tipaul
2745 # bug in acquisition : the title was also stored as subtitle.
2746 #
2747 # Revision 1.115.2.3  2005/02/10 13:14:36  tipaul
2748 # * multiple main authors are now correctly handled in simple (non-MARC) view
2749 #
2750 # Revision 1.115.2.2  2005/01/11 16:02:35  tipaul
2751 # in catalogue, modifs were not stored properly the non-MARC item DB. Affect only libraries without barcodes.
2752 #
2753 # Revision 1.115.2.1  2005/01/11 14:45:37  tipaul
2754 # bugfix : issn were not stored correctly in non-MARC DB on biblio modification
2755 #
2756 # Revision 1.115  2005/01/06 14:32:17  tipaul
2757 # improvement of speed for bulkmarcimport.
2758 # A sub had been forgotten to use the C4::Context->marcfromkohafield array, that caches DB datas.
2759 # this is only a little improvement for normal DB modif, but almost x2 the speed of bulkmarcimport... from 6records/seconds to more than 10.
2760 #
2761 # Revision 1.114  2005/01/03 10:48:33  tipaul
2762 # * bugfix for the search on a MARC detail, when you clic on the magnifying glass (caused an internal server error)
2763 # * partial support of the "linkage" MARC feature : if you enter a "link" on a MARC subfield, the magnifying glass won't search on the field, but on the linked field. I agree it's a partial support. Will be improved, but I need to investigate MARC21 & UNIMARC diffs on this topic.
2764 #
2765 # Revision 1.113  2004/12/10 16:27:53  tipaul
2766 # limiting the number of search term to 8. There was no limit before, but 8 words seems to be the upper limit mySQL can deal with (in less than a second. tested on a DB with 13 000 items)
2767 # In 2.4, a new DB structure will highly speed things and this limit will be removed.
2768 # FindDuplicate is activated again, the perf problems were due to this problem.
2769 #
2770 # Revision 1.112  2004/12/08 10:14:42  tipaul
2771 # * desactivate FindDuplicate
2772 # * fix from Genji
2773 #
2774 # Revision 1.111  2004/11/25 17:39:44  tipaul
2775 # removing useless &branches in package declaration
2776 #
2777 # Revision 1.110  2004/11/24 16:00:01  tipaul
2778 # removing sub branches (commited by chris for MARC=OFF bugfix, but sub branches is already in Acquisition.pm)
2779 #
2780 # Revision 1.109  2004/11/24 15:58:31  tipaul
2781 # * critical fix for acquisition (see RC3 release notes)
2782 # * critical fix for duplicate finder
2783 #
2784 # Revision 1.108  2004/11/19 19:41:22  rangi
2785 # Shifting branches() from deprecated C4::Catalogue to C4::Biblio
2786 # Allowing the non marc interface acquisitions to work.
2787 #
2788 # Revision 1.107  2004/11/05 10:15:27  tipaul
2789 # Improving FindDuplicate to find duplicate records on adding biblio
2790 #
2791 # Revision 1.106  2004/11/02 16:44:45  tipaul
2792 # new feature : checking for duplicate biblio.
2793 #
2794 # For instance, it's only done on ISBN only. Will be improved soon.
2795 #
2796 # When a duplicate is detected, the biblio is not saved, but the user is asked for a confirmations.
2797 #
2798 # Revision 1.105  2004/09/23 16:15:37  tipaul
2799 # indenting diff
2800 #
2801 # Revision 1.104  2004/09/16 15:06:46  tipaul
2802 # enabling # (| still possible too) for repeatable subfields
2803 #
2804 # Revision 1.103  2004/09/06 14:17:34  tipaul
2805 # some commented warning added + 1 major bugfix => drop empty fields, NOT fields containing 0
2806 #
2807 # Revision 1.102  2004/09/06 10:00:19  tipaul
2808 # adding a "location" field to the library.
2809 # This field is useful when the callnumber contains no information on the room where the item is stored.
2810 # With this field, we now have 3 levels of informations to find a book :
2811 # * the branch.
2812 # * the location.
2813 # * the callnumber.
2814 #
2815 # This should be versatile enough to solve any storing method.
2816 # This hack is quite simple, due to the nice Biblio.pm API. The MARC => koha db link is automatically managed. Just add the link in the parameters section.
2817 #
2818 # Revision 1.101  2004/08/18 16:01:37  tipaul
2819 # modifs to support frameworkcodes
2820 #
2821 # Revision 1.100  2004/08/13 16:37:25  tipaul
2822 # adding frameworkcode to API in some subs
2823 #
2824 # Revision 1.99  2004/07/30 13:54:50  doxulting
2825 # Beginning of serial commit
2826 #
2827 # Revision 1.98  2004/07/15 09:48:10  tipaul
2828 # * removing useless sub
2829 # * minor bugfix in moditem (managing homebranch & holdingbranch)
2830 #
2831 # Revision 1.97  2004/07/02 15:53:53  tipaul
2832 # bugfix (due to frameworkcode field)
2833 #
2834 # Revision 1.96  2004/06/29 16:07:10  tipaul
2835 # last sync for 2.1.0 release
2836 #
2837 # Revision 1.95  2004/06/26 23:19:59  rangi
2838 # Fixing modaddauthor, and adding getitemtypes.
2839 # Also tidying up formatting of code
2840 #
2841 # Revision 1.94  2004/06/17 08:16:32  tipaul
2842 # merging tag & subfield in marc_word for better perfs
2843 #
2844 # Revision 1.93  2004/06/11 15:38:06  joshferraro
2845 # Changes MARCaddword to index words >= 1 char ... needed for more accurate
2846 # searches using SearchMarc routines.
2847 #
2848 # Revision 1.92  2004/06/10 08:29:01  tipaul
2849 # MARC authority management (continued)
2850 #
2851 # Revision 1.91  2004/06/03 10:03:01  tipaul
2852 # * frameworks and itemtypes are independant
2853 # * in the MARC editor, showing the + to duplicate a tag only if the tag is repeatable
2854 #
2855 # Revision 1.90  2004/05/28 08:25:53  tipaul
2856 # hidding hidden & isurl constraints into MARC subfield structure
2857 #
2858 # Revision 1.89  2004/05/27 21:47:21  rangi
2859 # Fix for bug 787
2860 #
2861 # Revision 1.88  2004/05/18 15:23:49  tipaul
2862 # framework management : 1 MARC framework for each itemtype
2863 #
2864 # Revision 1.87  2004/05/18 11:54:07  tipaul
2865 # getitemtypes moved in Koha.pm
2866 #
2867 # Revision 1.86  2004/05/03 09:19:22  tipaul
2868 # some fixes for mysql prepare & execute
2869 #
2870 # Revision 1.85  2004/04/02 14:55:48  tipaul
2871 # renaming items.bulk field to items.itemcallnumber.
2872 # Will be used to store call number for libraries that don't use dewey classification.
2873 # Note it's related to ITEMS, not biblio.
2874 #
2875 # Revision 1.84  2004/03/24 17:18:30  joshferraro
2876 # Fixes bug 749 by removing the comma on line 1488.
2877 #
2878 # Revision 1.83  2004/03/15 14:31:50  tipaul
2879 # adding a minor check
2880 #
2881 # Revision 1.82  2004/03/07 05:47:31  acli
2882 # Various updates/fixes from rel_2_0
2883 # Fixes for bugs 721 (templating), 727, and 734
2884 #
2885 # Revision 1.81  2004/03/06 20:26:13  tipaul
2886 # adding seealso feature in MARC searches
2887 #
2888 # Revision 1.80  2004/02/12 13:40:56  tipaul
2889 # deleting subs duplicated by error
2890 #
2891 # Revision 1.79  2004/02/11 08:40:09  tipaul
2892 # synch'ing 2.0.0 branch and head
2893 #
2894 # Revision 1.78.2.3  2004/02/10 13:15:46  tipaul
2895 # removing 2 warnings
2896 #
2897 # Revision 1.78.2.2  2004/01/26 10:38:06  tipaul
2898 # dealing correctly "bulk" field
2899 #
2900 # Revision 1.78.2.1  2004/01/13 17:29:53  tipaul
2901 # * minor html fixes
2902 # * adding publisher in acquisition process (& ordering basket by publisher)
2903 #
2904 # Revision 1.78  2003/12/09 15:57:28  tipaul
2905 # rolling back to working char_decode sub
2906 #
2907 # Revision 1.77  2003/12/03 17:47:14  tipaul
2908 # bugfixes for biblio deletion
2909 #
2910 # Revision 1.76  2003/12/03 01:43:41  slef
2911 # conflict markers?
2912 #
2913 # Revision 1.75  2003/12/03 01:42:03  slef
2914 # bug 662 fixes securing DBI
2915 #
2916 # Revision 1.74  2003/11/28 09:48:33  tipaul
2917 # bugfix : misusing prepare & execute => now using prepare(?) and execute($var)
2918 #
2919 # Revision 1.73  2003/11/28 09:45:25  tipaul
2920 # bugfix for iso2709 file import in the "notforloan" field.
2921 #
2922 # But notforloan field called "loan" somewhere, so in case "loan" is used, copied to "notforloan" to avoid a bug.
2923 #
2924 # Revision 1.72  2003/11/24 17:40:14  tipaul
2925 # fix for #385
2926 #
2927 # Revision 1.71  2003/11/24 16:28:49  tipaul
2928 # biblio & item deletion now works fine in MARC editor.
2929 # Stores deleted biblio/item in the marc field of the deletedbiblio/deleteditem table.
2930 #
2931 # Revision 1.70  2003/11/24 13:29:55  tipaul
2932 # moving $id from beginning to end of file (70 commits... huge comments...)
2933 #
2934 # Revision 1.69  2003/11/24 13:27:17  tipaul
2935 # fix for #380 (bibliosubject)
2936 #
2937 # Revision 1.68  2003/11/06 17:18:30  tipaul
2938 # bugfix for #384
2939 #
2940 # 1st draft for MARC biblio deletion.
2941 # Still does not work well, but at least, Biblio.pm compiles & it should'nt break too many things
2942 # (Note the trash in the MARCdetail, but don't use it, please :-) )
2943 #
2944 # Revision 1.67  2003/10/25 08:46:27  tipaul
2945 # minor fixes for bilbio deletion (still buggy)
2946 #
2947 # Revision 1.66  2003/10/17 10:02:56  tipaul
2948 # Indexing only words longer than 2 letters. Was >=2 before, & 2 letters words usually means nothing.
2949 #
2950 # Revision 1.65  2003/10/14 09:45:29  tipaul
2951 # adding rebuildnonmarc.pl script : run this script when you change a link between marc and non MARC DB. It rebuilds the non-MARC DB (long operation)
2952 #
2953 # Revision 1.64  2003/10/06 15:20:51  tipaul
2954 # fix for 536 (subtitle error)
2955 #
2956 # Revision 1.63  2003/10/01 13:25:49  tipaul
2957 # seems a char encoding problem modified something in char_decode sub... changing back to something that works...
2958 #
2959 # Revision 1.62  2003/09/17 14:21:13  tipaul
2960 # fixing bug that makes a MARC biblio disappear when using full acquisition (order => recieve ==> MARC editor).
2961 # Before this 2 lines fix, the MARC biblio was deleted during recieve, and had to be entirely recreated :-(
2962 #
2963 # Revision 1.61  2003/09/17 10:24:39  tipaul
2964 # notforloan value in itemtype was overwritting notforloan value in a given item.
2965 # I changed this behaviour :
2966 # if notforloan is set for a given item, and NOT for all items from this itemtype, the notforloan is kept.
2967 # If notforloan is set for itemtype, it's used (and impossible to loan a specific item from this itemtype)
2968 #
2969 # Revision 1.60  2003/09/04 14:11:23  tipaul
2970 # fix for 593 (data duplication in MARC-DB)
2971 #
2972 # Revision 1.58  2003/08/06 12:54:52  tipaul
2973 # fix for publicationyear : extracting numeric value from MARC string, like for copyrightdate.
2974 # (note that copyrightdate still extracted to get numeric format)
2975 #
2976 # Revision 1.57  2003/07/15 23:09:18  slef
2977 # change show columns to use biblioitems bnotes too
2978 #
2979 # Revision 1.56  2003/07/15 11:34:52  slef
2980 # fixes from paul email
2981 #
2982 # Revision 1.55  2003/07/15 00:02:49  slef
2983 # Work on bug 515... can we do a single-side rename of notes to bnotes?
2984 #
2985 # Revision 1.54  2003/07/11 11:51:32  tipaul
2986 # *** empty log message ***
2987 #
2988 # Revision 1.52  2003/07/10 10:37:19  tipaul
2989 # fix for copyrightdate problem, #514
2990 #
2991 # Revision 1.51  2003/07/02 14:47:17  tipaul
2992 # fix for #519 : items.dateaccessioned imports incorrectly
2993 #
2994 # Revision 1.49  2003/06/17 11:21:13  tipaul
2995 # improvments/fixes for z3950 support.
2996 # * Works now even on ADD, not only on MODIFY
2997 # * able to search on ISBN, author, title
2998 #
2999 # Revision 1.48  2003/06/16 09:22:53  rangi
3000 # Just added an order clause to getitemtypes
3001 #
3002 # Revision 1.47  2003/05/20 16:22:44  tipaul
3003 # fixing typo in Biblio.pm POD
3004 #
3005 # Revision 1.46  2003/05/19 13:45:18  tipaul
3006 # support for subtitles, additional authors, subject.
3007 # This supports is only for MARC <-> OLD-DB link. It worked previously, but values entered as MARC were not reported to OLD-DB, neither values entered as OLD-DB were reported to MARC.
3008 # Note that some OLD-DB subs are strange (dummy ?) see OLDmodsubject, OLDmodsubtitle, OLDmodaddiauthor in C4/Biblio.pm
3009 # For example it seems impossible to have more that 1 addi author and 1 subtitle. In MARC it's not the case. So, if you enter more than one, I'm afraid only the LAST will be stored.
3010 #
3011 # Revision 1.45  2003/04/29 16:50:49  tipaul
3012 # really proud of this commit :-)
3013 # z3950 search and import seems to works fine.
3014 # Let me explain how :
3015 # * a "search z3950" button is added in the addbiblio template.
3016 # * when clicked, a popup appears and z3950/search.pl is called
3017 # * z3950/search.pl calls addz3950search in the DB
3018 # * the z3950 daemon retrieve the records and stores them in z3950results AND in marc_breeding table.
3019 # * as long as there as searches pending, the popup auto refresh every 2 seconds, and says how many searches are pending.
3020 # * when the user clicks on a z3950 result => the parent popup is called with the requested biblio, and auto-filled
3021 #
3022 # Note :
3023 # * character encoding support : (It's a nightmare...) In the z3950servers table, a "encoding" column has been added. You can put "UNIMARC" or "USMARC" in this column. Depending on this, the char_decode in C4::Biblio.pm replaces marc-char-encode by an iso 8859-1 encoding. Note that in the breeding import this value has been added too, for a better support.
3024 # * the marc_breeding and z3950* tables have been modified : they have an encoding column and the random z3950 number is stored too for convenience => it's the key I use to list only requested biblios in the popup.
3025 #
3026 # Revision 1.44  2003/04/28 13:07:14  tipaul
3027 # Those fixes solves the "internal server error" with MARC::Record 1.12.
3028 # It was due to an illegal contruction in Koha : we tried to retrive subfields from <10 tags.
3029 # That's not possible. MARC::Record accepted this in 0.93 version, but it was fixed after.
3030 # Now, the construct/retrieving is OK !
3031 #
3032 # Revision 1.43  2003/04/10 13:56:02  tipaul
3033 # Fix some bugs :
3034 # * worked in 1.9.0, but not in 1.9.1 :
3035 # - modif of a biblio didn't work
3036 # - empty fields where not shown when modifying a biblio. empty fields managed by the library (ie in tab 0->9 in MARC parameter table) MUST be entered, even if not presented.
3037 #
3038 # * did not work before :
3039 # - repeatable subfields now works correctly. Enter 2 subfields separated by | and they will be splitted during saving.
3040 # - dropped the last subfield of the MARC form :-(
3041 #
3042 # Internal changes :
3043 # - MARCmodbiblio now works by deleting and recreating the biblio. It's not perf optimized, but MARC is a "do_something_impossible_to_trace" standard, so, it's the best solution. not a problem for me, as biblio are rarely modified.
3044 # Note the MARCdelbiblio has been rewritted to enable deletion of a biblio WITHOUT deleting items.
3045 #
3046 # Revision 1.42  2003/04/04 08:41:11  tipaul
3047 # last commits before 1.9.1
3048 #
3049 # Revision 1.41  2003/04/01 12:26:43  tipaul
3050 # fixes
3051 #
3052 # Revision 1.40  2003/03/11 15:14:03  tipaul
3053 # pod updating
3054 #
3055 # Revision 1.39  2003/03/07 16:35:42  tipaul
3056 # * moving generic functions to Koha.pm
3057 # * improvement of SearchMarc.pm
3058 # * bugfixes
3059 # * code cleaning
3060 #
3061 # Revision 1.38  2003/02/27 16:51:59  tipaul
3062 # * moving prepare / execute to ? form.
3063 # * some # cleaning
3064 # * little bugfix.
3065 # * road to 1.9.2 => acquisition and cataloguing merging
3066 #
3067 # Revision 1.37  2003/02/12 11:03:03  tipaul
3068 # Support for 000 -> 010 fields.
3069 # Those fields doesn't have subfields.
3070 # In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@".
3071 # Note it's only virtual : when rebuilding the MARC::Record, the koha API handle correctly "@" subfields => the resulting MARC record has a 00x field without subfield.
3072 #
3073 # Revision 1.36  2003/02/12 11:01:01  tipaul
3074 # Support for 000 -> 010 fields.
3075 # Those fields doesn't have subfields.
3076 # In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@".
3077 # Note it's only virtual : when rebuilding the MARC::Record, the koha API handle correctly "@" subfields => the resulting MARC record has a 00x field without subfield.
3078 #
3079 # Revision 1.35  2003/02/03 18:46:00  acli
3080 # Minor factoring in C4/Biblio.pm, plus change to export the per-tag
3081 # 'mandatory' property to a per-subfield 'tag_mandatory' template parameter,
3082 # so that addbiblio.tmpl can distinguish between mandatory subfields in a
3083 # mandatory tag and mandatory subfields in an optional tag
3084 #
3085 # Not-minor factoring in acqui.simple/addbiblio.pl to make the if-else blocks
3086 # smaller, and to add some POD; need further testing for this
3087 #
3088 # Added function to check if a MARC subfield name is "koha-internal" (instead
3089 # of checking it for 'lib' and 'tag' everywhere); temporarily added to Koha.pm
3090 #
3091 # Use above function in acqui.simple/additem.pl and search.marc/search.pl
3092 #
3093 # Revision 1.34  2003/01/28 14:50:04  tipaul
3094 # fixing MARCmodbiblio API and reindenting code
3095 #
3096 # Revision 1.33  2003/01/23 12:22:37  tipaul
3097 # adding char_decode to decode MARC21 or UNIMARC extended chars
3098 #
3099 # Revision 1.32  2002/12/16 15:08:50  tipaul
3100 # small but important bugfix (fixes a problem in export)
3101 #
3102 # Revision 1.31  2002/12/13 16:22:04  tipaul
3103 # 1st draft of marc export
3104 #
3105 # Revision 1.30  2002/12/12 21:26:35  tipaul
3106 # YAB ! (Yet Another Bugfix) => related to biblio modif
3107 # (some warning cleaning too)
3108 #
3109 # Revision 1.29  2002/12/12 16:35:00  tipaul
3110 # adding authentification with Auth.pm and
3111 # MAJOR BUGFIX on marc biblio modification
3112 #
3113 # Revision 1.28  2002/12/10 13:30:03  tipaul
3114 # fugfixes from Dombes Abbey work
3115 #
3116 # Revision 1.27  2002/11/19 12:36:16  tipaul
3117 # road to 1.3.2
3118 # various bugfixes, improvments, and migration from acquisition.pm to biblio.pm
3119 #
3120 # Revision 1.26  2002/11/12 15:58:43  tipaul
3121 # road to 1.3.2 :
3122 # * many bugfixes
3123 # * 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)
3124 #
3125 # Revision 1.25  2002/10/25 10:58:26  tipaul
3126 # Road to 1.3.2
3127 # * bugfixes and improvements
3128 #
3129 # Revision 1.24  2002/10/24 12:09:01  arensb
3130 # Fixed "no title" warning when generating HTML documentation from POD.
3131 #
3132 # Revision 1.23  2002/10/16 12:43:08  arensb
3133 # Added some FIXME comments.
3134 #
3135 # Revision 1.22  2002/10/15 13:39:17  tipaul
3136 # removing Acquisition.pm
3137 # deleting unused code in biblio.pm, rewriting POD and answering most FIXME comments
3138 #
3139 # Revision 1.21  2002/10/13 11:34:14  arensb
3140 # Replaced expressions of the form "$x = $x <op> $y" with "$x <op>= $y".
3141 # Thus, $x = $x+2 becomes $x += 2, and so forth.
3142 #
3143 # Revision 1.20  2002/10/13 08:28:32  arensb
3144 # Deleted unused variables.
3145 # Removed trailing whitespace.
3146 #
3147 # Revision 1.19  2002/10/13 05:56:10  arensb
3148 # Added some FIXME comments.
3149 #
3150 # Revision 1.18  2002/10/11 12:34:53  arensb
3151 # Replaced &requireDBI with C4::Context->dbh
3152 #
3153 # Revision 1.17  2002/10/10 14:48:25  tipaul
3154 # bugfixes
3155 #
3156 # Revision 1.16  2002/10/07 14:04:26  tipaul
3157 # road to 1.3.1 : viewing MARC biblio
3158 #
3159 # Revision 1.15  2002/10/05 09:49:25  arensb
3160 # Merged with arensb-context branch: use C4::Context->dbh instead of
3161 # &C4Connect, and generally prefer C4::Context over C4::Database.
3162 #
3163 # Revision 1.14  2002/10/03 11:28:18  tipaul
3164 # Extending Context.pm to add stopword management and using it in MARC-API.
3165 # First benchmarks show a medium speed improvement, which  is nice as this part is heavily called.
3166 #
3167 # Revision 1.13  2002/10/02 16:26:44  tipaul
3168 # road to 1.3.1
3169 #
3170 # Revision 1.12.2.4  2002/10/05 07:09:31  arensb
3171 # Merged in changes from main branch.
3172 #
3173 # Revision 1.12.2.3  2002/10/05 06:12:10  arensb
3174 # Added a whole mess of FIXME comments.
3175 #
3176 # Revision 1.12.2.2  2002/10/05 04:03:14  arensb
3177 # Added some missing semicolons.
3178 #
3179 # Revision 1.12.2.1  2002/10/04 02:24:01  arensb
3180 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
3181 # C4Connect.
3182 #
3183 # Revision 1.12.2.3  2002/10/05 06:12:10  arensb
3184 # Added a whole mess of FIXME comments.
3185 #
3186 # Revision 1.12.2.2  2002/10/05 04:03:14  arensb
3187 # Added some missing semicolons.
3188 #
3189 # Revision 1.12.2.1  2002/10/04 02:24:01  arensb
3190 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
3191 # C4Connect.
3192 #
3193 # Revision 1.12  2002/10/01 11:48:51  arensb
3194 # Added some FIXME comments, mostly marking duplicate functions.
3195 #
3196 # Revision 1.11  2002/09/24 13:49:26  tipaul
3197 # long WAS the road to 1.3.0...
3198 # coming VERY SOON NOW...
3199 # modifying installer and buildrelease to update the DB
3200 #
3201 # Revision 1.10  2002/09/22 16:50:08  arensb
3202 # Added some FIXME comments.
3203 #
3204 # Revision 1.9  2002/09/20 12:57:46  tipaul
3205 # long is the road to 1.4.0
3206 # * MARCadditem and MARCmoditem now wroks
3207 # * various bugfixes in MARC management
3208 # !!! 1.3.0 should be released very soon now. Be careful !!!
3209 #
3210 # Revision 1.8  2002/09/10 13:53:52  tipaul
3211 # MARC API continued...
3212 # * some bugfixes
3213 # * 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)
3214 #
3215 # Note : it should not be hard for marcimport and marcexport to re-link fields from internal tag/subfield to "legal" tag/subfield.
3216 #
3217 # Revision 1.7  2002/08/14 18:12:51  tonnesen
3218 # Added copyright statement to all .pl and .pm files
3219 #
3220 # Revision 1.6  2002/07/25 13:40:31  tipaul
3221 # pod documenting the API.
3222 #
3223 # Revision 1.5  2002/07/24 16:11:37  tipaul
3224 # Now, the API...
3225 # Database.pm and Output.pm are almost not modified (var test...)
3226 #
3227 # Biblio.pm is almost completly rewritten.
3228 #
3229 # WHAT DOES IT ??? ==> END of Hitchcock suspens
3230 #
3231 # 1st, it does... nothing...
3232 # 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 ...
3233 #
3234 # All old-API functions have been cloned. for example, the "newbiblio" sub, now has become :
3235 # * a "newbiblio" sub, with the same parameters. It just call a sub named OLDnewbiblio
3236 # * 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.
3237 # * 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.
3238 # 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 ;-)
3239 #
3240 # 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.
3241 # Note we have decided with steve that a old-biblio <=> a MARC-Biblio.
3242 #