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