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     ################################################################
1797     ## Fix template and shift this to newbiblio
1798         my @subjects=split(/\n/,$biblioitem->{'subjectheadings'});
1799         modsubject($biblioitem->{'biblionumber'},1,@subjects);
1800     ################################################################
1801         my $MARCbiblio= MARCkoha2marcBiblio($dbh,0,$bibitemnum); # the 0 means "do NOT retrieve biblio, only biblioitem, in the MARC record
1802         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblioitem->{biblionumber});
1803         &MARCaddbiblio($dbh,$MARCbiblio,$biblioitem->{biblionumber},$bibid);
1804         return($bibitemnum);
1805 }
1806
1807 sub newsubject {
1808   my ($bibnum)=@_;
1809   my $dbh = C4::Context->dbh;
1810   &OLDnewsubject($dbh,$bibnum);
1811 }
1812
1813 sub newsubtitle {
1814     my ($bibnum, $subtitle) = @_;
1815     my $dbh   = C4::Context->dbh;
1816     &OLDnewsubtitle($dbh,$bibnum,$subtitle);
1817 }
1818
1819 sub newitems {
1820   my ($item, @barcodes) = @_;
1821   my $dbh   = C4::Context->dbh;
1822   my $errors;
1823   my $itemnumber;
1824   my $error;
1825   foreach my $barcode (@barcodes) {
1826       ($itemnumber,$error)=&OLDnewitems($dbh,$item,uc($barcode));
1827       $errors .=$error;
1828       my $MARCitem = &MARCkoha2marcItem($dbh,$item->{biblionumber},$itemnumber);
1829       &MARCadditem($dbh,$MARCitem,$item->{biblionumber});
1830   }
1831   return($errors);
1832 }
1833
1834 sub moditem {
1835     my ($item) = @_;
1836     my $dbh = C4::Context->dbh;
1837     &OLDmoditem($dbh,$item);
1838     my $MARCitem = &MARCkoha2marcItem($dbh,$item->{'biblionumber'},$item->{'itemnum'});
1839     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$item->{biblionumber});
1840     &MARCmoditem($dbh,$MARCitem,$bibid,$item->{itemnum},0);
1841 }
1842
1843 sub checkitems{
1844   my ($count,@barcodes)=@_;
1845   my $dbh = C4::Context->dbh;
1846   my $error;
1847   my $sth=$dbh->prepare("Select * from items where barcode=?");
1848   for (my $i=0;$i<$count;$i++){
1849     $barcodes[$i]=uc $barcodes[$i];
1850     $sth->execute($barcodes[$i]);
1851     if (my $data=$sth->fetchrow_hashref){
1852       $error.=" Duplicate Barcode: $barcodes[$i]";
1853     }
1854   }
1855   $sth->finish;
1856   return($error);
1857 }
1858
1859 sub countitems{
1860   my ($bibitemnum)=@_;
1861   my $dbh = C4::Context->dbh;
1862   my $query="";
1863   my $sth=$dbh->prepare("Select count(*) from items where biblioitemnumber=?");
1864   $sth->execute($bibitemnum);
1865   my $data=$sth->fetchrow_hashref;
1866   $sth->finish;
1867   return($data->{'count(*)'});
1868 }
1869
1870 sub delitem{
1871   my ($itemnum)=@_;
1872   my $dbh = C4::Context->dbh;
1873   &OLDdelitem($dbh,$itemnum);
1874 }
1875
1876 sub deletebiblioitem {
1877     my ($biblioitemnumber) = @_;
1878     my $dbh   = C4::Context->dbh;
1879     &OLDdeletebiblioitem($dbh,$biblioitemnumber);
1880 } # sub deletebiblioitem
1881
1882
1883 sub delbiblio {
1884         my ($biblio)=@_;
1885         my $dbh = C4::Context->dbh;
1886         &OLDdelbiblio($dbh,$biblio);
1887         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblio);
1888         &MARCdelbiblio($dbh,$bibid,0);
1889 }
1890
1891 sub getbiblio {
1892     my ($biblionumber) = @_;
1893     my $dbh   = C4::Context->dbh;
1894     my $sth   = $dbh->prepare("Select * from biblio where biblionumber = ?");
1895       # || die "Cannot prepare $query\n" . $dbh->errstr;
1896     my $count = 0;
1897     my @results;
1898
1899     $sth->execute($biblionumber);
1900       # || die "Cannot execute $query\n" . $sth->errstr;
1901     while (my $data = $sth->fetchrow_hashref) {
1902       $results[$count] = $data;
1903       $count++;
1904     } # while
1905
1906     $sth->finish;
1907     return($count, @results);
1908 } # sub getbiblio
1909
1910 sub getbiblioitem {
1911     my ($biblioitemnum) = @_;
1912     my $dbh   = C4::Context->dbh;
1913     my $sth   = $dbh->prepare("Select * from biblioitems where
1914 biblioitemnumber = ?");
1915     my $count = 0;
1916     my @results;
1917
1918     $sth->execute($biblioitemnum);
1919
1920     while (my $data = $sth->fetchrow_hashref) {
1921         $results[$count] = $data;
1922         $count++;
1923     } # while
1924
1925     $sth->finish;
1926     return($count, @results);
1927 } # sub getbiblioitem
1928
1929 sub getbiblioitembybiblionumber {
1930     my ($biblionumber) = @_;
1931     my $dbh   = C4::Context->dbh;
1932     my $sth   = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
1933     my $count = 0;
1934     my @results;
1935
1936     $sth->execute($biblionumber);
1937
1938     while (my $data = $sth->fetchrow_hashref) {
1939         $results[$count] = $data;
1940         $count++;
1941     } # while
1942
1943     $sth->finish;
1944     return($count, @results);
1945 } # sub
1946
1947 sub getitemsbybiblioitem {
1948     my ($biblioitemnum) = @_;
1949     my $dbh   = C4::Context->dbh;
1950     my $sth   = $dbh->prepare("Select * from items, biblio where
1951 biblio.biblionumber = items.biblionumber and biblioitemnumber
1952 = ?");
1953       # || die "Cannot prepare $query\n" . $dbh->errstr;
1954     my $count = 0;
1955     my @results;
1956
1957     $sth->execute($biblioitemnum);
1958       # || die "Cannot execute $query\n" . $sth->errstr;
1959     while (my $data = $sth->fetchrow_hashref) {
1960       $results[$count] = $data;
1961       $count++;
1962     } # while
1963
1964     $sth->finish;
1965     return($count, @results);
1966 } # sub getitemsbybiblioitem
1967
1968
1969 sub logchange {
1970 # Subroutine to log changes to databases
1971 # Eventually, this subroutine will be used to create a log of all changes made,
1972 # with the possibility of "undo"ing some changes
1973     my $database=shift;
1974     if ($database eq 'kohadb') {
1975         my $type=shift;
1976         my $section=shift;
1977         my $item=shift;
1978         my $original=shift;
1979         my $new=shift;
1980 #       print STDERR "KOHA: $type $section $item $original $new\n";
1981     } elsif ($database eq 'marc') {
1982         my $type=shift;
1983         my $Record_ID=shift;
1984         my $tag=shift;
1985         my $mark=shift;
1986         my $subfield_ID=shift;
1987         my $original=shift;
1988         my $new=shift;
1989 #       print STDERR "MARC: $type $Record_ID $tag $mark $subfield_ID $original $new\n";
1990     }
1991 }
1992
1993 #------------------------------------------------
1994
1995
1996 #---------------------------------------
1997 # Find a biblio entry, or create a new one if it doesn't exist.
1998 #  If a "subtitle" entry is in hash, add it to subtitle table
1999 sub getoraddbiblio {
2000         # input params
2001         my (
2002           $dbh,         # db handle
2003                         # FIXME - Unused argument
2004           $biblio,      # hash ref to fields
2005         )=@_;
2006
2007         # return
2008         my $biblionumber;
2009
2010         my $debug=0;
2011         my $sth;
2012         my $error;
2013
2014         #-----
2015         $dbh = C4::Context->dbh;
2016
2017         print "<PRE>Looking for biblio </PRE>\n" if $debug;
2018         $sth=$dbh->prepare("select biblionumber
2019                 from biblio
2020                 where title=? and author=?
2021                   and copyrightdate=? and seriestitle=?");
2022         $sth->execute(
2023                 $biblio->{title}, $biblio->{author},
2024                 $biblio->{copyright}, $biblio->{seriestitle} );
2025         if ($sth->rows) {
2026             ($biblionumber) = $sth->fetchrow;
2027             print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
2028         } else {
2029             # Doesn't exist.  Add new one.
2030             print "<PRE>Adding biblio</PRE>\n" if $debug;
2031             ($biblionumber,$error)=&newbiblio($biblio);
2032             if ( $biblionumber ) {
2033               print "<PRE>Added with biblio number=$biblionumber</PRE>\n" if $debug;
2034               if ( $biblio->{subtitle} ) {
2035                 &newsubtitle($biblionumber,$biblio->{subtitle} );
2036               } # if subtitle
2037             } else {
2038                 print "<PRE>Couldn't add biblio: $error</PRE>\n" if $debug;
2039             } # if added
2040         }
2041
2042         return $biblionumber,$error;
2043
2044 } # sub getoraddbiblio
2045
2046 sub char_decode {
2047         # converts ISO 5426 coded string to ISO 8859-1
2048         # sloppy code : should be improved in next issue
2049         my ($string,$encoding) = @_ ;
2050         $_ = $string ;
2051 #       $encoding = C4::Context->preference("marcflavour") unless $encoding;
2052         if ($encoding eq "UNIMARC") {
2053                 s/\xe1/Æ/gm ;
2054                 s/\xe2/Ð/gm ;
2055                 s/\xe9/Ø/gm ;
2056                 s/\xec/þ/gm ;
2057                 s/\xf1/æ/gm ;
2058                 s/\xf3/ð/gm ;
2059                 s/\xf9/ø/gm ;
2060                 s/\xfb/ß/gm ;
2061                 s/\xc1\x61/à/gm ;
2062                 s/\xc1\x65/è/gm ;
2063                 s/\xc1\x69/ì/gm ;
2064                 s/\xc1\x6f/ò/gm ;
2065                 s/\xc1\x75/ù/gm ;
2066                 s/\xc1\x41/À/gm ;
2067                 s/\xc1\x45/È/gm ;
2068                 s/\xc1\x49/Ì/gm ;
2069                 s/\xc1\x4f/Ò/gm ;
2070                 s/\xc1\x55/Ù/gm ;
2071                 s/\xc2\x41/Á/gm ;
2072                 s/\xc2\x45/É/gm ;
2073                 s/\xc2\x49/Í/gm ;
2074                 s/\xc2\x4f/Ó/gm ;
2075                 s/\xc2\x55/Ú/gm ;
2076                 s/\xc2\x59/Ý/gm ;
2077                 s/\xc2\x61/á/gm ;
2078                 s/\xc2\x65/é/gm ;
2079                 s/\xc2\x69/í/gm ;
2080                 s/\xc2\x6f/ó/gm ;
2081                 s/\xc2\x75/ú/gm ;
2082                 s/\xc2\x79/ý/gm ;
2083                 s/\xc3\x41/Â/gm ;
2084                 s/\xc3\x45/Ê/gm ;
2085                 s/\xc3\x49/Î/gm ;
2086                 s/\xc3\x4f/Ô/gm ;
2087                 s/\xc3\x55/Û/gm ;
2088                 s/\xc3\x61/â/gm ;
2089                 s/\xc3\x65/ê/gm ;
2090                 s/\xc3\x69/î/gm ;
2091                 s/\xc3\x6f/ô/gm ;
2092                 s/\xc3\x75/û/gm ;
2093                 s/\xc4\x41/Ã/gm ;
2094                 s/\xc4\x4e/Ñ/gm ;
2095                 s/\xc4\x4f/Õ/gm ;
2096                 s/\xc4\x61/ã/gm ;
2097                 s/\xc4\x6e/ñ/gm ;
2098                 s/\xc4\x6f/õ/gm ;
2099                 s/\xc8\x45/Ë/gm ;
2100                 s/\xc8\x49/Ï/gm ;
2101                 s/\xc8\x65/ë/gm ;
2102                 s/\xc8\x69/ï/gm ;
2103                 s/\xc8\x76/ÿ/gm ;
2104                 s/\xc9\x41/Ä/gm ;
2105                 s/\xc9\x4f/Ö/gm ;
2106                 s/\xc9\x55/Ü/gm ;
2107                 s/\xc9\x61/ä/gm ;
2108                 s/\xc9\x6f/ö/gm ;
2109                 s/\xc9\x75/ü/gm ;
2110                 s/\xca\x41/Å/gm ;
2111                 s/\xca\x61/å/gm ;
2112                 s/\xd0\x43/Ç/gm ;
2113                 s/\xd0\x63/ç/gm ;
2114                 # this handles non-sorting blocks (if implementation requires this)
2115                 $string = nsb_clean($_) ;
2116         } elsif ($encoding eq "USMARC" || $encoding eq "MARC21") {
2117                 if(/[\xc1-\xff]/) {
2118                         s/\xe1\x61/à/gm ;
2119                         s/\xe1\x65/è/gm ;
2120                         s/\xe1\x69/ì/gm ;
2121                         s/\xe1\x6f/ò/gm ;
2122                         s/\xe1\x75/ù/gm ;
2123                         s/\xe1\x41/À/gm ;
2124                         s/\xe1\x45/È/gm ;
2125                         s/\xe1\x49/Ì/gm ;
2126                         s/\xe1\x4f/Ò/gm ;
2127                         s/\xe1\x55/Ù/gm ;
2128                         s/\xe2\x41/Á/gm ;
2129                         s/\xe2\x45/É/gm ;
2130                         s/\xe2\x49/Í/gm ;
2131                         s/\xe2\x4f/Ó/gm ;
2132                         s/\xe2\x55/Ú/gm ;
2133                         s/\xe2\x59/Ý/gm ;
2134                         s/\xe2\x61/á/gm ;
2135                         s/\xe2\x65/é/gm ;
2136                         s/\xe2\x69/í/gm ;
2137                         s/\xe2\x6f/ó/gm ;
2138                         s/\xe2\x75/ú/gm ;
2139                         s/\xe2\x79/ý/gm ;
2140                         s/\xe3\x41/Â/gm ;
2141                         s/\xe3\x45/Ê/gm ;
2142                         s/\xe3\x49/Î/gm ;
2143                         s/\xe3\x4f/Ô/gm ;
2144                         s/\xe3\x55/Û/gm ;
2145                         s/\xe3\x61/â/gm ;
2146                         s/\xe3\x65/ê/gm ;
2147                         s/\xe3\x69/î/gm ;
2148                         s/\xe3\x6f/ô/gm ;
2149                         s/\xe3\x75/û/gm ;
2150                         s/\xe4\x41/Ã/gm ;
2151                         s/\xe4\x4e/Ñ/gm ;
2152                         s/\xe4\x4f/Õ/gm ;
2153                         s/\xe4\x61/ã/gm ;
2154                         s/\xe4\x6e/ñ/gm ;
2155                         s/\xe4\x6f/õ/gm ;
2156                         s/\xe8\x45/Ë/gm ;
2157                         s/\xe8\x49/Ï/gm ;
2158                         s/\xe8\x65/ë/gm ;
2159                         s/\xe8\x69/ï/gm ;
2160                         s/\xe8\x76/ÿ/gm ;
2161                         s/\xe9\x41/Ä/gm ;
2162                         s/\xe9\x4f/Ö/gm ;
2163                         s/\xe9\x55/Ü/gm ;
2164                         s/\xe9\x61/ä/gm ;
2165                         s/\xe9\x6f/ö/gm ;
2166                         s/\xe9\x75/ü/gm ;
2167                         s/\xea\x41/Å/gm ;
2168                         s/\xea\x61/å/gm ;
2169                         # this handles non-sorting blocks (if implementation requires this)
2170                         $string = nsb_clean($_) ;
2171                 }
2172         }
2173         return($string) ;
2174 }
2175
2176 sub nsb_clean {
2177         my $NSB = '\x88' ;              # NSB : begin Non Sorting Block
2178         my $NSE = '\x89' ;              # NSE : Non Sorting Block end
2179         # handles non sorting blocks
2180         my ($string) = @_ ;
2181         $_ = $string ;
2182         s/$NSB/(/gm ;
2183         s/[ ]{0,1}$NSE/) /gm ;
2184         $string = $_ ;
2185         return($string) ;
2186 }
2187
2188 END { }       # module clean-up code here (global destructor)
2189
2190 =back
2191
2192 =head1 AUTHOR
2193
2194 Koha Developement team <info@koha.org>
2195
2196 Paul POULAIN paul.poulain@free.fr
2197
2198 =cut
2199
2200 # $Id$
2201 # $Log$
2202 # Revision 1.89  2004/05/27 21:47:21  rangi
2203 # Fix for bug 787
2204 #
2205 # Revision 1.88  2004/05/18 15:23:49  tipaul
2206 # framework management : 1 MARC framework for each itemtype
2207 #
2208 # Revision 1.87  2004/05/18 11:54:07  tipaul
2209 # getitemtypes moved in Koha.pm
2210 #
2211 # Revision 1.86  2004/05/03 09:19:22  tipaul
2212 # some fixes for mysql prepare & execute
2213 #
2214 # Revision 1.85  2004/04/02 14:55:48  tipaul
2215 # renaming items.bulk field to items.itemcallnumber.
2216 # Will be used to store call number for libraries that don't use dewey classification.
2217 # Note it's related to ITEMS, not biblio.
2218 #
2219 # Revision 1.84  2004/03/24 17:18:30  joshferraro
2220 # Fixes bug 749 by removing the comma on line 1488.
2221 #
2222 # Revision 1.83  2004/03/15 14:31:50  tipaul
2223 # adding a minor check
2224 #
2225 # Revision 1.82  2004/03/07 05:47:31  acli
2226 # Various updates/fixes from rel_2_0
2227 # Fixes for bugs 721 (templating), 727, and 734
2228 #
2229 # Revision 1.81  2004/03/06 20:26:13  tipaul
2230 # adding seealso feature in MARC searches
2231 #
2232 # Revision 1.80  2004/02/12 13:40:56  tipaul
2233 # deleting subs duplicated by error
2234 #
2235 # Revision 1.79  2004/02/11 08:40:09  tipaul
2236 # synch'ing 2.0.0 branch and head
2237 #
2238 # Revision 1.78.2.3  2004/02/10 13:15:46  tipaul
2239 # removing 2 warnings
2240 #
2241 # Revision 1.78.2.2  2004/01/26 10:38:06  tipaul
2242 # dealing correctly "bulk" field
2243 #
2244 # Revision 1.78.2.1  2004/01/13 17:29:53  tipaul
2245 # * minor html fixes
2246 # * adding publisher in acquisition process (& ordering basket by publisher)
2247 #
2248 # Revision 1.78  2003/12/09 15:57:28  tipaul
2249 # rolling back to working char_decode sub
2250 #
2251 # Revision 1.77  2003/12/03 17:47:14  tipaul
2252 # bugfixes for biblio deletion
2253 #
2254 # Revision 1.76  2003/12/03 01:43:41  slef
2255 # conflict markers?
2256 #
2257 # Revision 1.75  2003/12/03 01:42:03  slef
2258 # bug 662 fixes securing DBI
2259 #
2260 # Revision 1.74  2003/11/28 09:48:33  tipaul
2261 # bugfix : misusing prepare & execute => now using prepare(?) and execute($var)
2262 #
2263 # Revision 1.73  2003/11/28 09:45:25  tipaul
2264 # bugfix for iso2709 file import in the "notforloan" field.
2265 #
2266 # But notforloan field called "loan" somewhere, so in case "loan" is used, copied to "notforloan" to avoid a bug.
2267 #
2268 # Revision 1.72  2003/11/24 17:40:14  tipaul
2269 # fix for #385
2270 #
2271 # Revision 1.71  2003/11/24 16:28:49  tipaul
2272 # biblio & item deletion now works fine in MARC editor.
2273 # Stores deleted biblio/item in the marc field of the deletedbiblio/deleteditem table.
2274 #
2275 # Revision 1.70  2003/11/24 13:29:55  tipaul
2276 # moving $id from beginning to end of file (70 commits... huge comments...)
2277 #
2278 # Revision 1.69  2003/11/24 13:27:17  tipaul
2279 # fix for #380 (bibliosubject)
2280 #
2281 # Revision 1.68  2003/11/06 17:18:30  tipaul
2282 # bugfix for #384
2283 #
2284 # 1st draft for MARC biblio deletion.
2285 # Still does not work well, but at least, Biblio.pm compiles & it should'nt break too many things
2286 # (Note the trash in the MARCdetail, but don't use it, please :-) )
2287 #
2288 # Revision 1.67  2003/10/25 08:46:27  tipaul
2289 # minor fixes for bilbio deletion (still buggy)
2290 #
2291 # Revision 1.66  2003/10/17 10:02:56  tipaul
2292 # Indexing only words longer than 2 letters. Was >=2 before, & 2 letters words usually means nothing.
2293 #
2294 # Revision 1.65  2003/10/14 09:45:29  tipaul
2295 # 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)
2296 #
2297 # Revision 1.64  2003/10/06 15:20:51  tipaul
2298 # fix for 536 (subtitle error)
2299 #
2300 # Revision 1.63  2003/10/01 13:25:49  tipaul
2301 # seems a char encoding problem modified something in char_decode sub... changing back to something that works...
2302 #
2303 # Revision 1.62  2003/09/17 14:21:13  tipaul
2304 # fixing bug that makes a MARC biblio disappear when using full acquisition (order => recieve ==> MARC editor).
2305 # Before this 2 lines fix, the MARC biblio was deleted during recieve, and had to be entirely recreated :-(
2306 #
2307 # Revision 1.61  2003/09/17 10:24:39  tipaul
2308 # notforloan value in itemtype was overwritting notforloan value in a given item.
2309 # I changed this behaviour :
2310 # if notforloan is set for a given item, and NOT for all items from this itemtype, the notforloan is kept.
2311 # If notforloan is set for itemtype, it's used (and impossible to loan a specific item from this itemtype)
2312 #
2313 # Revision 1.60  2003/09/04 14:11:23  tipaul
2314 # fix for 593 (data duplication in MARC-DB)
2315 #
2316 # Revision 1.58  2003/08/06 12:54:52  tipaul
2317 # fix for publicationyear : extracting numeric value from MARC string, like for copyrightdate.
2318 # (note that copyrightdate still extracted to get numeric format)
2319 #
2320 # Revision 1.57  2003/07/15 23:09:18  slef
2321 # change show columns to use biblioitems bnotes too
2322 #
2323 # Revision 1.56  2003/07/15 11:34:52  slef
2324 # fixes from paul email
2325 #
2326 # Revision 1.55  2003/07/15 00:02:49  slef
2327 # Work on bug 515... can we do a single-side rename of notes to bnotes?
2328 #
2329 # Revision 1.54  2003/07/11 11:51:32  tipaul
2330 # *** empty log message ***
2331 #
2332 # Revision 1.52  2003/07/10 10:37:19  tipaul
2333 # fix for copyrightdate problem, #514
2334 #
2335 # Revision 1.51  2003/07/02 14:47:17  tipaul
2336 # fix for #519 : items.dateaccessioned imports incorrectly
2337 #
2338 # Revision 1.49  2003/06/17 11:21:13  tipaul
2339 # improvments/fixes for z3950 support.
2340 # * Works now even on ADD, not only on MODIFY
2341 # * able to search on ISBN, author, title
2342 #
2343 # Revision 1.48  2003/06/16 09:22:53  rangi
2344 # Just added an order clause to getitemtypes
2345 #
2346 # Revision 1.47  2003/05/20 16:22:44  tipaul
2347 # fixing typo in Biblio.pm POD
2348 #
2349 # Revision 1.46  2003/05/19 13:45:18  tipaul
2350 # support for subtitles, additional authors, subject.
2351 # 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.
2352 # Note that some OLD-DB subs are strange (dummy ?) see OLDmodsubject, OLDmodsubtitle, OLDmodaddiauthor in C4/Biblio.pm
2353 # 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.
2354 #
2355 # Revision 1.45  2003/04/29 16:50:49  tipaul
2356 # really proud of this commit :-)
2357 # z3950 search and import seems to works fine.
2358 # Let me explain how :
2359 # * a "search z3950" button is added in the addbiblio template.
2360 # * when clicked, a popup appears and z3950/search.pl is called
2361 # * z3950/search.pl calls addz3950search in the DB
2362 # * the z3950 daemon retrieve the records and stores them in z3950results AND in marc_breeding table.
2363 # * as long as there as searches pending, the popup auto refresh every 2 seconds, and says how many searches are pending.
2364 # * when the user clicks on a z3950 result => the parent popup is called with the requested biblio, and auto-filled
2365 #
2366 # Note :
2367 # * 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.
2368 # * 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.
2369 #
2370 # Revision 1.44  2003/04/28 13:07:14  tipaul
2371 # Those fixes solves the "internal server error" with MARC::Record 1.12.
2372 # It was due to an illegal contruction in Koha : we tried to retrive subfields from <10 tags.
2373 # That's not possible. MARC::Record accepted this in 0.93 version, but it was fixed after.
2374 # Now, the construct/retrieving is OK !
2375 #
2376 # Revision 1.43  2003/04/10 13:56:02  tipaul
2377 # Fix some bugs :
2378 # * worked in 1.9.0, but not in 1.9.1 :
2379 # - modif of a biblio didn't work
2380 # - 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.
2381 #
2382 # * did not work before :
2383 # - repeatable subfields now works correctly. Enter 2 subfields separated by | and they will be splitted during saving.
2384 # - dropped the last subfield of the MARC form :-(
2385 #
2386 # Internal changes :
2387 # - 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.
2388 # Note the MARCdelbiblio has been rewritted to enable deletion of a biblio WITHOUT deleting items.
2389 #
2390 # Revision 1.42  2003/04/04 08:41:11  tipaul
2391 # last commits before 1.9.1
2392 #
2393 # Revision 1.41  2003/04/01 12:26:43  tipaul
2394 # fixes
2395 #
2396 # Revision 1.40  2003/03/11 15:14:03  tipaul
2397 # pod updating
2398 #
2399 # Revision 1.39  2003/03/07 16:35:42  tipaul
2400 # * moving generic functions to Koha.pm
2401 # * improvement of SearchMarc.pm
2402 # * bugfixes
2403 # * code cleaning
2404 #
2405 # Revision 1.38  2003/02/27 16:51:59  tipaul
2406 # * moving prepare / execute to ? form.
2407 # * some # cleaning
2408 # * little bugfix.
2409 # * road to 1.9.2 => acquisition and cataloguing merging
2410 #
2411 # Revision 1.37  2003/02/12 11:03:03  tipaul
2412 # Support for 000 -> 010 fields.
2413 # Those fields doesn't have subfields.
2414 # In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@".
2415 # 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.
2416 #
2417 # Revision 1.36  2003/02/12 11:01:01  tipaul
2418 # Support for 000 -> 010 fields.
2419 # Those fields doesn't have subfields.
2420 # In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@".
2421 # 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.
2422 #
2423 # Revision 1.35  2003/02/03 18:46:00  acli
2424 # Minor factoring in C4/Biblio.pm, plus change to export the per-tag
2425 # 'mandatory' property to a per-subfield 'tag_mandatory' template parameter,
2426 # so that addbiblio.tmpl can distinguish between mandatory subfields in a
2427 # mandatory tag and mandatory subfields in an optional tag
2428 #
2429 # Not-minor factoring in acqui.simple/addbiblio.pl to make the if-else blocks
2430 # smaller, and to add some POD; need further testing for this
2431 #
2432 # Added function to check if a MARC subfield name is "koha-internal" (instead
2433 # of checking it for 'lib' and 'tag' everywhere); temporarily added to Koha.pm
2434 #
2435 # Use above function in acqui.simple/additem.pl and search.marc/search.pl
2436 #
2437 # Revision 1.34  2003/01/28 14:50:04  tipaul
2438 # fixing MARCmodbiblio API and reindenting code
2439 #
2440 # Revision 1.33  2003/01/23 12:22:37  tipaul
2441 # adding char_decode to decode MARC21 or UNIMARC extended chars
2442 #
2443 # Revision 1.32  2002/12/16 15:08:50  tipaul
2444 # small but important bugfix (fixes a problem in export)
2445 #
2446 # Revision 1.31  2002/12/13 16:22:04  tipaul
2447 # 1st draft of marc export
2448 #
2449 # Revision 1.30  2002/12/12 21:26:35  tipaul
2450 # YAB ! (Yet Another Bugfix) => related to biblio modif
2451 # (some warning cleaning too)
2452 #
2453 # Revision 1.29  2002/12/12 16:35:00  tipaul
2454 # adding authentification with Auth.pm and
2455 # MAJOR BUGFIX on marc biblio modification
2456 #
2457 # Revision 1.28  2002/12/10 13:30:03  tipaul
2458 # fugfixes from Dombes Abbey work
2459 #
2460 # Revision 1.27  2002/11/19 12:36:16  tipaul
2461 # road to 1.3.2
2462 # various bugfixes, improvments, and migration from acquisition.pm to biblio.pm
2463 #
2464 # Revision 1.26  2002/11/12 15:58:43  tipaul
2465 # road to 1.3.2 :
2466 # * many bugfixes
2467 # * 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)
2468 #
2469 # Revision 1.25  2002/10/25 10:58:26  tipaul
2470 # Road to 1.3.2
2471 # * bugfixes and improvements
2472 #
2473 # Revision 1.24  2002/10/24 12:09:01  arensb
2474 # Fixed "no title" warning when generating HTML documentation from POD.
2475 #
2476 # Revision 1.23  2002/10/16 12:43:08  arensb
2477 # Added some FIXME comments.
2478 #
2479 # Revision 1.22  2002/10/15 13:39:17  tipaul
2480 # removing Acquisition.pm
2481 # deleting unused code in biblio.pm, rewriting POD and answering most FIXME comments
2482 #
2483 # Revision 1.21  2002/10/13 11:34:14  arensb
2484 # Replaced expressions of the form "$x = $x <op> $y" with "$x <op>= $y".
2485 # Thus, $x = $x+2 becomes $x += 2, and so forth.
2486 #
2487 # Revision 1.20  2002/10/13 08:28:32  arensb
2488 # Deleted unused variables.
2489 # Removed trailing whitespace.
2490 #
2491 # Revision 1.19  2002/10/13 05:56:10  arensb
2492 # Added some FIXME comments.
2493 #
2494 # Revision 1.18  2002/10/11 12:34:53  arensb
2495 # Replaced &requireDBI with C4::Context->dbh
2496 #
2497 # Revision 1.17  2002/10/10 14:48:25  tipaul
2498 # bugfixes
2499 #
2500 # Revision 1.16  2002/10/07 14:04:26  tipaul
2501 # road to 1.3.1 : viewing MARC biblio
2502 #
2503 # Revision 1.15  2002/10/05 09:49:25  arensb
2504 # Merged with arensb-context branch: use C4::Context->dbh instead of
2505 # &C4Connect, and generally prefer C4::Context over C4::Database.
2506 #
2507 # Revision 1.14  2002/10/03 11:28:18  tipaul
2508 # Extending Context.pm to add stopword management and using it in MARC-API.
2509 # First benchmarks show a medium speed improvement, which  is nice as this part is heavily called.
2510 #
2511 # Revision 1.13  2002/10/02 16:26:44  tipaul
2512 # road to 1.3.1
2513 #
2514 # Revision 1.12.2.4  2002/10/05 07:09:31  arensb
2515 # Merged in changes from main branch.
2516 #
2517 # Revision 1.12.2.3  2002/10/05 06:12:10  arensb
2518 # Added a whole mess of FIXME comments.
2519 #
2520 # Revision 1.12.2.2  2002/10/05 04:03:14  arensb
2521 # Added some missing semicolons.
2522 #
2523 # Revision 1.12.2.1  2002/10/04 02:24:01  arensb
2524 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
2525 # C4Connect.
2526 #
2527 # Revision 1.12.2.3  2002/10/05 06:12:10  arensb
2528 # Added a whole mess of FIXME comments.
2529 #
2530 # Revision 1.12.2.2  2002/10/05 04:03:14  arensb
2531 # Added some missing semicolons.
2532 #
2533 # Revision 1.12.2.1  2002/10/04 02:24:01  arensb
2534 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
2535 # C4Connect.
2536 #
2537 # Revision 1.12  2002/10/01 11:48:51  arensb
2538 # Added some FIXME comments, mostly marking duplicate functions.
2539 #
2540 # Revision 1.11  2002/09/24 13:49:26  tipaul
2541 # long WAS the road to 1.3.0...
2542 # coming VERY SOON NOW...
2543 # modifying installer and buildrelease to update the DB
2544 #
2545 # Revision 1.10  2002/09/22 16:50:08  arensb
2546 # Added some FIXME comments.
2547 #
2548 # Revision 1.9  2002/09/20 12:57:46  tipaul
2549 # long is the road to 1.4.0
2550 # * MARCadditem and MARCmoditem now wroks
2551 # * various bugfixes in MARC management
2552 # !!! 1.3.0 should be released very soon now. Be careful !!!
2553 #
2554 # Revision 1.8  2002/09/10 13:53:52  tipaul
2555 # MARC API continued...
2556 # * some bugfixes
2557 # * 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)
2558 #
2559 # Note : it should not be hard for marcimport and marcexport to re-link fields from internal tag/subfield to "legal" tag/subfield.
2560 #
2561 # Revision 1.7  2002/08/14 18:12:51  tonnesen
2562 # Added copyright statement to all .pl and .pm files
2563 #
2564 # Revision 1.6  2002/07/25 13:40:31  tipaul
2565 # pod documenting the API.
2566 #
2567 # Revision 1.5  2002/07/24 16:11:37  tipaul
2568 # Now, the API...
2569 # Database.pm and Output.pm are almost not modified (var test...)
2570 #
2571 # Biblio.pm is almost completly rewritten.
2572 #
2573 # WHAT DOES IT ??? ==> END of Hitchcock suspens
2574 #
2575 # 1st, it does... nothing...
2576 # 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 ...
2577 #
2578 # All old-API functions have been cloned. for example, the "newbiblio" sub, now has become :
2579 # * a "newbiblio" sub, with the same parameters. It just call a sub named OLDnewbiblio
2580 # * 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.
2581 # * 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.
2582 # 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 ;-)
2583 #
2584 # 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.
2585 # Note we have decided with steve that a old-biblio <=> a MARC-Biblio.
2586 #