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