C4/Biblio.pm

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