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