C4/Biblio.pm

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