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