C4/Biblio.pm

   1 package C4::Biblio;
   2 # Copyright 2000-2002 Katipo Communications
   3 #
   4 # This file is part of Koha.
   5 #
   6 # Koha is free software; you can redistribute it and/or modify it under the
   7 # terms of the GNU General Public License as published by the Free Software
   8 # Foundation; either version 2 of the License, or (at your option) any later
   9 # version.
  10 #
  11 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  12 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  13 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License along with
  16 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  17 # Suite 330, Boston, MA  02111-1307 USA
  18
  19 use strict;
  20 require Exporter;
  21 use C4::Context;
  22 use C4::Database;
  23 use MARC::Record;
  24
  25 use vars qw($VERSION @ISA @EXPORT);
  26
  27 # set the version for version checking
  28 $VERSION = 0.01;
  29
  30 @ISA = qw(Exporter);
  31 #
  32 # don't forget MARCxxx subs are exported only for testing purposes. Should not be used
  33 # as the old-style API and the NEW one are the only public functions.
  34 #
  35 @EXPORT = qw(
  36         &updateBiblio &updateBiblioItem &updateItem
  37         &itemcount &newbiblio &newbiblioitem
  38         &modnote &newsubject &newsubtitle
  39         &modbiblio &checkitems
  40         &newitems &modbibitem
  41         &modsubtitle &modsubject &modaddauthor &moditem &countitems
  42         &delitem &deletebiblioitem &delbiblio
  43         &getbiblio
  44         &getbiblioitembybiblionumber
  45         &getbiblioitem &getitemsbybiblioitem
  46         &skip
  47         &newcompletebiblioitem
  48
  49         &MARCfind_oldbiblionumber_from_MARCbibid
  50         &MARCfind_MARCbibid_from_oldbiblionumber
  51         &MARCfind_marc_from_kohafield
  52         &MARCfindsubfield
  53         &MARCfind_itemtype
  54         &MARCgettagslib
  55
  56         &NEWnewbiblio &NEWnewitem
  57         &NEWmodbiblio &NEWmoditem
  58         &NEWdelbiblio &NEWdelitem
  59
  60         &MARCaddbiblio &MARCadditem
  61         &MARCmodsubfield &MARCaddsubfield
  62         &MARCmodbiblio &MARCmoditem
  63         &MARCkoha2marcBiblio &MARCmarc2koha
  64         &MARCkoha2marcItem &MARChtml2marc
  65         &MARCgetbiblio &MARCgetitem
  66         &MARCaddword &MARCdelword
  67         &char_decode
  68  );
  69
  70 #
  71 #
  72 # MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC
  73 #
  74 #
  75 # all the following subs takes a MARC::Record as parameter and manage
  76 # the MARC-DB. They are called by the 1.0/1.2 xxx subs, and by the
  77 # NEWxxx subs (xxx deals with old-DB parameters, the NEWxxx deals with MARC-DB parameter)
  78
  79 =head1 NAME
  80
  81 C4::Biblio - acquisition, catalog  management functions
  82
  83 =head1 SYNOPSIS
  84
  85 move from 1.2 to 1.4 version :
  86 1.2 and previous version uses a specific API to manage biblios. This API uses old-DB style parameters.
  87 In the 1.4 version, we want to do 2 differents things :
  88  - keep populating the old-DB, that has a LOT less datas than MARC
  89  - populate the MARC-DB
  90 To populate the DBs we have 2 differents sources :
  91  - the standard acquisition system (through book sellers), that does'nt use MARC data
  92  - the MARC acquisition system, that uses MARC data.
  93
  94 Thus, we have 2 differents cases :
  95 - 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
  96 - 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
  97
  98 That's why we need 4 subs :
  99 all I<subs beginning by MARC> manage only MARC tables. They manage MARC-DB with MARC::Record parameters
 100 all I<subs beginning by OLD> manage only OLD-DB tables. They manage old-DB with old-DB parameters
 101 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
 102 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.
 103
 104 - NEW and old-style API should be used in koha to manage biblio
 105 - MARCsubs are divided in 2 parts :
 106 * some of them manage MARC parameters. They are heavily used in koha.
 107 * some of them manage MARC biblio : they are mostly used by NEW and old-style subs.
 108 - OLD are used internally only
 109
 110 all subs requires/use $dbh as 1st parameter.
 111
 112 I<NEWxxx related subs>
 113
 114 all subs requires/use $dbh as 1st parameter.
 115 those subs are used by the MARC-compliant version of koha : marc import, or marc management.
 116
 117 I<OLDxxx related subs>
 118
 119 all subs requires/use $dbh as 1st parameter.
 120 those subs are used by the MARC-compliant version of koha : marc import, or marc management.
 121
 122 They all are the exact copy of 1.0/1.2 version of the sub without the OLD.
 123 The OLDxxx is called by the original xxx sub.
 124 the 1.4 xxx sub also builds MARC::Record an calls the MARCxxx
 125
 126 WARNING : there is 1 difference between initialxxx and OLDxxx :
 127 the db header $dbh is always passed as parameter to avoid over-DB connexion
 128
 129 =head1 DESCRIPTION
 130
 131 =over 4
 132
 133 =item @tagslib = &MARCgettagslib($dbh,1|0,$itemtype);
 134
 135 last param is 1 for liblibrarian and 0 for libopac
 136 $itemtype contains the itemtype framework reference. If empty or does not exist, the default one is used
 137 returns a hash with tag/subfield meaning
 138 =item ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
 139
 140 finds MARC tag and subfield for a given kohafield
 141 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
 142
 143 =item $biblionumber = &MARCfind_oldbiblionumber_from_MARCbibid($dbh,$MARCbibi);
 144
 145 finds a old-db biblio number for a given MARCbibid number
 146
 147 =item $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$oldbiblionumber);
 148
 149 finds a MARC bibid from a old-db biblionumber
 150
 151 =item $MARCRecord = &MARCkoha2marcBiblio($dbh,$biblionumber,biblioitemnumber);
 152
 153 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem
 154
 155 =item $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);
 156
 157 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB item
 158
 159 =item $MARCRecord = &MARCkoha2marcSubtitle($dbh,$biblionumber,$subtitle);
 160
 161 MARCkoha2marcSubtitle is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB subtitle
 162
 163 =item $olddb = &MARCmarc2koha($dbh,$MARCRecord);
 164
 165 builds a hash with old-db datas from a MARC::Record
 166
 167 =item &MARCaddbiblio($dbh,$MARC::Record,$biblionumber);
 168
 169 creates a biblio (in the MARC tables only). $biblionumber is the old-db biblionumber of the biblio
 170
 171 =item &MARCaddsubfield($dbh,$bibid,$tagid,$indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
 172
 173 adds a subfield in a biblio (in the MARC tables only).
 174
 175 =item $MARCRecord = &MARCgetbiblio($dbh,$bibid);
 176
 177 Returns a MARC::Record for the biblio $bibid.
 178
 179 =item &MARCmodbiblio($dbh,$bibid,$record,$delete);
 180
 181 MARCmodbiblio changes a biblio for a biblio,MARC::Record passed as parameter
 182 It 1st delete the biblio, then recreates it.
 183 WARNING : the $delete parameter is not used anymore (too much unsolvable cases).
 184 =item ($subfieldid,$subfieldvalue) = &MARCmodsubfield($dbh,$subfieldid,$subfieldvalue);
 185
 186 MARCmodsubfield changes the value of a given subfield
 187
 188 =item $subfieldid = &MARCfindsubfield($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue);
 189
 190 MARCfindsubfield returns a subfield number given a bibid/tag/subfieldvalue values.
 191 Returns -1 if more than 1 answer
 192
 193 =item $subfieldid = &MARCfindsubfieldid($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
 194
 195 MARCfindsubfieldid find a subfieldid for a bibid/tag/tagorder/subfield/subfieldorder
 196
 197 =item &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
 198
 199 MARCdelsubfield delete a subfield for a bibid/tag/tagorder/subfield/subfieldorder
 200
 201 =item &MARCdelbiblio($dbh,$bibid);
 202
 203 MARCdelbiblio delete biblio $bibid
 204
 205 =item &MARCkoha2marcOnefield
 206
 207 used by MARCkoha2marc and should not be useful elsewhere
 208
 209 =item &MARCmarc2kohaOnefield
 210
 211 used by MARCmarc2koha and should not be useful elsewhere
 212
 213 =item MARCaddword
 214
 215 used to manage MARC_word table and should not be useful elsewhere
 216
 217 =item MARCdelword
 218
 219 used to manage MARC_word table and should not be useful elsewhere
 220
 221 =cut
 222
 223 sub MARCgettagslib {
 224         my ($dbh,$forlibrarian,$itemtype)= @_;
 225         $itemtype="" unless $itemtype;
 226         my $sth;
 227         my $libfield = ($forlibrarian eq 1)? 'liblibrarian' : 'libopac';
 228         # check that itemtype framework exists
 229         $sth=$dbh->prepare("select count(*) from marc_tag_structure where itemtype=? order by ?");
 230         $sth->execute($itemtype,$itemtype);
 231         my ($total) = $sth->fetchrow;
 232         $itemtype="" unless ($total >0);
 233         $sth=$dbh->prepare("select tagfield,$libfield as lib,mandatory from marc_tag_structure where itemtype=? order by tagfield");
 234         $sth->execute($itemtype);
 235         my ($lib,$tag,$res,$tab,$mandatory,$repeatable);
 236         while ( ($tag,$lib,$mandatory) = $sth->fetchrow) {
 237                 $res->{$tag}->{lib}=$lib;
 238                 $res->{$tab}->{tab}=""; # XXX
 239                 $res->{$tag}->{mandatory}=$mandatory;
 240         }
 241
 242         $sth=$dbh->prepare("select tagfield,tagsubfield,$libfield as lib,tab, mandatory, repeatable,authorised_value,thesaurus_category,value_builder,kohafield,seealso,hidden,isurl from marc_subfield_structure where itemtype=? order by tagfield,tagsubfield");
 243         $sth->execute($itemtype);
 244
 245         my $subfield;
 246         my $authorised_value;
 247         my $thesaurus_category;
 248         my $value_builder;
 249         my $kohafield;
 250         my $seealso;
 251         my $hidden;
 252         my $isurl;
 253         while ( ($tag, $subfield, $lib, $tab, $mandatory, $repeatable,$authorised_value,$thesaurus_category,$value_builder,$kohafield,$seealso,$hidden,$isurl) = $sth->fetchrow) {
 254                 $res->{$tag}->{$subfield}->{lib}=$lib;
 255                 $res->{$tag}->{$subfield}->{tab}=$tab;
 256                 $res->{$tag}->{$subfield}->{mandatory}=$mandatory;
 257                 $res->{$tag}->{$subfield}->{repeatable}=$repeatable;
 258                 $res->{$tag}->{$subfield}->{authorised_value}=$authorised_value;
 259                 $res->{$tag}->{$subfield}->{thesaurus_category}=$thesaurus_category;
 260                 $res->{$tag}->{$subfield}->{value_builder}=$value_builder;
 261                 $res->{$tag}->{$subfield}->{kohafield}=$kohafield;
 262                 $res->{$tag}->{$subfield}->{seealso}=$seealso;
 263                 $res->{$tag}->{$subfield}->{hidden}=$hidden;
 264                 $res->{$tag}->{$subfield}->{isurl}=$isurl;
 265         }
 266         return $res;
 267 }
 268
 269 sub MARCfind_marc_from_kohafield {
 270     my ($dbh,$kohafield) = @_;
 271     return 0,0 unless $kohafield;
 272     my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
 273     $sth->execute($kohafield);
 274     my ($tagfield,$tagsubfield) = $sth->fetchrow;
 275     return ($tagfield,$tagsubfield);
 276 }
 277
 278 sub MARCfind_oldbiblionumber_from_MARCbibid {
 279     my ($dbh,$MARCbibid) = @_;
 280     my $sth=$dbh->prepare("select biblionumber from marc_biblio where bibid=?");
 281     $sth->execute($MARCbibid);
 282     my ($biblionumber) = $sth->fetchrow;
 283     return $biblionumber;
 284 }
 285
 286 sub MARCfind_MARCbibid_from_oldbiblionumber {
 287     my ($dbh,$oldbiblionumber) = @_;
 288     my $sth=$dbh->prepare("select bibid from marc_biblio where biblionumber=?");
 289     $sth->execute($oldbiblionumber);
 290     my ($bibid) = $sth->fetchrow;
 291     return $bibid;
 292 }
 293
 294 sub MARCaddbiblio {
 295 # pass the MARC::Record to this function, and it will create the records in the marc tables
 296         my ($dbh,$record,$biblionumber,$bibid) = @_;
 297         my @fields=$record->fields();
 298 #       warn "IN MARCaddbiblio $bibid => ".$record->as_formatted;
 299 # my $bibid;
 300 # adding main table, and retrieving bibid
 301 # if bibid is sent, then it's not a true add, it's only a re-add, after a delete (ie, a mod)
 302 # if bibid empty => true add, find a new bibid number
 303         unless ($bibid) {
 304                 $dbh->do("lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ");
 305                 my $sth=$dbh->prepare("insert into marc_biblio (datecreated,biblionumber) values (now(),?)");
 306                 $sth->execute($biblionumber);
 307                 $sth=$dbh->prepare("select max(bibid) from marc_biblio");
 308                 $sth->execute;
 309                 ($bibid)=$sth->fetchrow;
 310                 $sth->finish;
 311         }
 312         my $fieldcount=0;
 313         # now, add subfields...
 314         foreach my $field (@fields) {
 315                 $fieldcount++;
 316                 if ($field->tag() <10) {
 317                                 &MARCaddsubfield($dbh,$bibid,
 318                                                 $field->tag(),
 319                                                 '',
 320                                                 $fieldcount,
 321                                                 '',
 322                                                 1,
 323                                                 $field->data()
 324                                                 );
 325                 } else {
 326                         my @subfields=$field->subfields();
 327                         foreach my $subfieldcount (0..$#subfields) {
 328                                 &MARCaddsubfield($dbh,$bibid,
 329                                                 $field->tag(),
 330                                                 $field->indicator(1).$field->indicator(2),
 331                                                 $fieldcount,
 332                                                 $subfields[$subfieldcount][0],
 333                                                 $subfieldcount+1,
 334                                                 $subfields[$subfieldcount][1]
 335                                                 );
 336                         }
 337                 }
 338         }
 339         $dbh->do("unlock tables");
 340         return $bibid;
 341 }
 342
 343 sub MARCadditem {
 344 # pass the MARC::Record to this function, and it will create the records in the marc tables
 345     my ($dbh,$record,$biblionumber) = @_;
 346 #    warn "adding : ".$record->as_formatted();
 347 # search for MARC biblionumber
 348     $dbh->do("lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ");
 349     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
 350     my @fields=$record->fields();
 351     my $sth = $dbh->prepare("select max(tagorder) from marc_subfield_table where bibid=?");
 352     $sth->execute($bibid);
 353     my ($fieldcount) = $sth->fetchrow;
 354     # now, add subfields...
 355     foreach my $field (@fields) {
 356         my @subfields=$field->subfields();
 357         $fieldcount++;
 358         foreach my $subfieldcount (0..$#subfields) {
 359                     &MARCaddsubfield($dbh,$bibid,
 360                                  $field->tag(),
 361                                  $field->indicator(1).$field->indicator(2),
 362                                  $fieldcount,
 363                                  $subfields[$subfieldcount][0],
 364                                  $subfieldcount+1,
 365                                  $subfields[$subfieldcount][1]
 366                                  );
 367         }
 368     }
 369     $dbh->do("unlock tables");
 370     return $bibid;
 371 }
 372
 373 sub MARCaddsubfield {
 374 # Add a new subfield to a tag into the DB.
 375         my ($dbh,$bibid,$tagid,$tag_indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalues) = @_;
 376         # if not value, end of job, we do nothing
 377         if (length($subfieldvalues) ==0) {
 378                 return;
 379         }
 380         if (not($subfieldcode)) {
 381                 $subfieldcode=' ';
 382         }
 383         my @subfieldvalues = split /\|/,$subfieldvalues;
 384         foreach my $subfieldvalue (@subfieldvalues) {
 385                 if (length($subfieldvalue)>255) {
 386                         $dbh->do("lock tables marc_blob_subfield WRITE, marc_subfield_table WRITE");
 387                         my $sth=$dbh->prepare("insert into marc_blob_subfield (subfieldvalue) values (?)");
 388                         $sth->execute($subfieldvalue);
 389                         $sth=$dbh->prepare("select max(blobidlink)from marc_blob_subfield");
 390                         $sth->execute;
 391                         my ($res)=$sth->fetchrow;
 392                         $sth=$dbh->prepare("insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,valuebloblink) values (?,?,?,?,?,?,?)");
 393                         $sth->execute($bibid,(sprintf "%03s",$tagid),$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$res);
 394                         if ($sth->errstr) {
 395                                 warn "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
 396                         }
 397                 $dbh->do("unlock tables");
 398                 } else {
 399                         my $sth=$dbh->prepare("insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values (?,?,?,?,?,?,?)");
 400                         $sth->execute($bibid,(sprintf "%03s",$tagid),$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue);
 401                         if ($sth->errstr) {
 402                         warn "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
 403                         }
 404                 }
 405                 &MARCaddword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
 406         }
 407 }
 408
 409 sub MARCgetbiblio {
 410 # Returns MARC::Record of the biblio passed in parameter.
 411     my ($dbh,$bibid)=@_;
 412     my $record = MARC::Record->new();
 413 #---- TODO : the leader is missing
 414         $record->leader('                        ');
 415     my $sth=$dbh->prepare("select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
 416                                  from marc_subfield_table
 417                                  where bibid=? order by tag,tagorder,subfieldcode
 418                          ");
 419         my $sth2=$dbh->prepare("select subfieldvalue from marc_blob_subfield where blobidlink=?");
 420         $sth->execute($bibid);
 421         my $prevtagorder=1;
 422         my $prevtag='XXX';
 423         my $previndicator;
 424         my $field; # for >=10 tags
 425         my $prevvalue; # for <10 tags
 426         while (my $row=$sth->fetchrow_hashref) {
 427                 if ($row->{'valuebloblink'}) { #---- search blob if there is one
 428                         $sth2->execute($row->{'valuebloblink'});
 429                         my $row2=$sth2->fetchrow_hashref;
 430                         $sth2->finish;
 431                         $row->{'subfieldvalue'}=$row2->{'subfieldvalue'};
 432                 }
 433                 if ($row->{tagorder} ne $prevtagorder || $row->{tag} ne $prevtag) {
 434                         $previndicator.="  ";
 435                         if ($prevtag <10) {
 436                         $record->add_fields((sprintf "%03s",$prevtag),$prevvalue) unless $prevtag eq "XXX"; # ignore the 1st loop
 437                         } else {
 438                                 $record->add_fields($field) unless $prevtag eq "XXX";
 439                         }
 440                         undef $field;
 441                         $prevtagorder=$row->{tagorder};
 442                         $prevtag = $row->{tag};
 443                         $previndicator=$row->{tag_indicator};
 444                         if ($row->{tag}<10) {
 445                                 $prevvalue = $row->{subfieldvalue};
 446                         } else {
 447                                 $field = MARC::Field->new((sprintf "%03s",$prevtag), substr($row->{tag_indicator}.'  ',0,1), substr($row->{tag_indicator}.'  ',1,1), $row->{'subfieldcode'}, $row->{'subfieldvalue'} );
 448                         }
 449                 } else {
 450                         if ($row->{tag} <10) {
 451                                 $record->add_fields((sprintf "%03s",$row->{tag}), $row->{'subfieldvalue'});
 452                         } else {
 453                                 $field->add_subfields($row->{'subfieldcode'}, $row->{'subfieldvalue'} );
 454                         }
 455                         $prevtag= $row->{tag};
 456                         $previndicator=$row->{tag_indicator};
 457                 }
 458         }
 459         # the last has not been included inside the loop... do it now !
 460         if ($prevtag ne "XXX") { # check that we have found something. Otherwise, prevtag is still XXX and we
 461                                                 # must return an empty record, not make MARC::Record fail because we try to
 462                                                 # create a record with XXX as field :-(
 463                 if ($prevtag <10) {
 464                         $record->add_fields($prevtag,$prevvalue);
 465                 } else {
 466         #               my $field = MARC::Field->new( $prevtag, "", "", %subfieldlist);
 467                         $record->add_fields($field);
 468                 }
 469         }
 470         return $record;
 471 }
 472 sub MARCgetitem {
 473 # Returns MARC::Record of the biblio passed in parameter.
 474     my ($dbh,$bibid,$itemnumber)=@_;
 475     my $record = MARC::Record->new();
 476 # search MARC tagorder
 477     my $sth2 = $dbh->prepare("select tagorder from marc_subfield_table,marc_subfield_structure where marc_subfield_table.tag=marc_subfield_structure.tagfield and marc_subfield_table.subfieldcode=marc_subfield_structure.tagsubfield and bibid=? and kohafield='items.itemnumber' and subfieldvalue=?");
 478     $sth2->execute($bibid,$itemnumber);
 479     my ($tagorder) = $sth2->fetchrow_array();
 480 #---- TODO : the leader is missing
 481     my $sth=$dbh->prepare("select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
 482                                  from marc_subfield_table
 483                                  where bibid=? and tagorder=? order by subfieldcode,subfieldorder
 484                          ");
 485         $sth2=$dbh->prepare("select subfieldvalue from marc_blob_subfield where blobidlink=?");
 486         $sth->execute($bibid,$tagorder);
 487         while (my $row=$sth->fetchrow_hashref) {
 488         if ($row->{'valuebloblink'}) { #---- search blob if there is one
 489                 $sth2->execute($row->{'valuebloblink'});
 490                 my $row2=$sth2->fetchrow_hashref;
 491                 $sth2->finish;
 492                 $row->{'subfieldvalue'}=$row2->{'subfieldvalue'};
 493         }
 494         if ($record->field($row->{'tag'})) {
 495             my $field;
 496 #--- this test must stay as this, because of strange behaviour of mySQL/Perl DBI with char var containing a number...
 497 #--- sometimes, eliminates 0 at beginning, sometimes no ;-\\\
 498             if (length($row->{'tag'}) <3) {
 499                 $row->{'tag'} = "0".$row->{'tag'};
 500             }
 501             $field =$record->field($row->{'tag'});
 502             if ($field) {
 503                 my $x = $field->add_subfields($row->{'subfieldcode'},$row->{'subfieldvalue'});
 504                 $record->delete_field($field);
 505                 $record->add_fields($field);
 506             }
 507         } else {
 508             if (length($row->{'tag'}) < 3) {
 509                 $row->{'tag'} = "0".$row->{'tag'};
 510             }
 511             my $temp = MARC::Field->new($row->{'tag'}," "," ", $row->{'subfieldcode'} => $row->{'subfieldvalue'});
 512             $record->add_fields($temp);
 513         }
 514
 515     }
 516     return $record;
 517 }
 518
 519 sub MARCmodbiblio {
 520         my ($dbh,$bibid,$record,$delete)=@_;
 521         my $oldrecord=&MARCgetbiblio($dbh,$bibid);
 522         if ($oldrecord eq $record) {
 523                 return;
 524         }
 525 # 1st delete the biblio,
 526 # 2nd recreate it
 527         my $biblionumber = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
 528         &MARCdelbiblio($dbh,$bibid,1);
 529         &MARCaddbiblio($dbh,$record,$biblionumber,$bibid);
 530 }
 531
 532 sub MARCdelbiblio {
 533         my ($dbh,$bibid,$keep_items) = @_;
 534 # if the keep_item is set to 1, then all items are preserved.
 535 # This flag is set when the delbiblio is called by modbiblio
 536 # due to a too complex structure of MARC (repeatable fields and subfields),
 537 # the best solution for a modif is to delete / recreate the record.
 538
 539 # 1st of all, copy the MARC::Record to deletedbiblio table => if a true deletion, MARC data will be kept.
 540 # if deletion called before MARCmodbiblio => won't do anything, as the oldbiblionumber doesn't
 541 # exist in deletedbiblio table
 542         my $record = MARCgetbiblio($dbh,$bibid);
 543         my $oldbiblionumber = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
 544         my $copy2deleted=$dbh->prepare("update deletedbiblio set marc=? where biblionumber=?");
 545         $copy2deleted->execute($record->as_usmarc(),$oldbiblionumber);
 546 # now, delete in MARC tables.
 547         if ($keep_items eq 1) {
 548         #search item field code
 549                 my $sth = $dbh->prepare("select tagfield from marc_subfield_structure where kohafield like 'items.%'");
 550                 $sth->execute;
 551                 my $itemtag = $sth->fetchrow_hashref->{tagfield};
 552                 $dbh->do("delete from marc_subfield_table where bibid=$bibid and tag<>$itemtag");
 553                 $dbh->do("delete from marc_word where bibid=$bibid and tag<>$itemtag");
 554         } else {
 555                 $dbh->do("delete from marc_biblio where bibid=$bibid");
 556                 $dbh->do("delete from marc_subfield_table where bibid=$bibid");
 557                 $dbh->do("delete from marc_word where bibid=$bibid");
 558         }
 559 }
 560
 561 sub MARCdelitem {
 562 # delete the item passed in parameter in MARC tables.
 563         my ($dbh,$bibid,$itemnumber)=@_;
 564         #    my $record = MARC::Record->new();
 565         # search MARC tagorder
 566         my $record = MARCgetitem($dbh,$bibid,$itemnumber);
 567         my $copy2deleted=$dbh->prepare("update deleteditems set marc=? where itemnumber=?");
 568         $copy2deleted->execute($record->as_usmarc(),$itemnumber);
 569
 570         my $sth2 = $dbh->prepare("select tagorder from marc_subfield_table,marc_subfield_structure where marc_subfield_table.tag=marc_subfield_structure.tagfield and marc_subfield_table.subfieldcode=marc_subfield_structure.tagsubfield and bibid=? and kohafield='items.itemnumber' and subfieldvalue=?");
 571         $sth2->execute($bibid,$itemnumber);
 572         my ($tagorder) = $sth2->fetchrow_array();
 573         my $sth=$dbh->prepare("delete from marc_subfield_table where bibid=? and tagorder=?");
 574         $sth->execute($bibid,$tagorder);
 575 }
 576
 577 sub MARCmoditem {
 578         my ($dbh,$record,$bibid,$itemnumber,$delete)=@_;
 579         my $oldrecord=&MARCgetitem($dbh,$bibid,$itemnumber);
 580         # if nothing to change, don't waste time...
 581         if ($oldrecord eq $record) {
 582                 return;
 583         }
 584         # otherwise, skip through each subfield...
 585         my @fields = $record->fields();
 586         # search old MARC item
 587         my $sth2 = $dbh->prepare("select tagorder from marc_subfield_table,marc_subfield_structure where marc_subfield_table.tag=marc_subfield_structure.tagfield and marc_subfield_table.subfieldcode=marc_subfield_structure.tagsubfield and bibid=? and kohafield='items.itemnumber' and subfieldvalue=?");
 588         $sth2->execute($bibid,$itemnumber);
 589         my ($tagorder) = $sth2->fetchrow_array();
 590         foreach my $field (@fields) {
 591                 my $oldfield = $oldrecord->field($field->tag());
 592                 my @subfields=$field->subfields();
 593                 my $subfieldorder=0;
 594                 foreach my $subfield (@subfields) {
 595                         $subfieldorder++;
 596 #                       warn "compare : $oldfield".$oldfield->subfield(@$subfield[0]);
 597                         if ($oldfield eq 0 or (length($oldfield->subfield(@$subfield[0])) ==0) ) {
 598                 # just adding datas...
 599 #               warn "addfield : / $subfieldorder / @$subfield[0] - @$subfield[1]";
 600 #                               warn "NEW subfield : $bibid,".$field->tag().",".$tagorder.",".@$subfield[0].",".$subfieldorder.",".@$subfield[1].")";
 601                                 &MARCaddsubfield($dbh,$bibid,$field->tag(),$field->indicator(1).$field->indicator(2),
 602                                                 $tagorder,@$subfield[0],$subfieldorder,@$subfield[1]);
 603                         } else {
 604 #               warn "modfield : / $subfieldorder / @$subfield[0] - @$subfield[1]";
 605                 # modify he subfield if it's a different string
 606                                 if ($oldfield->subfield(@$subfield[0]) ne @$subfield[1] ) {
 607                                         my $subfieldid=&MARCfindsubfieldid($dbh,$bibid,$field->tag(),$tagorder,@$subfield[0],$subfieldorder);
 608 #                                       warn "changing : $subfieldid, $bibid,".$field->tag(),",$tagorder,@$subfield[0],@$subfield[1],$subfieldorder";
 609                                         &MARCmodsubfield($dbh,$subfieldid,@$subfield[1]);
 610                                 }
 611                         }
 612                 }
 613         }
 614 }
 615
 616
 617 sub MARCmodsubfield {
 618 # Subroutine changes a subfield value given a subfieldid.
 619     my ($dbh, $subfieldid, $subfieldvalue )=@_;
 620     $dbh->do("lock tables marc_blob_subfield WRITE,marc_subfield_table WRITE");
 621     my $sth1=$dbh->prepare("select valuebloblink from marc_subfield_table where subfieldid=?");
 622     $sth1->execute($subfieldid);
 623     my ($oldvaluebloblink)=$sth1->fetchrow;
 624     $sth1->finish;
 625     my $sth;
 626     # if too long, use a bloblink
 627     if (length($subfieldvalue)>255 ) {
 628         # if already a bloblink, update it, otherwise, insert a new one.
 629         if ($oldvaluebloblink) {
 630             $sth=$dbh->prepare("update marc_blob_subfield set subfieldvalue=? where blobidlink=?");
 631             $sth->execute($subfieldvalue,$oldvaluebloblink);
 632         } else {
 633             $sth=$dbh->prepare("insert into marc_blob_subfield (subfieldvalue) values (?)");
 634             $sth->execute($subfieldvalue);
 635             $sth=$dbh->prepare("select max(blobidlink) from marc_blob_subfield");
 636             $sth->execute;
 637             my ($res)=$sth->fetchrow;
 638             $sth=$dbh->prepare("update marc_subfield_table set subfieldvalue=null, valuebloblink=? where subfieldid=?");
 639             $sth->execute($res,$subfieldid);
 640         }
 641     } else {
 642         # note this can leave orphan bloblink. Not a big problem, but we should build somewhere a orphan deleting script...
 643         $sth=$dbh->prepare("update marc_subfield_table set subfieldvalue=?,valuebloblink=null where subfieldid=?");
 644         $sth->execute($subfieldvalue, $subfieldid);
 645     }
 646     $dbh->do("unlock tables");
 647     $sth->finish;
 648     $sth=$dbh->prepare("select bibid,tag,tagorder,subfieldcode,subfieldid,subfieldorder from marc_subfield_table where subfieldid=?");
 649     $sth->execute($subfieldid);
 650     my ($bibid,$tagid,$tagorder,$subfieldcode,$x,$subfieldorder) = $sth->fetchrow;
 651     $subfieldid=$x;
 652     &MARCdelword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder);
 653     &MARCaddword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
 654     return($subfieldid, $subfieldvalue);
 655 }
 656
 657 sub MARCfindsubfield {
 658     my ($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue) = @_;
 659     my $resultcounter=0;
 660     my $subfieldid;
 661     my $lastsubfieldid;
 662     my $query="select subfieldid from marc_subfield_table where bibid=? and tag=? and subfieldcode=?";
 663     my @bind_values = ($bibid,$tag, $subfieldcode);
 664     if ($subfieldvalue) {
 665         $query .= " and subfieldvalue=?";
 666         push(@bind_values,$subfieldvalue);
 667     } else {
 668         if ($subfieldorder<1) {
 669             $subfieldorder=1;
 670         }
 671         $query .= " and subfieldorder=?";
 672         push(@bind_values,$subfieldorder);
 673     }
 674     my $sti=$dbh->prepare($query);
 675     $sti->execute(@bind_values);
 676     while (($subfieldid) = $sti->fetchrow) {
 677         $resultcounter++;
 678         $lastsubfieldid=$subfieldid;
 679     }
 680     if ($resultcounter>1) {
 681         # Error condition.  Values given did not resolve into a unique record.  Don't know what to edit
 682         # should rarely occur (only if we use subfieldvalue with a value that exists twice, which is strange)
 683         return -1;
 684     } else {
 685         return $lastsubfieldid;
 686     }
 687 }
 688
 689 sub MARCfindsubfieldid {
 690         my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
 691         my $sth=$dbh->prepare("select subfieldid from marc_subfield_table
 692                                 where bibid=? and tag=? and tagorder=?
 693                                         and subfieldcode=? and subfieldorder=?");
 694         $sth->execute($bibid,$tag,$tagorder,$subfield,$subfieldorder);
 695         my ($res) = $sth->fetchrow;
 696         unless ($res) {
 697                 $sth=$dbh->prepare("select subfieldid from marc_subfield_table
 698                                 where bibid=? and tag=? and tagorder=?
 699                                         and subfieldcode=?");
 700                 $sth->execute($bibid,$tag,$tagorder,$subfield);
 701                 ($res) = $sth->fetchrow;
 702         }
 703     return $res;
 704 }
 705
 706 sub MARCfind_itemtype {
 707         my ($dbh,$bibid) = @_;
 708         my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.itemtype");
 709         my $sth = $dbh->prepare("select subfieldvalue from marc_subfield_table where bibid=? and tag=? and subfieldcode=?");
 710         $sth->execute($bibid,$tagfield,$tagsubfield);
 711         my ($subfieldvalue) = $sth->fetchrow;
 712         return $subfieldvalue;
 713 }
 714 sub MARCdelsubfield {
 715 # delete a subfield for $bibid / tag / tagorder / subfield / subfieldorder
 716     my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
 717     $dbh->do("delete from marc_subfield_table where bibid='$bibid' and
 718                         tag='$tag' and tagorder='$tagorder'
 719                         and subfieldcode='$subfield' and subfieldorder='$subfieldorder'
 720                         ");
 721 }
 722
 723 sub MARCkoha2marcBiblio {
 724 # this function builds partial MARC::Record from the old koha-DB fields
 725     my ($dbh,$biblionumber,$biblioitemnumber) = @_;
 726     my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
 727     my $record = MARC::Record->new();
 728 #--- if bibid, then retrieve old-style koha data
 729     if ($biblionumber>0) {
 730         my $sth2=$dbh->prepare("select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp
 731                 from biblio where biblionumber=?");
 732         $sth2->execute($biblionumber);
 733         my $row=$sth2->fetchrow_hashref;
 734         my $code;
 735         foreach $code (keys %$row) {
 736             if ($row->{$code}) {
 737                 &MARCkoha2marcOnefield($sth,$record,"biblio.".$code,$row->{$code});
 738             }
 739         }
 740     }
 741 #--- if biblioitem, then retrieve old-style koha data
 742     if ($biblioitemnumber>0) {
 743         my $sth2=$dbh->prepare(" SELECT biblioitemnumber,biblionumber,volume,number,classification,
 744                                                 itemtype,url,isbn,issn,dewey,subclass,publicationyear,publishercode,
 745                                                 volumedate,volumeddesc,timestamp,illus,pages,notes AS bnotes,size,place
 746                                         FROM biblioitems
 747                                         WHERE biblioitemnumber=?
 748                                         ");
 749         $sth2->execute($biblioitemnumber);
 750         my $row=$sth2->fetchrow_hashref;
 751         my $code;
 752         foreach $code (keys %$row) {
 753             if ($row->{$code}) {
 754                 &MARCkoha2marcOnefield($sth,$record,"biblioitems.".$code,$row->{$code});
 755             }
 756         }
 757     }
 758         # other fields => additional authors, subjects, subtitles
 759         my $sth2=$dbh->prepare(" SELECT author FROM additionalauthors WHERE biblionumber=?");
 760         $sth2->execute($biblionumber);
 761         while (my $row=$sth2->fetchrow_hashref) {
 762                         &MARCkoha2marcOnefield($sth,$record,"additionalauthors.author",$row->{'author'});
 763                 }
 764         my $sth2=$dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?");
 765         $sth2->execute($biblionumber);
 766         while (my $row=$sth2->fetchrow_hashref) {
 767                         &MARCkoha2marcOnefield($sth,$record,"bibliosubject.subject",$row->{'subject'});
 768                 }
 769         my $sth2=$dbh->prepare(" SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?");
 770         $sth2->execute($biblionumber);
 771         while (my $row=$sth2->fetchrow_hashref) {
 772                         &MARCkoha2marcOnefield($sth,$record,"bibliosubtitle.title",$row->{'subtitle'});
 773                 }
 774     return $record;
 775 }
 776
 777 sub MARCkoha2marcItem {
 778 # this function builds partial MARC::Record from the old koha-DB fields
 779     my ($dbh,$biblionumber,$itemnumber) = @_;
 780 #    my $dbh=&C4Connect;
 781     my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
 782     my $record = MARC::Record->new();
 783 #--- if item, then retrieve old-style koha data
 784     if ($itemnumber>0) {
 785 #       print STDERR "prepare $biblionumber,$itemnumber\n";
 786         my $sth2=$dbh->prepare("SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned,
 787                                                 booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
 788                                                 datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,itemcallnumber,issues,renewals,
 789                                         reserves,restricted,binding,itemnotes,holdingbranch,timestamp
 790                                         FROM items
 791                                         WHERE itemnumber=?");
 792         $sth2->execute($itemnumber);
 793         my $row=$sth2->fetchrow_hashref;
 794         my $code;
 795         foreach $code (keys %$row) {
 796             if ($row->{$code}) {
 797                 &MARCkoha2marcOnefield($sth,$record,"items.".$code,$row->{$code});
 798             }
 799         }
 800     }
 801     return $record;
 802 }
 803
 804 sub MARCkoha2marcSubtitle {
 805 # this function builds partial MARC::Record from the old koha-DB fields
 806     my ($dbh,$bibnum,$subtitle) = @_;
 807     my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
 808     my $record = MARC::Record->new();
 809     &MARCkoha2marcOnefield($sth,$record,"bibliosubtitle.subtitle",$subtitle);
 810     return $record;
 811 }
 812
 813 sub MARCkoha2marcOnefield {
 814     my ($sth,$record,$kohafieldname,$value)=@_;
 815     my $tagfield;
 816     my $tagsubfield;
 817     $sth->execute($kohafieldname);
 818     if (($tagfield,$tagsubfield)=$sth->fetchrow) {
 819         if ($record->field($tagfield)) {
 820             my $tag =$record->field($tagfield);
 821             if ($tag) {
 822                 $tag->add_subfields($tagsubfield,$value);
 823                 $record->delete_field($tag);
 824                 $record->add_fields($tag);
 825             }
 826         } else {
 827             $record->add_fields($tagfield," "," ",$tagsubfield => $value);
 828         }
 829     }
 830     return $record;
 831 }
 832
 833 sub MARChtml2marc {
 834         my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
 835         my $prevtag = -1;
 836         my $record = MARC::Record->new();
 837 #       my %subfieldlist=();
 838         my $prevvalue; # if tag <10
 839         my $field; # if tag >=10
 840         for (my $i=0; $i< @$rtags; $i++) {
 841                 # rebuild MARC::Record
 842                 if (@$rtags[$i] ne $prevtag) {
 843                         if ($prevtag < 10) {
 844                                 if ($prevvalue) {
 845                                         $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
 846                                 }
 847                         } else {
 848                                 if ($field) {
 849                                         $record->add_fields($field);
 850                                 }
 851                         }
 852                         $indicators{@$rtags[$i]}.='  ';
 853                         if (@$rtags[$i] <10) {
 854                                 $prevvalue= @$rvalues[$i];
 855                         } else {
 856                                 $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
 857                         }
 858                         $prevtag = @$rtags[$i];
 859                 } else {
 860                         if (@$rtags[$i] <10) {
 861                                 $prevvalue=@$rvalues[$i];
 862                         } else {
 863                                 if (@$rvalues[$i]) {
 864                                         $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
 865                                 }
 866                         }
 867                         $prevtag= @$rtags[$i];
 868                 }
 869         }
 870         # the last has not been included inside the loop... do it now !
 871         $record->add_fields($field);
 872 #       warn $record->as_formatted;
 873         return $record;
 874 }
 875
 876 sub MARCmarc2koha {
 877         my ($dbh,$record) = @_;
 878         my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
 879         my $result;
 880         my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
 881         $sth2->execute;
 882         my $field;
 883         #    print STDERR $record->as_formatted;
 884         while (($field)=$sth2->fetchrow) {
 885                 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result);
 886         }
 887         $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
 888         $sth2->execute;
 889         while (($field)=$sth2->fetchrow) {
 890                 if ($field eq 'notes') { $field = 'bnotes'; }
 891                 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result);
 892         }
 893         $sth2=$dbh->prepare("SHOW COLUMNS from items");
 894         $sth2->execute;
 895         while (($field)=$sth2->fetchrow) {
 896                 $result = &MARCmarc2kohaOneField($sth,"items",$field,$record,$result);
 897         }
 898         # additional authors : specific
 899         $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result);
 900         $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result);
 901 # modify copyrightdate to keep only the 1st year found
 902         my $temp = $result->{'copyrightdate'};
 903         $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
 904         if ($1>0) {
 905                 $result->{'copyrightdate'} = $1;
 906         } else { # if no cYYYY, get the 1st date.
 907                 $temp =~ m/(\d\d\d\d)/;
 908                 $result->{'copyrightdate'} = $1;
 909         }
 910 # modify publicationyear to keep only the 1st year found
 911         my $temp = $result->{'publicationyear'};
 912         $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
 913         if ($1>0) {
 914                 $result->{'publicationyear'} = $1;
 915         } else { # if no cYYYY, get the 1st date.
 916                 $temp =~ m/(\d\d\d\d)/;
 917                 $result->{'publicationyear'} = $1;
 918         }
 919         return $result;
 920 }
 921
 922 sub MARCmarc2kohaOneField {
 923 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
 924         my ($sth,$kohatable,$kohafield,$record,$result)= @_;
 925 #    warn "kohatable / $kohafield / $result / ";
 926         my $res="";
 927         my $tagfield;
 928         my $subfield;
 929         $sth->execute($kohatable.".".$kohafield);
 930         ($tagfield,$subfield) = $sth->fetchrow;
 931         foreach my $field ($record->field($tagfield)) {
 932                 if ($field->subfield($subfield)) {
 933                 if ($result->{$kohafield}) {
 934                         $result->{$kohafield} .= " | ".$field->subfield($subfield);
 935                 } else {
 936                         $result->{$kohafield}=$field->subfield($subfield);
 937                 }
 938                 }
 939         }
 940         return $result;
 941 }
 942
 943 sub MARCaddword {
 944 # split a subfield string and adds it into the word table.
 945 # removes stopwords
 946     my ($dbh,$bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$sentence) =@_;
 947     $sentence =~ s/(\.|\?|\:|\!|\'|,|\-|\"|\(|\)|\[|\]|\{|\})/ /g;
 948     my @words = split / /,$sentence;
 949     my $stopwords= C4::Context->stopwords;
 950     my $sth=$dbh->prepare("insert into marc_word (bibid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word)
 951                         values (?,?,?,?,?,?,soundex(?))");
 952     foreach my $word (@words) {
 953 # we record only words longer than 2 car and not in stopwords hash
 954         if (length($word)>2 and !($stopwords->{uc($word)})) {
 955             $sth->execute($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,$word);
 956             if ($sth->err()) {
 957                 warn "ERROR ==> insert into marc_word (bibid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word) values ($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,soundex($word))\n";
 958             }
 959         }
 960     }
 961 }
 962
 963 sub MARCdelword {
 964 # delete words. this sub deletes all the words from a sentence. a subfield modif is done by a delete then a add
 965     my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
 966     my $sth=$dbh->prepare("delete from marc_word where bibid=? and tag=? and tagorder=? and subfieldid=? and subfieldorder=?");
 967     $sth->execute($bibid,$tag,$tagorder,$subfield,$subfieldorder);
 968 }
 969
 970 #
 971 #
 972 # NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW
 973 #
 974 #
 975 # all the following subs are useful to manage MARC-DB with complete MARC records.
 976 # it's used with marcimport, and marc management tools
 977 #
 978
 979
 980 =item ($bibid,$oldbibnum,$oldbibitemnum) = NEWnewbibilio($dbh,$MARCRecord,$oldbiblio,$oldbiblioitem);
 981
 982 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
 983 are builded from the MARC::Record. If they are passed, they are used.
 984
 985 =item NEWnewitem($dbh, $record,$bibid);
 986
 987 adds an item in the db.
 988
 989 =cut
 990
 991 sub NEWnewbiblio {
 992         my ($dbh, $record, $oldbiblio, $oldbiblioitem) = @_;
 993         # note $oldbiblio and $oldbiblioitem are not mandatory.
 994         # if not present, they will be builded from $record with MARCmarc2koha function
 995         if (($oldbiblio) and not($oldbiblioitem)) {
 996                 print STDERR "NEWnewbiblio : missing parameter\n";
 997                 print "NEWnewbiblio : missing parameter : contact koha development  team\n";
 998                 die;
 999         }
1000         my $oldbibnum;
1001         my $oldbibitemnum;
1002         if ($oldbiblio) {
1003                 $oldbibnum = OLDnewbiblio($dbh,$oldbiblio);
1004                 $oldbiblioitem->{'biblionumber'} = $oldbibnum;
1005                 $oldbibitemnum = OLDnewbiblioitem($dbh,$oldbiblioitem);
1006         } else {
1007                 my $olddata = MARCmarc2koha($dbh,$record);
1008                 $oldbibnum = OLDnewbiblio($dbh,$olddata);
1009                 $olddata->{'biblionumber'} = $oldbibnum;
1010                 $oldbibitemnum = OLDnewbiblioitem($dbh,$olddata);
1011         }
1012         # search subtiles, addiauthors and subjects
1013         my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author");
1014         my @addiauthfields = $record->field($tagfield);
1015         foreach my $addiauthfield (@addiauthfields) {
1016                 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
1017                 foreach my $subfieldcount (0..$#addiauthsubfields) {
1018                         OLDmodaddauthor($dbh,$oldbibnum,$addiauthsubfields[$subfieldcount]);
1019                 }
1020         }
1021         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.title");
1022         my @subtitlefields = $record->field($tagfield);
1023         foreach my $subtitlefield (@subtitlefields) {
1024                 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
1025                 foreach my $subfieldcount (0..$#subtitlesubfields) {
1026                         OLDnewsubtitle($dbh,$oldbibnum,$subtitlesubfields[$subfieldcount]);
1027                 }
1028         }
1029         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject");
1030         my @subj = $record->field($tagfield);
1031         my @subjects;
1032         foreach my $subject (@subj) {
1033                 my @subjsubfield = $subject->subfield($tagsubfield);
1034                 foreach my $subfieldcount (0..$#subjsubfield) {
1035                         push @subjects,$subjsubfield[$subfieldcount];
1036                 }
1037         }
1038         OLDmodsubject($dbh,$oldbibnum,1,@subjects);
1039         # we must add bibnum and bibitemnum in MARC::Record...
1040         # we build the new field with biblionumber and biblioitemnumber
1041         # we drop the original field
1042         # we add the new builded field.
1043         # NOTE : Works only if the field is ONLY for biblionumber and biblioitemnumber
1044         # (steve and paul : thinks 090 is a good choice)
1045         my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
1046         $sth->execute("biblio.biblionumber");
1047         (my $tagfield1, my $tagsubfield1) = $sth->fetchrow;
1048         $sth->execute("biblioitems.biblioitemnumber");
1049         (my $tagfield2, my $tagsubfield2) = $sth->fetchrow;
1050         if ($tagfield1 != $tagfield2) {
1051                 warn "Error in NEWnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number";
1052                 print "Content-Type: text/html\n\nError in NEWnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number";
1053                 die;
1054         }
1055         my $newfield = MARC::Field->new( $tagfield1,'','',
1056                                                 "$tagsubfield1" => $oldbibnum,
1057                                                 "$tagsubfield2" => $oldbibitemnum);
1058         # drop old field and create new one...
1059         my $old_field = $record->field($tagfield1);
1060         $record->delete_field($old_field);
1061         $record->add_fields($newfield);
1062         my $bibid = MARCaddbiblio($dbh,$record,$oldbibnum);
1063         return ($bibid,$oldbibnum,$oldbibitemnum );
1064 }
1065
1066 sub NEWmodbiblio {
1067         my ($dbh,$record,$bibid) =@_;
1068         &MARCmodbiblio($dbh,$bibid,$record,0);
1069         my $oldbiblio = MARCmarc2koha($dbh,$record);
1070         my $oldbiblionumber = OLDmodbiblio($dbh,$oldbiblio);
1071         OLDmodbibitem($dbh,$oldbiblio);
1072         # now, modify addi authors, subject, addititles.
1073         my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author");
1074         my @addiauthfields = $record->field($tagfield);
1075         foreach my $addiauthfield (@addiauthfields) {
1076                 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
1077                 foreach my $subfieldcount (0..$#addiauthsubfields) {
1078                         OLDmodaddauthor($dbh,$oldbiblionumber,$addiauthsubfields[$subfieldcount]);
1079                 }
1080         }
1081         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle");
1082         my @subtitlefields = $record->field($tagfield);
1083         foreach my $subtitlefield (@subtitlefields) {
1084                 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
1085                 foreach my $subfieldcount (0..$#subtitlesubfields) {
1086                         OLDmodsubtitle($dbh,$oldbiblionumber,$subtitlesubfields[$subfieldcount]);
1087                 }
1088         }
1089         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject");
1090         my @subj = $record->field($tagfield);
1091         my @subjects;
1092         foreach my $subject (@subj) {
1093                 my @subjsubfield = $subject->subfield($tagsubfield);
1094                 foreach my $subfieldcount (0..$#subjsubfield) {
1095                         push @subjects,$subjsubfield[$subfieldcount];
1096                 }
1097         }
1098         OLDmodsubject($dbh,$oldbiblionumber,1,@subjects);
1099         return 1;
1100 }
1101
1102 sub NEWdelbiblio {
1103         my ($dbh,$bibid)=@_;
1104         my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
1105         &OLDdelbiblio($dbh,$biblio);
1106         my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
1107         $sth->execute($biblio);
1108         while(my ($biblioitemnumber) = $sth->fetchrow) {
1109                 OLDdeletebiblioitem($dbh,$biblioitemnumber);
1110         }
1111         &MARCdelbiblio($dbh,$bibid,0);
1112 }
1113
1114
1115 sub NEWnewitem {
1116         my ($dbh, $record,$bibid) = @_;
1117         # add item in old-DB
1118         my $item = &MARCmarc2koha($dbh,$record);
1119         # needs old biblionumber and biblioitemnumber
1120         $item->{'biblionumber'} = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
1121         my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
1122         $sth->execute($item->{'biblionumber'});
1123         ($item->{'biblioitemnumber'}) = $sth->fetchrow;
1124         my ($itemnumber,$error) = &OLDnewitems($dbh,$item,$item->{barcode});
1125         # add itemnumber to MARC::Record before adding the item.
1126         my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
1127         &MARCkoha2marcOnefield($sth,$record,"items.itemnumber",$itemnumber);
1128         # add the item
1129         my $bib = &MARCadditem($dbh,$record,$item->{'biblionumber'});
1130 }
1131
1132 sub NEWmoditem {
1133         my ($dbh,$record,$bibid,$itemnumber,$delete) = @_;
1134         &MARCmoditem($dbh,$record,$bibid,$itemnumber,$delete);
1135         my $olditem = MARCmarc2koha($dbh,$record);
1136         OLDmoditem($dbh,$olditem);
1137 }
1138
1139 sub NEWdelitem {
1140         my ($dbh,$bibid,$itemnumber)=@_;
1141         my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
1142         &OLDdelitem($dbh,$itemnumber);
1143         &MARCdelitem($dbh,$bibid,$itemnumber);
1144 }
1145
1146 #
1147 #
1148 # OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD
1149 #
1150 #
1151
1152 =item $biblionumber = OLDnewbiblio($dbh,$biblio);
1153
1154 adds a record in biblio table. Datas are in the hash $biblio.
1155
1156 =item $biblionumber = OLDmodbiblio($dbh,$biblio);
1157
1158 modify a record in biblio table. Datas are in the hash $biblio.
1159
1160 =item OLDmodsubtitle($dbh,$bibnum,$subtitle);
1161
1162 modify subtitles in bibliosubtitle table.
1163
1164 =item OLDmodaddauthor($dbh,$bibnum,$author);
1165
1166 adds or modify additional authors
1167 NOTE :  Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
1168
1169 =item $errors = OLDmodsubject($dbh,$bibnum, $force, @subject);
1170
1171 modify/adds subjects
1172
1173 =item OLDmodbibitem($dbh, $biblioitem);
1174
1175 modify a biblioitem
1176
1177 =item OLDmodnote($dbh,$bibitemnum,$note
1178
1179 modify a note for a biblioitem
1180
1181 =item OLDnewbiblioitem($dbh,$biblioitem);
1182
1183 adds a biblioitem ($biblioitem is a hash with the values)
1184
1185 =item OLDnewsubject($dbh,$bibnum);
1186
1187 adds a subject
1188
1189 =item OLDnewsubtitle($dbh,$bibnum,$subtitle);
1190
1191 create a new subtitle
1192
1193 =item ($itemnumber,$errors)= OLDnewitems($dbh,$item,$barcode);
1194
1195 create a item. $item is a hash and $barcode the barcode.
1196
1197 =item OLDmoditem($dbh,$item);
1198
1199 modify item
1200
1201 =item OLDdelitem($dbh,$itemnum);
1202
1203 delete item
1204
1205 =item OLDdeletebiblioitem($dbh,$biblioitemnumber);
1206
1207 deletes a biblioitem
1208 NOTE : not standard sub name. Should be OLDdelbiblioitem()
1209
1210 =item OLDdelbiblio($dbh,$biblio);
1211
1212 delete a biblio
1213
1214 =cut
1215
1216 sub OLDnewbiblio {
1217   my ($dbh,$biblio) = @_;
1218 #  my $dbh    = &C4Connect;
1219   my $sth    = $dbh->prepare("Select max(biblionumber) from biblio");
1220   $sth->execute;
1221   my $data   = $sth->fetchrow_arrayref;
1222   my $bibnum = $$data[0] + 1;
1223   my $series = 0;
1224
1225   if ($biblio->{'seriestitle'}) { $series = 1 };
1226   $sth->finish;
1227   $sth = $dbh->prepare("insert into biblio set biblionumber  = ?, title = ?, author = ?, copyrightdate = ?, serial = ?, seriestitle = ?, notes = ?, abstract = ?");
1228   $sth->execute($bibnum,$biblio->{'title'},$biblio->{'author'},$biblio->{'copyrightdate'},$series,$biblio->{'seriestitle'},$biblio->{'notes'},$biblio->{'abstract'});
1229
1230   $sth->finish;
1231 #  $dbh->disconnect;
1232   return($bibnum);
1233 }
1234
1235 sub OLDmodbiblio {
1236         my ($dbh,$biblio) = @_;
1237         #  my $dbh   = C4Connect;
1238         my $query;
1239         my $sth;
1240
1241         $query = "";
1242         $sth   = $dbh->prepare("Update biblio set title = ?, author = ?, abstract = ?, copyrightdate = ?, seriestitle = ?, serial = ?, unititle = ?, notes = ? where biblionumber = ?");
1243         $sth->execute($biblio->{'title'},$biblio->{'author'},$biblio->{'abstract'},$biblio->{'copyrightdate'}, $biblio->{'seriestitle'},$biblio->{'serial'},$biblio->{'unititle'},$biblio->{'notes'},$biblio->{'biblionumber'});
1244
1245         $sth->finish;
1246         return($biblio->{'biblionumber'});
1247 } # sub modbiblio
1248
1249 sub OLDmodsubtitle {
1250         my ($dbh,$bibnum, $subtitle) = @_;
1251         my $sth   = $dbh->prepare("update bibliosubtitle set subtitle = ? where biblionumber = ?");
1252         $sth->execute($subtitle,$bibnum);
1253         $sth->finish;
1254 } # sub modsubtitle
1255
1256
1257 sub OLDmodaddauthor {
1258     my ($dbh,$bibnum, $author) = @_;
1259 #    my $dbh   = C4Connect;
1260     my $sth = $dbh->prepare("Delete from additionalauthors where biblionumber = ?");
1261
1262     $sth->execute($bibnum);
1263     $sth->finish;
1264
1265     if ($author ne '') {
1266         $sth   = $dbh->prepare("Insert into additionalauthors set author = ?, biblionumber = ?");
1267
1268         $sth->execute($author,$bibnum);
1269
1270         $sth->finish;
1271     } # if
1272 } # sub modaddauthor
1273
1274
1275 sub OLDmodsubject {
1276         my ($dbh,$bibnum, $force, @subject) = @_;
1277         #  my $dbh   = C4Connect;
1278         my $count = @subject;
1279         my $error;
1280         for (my $i = 0; $i < $count; $i++) {
1281                 $subject[$i] =~ s/^ //g;
1282                 $subject[$i] =~ s/ $//g;
1283                 my $sth   = $dbh->prepare("select * from catalogueentry where entrytype = 's' and catalogueentry = ?");
1284                 $sth->execute($subject[$i]);
1285
1286                 if (my $data = $sth->fetchrow_hashref) {
1287                 } else {
1288                         if ($force eq $subject[$i] || $force == 1) {
1289                                 # subject not in aut, chosen to force anway
1290                                 # so insert into cataloguentry so its in auth file
1291                                 my $sth2 = $dbh->prepare("Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)");
1292
1293                                 $sth2->execute($subject[$i]) if ($subject[$i]);
1294                                 $sth2->finish;
1295                         } else {
1296                                 $error = "$subject[$i]\n does not exist in the subject authority file";
1297                                 my $sth2 = $dbh->prepare("Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)");
1298                                 $sth2->execute("$subject[$i] %","% $subject[$i] %","% $subject[$i]");
1299                                 while (my $data = $sth2->fetchrow_hashref) {
1300                                         $error .= "<br>$data->{'catalogueentry'}";
1301                                 } # while
1302                                 $sth2->finish;
1303                         } # else
1304                 } # else
1305                 $sth->finish;
1306         } # else
1307         if ($error eq '') {
1308                 my $sth   = $dbh->prepare("Delete from bibliosubject where biblionumber = ?");
1309                 $sth->execute($bibnum);
1310                 $sth->finish;
1311                 $sth = $dbh->prepare("Insert into bibliosubject (subject,biblionumber) values (?,?)");
1312                 my $query;
1313                 foreach $query (@subject) {
1314                         $sth->execute($query,$bibnum) if ($query && $bibnum);
1315                 } # foreach
1316                 $sth->finish;
1317         } # if
1318
1319         #  $dbh->disconnect;
1320         return($error);
1321 } # sub modsubject
1322
1323 sub OLDmodbibitem {
1324     my ($dbh,$biblioitem) = @_;
1325 #    my $dbh   = C4Connect;
1326     my $query;
1327
1328     $biblioitem->{'itemtype'}        = $dbh->quote($biblioitem->{'itemtype'});
1329     $biblioitem->{'url'}             = $dbh->quote($biblioitem->{'url'});
1330     $biblioitem->{'isbn'}            = $dbh->quote($biblioitem->{'isbn'});
1331     $biblioitem->{'publishercode'}   = $dbh->quote($biblioitem->{'publishercode'});
1332     $biblioitem->{'publicationyear'} = $dbh->quote($biblioitem->{'publicationyear'});
1333     $biblioitem->{'classification'}  = $dbh->quote($biblioitem->{'classification'});
1334     $biblioitem->{'dewey'}           = $dbh->quote($biblioitem->{'dewey'});
1335     $biblioitem->{'subclass'}        = $dbh->quote($biblioitem->{'subclass'});
1336     $biblioitem->{'illus'}           = $dbh->quote($biblioitem->{'illus'});
1337     $biblioitem->{'pages'}           = $dbh->quote($biblioitem->{'pages'});
1338     $biblioitem->{'volumeddesc'}     = $dbh->quote($biblioitem->{'volumeddesc'});
1339     $biblioitem->{'bnotes'}          = $dbh->quote($biblioitem->{'bnotes'});
1340     $biblioitem->{'size'}            = $dbh->quote($biblioitem->{'size'});
1341     $biblioitem->{'place'}           = $dbh->quote($biblioitem->{'place'});
1342
1343     $query = "Update biblioitems set
1344 itemtype        = $biblioitem->{'itemtype'},
1345 url             = $biblioitem->{'url'},
1346 isbn            = $biblioitem->{'isbn'},
1347 publishercode   = $biblioitem->{'publishercode'},
1348 publicationyear = $biblioitem->{'publicationyear'},
1349 classification  = $biblioitem->{'classification'},
1350 dewey           = $biblioitem->{'dewey'},
1351 subclass        = $biblioitem->{'subclass'},
1352 illus           = $biblioitem->{'illus'},
1353 pages           = $biblioitem->{'pages'},
1354 volumeddesc     = $biblioitem->{'volumeddesc'},
1355 notes           = $biblioitem->{'bnotes'},
1356 size            = $biblioitem->{'size'},
1357 place           = $biblioitem->{'place'}
1358 where biblioitemnumber = $biblioitem->{'biblioitemnumber'}";
1359
1360 $dbh->do($query);
1361 if ($dbh->errstr) {
1362         warn "$query";
1363 }
1364 #    $dbh->disconnect;
1365 } # sub modbibitem
1366
1367 sub OLDmodnote {
1368   my ($dbh,$bibitemnum,$note)=@_;
1369 #  my $dbh=C4Connect;
1370   my $query="update biblioitems set notes='$note' where
1371   biblioitemnumber='$bibitemnum'";
1372   my $sth=$dbh->prepare($query);
1373   $sth->execute;
1374   $sth->finish;
1375 #  $dbh->disconnect;
1376 }
1377
1378 sub OLDnewbiblioitem {
1379         my ($dbh,$biblioitem) = @_;
1380         #  my $dbh   = C4Connect;
1381         my $sth   = $dbh->prepare("Select max(biblioitemnumber) from biblioitems");
1382         my $data;
1383         my $bibitemnum;
1384
1385         $sth->execute;
1386         $data       = $sth->fetchrow_arrayref;
1387         $bibitemnum = $$data[0] + 1;
1388
1389         $sth->finish;
1390
1391         $sth = $dbh->prepare("insert into biblioitems set
1392                                                                         biblioitemnumber = ?,           biblionumber     = ?,
1393                                                                         volume           = ?,                   number           = ?,
1394                                                                         classification  = ?,                    itemtype         = ?,
1395                                                                         url              = ?,                           isbn             = ?,
1396                                                                         issn             = ?,                           dewey            = ?,
1397                                                                         subclass         = ?,                           publicationyear  = ?,
1398                                                                         publishercode    = ?,           volumedate       = ?,
1399                                                                         volumeddesc      = ?,           illus            = ?,
1400                                                                         pages            = ?,                           notes            = ?,
1401                                                                         size             = ?,                           lccn             = ?,
1402                                                                         marc             = ?,                           place            = ?");
1403         $sth->execute($bibitemnum,                                                      $biblioitem->{'biblionumber'},
1404                                                 $biblioitem->{'volume'},                        $biblioitem->{'number'},
1405                                                 $biblioitem->{'classification'},                $biblioitem->{'itemtype'},
1406                                                 $biblioitem->{'url'},                                   $biblioitem->{'isbn'},
1407                                                 $biblioitem->{'issn'},                          $biblioitem->{'dewey'},
1408                                                 $biblioitem->{'subclass'},                      $biblioitem->{'publicationyear'},
1409                                                 $biblioitem->{'publishercode'}, $biblioitem->{'volumedate'},
1410                                                 $biblioitem->{'volumeddesc'},           $biblioitem->{'illus'},
1411                                                 $biblioitem->{'pages'},                         $biblioitem->{'bnotes'},
1412                                                 $biblioitem->{'size'},                          $biblioitem->{'lccn'},
1413                                                 $biblioitem->{'marc'},                          $biblioitem->{'place'});
1414         $sth->finish;
1415         #    $dbh->disconnect;
1416         return($bibitemnum);
1417 }
1418
1419 sub OLDnewsubject {
1420   my ($dbh,$bibnum)=@_;
1421   my $sth=$dbh->prepare("insert into bibliosubject (biblionumber) values (?)");
1422   $sth->execute($bibnum);
1423   $sth->finish;
1424 }
1425
1426 sub OLDnewsubtitle {
1427     my ($dbh,$bibnum, $subtitle) = @_;
1428     my $sth   = $dbh->prepare("insert into bibliosubtitle set biblionumber = ?, subtitle = ?");
1429     $sth->execute($bibnum,$subtitle);
1430     $sth->finish;
1431 }
1432
1433
1434 sub OLDnewitems {
1435         my ($dbh,$item, $barcode) = @_;
1436         #  my $dbh   = C4Connect;
1437         my $sth   = $dbh->prepare("Select max(itemnumber) from items");
1438         my $data;
1439         my $itemnumber;
1440         my $error = "";
1441
1442         $sth->execute;
1443         $data       = $sth->fetchrow_hashref;
1444         $itemnumber = $data->{'max(itemnumber)'} + 1;
1445         $sth->finish;
1446 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
1447         if ($item->{'loan'}) {
1448                 $item->{'notforloan'} = $item->{'loan'};
1449         }
1450 # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1451         if ($item->{'dateaccessioned'}) {
1452                 $sth=$dbh->prepare("Insert into items set
1453                                                         itemnumber           = ?,                               biblionumber         = ?,
1454                                                         biblioitemnumber     = ?,                               barcode              = ?,
1455                                                         booksellerid         = ?,                                       dateaccessioned      = ?,
1456                                                         homebranch           = ?,                               holdingbranch        = ?,
1457                                                         price                = ?,                                               replacementprice     = ?,
1458                                                         replacementpricedate = NOW(),   itemnotes            = ?,
1459                                                         itemcallnumber  =?,                                                     notforloan = ?
1460                                                         ");
1461                 $sth->execute($itemnumber,      $item->{'biblionumber'},
1462                                                                 $item->{'biblioitemnumber'},$barcode,
1463                                                                 $item->{'booksellerid'},$item->{'dateaccessioned'},
1464                                                                 $item->{'homebranch'},$item->{'holdingbranch'},
1465                                                                 $item->{'price'},$item->{'replacementprice'},
1466                                                                 $item->{'itemnotes'},$item->{'itemcallnumber'},$item->{'notforloan'});
1467         } else {
1468                 $sth=$dbh->prepare("Insert into items set
1469                                                         itemnumber           = ?,                               biblionumber         = ?,
1470                                                         biblioitemnumber     = ?,                               barcode              = ?,
1471                                                         booksellerid         = ?,                                       dateaccessioned      = NOW(),
1472                                                         homebranch           = ?,                               holdingbranch        = ?,
1473                                                         price                = ?,                                               replacementprice     = ?,
1474                                                         replacementpricedate = NOW(),   itemnotes            = ?,
1475                                                         itemcallnumber = ? , notforloan = ?
1476                                                         ");
1477                 $sth->execute($itemnumber,      $item->{'biblionumber'},
1478                                                                 $item->{'biblioitemnumber'},$barcode,
1479                                                                 $item->{'booksellerid'},
1480                                                                 $item->{'homebranch'},$item->{'holdingbranch'},
1481                                                                 $item->{'price'},$item->{'replacementprice'},
1482                                                                 $item->{'itemnotes'},$item->{'itemcallnumber'},$item->{'notforloan'});
1483         }
1484         if (defined $sth->errstr) {
1485                 $error .= $sth->errstr;
1486         }
1487         $sth->finish;
1488         return($itemnumber,$error);
1489 }
1490
1491 sub OLDmoditem {
1492     my ($dbh,$item) = @_;
1493 #  my ($dbh,$loan,$itemnum,$bibitemnum,$barcode,$notes,$homebranch,$lost,$wthdrawn,$replacement)=@_;
1494 #  my $dbh=C4Connect;
1495 $item->{'itemnum'}=$item->{'itemnumber'} unless $item->{'itemnum'};
1496   my $query="update items set  barcode=?,itemnotes=?,itemcallnumber=?,notforloan=? where itemnumber=?";
1497   my @bind = ($item->{'barcode'},$item->{'notes'},$item->{'itemcallnumber'},$item->{'notforloan'},$item->{'itemnum'});
1498   if ($item->{'barcode'} eq ''){
1499         $item->{'notforloan'}=0 unless $item->{'notforloan'};
1500     $query="update items set notforloan=? where itemnumber=?";
1501     @bind = ($item->{'notforloan'},$item->{'itemnum'});
1502   }
1503   if ($item->{'lost'} ne ''){
1504     $query="update items set biblioitemnumber=?,
1505                              barcode=?,
1506                              itemnotes=?,
1507                              homebranch=?,
1508                              itemlost=?,
1509                              wthdrawn=?,
1510                              itemcallnumber=?,
1511                              notforloan=?,
1512                           where itemnumber=?";
1513     @bind = ($item->{'bibitemnum'},$item->{'barcode'},$item->{'notes'},$item->{'homebranch'},$item->{'lost'},$item->{'wthdrawn'},$item->{'itemcallnumber'},$item->{'notforloan'},$item->{'itemnum'});
1514   }
1515   if ($item->{'replacement'} ne ''){
1516     $query=~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1517   }
1518   my $sth=$dbh->prepare($query);
1519   $sth->execute(@bind);
1520   $sth->finish;
1521 #  $dbh->disconnect;
1522 }
1523
1524 sub OLDdelitem{
1525         my ($dbh,$itemnum)=@_;
1526         #  my $dbh=C4Connect;
1527         my $sth=$dbh->prepare("select * from items where itemnumber=?");
1528         $sth->execute($itemnum);
1529         my $data=$sth->fetchrow_hashref;
1530         $sth->finish;
1531         my $query="Insert into deleteditems set ";
1532         my @bind = ();
1533         foreach my $temp (keys %$data){
1534                 $query .= "$temp = ?,";
1535                 push(@bind,$data->{$temp});
1536         }
1537         $query =~ s/\,$//;
1538 #  print $query;
1539         $sth=$dbh->prepare($query);
1540         $sth->execute(@bind);
1541         $sth->finish;
1542         $sth=$dbh->prepare("Delete from items where itemnumber=?");
1543         $sth->execute($itemnum);
1544         $sth->finish;
1545 #  $dbh->disconnect;
1546 }
1547
1548 sub OLDdeletebiblioitem {
1549     my ($dbh,$biblioitemnumber) = @_;
1550 #    my $dbh   = C4Connect;
1551     my $sth   = $dbh->prepare("Select * from biblioitems
1552 where biblioitemnumber = ?");
1553     my $results;
1554
1555     $sth->execute($biblioitemnumber);
1556
1557     if ($results = $sth->fetchrow_hashref) {
1558         $sth->finish;
1559         $sth=$dbh->prepare("Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
1560                                         isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
1561                                         pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)");
1562
1563         $sth->execute($results->{biblioitemnumber}, $results->{biblionumber}, $results->{volume}, $results->{number}, $results->{classification}, $results->{itemtype},
1564                                         $results->{isbn}, $results->{issn} ,$results->{dewey} ,$results->{subclass} ,$results->{publicationyear} ,$results->{publishercode} ,$results->{volumedate} ,$results->{volumeddesc} ,$results->{timestamp} ,$results->{illus} ,
1565                                         $results->{pages} ,$results->{notes} ,$results->{size} ,$results->{url} ,$results->{lccn} );
1566         my $sth2 = $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?");
1567         $sth2->execute($biblioitemnumber);
1568         $sth2->finish();
1569     } # if
1570     $sth->finish;
1571 # Now delete all the items attached to the biblioitem
1572         $sth   = $dbh->prepare("Select * from items where biblioitemnumber = ?");
1573         $sth->execute($biblioitemnumber);
1574         my @results;
1575         while (my $data = $sth->fetchrow_hashref) {
1576                 my $query="Insert into deleteditems set ";
1577                 my @bind = ();
1578                 foreach my $temp (keys %$data){
1579                         $query .= "$temp = ?,";
1580                         push(@bind,$data->{$temp});
1581                 }
1582                 $query =~ s/\,$//;
1583                 my $sth2=$dbh->prepare($query);
1584                 $sth2->execute(@bind);
1585         } # while
1586         $sth->finish;
1587         $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
1588         $sth->execute($biblioitemnumber);
1589         $sth->finish();
1590 #    $dbh->disconnect;
1591 } # sub deletebiblioitem
1592
1593 sub OLDdelbiblio{
1594         my ($dbh,$biblio)=@_;
1595         my $sth=$dbh->prepare("select * from biblio where biblionumber=?");
1596         $sth->execute($biblio);
1597         if (my $data=$sth->fetchrow_hashref){
1598                 $sth->finish;
1599                 my $query="Insert into deletedbiblio set ";
1600                 my @bind =();
1601                 foreach my $temp (keys %$data){
1602                         $query .= "$temp = ?,";
1603                         push(@bind,$data->{$temp});
1604                 }
1605                 #replacing the last , by ",?)"
1606                 $query=~ s/\,$//;
1607                 $sth=$dbh->prepare($query);
1608                 $sth->execute(@bind);
1609                 $sth->finish;
1610                 $sth=$dbh->prepare("Delete from biblio where biblionumber=?");
1611                 $sth->execute($biblio);
1612                 $sth->finish;
1613         }
1614         $sth->finish;
1615 }
1616
1617 #
1618 #
1619 # old functions
1620 #
1621 #
1622
1623 sub itemcount{
1624   my ($biblio)=@_;
1625   my $dbh = C4::Context->dbh;
1626 #  print $query;
1627   my $sth=$dbh->prepare("Select count(*) from items where biblionumber=?");
1628   $sth->execute($biblio);
1629   my $data=$sth->fetchrow_hashref;
1630   $sth->finish;
1631   return($data->{'count(*)'});
1632 }
1633
1634 =item getorder
1635
1636   ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
1637
1638 Looks up the order with the given biblionumber and biblioitemnumber.
1639
1640 Returns a two-element array. C<$ordernumber> is the order number.
1641 C<$order> is a reference-to-hash describing the order; its keys are
1642 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
1643 tables of the Koha database.
1644
1645 =cut
1646 #'
1647 # FIXME - This is effectively identical to &C4::Catalogue::getorder.
1648 # Pick one and stick with it.
1649 sub getorder{
1650   my ($bi,$bib)=@_;
1651   my $dbh = C4::Context->dbh;
1652   my $sth=$dbh->prepare("Select ordernumber
1653         from aqorders
1654         where biblionumber=? and biblioitemnumber=?");
1655   $sth->execute($bib,$bi);
1656   # FIXME - Use fetchrow_array(), since we're only interested in the one
1657   # value.
1658   my $ordnum=$sth->fetchrow_hashref;
1659   $sth->finish;
1660   my $order=getsingleorder($ordnum->{'ordernumber'});
1661   return ($order,$ordnum->{'ordernumber'});
1662 }
1663
1664 =item getsingleorder
1665
1666   $order = &getsingleorder($ordernumber);
1667
1668 Looks up an order by order number.
1669
1670 Returns a reference-to-hash describing the order. The keys of
1671 C<$order> are fields from the biblio, biblioitems, aqorders, and
1672 aqorderbreakdown tables of the Koha database.
1673
1674 =cut
1675 #'
1676 # FIXME - This is effectively identical to
1677 # &C4::Catalogue::getsingleorder.
1678 # Pick one and stick with it.
1679 sub getsingleorder {
1680   my ($ordnum)=@_;
1681   my $dbh = C4::Context->dbh;
1682   my $sth=$dbh->prepare("Select * from biblio,biblioitems,aqorders left join aqorderbreakdown
1683   on aqorders.ordernumber=aqorderbreakdown.ordernumber
1684   where aqorders.ordernumber=?
1685   and biblio.biblionumber=aqorders.biblionumber
1686   and biblioitems.biblioitemnumber=aqorders.biblioitemnumber");
1687   $sth->execute($ordnum);
1688   my $data=$sth->fetchrow_hashref;
1689   $sth->finish;
1690   return($data);
1691 }
1692
1693 sub newbiblio {
1694         my ($biblio) = @_;
1695         my $dbh    = C4::Context->dbh;
1696         my $bibnum=OLDnewbiblio($dbh,$biblio);
1697         # finds new (MARC bibid
1698 #       my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1699         my $record = &MARCkoha2marcBiblio($dbh,$bibnum);
1700         MARCaddbiblio($dbh,$record,$bibnum);
1701         return($bibnum);
1702 }
1703
1704 =item modbiblio
1705
1706   $biblionumber = &modbiblio($biblio);
1707
1708 Update a biblio record.
1709
1710 C<$biblio> is a reference-to-hash whose keys are the fields in the
1711 biblio table in the Koha database. All fields must be present, not
1712 just the ones you wish to change.
1713
1714 C<&modbiblio> updates the record defined by
1715 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1716
1717 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1718 successful or not.
1719
1720 =cut
1721
1722 sub modbiblio {
1723         my ($biblio) = @_;
1724         my $dbh  = C4::Context->dbh;
1725         my $biblionumber=OLDmodbiblio($dbh,$biblio);
1726         my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
1727         # finds new (MARC bibid
1728         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
1729         MARCmodbiblio($dbh,$bibid,$record,0);
1730         return($biblionumber);
1731 } # sub modbiblio
1732
1733 =item modsubtitle
1734
1735   &modsubtitle($biblionumber, $subtitle);
1736
1737 Sets the subtitle of a book.
1738
1739 C<$biblionumber> is the biblionumber of the book to modify.
1740
1741 C<$subtitle> is the new subtitle.
1742
1743 =cut
1744
1745 sub modsubtitle {
1746   my ($bibnum, $subtitle) = @_;
1747   my $dbh   = C4::Context->dbh;
1748   &OLDmodsubtitle($dbh,$bibnum,$subtitle);
1749 } # sub modsubtitle
1750
1751 =item modaddauthor
1752
1753   &modaddauthor($biblionumber, $author);
1754
1755 Replaces all additional authors for the book with biblio number
1756 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1757 C<&modaddauthor> deletes all additional authors.
1758
1759 =cut
1760
1761 sub modaddauthor {
1762     my ($bibnum, $author) = @_;
1763     my $dbh   = C4::Context->dbh;
1764     &OLDmodaddauthor($dbh,$bibnum,$author);
1765 } # sub modaddauthor
1766
1767 =item modsubject
1768
1769   $error = &modsubject($biblionumber, $force, @subjects);
1770
1771 $force - a subject to force
1772
1773 $error - Error message, or undef if successful.
1774
1775 =cut
1776
1777 sub modsubject {
1778   my ($bibnum, $force, @subject) = @_;
1779   my $dbh   = C4::Context->dbh;
1780   my $error= &OLDmodsubject($dbh,$bibnum,$force, @subject);
1781   return($error);
1782 } # sub modsubject
1783
1784 sub modbibitem {
1785     my ($biblioitem) = @_;
1786     my $dbh   = C4::Context->dbh;
1787     &OLDmodbibitem($dbh,$biblioitem);
1788 } # sub modbibitem
1789
1790 sub modnote {
1791   my ($bibitemnum,$note)=@_;
1792   my $dbh = C4::Context->dbh;
1793   &OLDmodnote($dbh,$bibitemnum,$note);
1794 }
1795
1796 sub newbiblioitem {
1797         my ($biblioitem) = @_;
1798         my $dbh   = C4::Context->dbh;
1799         my $bibitemnum = &OLDnewbiblioitem($dbh,$biblioitem);
1800     ################################################################
1801     ## Fix template and shift this to newbiblio
1802         my @subjects=split(/\n/,$biblioitem->{'subjectheadings'});
1803         modsubject($biblioitem->{'biblionumber'},1,@subjects);
1804     ################################################################
1805         my $MARCbiblio= MARCkoha2marcBiblio($dbh,0,$bibitemnum); # the 0 means "do NOT retrieve biblio, only biblioitem, in the MARC record
1806         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblioitem->{biblionumber});
1807         &MARCaddbiblio($dbh,$MARCbiblio,$biblioitem->{biblionumber},$bibid);
1808         return($bibitemnum);
1809 }
1810
1811 sub newsubject {
1812   my ($bibnum)=@_;
1813   my $dbh = C4::Context->dbh;
1814   &OLDnewsubject($dbh,$bibnum);
1815 }
1816
1817 sub newsubtitle {
1818     my ($bibnum, $subtitle) = @_;
1819     my $dbh   = C4::Context->dbh;
1820     &OLDnewsubtitle($dbh,$bibnum,$subtitle);
1821 }
1822
1823 sub newitems {
1824   my ($item, @barcodes) = @_;
1825   my $dbh   = C4::Context->dbh;
1826   my $errors;
1827   my $itemnumber;
1828   my $error;
1829   foreach my $barcode (@barcodes) {
1830       ($itemnumber,$error)=&OLDnewitems($dbh,$item,uc($barcode));
1831       $errors .=$error;
1832       my $MARCitem = &MARCkoha2marcItem($dbh,$item->{biblionumber},$itemnumber);
1833       &MARCadditem($dbh,$MARCitem,$item->{biblionumber});
1834   }
1835   return($errors);
1836 }
1837
1838 sub moditem {
1839     my ($item) = @_;
1840     my $dbh = C4::Context->dbh;
1841     &OLDmoditem($dbh,$item);
1842     my $MARCitem = &MARCkoha2marcItem($dbh,$item->{'biblionumber'},$item->{'itemnum'});
1843     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$item->{biblionumber});
1844     &MARCmoditem($dbh,$MARCitem,$bibid,$item->{itemnum},0);
1845 }
1846
1847 sub checkitems{
1848   my ($count,@barcodes)=@_;
1849   my $dbh = C4::Context->dbh;
1850   my $error;
1851   my $sth=$dbh->prepare("Select * from items where barcode=?");
1852   for (my $i=0;$i<$count;$i++){
1853     $barcodes[$i]=uc $barcodes[$i];
1854     $sth->execute($barcodes[$i]);
1855     if (my $data=$sth->fetchrow_hashref){
1856       $error.=" Duplicate Barcode: $barcodes[$i]";
1857     }
1858   }
1859   $sth->finish;
1860   return($error);
1861 }
1862
1863 sub countitems{
1864   my ($bibitemnum)=@_;
1865   my $dbh = C4::Context->dbh;
1866   my $query="";
1867   my $sth=$dbh->prepare("Select count(*) from items where biblioitemnumber=?");
1868   $sth->execute($bibitemnum);
1869   my $data=$sth->fetchrow_hashref;
1870   $sth->finish;
1871   return($data->{'count(*)'});
1872 }
1873
1874 sub delitem{
1875   my ($itemnum)=@_;
1876   my $dbh = C4::Context->dbh;
1877   &OLDdelitem($dbh,$itemnum);
1878 }
1879
1880 sub deletebiblioitem {
1881     my ($biblioitemnumber) = @_;
1882     my $dbh   = C4::Context->dbh;
1883     &OLDdeletebiblioitem($dbh,$biblioitemnumber);
1884 } # sub deletebiblioitem
1885
1886
1887 sub delbiblio {
1888         my ($biblio)=@_;
1889         my $dbh = C4::Context->dbh;
1890         &OLDdelbiblio($dbh,$biblio);
1891         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblio);
1892         &MARCdelbiblio($dbh,$bibid,0);
1893 }
1894
1895 sub getbiblio {
1896     my ($biblionumber) = @_;
1897     my $dbh   = C4::Context->dbh;
1898     my $sth   = $dbh->prepare("Select * from biblio where biblionumber = ?");
1899       # || die "Cannot prepare $query\n" . $dbh->errstr;
1900     my $count = 0;
1901     my @results;
1902
1903     $sth->execute($biblionumber);
1904       # || die "Cannot execute $query\n" . $sth->errstr;
1905     while (my $data = $sth->fetchrow_hashref) {
1906       $results[$count] = $data;
1907       $count++;
1908     } # while
1909
1910     $sth->finish;
1911     return($count, @results);
1912 } # sub getbiblio
1913
1914 sub getbiblioitem {
1915     my ($biblioitemnum) = @_;
1916     my $dbh   = C4::Context->dbh;
1917     my $sth   = $dbh->prepare("Select * from biblioitems where
1918 biblioitemnumber = ?");
1919     my $count = 0;
1920     my @results;
1921
1922     $sth->execute($biblioitemnum);
1923
1924     while (my $data = $sth->fetchrow_hashref) {
1925         $results[$count] = $data;
1926         $count++;
1927     } # while
1928
1929     $sth->finish;
1930     return($count, @results);
1931 } # sub getbiblioitem
1932
1933 sub getbiblioitembybiblionumber {
1934     my ($biblionumber) = @_;
1935     my $dbh   = C4::Context->dbh;
1936     my $sth   = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
1937     my $count = 0;
1938     my @results;
1939
1940     $sth->execute($biblionumber);
1941
1942     while (my $data = $sth->fetchrow_hashref) {
1943         $results[$count] = $data;
1944         $count++;
1945     } # while
1946
1947     $sth->finish;
1948     return($count, @results);
1949 } # sub
1950
1951 sub getitemsbybiblioitem {
1952     my ($biblioitemnum) = @_;
1953     my $dbh   = C4::Context->dbh;
1954     my $sth   = $dbh->prepare("Select * from items, biblio where
1955 biblio.biblionumber = items.biblionumber and biblioitemnumber
1956 = ?");
1957       # || die "Cannot prepare $query\n" . $dbh->errstr;
1958     my $count = 0;
1959     my @results;
1960
1961     $sth->execute($biblioitemnum);
1962       # || die "Cannot execute $query\n" . $sth->errstr;
1963     while (my $data = $sth->fetchrow_hashref) {
1964       $results[$count] = $data;
1965       $count++;
1966     } # while
1967
1968     $sth->finish;
1969     return($count, @results);
1970 } # sub getitemsbybiblioitem
1971
1972
1973 sub logchange {
1974 # Subroutine to log changes to databases
1975 # Eventually, this subroutine will be used to create a log of all changes made,
1976 # with the possibility of "undo"ing some changes
1977     my $database=shift;
1978     if ($database eq 'kohadb') {
1979         my $type=shift;
1980         my $section=shift;
1981         my $item=shift;
1982         my $original=shift;
1983         my $new=shift;
1984 #       print STDERR "KOHA: $type $section $item $original $new\n";
1985     } elsif ($database eq 'marc') {
1986         my $type=shift;
1987         my $Record_ID=shift;
1988         my $tag=shift;
1989         my $mark=shift;
1990         my $subfield_ID=shift;
1991         my $original=shift;
1992         my $new=shift;
1993 #       print STDERR "MARC: $type $Record_ID $tag $mark $subfield_ID $original $new\n";
1994     }
1995 }
1996
1997 #------------------------------------------------
1998
1999
2000 #---------------------------------------
2001 # Find a biblio entry, or create a new one if it doesn't exist.
2002 #  If a "subtitle" entry is in hash, add it to subtitle table
2003 sub getoraddbiblio {
2004         # input params
2005         my (
2006           $dbh,         # db handle
2007                         # FIXME - Unused argument
2008           $biblio,      # hash ref to fields
2009         )=@_;
2010
2011         # return
2012         my $biblionumber;
2013
2014         my $debug=0;
2015         my $sth;
2016         my $error;
2017
2018         #-----
2019         $dbh = C4::Context->dbh;
2020
2021         print "<PRE>Looking for biblio </PRE>\n" if $debug;
2022         $sth=$dbh->prepare("select biblionumber
2023                 from biblio
2024                 where title=? and author=?
2025                   and copyrightdate=? and seriestitle=?");
2026         $sth->execute(
2027                 $biblio->{title}, $biblio->{author},
2028                 $biblio->{copyright}, $biblio->{seriestitle} );
2029         if ($sth->rows) {
2030             ($biblionumber) = $sth->fetchrow;
2031             print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
2032         } else {
2033             # Doesn't exist.  Add new one.
2034             print "<PRE>Adding biblio</PRE>\n" if $debug;
2035             ($biblionumber,$error)=&newbiblio($biblio);
2036             if ( $biblionumber ) {
2037               print "<PRE>Added with biblio number=$biblionumber</PRE>\n" if $debug;
2038               if ( $biblio->{subtitle} ) {
2039                 &newsubtitle($biblionumber,$biblio->{subtitle} );
2040               } # if subtitle
2041             } else {
2042                 print "<PRE>Couldn't add biblio: $error</PRE>\n" if $debug;
2043             } # if added
2044         }
2045
2046         return $biblionumber,$error;
2047
2048 } # sub getoraddbiblio
2049
2050 sub char_decode {
2051         # converts ISO 5426 coded string to ISO 8859-1
2052         # sloppy code : should be improved in next issue
2053         my ($string,$encoding) = @_ ;
2054         $_ = $string ;
2055 #       $encoding = C4::Context->preference("marcflavour") unless $encoding;
2056         if ($encoding eq "UNIMARC") {
2057                 s/\xe1/Æ/gm ;
2058                 s/\xe2/Ð/gm ;
2059                 s/\xe9/Ø/gm ;
2060                 s/\xec/þ/gm ;
2061                 s/\xf1/æ/gm ;
2062                 s/\xf3/ð/gm ;
2063                 s/\xf9/ø/gm ;
2064                 s/\xfb/ß/gm ;
2065                 s/\xc1\x61/à/gm ;
2066                 s/\xc1\x65/è/gm ;
2067                 s/\xc1\x69/ì/gm ;
2068                 s/\xc1\x6f/ò/gm ;
2069                 s/\xc1\x75/ù/gm ;
2070                 s/\xc1\x41/À/gm ;
2071                 s/\xc1\x45/È/gm ;
2072                 s/\xc1\x49/Ì/gm ;
2073                 s/\xc1\x4f/Ò/gm ;
2074                 s/\xc1\x55/Ù/gm ;
2075                 s/\xc2\x41/Á/gm ;
2076                 s/\xc2\x45/É/gm ;
2077                 s/\xc2\x49/Í/gm ;
2078                 s/\xc2\x4f/Ó/gm ;
2079                 s/\xc2\x55/Ú/gm ;
2080                 s/\xc2\x59/Ý/gm ;
2081                 s/\xc2\x61/á/gm ;
2082                 s/\xc2\x65/é/gm ;
2083                 s/\xc2\x69/í/gm ;
2084                 s/\xc2\x6f/ó/gm ;
2085                 s/\xc2\x75/ú/gm ;
2086                 s/\xc2\x79/ý/gm ;
2087                 s/\xc3\x41/Â/gm ;
2088                 s/\xc3\x45/Ê/gm ;
2089                 s/\xc3\x49/Î/gm ;
2090                 s/\xc3\x4f/Ô/gm ;
2091                 s/\xc3\x55/Û/gm ;
2092                 s/\xc3\x61/â/gm ;
2093                 s/\xc3\x65/ê/gm ;
2094                 s/\xc3\x69/î/gm ;
2095                 s/\xc3\x6f/ô/gm ;
2096                 s/\xc3\x75/û/gm ;
2097                 s/\xc4\x41/Ã/gm ;
2098                 s/\xc4\x4e/Ñ/gm ;
2099                 s/\xc4\x4f/Õ/gm ;
2100                 s/\xc4\x61/ã/gm ;
2101                 s/\xc4\x6e/ñ/gm ;
2102                 s/\xc4\x6f/õ/gm ;
2103                 s/\xc8\x45/Ë/gm ;
2104                 s/\xc8\x49/Ï/gm ;
2105                 s/\xc8\x65/ë/gm ;
2106                 s/\xc8\x69/ï/gm ;
2107                 s/\xc8\x76/ÿ/gm ;
2108                 s/\xc9\x41/Ä/gm ;
2109                 s/\xc9\x4f/Ö/gm ;
2110                 s/\xc9\x55/Ü/gm ;
2111                 s/\xc9\x61/ä/gm ;
2112                 s/\xc9\x6f/ö/gm ;
2113                 s/\xc9\x75/ü/gm ;
2114                 s/\xca\x41/Å/gm ;
2115                 s/\xca\x61/å/gm ;
2116                 s/\xd0\x43/Ç/gm ;
2117                 s/\xd0\x63/ç/gm ;
2118                 # this handles non-sorting blocks (if implementation requires this)
2119                 $string = nsb_clean($_) ;
2120         } elsif ($encoding eq "USMARC" || $encoding eq "MARC21") {
2121                 if(/[\xc1-\xff]/) {
2122                         s/\xe1\x61/à/gm ;
2123                         s/\xe1\x65/è/gm ;
2124                         s/\xe1\x69/ì/gm ;
2125                         s/\xe1\x6f/ò/gm ;
2126                         s/\xe1\x75/ù/gm ;
2127                         s/\xe1\x41/À/gm ;
2128                         s/\xe1\x45/È/gm ;
2129                         s/\xe1\x49/Ì/gm ;
2130                         s/\xe1\x4f/Ò/gm ;
2131                         s/\xe1\x55/Ù/gm ;
2132                         s/\xe2\x41/Á/gm ;
2133                         s/\xe2\x45/É/gm ;
2134                         s/\xe2\x49/Í/gm ;
2135                         s/\xe2\x4f/Ó/gm ;
2136                         s/\xe2\x55/Ú/gm ;
2137                         s/\xe2\x59/Ý/gm ;
2138                         s/\xe2\x61/á/gm ;
2139                         s/\xe2\x65/é/gm ;
2140                         s/\xe2\x69/í/gm ;
2141                         s/\xe2\x6f/ó/gm ;
2142                         s/\xe2\x75/ú/gm ;
2143                         s/\xe2\x79/ý/gm ;
2144                         s/\xe3\x41/Â/gm ;
2145                         s/\xe3\x45/Ê/gm ;
2146                         s/\xe3\x49/Î/gm ;
2147                         s/\xe3\x4f/Ô/gm ;
2148                         s/\xe3\x55/Û/gm ;
2149                         s/\xe3\x61/â/gm ;
2150                         s/\xe3\x65/ê/gm ;
2151                         s/\xe3\x69/î/gm ;
2152                         s/\xe3\x6f/ô/gm ;
2153                         s/\xe3\x75/û/gm ;
2154                         s/\xe4\x41/Ã/gm ;
2155                         s/\xe4\x4e/Ñ/gm ;
2156                         s/\xe4\x4f/Õ/gm ;
2157                         s/\xe4\x61/ã/gm ;
2158                         s/\xe4\x6e/ñ/gm ;
2159                         s/\xe4\x6f/õ/gm ;
2160                         s/\xe8\x45/Ë/gm ;
2161                         s/\xe8\x49/Ï/gm ;
2162                         s/\xe8\x65/ë/gm ;
2163                         s/\xe8\x69/ï/gm ;
2164                         s/\xe8\x76/ÿ/gm ;
2165                         s/\xe9\x41/Ä/gm ;
2166                         s/\xe9\x4f/Ö/gm ;
2167                         s/\xe9\x55/Ü/gm ;
2168                         s/\xe9\x61/ä/gm ;
2169                         s/\xe9\x6f/ö/gm ;
2170                         s/\xe9\x75/ü/gm ;
2171                         s/\xea\x41/Å/gm ;
2172                         s/\xea\x61/å/gm ;
2173                         # this handles non-sorting blocks (if implementation requires this)
2174                         $string = nsb_clean($_) ;
2175                 }
2176         }
2177         return($string) ;
2178 }
2179
2180 sub nsb_clean {
2181         my $NSB = '\x88' ;              # NSB : begin Non Sorting Block
2182         my $NSE = '\x89' ;              # NSE : Non Sorting Block end
2183         # handles non sorting blocks
2184         my ($string) = @_ ;
2185         $_ = $string ;
2186         s/$NSB/(/gm ;
2187         s/[ ]{0,1}$NSE/) /gm ;
2188         $string = $_ ;
2189         return($string) ;
2190 }
2191
2192 END { }       # module clean-up code here (global destructor)
2193
2194 =back
2195
2196 =head1 AUTHOR
2197
2198 Koha Developement team <info@koha.org>
2199
2200 Paul POULAIN paul.poulain@free.fr
2201
2202 =cut
2203
2204 # $Id$
2205 # $Log$
2206 # Revision 1.90  2004/05/28 08:25:53  tipaul
2207 # hidding hidden & isurl constraints into MARC subfield structure
2208 #
2209 # Revision 1.89  2004/05/27 21:47:21  rangi
2210 # Fix for bug 787
2211 #
2212 # Revision 1.88  2004/05/18 15:23:49  tipaul
2213 # framework management : 1 MARC framework for each itemtype
2214 #
2215 # Revision 1.87  2004/05/18 11:54:07  tipaul
2216 # getitemtypes moved in Koha.pm
2217 #
2218 # Revision 1.86  2004/05/03 09:19:22  tipaul
2219 # some fixes for mysql prepare & execute
2220 #
2221 # Revision 1.85  2004/04/02 14:55:48  tipaul
2222 # renaming items.bulk field to items.itemcallnumber.
2223 # Will be used to store call number for libraries that don't use dewey classification.
2224 # Note it's related to ITEMS, not biblio.
2225 #
2226 # Revision 1.84  2004/03/24 17:18:30  joshferraro
2227 # Fixes bug 749 by removing the comma on line 1488.
2228 #
2229 # Revision 1.83  2004/03/15 14:31:50  tipaul
2230 # adding a minor check
2231 #
2232 # Revision 1.82  2004/03/07 05:47:31  acli
2233 # Various updates/fixes from rel_2_0
2234 # Fixes for bugs 721 (templating), 727, and 734
2235 #
2236 # Revision 1.81  2004/03/06 20:26:13  tipaul
2237 # adding seealso feature in MARC searches
2238 #
2239 # Revision 1.80  2004/02/12 13:40:56  tipaul
2240 # deleting subs duplicated by error
2241 #
2242 # Revision 1.79  2004/02/11 08:40:09  tipaul
2243 # synch'ing 2.0.0 branch and head
2244 #
2245 # Revision 1.78.2.3  2004/02/10 13:15:46  tipaul
2246 # removing 2 warnings
2247 #
2248 # Revision 1.78.2.2  2004/01/26 10:38:06  tipaul
2249 # dealing correctly "bulk" field
2250 #
2251 # Revision 1.78.2.1  2004/01/13 17:29:53  tipaul
2252 # * minor html fixes
2253 # * adding publisher in acquisition process (& ordering basket by publisher)
2254 #
2255 # Revision 1.78  2003/12/09 15:57:28  tipaul
2256 # rolling back to working char_decode sub
2257 #
2258 # Revision 1.77  2003/12/03 17:47:14  tipaul
2259 # bugfixes for biblio deletion
2260 #
2261 # Revision 1.76  2003/12/03 01:43:41  slef
2262 # conflict markers?
2263 #
2264 # Revision 1.75  2003/12/03 01:42:03  slef
2265 # bug 662 fixes securing DBI
2266 #
2267 # Revision 1.74  2003/11/28 09:48:33  tipaul
2268 # bugfix : misusing prepare & execute => now using prepare(?) and execute($var)
2269 #
2270 # Revision 1.73  2003/11/28 09:45:25  tipaul
2271 # bugfix for iso2709 file import in the "notforloan" field.
2272 #
2273 # But notforloan field called "loan" somewhere, so in case "loan" is used, copied to "notforloan" to avoid a bug.
2274 #
2275 # Revision 1.72  2003/11/24 17:40:14  tipaul
2276 # fix for #385
2277 #
2278 # Revision 1.71  2003/11/24 16:28:49  tipaul
2279 # biblio & item deletion now works fine in MARC editor.
2280 # Stores deleted biblio/item in the marc field of the deletedbiblio/deleteditem table.
2281 #
2282 # Revision 1.70  2003/11/24 13:29:55  tipaul
2283 # moving $id from beginning to end of file (70 commits... huge comments...)
2284 #
2285 # Revision 1.69  2003/11/24 13:27:17  tipaul
2286 # fix for #380 (bibliosubject)
2287 #
2288 # Revision 1.68  2003/11/06 17:18:30  tipaul
2289 # bugfix for #384
2290 #
2291 # 1st draft for MARC biblio deletion.
2292 # Still does not work well, but at least, Biblio.pm compiles & it should'nt break too many things
2293 # (Note the trash in the MARCdetail, but don't use it, please :-) )
2294 #
2295 # Revision 1.67  2003/10/25 08:46:27  tipaul
2296 # minor fixes for bilbio deletion (still buggy)
2297 #
2298 # Revision 1.66  2003/10/17 10:02:56  tipaul
2299 # Indexing only words longer than 2 letters. Was >=2 before, & 2 letters words usually means nothing.
2300 #
2301 # Revision 1.65  2003/10/14 09:45:29  tipaul
2302 # 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)
2303 #
2304 # Revision 1.64  2003/10/06 15:20:51  tipaul
2305 # fix for 536 (subtitle error)
2306 #
2307 # Revision 1.63  2003/10/01 13:25:49  tipaul
2308 # seems a char encoding problem modified something in char_decode sub... changing back to something that works...
2309 #
2310 # Revision 1.62  2003/09/17 14:21:13  tipaul
2311 # fixing bug that makes a MARC biblio disappear when using full acquisition (order => recieve ==> MARC editor).
2312 # Before this 2 lines fix, the MARC biblio was deleted during recieve, and had to be entirely recreated :-(
2313 #
2314 # Revision 1.61  2003/09/17 10:24:39  tipaul
2315 # notforloan value in itemtype was overwritting notforloan value in a given item.
2316 # I changed this behaviour :
2317 # if notforloan is set for a given item, and NOT for all items from this itemtype, the notforloan is kept.
2318 # If notforloan is set for itemtype, it's used (and impossible to loan a specific item from this itemtype)
2319 #
2320 # Revision 1.60  2003/09/04 14:11:23  tipaul
2321 # fix for 593 (data duplication in MARC-DB)
2322 #
2323 # Revision 1.58  2003/08/06 12:54:52  tipaul
2324 # fix for publicationyear : extracting numeric value from MARC string, like for copyrightdate.
2325 # (note that copyrightdate still extracted to get numeric format)
2326 #
2327 # Revision 1.57  2003/07/15 23:09:18  slef
2328 # change show columns to use biblioitems bnotes too
2329 #
2330 # Revision 1.56  2003/07/15 11:34:52  slef
2331 # fixes from paul email
2332 #
2333 # Revision 1.55  2003/07/15 00:02:49  slef
2334 # Work on bug 515... can we do a single-side rename of notes to bnotes?
2335 #
2336 # Revision 1.54  2003/07/11 11:51:32  tipaul
2337 # *** empty log message ***
2338 #
2339 # Revision 1.52  2003/07/10 10:37:19  tipaul
2340 # fix for copyrightdate problem, #514
2341 #
2342 # Revision 1.51  2003/07/02 14:47:17  tipaul
2343 # fix for #519 : items.dateaccessioned imports incorrectly
2344 #
2345 # Revision 1.49  2003/06/17 11:21:13  tipaul
2346 # improvments/fixes for z3950 support.
2347 # * Works now even on ADD, not only on MODIFY
2348 # * able to search on ISBN, author, title
2349 #
2350 # Revision 1.48  2003/06/16 09:22:53  rangi
2351 # Just added an order clause to getitemtypes
2352 #
2353 # Revision 1.47  2003/05/20 16:22:44  tipaul
2354 # fixing typo in Biblio.pm POD
2355 #
2356 # Revision 1.46  2003/05/19 13:45:18  tipaul
2357 # support for subtitles, additional authors, subject.
2358 # 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.
2359 # Note that some OLD-DB subs are strange (dummy ?) see OLDmodsubject, OLDmodsubtitle, OLDmodaddiauthor in C4/Biblio.pm
2360 # 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.
2361 #
2362 # Revision 1.45  2003/04/29 16:50:49  tipaul
2363 # really proud of this commit :-)
2364 # z3950 search and import seems to works fine.
2365 # Let me explain how :
2366 # * a "search z3950" button is added in the addbiblio template.
2367 # * when clicked, a popup appears and z3950/search.pl is called
2368 # * z3950/search.pl calls addz3950search in the DB
2369 # * the z3950 daemon retrieve the records and stores them in z3950results AND in marc_breeding table.
2370 # * as long as there as searches pending, the popup auto refresh every 2 seconds, and says how many searches are pending.
2371 # * when the user clicks on a z3950 result => the parent popup is called with the requested biblio, and auto-filled
2372 #
2373 # Note :
2374 # * 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.
2375 # * 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.
2376 #
2377 # Revision 1.44  2003/04/28 13:07:14  tipaul
2378 # Those fixes solves the "internal server error" with MARC::Record 1.12.
2379 # It was due to an illegal contruction in Koha : we tried to retrive subfields from <10 tags.
2380 # That's not possible. MARC::Record accepted this in 0.93 version, but it was fixed after.
2381 # Now, the construct/retrieving is OK !
2382 #
2383 # Revision 1.43  2003/04/10 13:56:02  tipaul
2384 # Fix some bugs :
2385 # * worked in 1.9.0, but not in 1.9.1 :
2386 # - modif of a biblio didn't work
2387 # - 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.
2388 #
2389 # * did not work before :
2390 # - repeatable subfields now works correctly. Enter 2 subfields separated by | and they will be splitted during saving.
2391 # - dropped the last subfield of the MARC form :-(
2392 #
2393 # Internal changes :
2394 # - 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.
2395 # Note the MARCdelbiblio has been rewritted to enable deletion of a biblio WITHOUT deleting items.
2396 #
2397 # Revision 1.42  2003/04/04 08:41:11  tipaul
2398 # last commits before 1.9.1
2399 #
2400 # Revision 1.41  2003/04/01 12:26:43  tipaul
2401 # fixes
2402 #
2403 # Revision 1.40  2003/03/11 15:14:03  tipaul
2404 # pod updating
2405 #
2406 # Revision 1.39  2003/03/07 16:35:42  tipaul
2407 # * moving generic functions to Koha.pm
2408 # * improvement of SearchMarc.pm
2409 # * bugfixes
2410 # * code cleaning
2411 #
2412 # Revision 1.38  2003/02/27 16:51:59  tipaul
2413 # * moving prepare / execute to ? form.
2414 # * some # cleaning
2415 # * little bugfix.
2416 # * road to 1.9.2 => acquisition and cataloguing merging
2417 #
2418 # Revision 1.37  2003/02/12 11:03:03  tipaul
2419 # Support for 000 -> 010 fields.
2420 # Those fields doesn't have subfields.
2421 # In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@".
2422 # 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.
2423 #
2424 # Revision 1.36  2003/02/12 11:01:01  tipaul
2425 # Support for 000 -> 010 fields.
2426 # Those fields doesn't have subfields.
2427 # In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@".
2428 # 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.
2429 #
2430 # Revision 1.35  2003/02/03 18:46:00  acli
2431 # Minor factoring in C4/Biblio.pm, plus change to export the per-tag
2432 # 'mandatory' property to a per-subfield 'tag_mandatory' template parameter,
2433 # so that addbiblio.tmpl can distinguish between mandatory subfields in a
2434 # mandatory tag and mandatory subfields in an optional tag
2435 #
2436 # Not-minor factoring in acqui.simple/addbiblio.pl to make the if-else blocks
2437 # smaller, and to add some POD; need further testing for this
2438 #
2439 # Added function to check if a MARC subfield name is "koha-internal" (instead
2440 # of checking it for 'lib' and 'tag' everywhere); temporarily added to Koha.pm
2441 #
2442 # Use above function in acqui.simple/additem.pl and search.marc/search.pl
2443 #
2444 # Revision 1.34  2003/01/28 14:50:04  tipaul
2445 # fixing MARCmodbiblio API and reindenting code
2446 #
2447 # Revision 1.33  2003/01/23 12:22:37  tipaul
2448 # adding char_decode to decode MARC21 or UNIMARC extended chars
2449 #
2450 # Revision 1.32  2002/12/16 15:08:50  tipaul
2451 # small but important bugfix (fixes a problem in export)
2452 #
2453 # Revision 1.31  2002/12/13 16:22:04  tipaul
2454 # 1st draft of marc export
2455 #
2456 # Revision 1.30  2002/12/12 21:26:35  tipaul
2457 # YAB ! (Yet Another Bugfix) => related to biblio modif
2458 # (some warning cleaning too)
2459 #
2460 # Revision 1.29  2002/12/12 16:35:00  tipaul
2461 # adding authentification with Auth.pm and
2462 # MAJOR BUGFIX on marc biblio modification
2463 #
2464 # Revision 1.28  2002/12/10 13:30:03  tipaul
2465 # fugfixes from Dombes Abbey work
2466 #
2467 # Revision 1.27  2002/11/19 12:36:16  tipaul
2468 # road to 1.3.2
2469 # various bugfixes, improvments, and migration from acquisition.pm to biblio.pm
2470 #
2471 # Revision 1.26  2002/11/12 15:58:43  tipaul
2472 # road to 1.3.2 :
2473 # * many bugfixes
2474 # * 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)
2475 #
2476 # Revision 1.25  2002/10/25 10:58:26  tipaul
2477 # Road to 1.3.2
2478 # * bugfixes and improvements
2479 #
2480 # Revision 1.24  2002/10/24 12:09:01  arensb
2481 # Fixed "no title" warning when generating HTML documentation from POD.
2482 #
2483 # Revision 1.23  2002/10/16 12:43:08  arensb
2484 # Added some FIXME comments.
2485 #
2486 # Revision 1.22  2002/10/15 13:39:17  tipaul
2487 # removing Acquisition.pm
2488 # deleting unused code in biblio.pm, rewriting POD and answering most FIXME comments
2489 #
2490 # Revision 1.21  2002/10/13 11:34:14  arensb
2491 # Replaced expressions of the form "$x = $x <op> $y" with "$x <op>= $y".
2492 # Thus, $x = $x+2 becomes $x += 2, and so forth.
2493 #
2494 # Revision 1.20  2002/10/13 08:28:32  arensb
2495 # Deleted unused variables.
2496 # Removed trailing whitespace.
2497 #
2498 # Revision 1.19  2002/10/13 05:56:10  arensb
2499 # Added some FIXME comments.
2500 #
2501 # Revision 1.18  2002/10/11 12:34:53  arensb
2502 # Replaced &requireDBI with C4::Context->dbh
2503 #
2504 # Revision 1.17  2002/10/10 14:48:25  tipaul
2505 # bugfixes
2506 #
2507 # Revision 1.16  2002/10/07 14:04:26  tipaul
2508 # road to 1.3.1 : viewing MARC biblio
2509 #
2510 # Revision 1.15  2002/10/05 09:49:25  arensb
2511 # Merged with arensb-context branch: use C4::Context->dbh instead of
2512 # &C4Connect, and generally prefer C4::Context over C4::Database.
2513 #
2514 # Revision 1.14  2002/10/03 11:28:18  tipaul
2515 # Extending Context.pm to add stopword management and using it in MARC-API.
2516 # First benchmarks show a medium speed improvement, which  is nice as this part is heavily called.
2517 #
2518 # Revision 1.13  2002/10/02 16:26:44  tipaul
2519 # road to 1.3.1
2520 #
2521 # Revision 1.12.2.4  2002/10/05 07:09:31  arensb
2522 # Merged in changes from main branch.
2523 #
2524 # Revision 1.12.2.3  2002/10/05 06:12:10  arensb
2525 # Added a whole mess of FIXME comments.
2526 #
2527 # Revision 1.12.2.2  2002/10/05 04:03:14  arensb
2528 # Added some missing semicolons.
2529 #
2530 # Revision 1.12.2.1  2002/10/04 02:24:01  arensb
2531 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
2532 # C4Connect.
2533 #
2534 # Revision 1.12.2.3  2002/10/05 06:12:10  arensb
2535 # Added a whole mess of FIXME comments.
2536 #
2537 # Revision 1.12.2.2  2002/10/05 04:03:14  arensb
2538 # Added some missing semicolons.
2539 #
2540 # Revision 1.12.2.1  2002/10/04 02:24:01  arensb
2541 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
2542 # C4Connect.
2543 #
2544 # Revision 1.12  2002/10/01 11:48:51  arensb
2545 # Added some FIXME comments, mostly marking duplicate functions.
2546 #
2547 # Revision 1.11  2002/09/24 13:49:26  tipaul
2548 # long WAS the road to 1.3.0...
2549 # coming VERY SOON NOW...
2550 # modifying installer and buildrelease to update the DB
2551 #
2552 # Revision 1.10  2002/09/22 16:50:08  arensb
2553 # Added some FIXME comments.
2554 #
2555 # Revision 1.9  2002/09/20 12:57:46  tipaul
2556 # long is the road to 1.4.0
2557 # * MARCadditem and MARCmoditem now wroks
2558 # * various bugfixes in MARC management
2559 # !!! 1.3.0 should be released very soon now. Be careful !!!
2560 #
2561 # Revision 1.8  2002/09/10 13:53:52  tipaul
2562 # MARC API continued...
2563 # * some bugfixes
2564 # * 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)
2565 #
2566 # Note : it should not be hard for marcimport and marcexport to re-link fields from internal tag/subfield to "legal" tag/subfield.
2567 #
2568 # Revision 1.7  2002/08/14 18:12:51  tonnesen
2569 # Added copyright statement to all .pl and .pm files
2570 #
2571 # Revision 1.6  2002/07/25 13:40:31  tipaul
2572 # pod documenting the API.
2573 #
2574 # Revision 1.5  2002/07/24 16:11:37  tipaul
2575 # Now, the API...
2576 # Database.pm and Output.pm are almost not modified (var test...)
2577 #
2578 # Biblio.pm is almost completly rewritten.
2579 #
2580 # WHAT DOES IT ??? ==> END of Hitchcock suspens
2581 #
2582 # 1st, it does... nothing...
2583 # 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 ...
2584 #
2585 # All old-API functions have been cloned. for example, the "newbiblio" sub, now has become :
2586 # * a "newbiblio" sub, with the same parameters. It just call a sub named OLDnewbiblio
2587 # * 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.
2588 # * 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.
2589 # 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 ;-)
2590 #
2591 # 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.
2592 # Note we have decided with steve that a old-biblio <=> a MARC-Biblio.
2593 #