C4/Biblio.pm

   1 package C4::Biblio;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20 use strict;
  21 require Exporter;
  22 use C4::Context;
  23 use C4::Database;
  24 use MARC::Record;
  25 use MARC::File::USMARC;
  26 use MARC::File::XML;
  27
  28 use vars qw($VERSION @ISA @EXPORT);
  29
  30 # set the version for version checking
  31 $VERSION = 0.01;
  32
  33 @ISA = qw(Exporter);
  34
  35 #
  36 # don't forget MARCxxx subs are exported only for testing purposes. Should not be used
  37 # as the old-style API and the NEW one are the only public functions.
  38 #
  39 @EXPORT = qw(
  40   &updateBiblio &updateBiblioItem &updateItem
  41   &itemcount &newbiblio &newbiblioitem
  42   &modnote &newsubject &newsubtitle
  43   &modbiblio &checkitems
  44   &newitems &modbibitem
  45   &modsubtitle &modsubject &modaddauthor &moditem &countitems
  46   &delitem &deletebiblioitem &delbiblio
  47   &getbiblio
  48   &getbiblioitembybiblionumber
  49   &getbiblioitem &getitemsbybiblioitem
  50   &skip &getitemtypes
  51   &newcompletebiblioitem
  52
  53   &MARCfind_oldbiblionumber_from_MARCbibid
  54   &MARCfind_MARCbibid_from_oldbiblionumber
  55   &MARCfind_marc_from_kohafield
  56   &MARCfindsubfield
  57   &MARCfind_frameworkcode
  58   &MARCgettagslib
  59
  60   &NEWnewbiblio &NEWnewitem
  61   &NEWmodbiblio &NEWmoditem
  62   &NEWdelbiblio &NEWdelitem
  63   &NEWmodbiblioframework
  64
  65   &MARCaddbiblio &MARCadditem
  66   &MARCmodsubfield &MARCaddsubfield
  67   &MARCmodbiblio &MARCmoditem
  68   &MARCkoha2marcBiblio &MARCmarc2koha
  69   &MARCkoha2marcItem &MARChtml2marc
  70   &MARCgetbiblio &MARCgetitem
  71   &MARCaddword &MARCdelword
  72   &MARCdelsubfield
  73   &char_decode
  74
  75   &FindDuplicate
  76   &DisplayISBN
  77 );
  78
  79 #
  80 #
  81 # MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC
  82 #
  83 #
  84 # all the following subs takes a MARC::Record as parameter and manage
  85 # the MARC-DB. They are called by the 1.0/1.2 xxx subs, and by the
  86 # NEWxxx subs (xxx deals with old-DB parameters, the NEWxxx deals with MARC-DB parameter)
  87
  88 =head1 NAME
  89
  90 C4::Biblio - acquisition, catalog  management functions
  91
  92 =head1 SYNOPSIS
  93
  94 move from 1.2 to 1.4 version :
  95 1.2 and previous version uses a specific API to manage biblios. This API uses old-DB style parameters.
  96 In the 1.4 version, we want to do 2 differents things :
  97  - keep populating the old-DB, that has a LOT less datas than MARC
  98  - populate the MARC-DB
  99 To populate the DBs we have 2 differents sources :
 100  - the standard acquisition system (through book sellers), that does'nt use MARC data
 101  - the MARC acquisition system, that uses MARC data.
 102
 103 Thus, we have 2 differents cases :
 104 - 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
 105 - 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
 106
 107 That's why we need 4 subs :
 108 all I<subs beginning by MARC> manage only MARC tables. They manage MARC-DB with MARC::Record parameters
 109 all I<subs beginning by OLD> manage only OLD-DB tables. They manage old-DB with old-DB parameters
 110 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
 111 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.
 112
 113 - NEW and old-style API should be used in koha to manage biblio
 114 - MARCsubs are divided in 2 parts :
 115 * some of them manage MARC parameters. They are heavily used in koha.
 116 * some of them manage MARC biblio : they are mostly used by NEW and old-style subs.
 117 - OLD are used internally only
 118
 119 all subs requires/use $dbh as 1st parameter.
 120
 121 I<NEWxxx related subs>
 122
 123 all subs requires/use $dbh as 1st parameter.
 124 those subs are used by the MARC-compliant version of koha : marc import, or marc management.
 125
 126 I<OLDxxx related subs>
 127
 128 all subs requires/use $dbh as 1st parameter.
 129 those subs are used by the MARC-compliant version of koha : marc import, or marc management.
 130
 131 They all are the exact copy of 1.0/1.2 version of the sub without the OLD.
 132 The OLDxxx is called by the original xxx sub.
 133 the 1.4 xxx sub also builds MARC::Record an calls the MARCxxx
 134
 135 WARNING : there is 1 difference between initialxxx and OLDxxx :
 136 the db header $dbh is always passed as parameter to avoid over-DB connexion
 137
 138 =head1 DESCRIPTION
 139
 140 =over 4
 141
 142 =item @tagslib = &MARCgettagslib($dbh,1|0,$itemtype);
 143
 144 last param is 1 for liblibrarian and 0 for libopac
 145 $itemtype contains the itemtype framework reference. If empty or does not exist, the default one is used
 146 returns a hash with tag/subfield meaning
 147 =item ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
 148
 149 finds MARC tag and subfield for a given kohafield
 150 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
 151
 152 =item $biblionumber = &MARCfind_oldbiblionumber_from_MARCbibid($dbh,$MARCbibi);
 153
 154 finds a old-db biblio number for a given MARCbibid number
 155
 156 =item $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$oldbiblionumber);
 157
 158 finds a MARC bibid from a old-db biblionumber
 159
 160 =item $MARCRecord = &MARCkoha2marcBiblio($dbh,$biblionumber,biblioitemnumber);
 161
 162 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem
 163
 164 =item $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);
 165
 166 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB item
 167
 168 =item $MARCRecord = &MARCkoha2marcSubtitle($dbh,$biblionumber,$subtitle);
 169
 170 MARCkoha2marcSubtitle is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB subtitle
 171
 172 =item $olddb = &MARCmarc2koha($dbh,$MARCRecord);
 173
 174 builds a hash with old-db datas from a MARC::Record
 175
 176 =item &MARCaddbiblio($dbh,$MARC::Record,$biblionumber);
 177
 178 creates a biblio (in the MARC tables only). $biblionumber is the old-db biblionumber of the biblio
 179
 180 =item &MARCaddsubfield($dbh,$bibid,$tagid,$indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
 181
 182 adds a subfield in a biblio (in the MARC tables only).
 183
 184 =item $MARCRecord = &MARCgetbiblio($dbh,$bibid);
 185
 186 Returns a MARC::Record for the biblio $bibid.
 187
 188 =item &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,$delete);
 189
 190 MARCmodbiblio changes a biblio for a biblio,MARC::Record passed as parameter
 191 It 1st delete the biblio, then recreates it.
 192 WARNING : the $delete parameter is not used anymore (too much unsolvable cases).
 193 =item ($subfieldid,$subfieldvalue) = &MARCmodsubfield($dbh,$subfieldid,$subfieldvalue);
 194
 195 MARCmodsubfield changes the value of a given subfield
 196
 197 =item $subfieldid = &MARCfindsubfield($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue);
 198
 199 MARCfindsubfield returns a subfield number given a bibid/tag/subfieldvalue values.
 200 Returns -1 if more than 1 answer
 201
 202 =item $subfieldid = &MARCfindsubfieldid($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
 203
 204 MARCfindsubfieldid find a subfieldid for a bibid/tag/tagorder/subfield/subfieldorder
 205
 206 =item &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
 207
 208 MARCdelsubfield delete a subfield for a bibid/tag/tagorder/subfield/subfieldorder
 209 If $subfieldorder is not set, delete all the $tag$subfield subfields
 210
 211 =item &MARCdelbiblio($dbh,$bibid);
 212
 213 MARCdelbiblio delete biblio $bibid
 214
 215 =item &MARCkoha2marcOnefield
 216
 217 used by MARCkoha2marc and should not be useful elsewhere
 218
 219 =item &MARCmarc2kohaOnefield
 220
 221 used by MARCmarc2koha and should not be useful elsewhere
 222
 223 =item MARCaddword
 224
 225 used to manage MARC_word table and should not be useful elsewhere
 226
 227 =item MARCdelword
 228
 229 used to manage MARC_word table and should not be useful elsewhere
 230
 231 =cut
 232
 233 sub MARCgettagslib {
 234     my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
 235     $frameworkcode = "" unless $frameworkcode;
 236     my $sth;
 237     my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
 238
 239     # check that framework exists
 240     $sth =
 241       $dbh->prepare(
 242         "select count(*) from marc_tag_structure where frameworkcode=?");
 243     $sth->execute($frameworkcode);
 244     my ($total) = $sth->fetchrow;
 245     $frameworkcode = "" unless ( $total > 0 );
 246     $sth =
 247       $dbh->prepare(
 248 "select tagfield,liblibrarian,libopac,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield"
 249     );
 250     $sth->execute($frameworkcode);
 251     my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
 252
 253     while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
 254         $res->{$tag}->{lib}        = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 255         $res->{$tab}->{tab}        = "";            # XXX
 256         $res->{$tag}->{mandatory}  = $mandatory;
 257         $res->{$tag}->{repeatable} = $repeatable;
 258     }
 259
 260     $sth =
 261       $dbh->prepare(
 262 "select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link from marc_subfield_structure where frameworkcode=? order by tagfield,tagsubfield"
 263     );
 264     $sth->execute($frameworkcode);
 265
 266     my $subfield;
 267     my $authorised_value;
 268     my $authtypecode;
 269     my $value_builder;
 270     my $kohafield;
 271     my $seealso;
 272     my $hidden;
 273     my $isurl;
 274         my $link;
 275
 276     while (
 277         ( $tag,         $subfield,   $liblibrarian,   , $libopac,      $tab,
 278         $mandatory,     $repeatable, $authorised_value, $authtypecode,
 279         $value_builder, $kohafield,  $seealso,          $hidden,
 280         $isurl,                 $link )
 281         = $sth->fetchrow
 282       )
 283     {
 284         $res->{$tag}->{$subfield}->{lib}              = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 285         $res->{$tag}->{$subfield}->{tab}              = $tab;
 286         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
 287         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
 288         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
 289         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
 290         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
 291         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
 292         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
 293         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
 294         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
 295         $res->{$tag}->{$subfield}->{link}            = $link;
 296     }
 297     return $res;
 298 }
 299
 300 sub MARCfind_marc_from_kohafield {
 301     my ( $dbh, $kohafield,$frameworkcode ) = @_;
 302     return 0, 0 unless $kohafield;
 303         my $relations = C4::Context->marcfromkohafield;
 304         return ($relations->{$frameworkcode}->{$kohafield}->[0],$relations->{$frameworkcode}->{$kohafield}->[1]);
 305 }
 306
 307 sub MARCfind_oldbiblionumber_from_MARCbibid {
 308     my ( $dbh, $MARCbibid ) = @_;
 309     my $sth =
 310       $dbh->prepare("select biblionumber from marc_biblio where bibid=?");
 311     $sth->execute($MARCbibid);
 312     my ($biblionumber) = $sth->fetchrow;
 313     return $biblionumber;
 314 }
 315
 316 sub MARCfind_MARCbibid_from_oldbiblionumber {
 317     my ( $dbh, $oldbiblionumber ) = @_;
 318     my $sth =
 319       $dbh->prepare("select bibid from marc_biblio where biblionumber=?");
 320     $sth->execute($oldbiblionumber);
 321     my ($bibid) = $sth->fetchrow;
 322     return $bibid;
 323 }
 324
 325 sub MARCaddbiblio {
 326
 327 # pass the MARC::Record to this function, and it will create the records in the marc tables
 328         my ($dbh,$record,$biblionumber,$frameworkcode,$bibid) = @_;
 329         my @fields=$record->fields();
 330 # my $bibid;
 331 # adding main table, and retrieving bibid
 332 # if bibid is sent, then it's not a true add, it's only a re-add, after a delete (ie, a mod)
 333     # if bibid empty => true add, find a new bibid number
 334     unless ($bibid) {
 335         $dbh->do(
 336 "lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ"
 337         );
 338         my $sth =
 339           $dbh->prepare(
 340 "insert into marc_biblio (datecreated,biblionumber,frameworkcode) values (now(),?,?)"
 341         );
 342         $sth->execute( $biblionumber, $frameworkcode );
 343         $sth = $dbh->prepare("select max(bibid) from marc_biblio");
 344         $sth->execute;
 345         ($bibid) = $sth->fetchrow;
 346         $sth->finish;
 347     }
 348     my $fieldcount = 0;
 349
 350     # now, add subfields...
 351     foreach my $field (@fields) {
 352         $fieldcount++;
 353         if ( $field->tag() < 10 ) {
 354             &MARCaddsubfield( $dbh, $bibid, $field->tag(), '', $fieldcount, '',
 355                 1, $field->data() );
 356         }
 357         else {
 358             my @subfields = $field->subfields();
 359             foreach my $subfieldcount ( 0 .. $#subfields ) {
 360                 &MARCaddsubfield(
 361                     $dbh,
 362                     $bibid,
 363                     $field->tag(),
 364                     $field->indicator(1) . $field->indicator(2),
 365                     $fieldcount,
 366                     $subfields[$subfieldcount][0],
 367                     $subfieldcount + 1,
 368                     $subfields[$subfieldcount][1]
 369                 );
 370             }
 371         }
 372     }
 373         # save leader
 374         &MARCaddsubfield($dbh,$bibid,'000','',$fieldcount+1,'',1,$record->leader);
 375     $dbh->do("unlock tables");
 376     return $bibid;
 377 }
 378
 379 sub MARCadditem {
 380
 381 # pass the MARC::Record to this function, and it will create the records in the marc tables
 382     my ($dbh,$record,$biblionumber) = @_;
 383 # search for MARC biblionumber
 384     $dbh->do("lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ");
 385     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
 386     my @fields=$record->fields();
 387     my $sth = $dbh->prepare("select max(tagorder) from marc_subfield_table where bibid=?");
 388     $sth->execute($bibid);
 389     my ($fieldcount) = $sth->fetchrow;
 390
 391     # now, add subfields...
 392     foreach my $field (@fields) {
 393         my @subfields = $field->subfields();
 394         $fieldcount++;
 395         foreach my $subfieldcount ( 0 .. $#subfields ) {
 396             &MARCaddsubfield(
 397                 $dbh,
 398                 $bibid,
 399                 $field->tag(),
 400                 $field->indicator(1) . $field->indicator(2),
 401                 $fieldcount,
 402                 $subfields[$subfieldcount][0],
 403                 $subfieldcount + 1,
 404                 $subfields[$subfieldcount][1]
 405             );
 406         }
 407     }
 408     $dbh->do("unlock tables");
 409     return $bibid;
 410 }
 411
 412 sub MARCaddsubfield {
 413
 414     # Add a new subfield to a tag into the DB.
 415     my (
 416         $dbh,      $bibid,        $tagid,         $tag_indicator,
 417         $tagorder, $subfieldcode, $subfieldorder, $subfieldvalues
 418       )
 419       = @_;
 420           return unless $subfieldvalues;
 421 # warn "$tagid / $subfieldcode / $subfieldvalues";
 422     # if not value, end of job, we do nothing
 423 #     if ( length($subfieldvalues) == 0 ) {
 424 #         return;
 425 #     }
 426     if ( not($subfieldcode) ) {
 427         $subfieldcode = ' ';
 428     }
 429     my @subfieldvalues = split /\||#/, $subfieldvalues;
 430     foreach my $subfieldvalue (@subfieldvalues) {
 431         if ( length($subfieldvalue) > 255 ) {
 432             $dbh->do(
 433 "lock tables marc_blob_subfield WRITE, marc_subfield_table WRITE"
 434             );
 435             my $sth =
 436               $dbh->prepare(
 437                 "insert into marc_blob_subfield (subfieldvalue) values (?)");
 438             $sth->execute($subfieldvalue);
 439             $sth =
 440               $dbh->prepare("select max(blobidlink)from marc_blob_subfield");
 441             $sth->execute;
 442             my ($res) = $sth->fetchrow;
 443             $sth =
 444               $dbh->prepare(
 445 "insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,valuebloblink) values (?,?,?,?,?,?,?)"
 446             );
 447             $sth->execute( $bibid, ( sprintf "%03s", $tagid ), $tagorder,
 448                 $tag_indicator, $subfieldcode, $subfieldorder, $res );
 449
 450             if ( $sth->errstr ) {
 451                 warn
 452 "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
 453             }
 454             $dbh->do("unlock tables");
 455         }
 456         else {
 457             my $sth =
 458               $dbh->prepare(
 459 "insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values (?,?,?,?,?,?,?)"
 460             );
 461             $sth->execute(
 462                 $bibid,        ( sprintf "%03s", $tagid ),
 463                 $tagorder,     $tag_indicator,
 464                 $subfieldcode, $subfieldorder,
 465                 $subfieldvalue
 466             );
 467             if ( $sth->errstr ) {
 468                 warn
 469 "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
 470             }
 471         }
 472         &MARCaddword(
 473             $dbh,          $bibid,         $tagid,       $tagorder,
 474             $subfieldcode, $subfieldorder, $subfieldvalue
 475         );
 476     }
 477 }
 478
 479 sub MARCgetbiblio {
 480
 481     # Returns MARC::Record of the biblio passed in parameter.
 482     my ( $dbh, $biblionumber ) = @_;
 483         my $sth = $dbh->prepare('select marc from biblioitems where biblionumber=?');
 484         $sth->execute($biblionumber);
 485         my ($marc) = $sth->fetchrow;
 486         my $record = MARC::File::USMARC::decode($marc);
 487     return $record;
 488 }
 489
 490 sub MARCgetitem {
 491
 492     # Returns MARC::Record of the biblio passed in parameter.
 493     my ( $dbh, $bibid, $itemnumber ) = @_;
 494     my $record = MARC::Record->new();
 495
 496     # search MARC tagorder
 497     my $sth2 =
 498       $dbh->prepare(
 499 "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=?"
 500     );
 501     $sth2->execute( $bibid, $itemnumber );
 502     my ($tagorder) = $sth2->fetchrow_array();
 503
 504     #---- TODO : the leader is missing
 505     my $sth =
 506       $dbh->prepare(
 507 "select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
 508                                  from marc_subfield_table
 509                                  where bibid=? and tagorder=? order by subfieldcode,subfieldorder
 510                          "
 511     );
 512     $sth2 =
 513       $dbh->prepare(
 514         "select subfieldvalue from marc_blob_subfield where blobidlink=?");
 515     $sth->execute( $bibid, $tagorder );
 516     while ( my $row = $sth->fetchrow_hashref ) {
 517         if ( $row->{'valuebloblink'} ) {    #---- search blob if there is one
 518             $sth2->execute( $row->{'valuebloblink'} );
 519             my $row2 = $sth2->fetchrow_hashref;
 520             $sth2->finish;
 521             $row->{'subfieldvalue'} = $row2->{'subfieldvalue'};
 522         }
 523         if ( $record->field( $row->{'tag'} ) ) {
 524             my $field;
 525
 526 #--- this test must stay as this, because of strange behaviour of mySQL/Perl DBI with char var containing a number...
 527             #--- sometimes, eliminates 0 at beginning, sometimes no ;-\\\
 528             if ( length( $row->{'tag'} ) < 3 ) {
 529                 $row->{'tag'} = "0" . $row->{'tag'};
 530             }
 531             $field = $record->field( $row->{'tag'} );
 532             if ($field) {
 533                 my $x =
 534                   $field->add_subfields( $row->{'subfieldcode'},
 535                     $row->{'subfieldvalue'} );
 536                 $record->delete_field($field);
 537                 $record->add_fields($field);
 538             }
 539         }
 540         else {
 541             if ( length( $row->{'tag'} ) < 3 ) {
 542                 $row->{'tag'} = "0" . $row->{'tag'};
 543             }
 544             my $temp =
 545               MARC::Field->new( $row->{'tag'}, " ", " ",
 546                 $row->{'subfieldcode'} => $row->{'subfieldvalue'} );
 547             $record->add_fields($temp);
 548         }
 549
 550     }
 551     return $record;
 552 }
 553
 554 sub MARCmodbiblio {
 555         my ($dbh,$bibid,$record,$frameworkcode,$delete)=@_;
 556 # 1st delete the biblio,
 557 # 2nd recreate it
 558         my $biblionumber = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
 559         &MARCdelbiblio($dbh,$bibid,1);
 560         &MARCaddbiblio($dbh,$record,$biblionumber,$frameworkcode,$bibid);
 561 }
 562
 563 sub MARCdelbiblio {
 564     my ( $dbh, $bibid, $keep_items ) = @_;
 565
 566     # if the keep_item is set to 1, then all items are preserved.
 567     # This flag is set when the delbiblio is called by modbiblio
 568     # due to a too complex structure of MARC (repeatable fields and subfields),
 569     # the best solution for a modif is to delete / recreate the record.
 570
 571 # 1st of all, copy the MARC::Record to deletedbiblio table => if a true deletion, MARC data will be kept.
 572 # if deletion called before MARCmodbiblio => won't do anything, as the oldbiblionumber doesn't
 573     # exist in deletedbiblio table
 574     my $record = MARCgetbiblio( $dbh, $bibid );
 575     my $oldbiblionumber =
 576       MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
 577     my $copy2deleted =
 578       $dbh->prepare("update deletedbiblio set marc=? where biblionumber=?");
 579     $copy2deleted->execute( $record->as_usmarc(), $oldbiblionumber );
 580
 581     # now, delete in MARC tables.
 582     if ( $keep_items eq 1 ) {
 583
 584         #search item field code
 585         my $sth =
 586           $dbh->prepare(
 587 "select tagfield from marc_subfield_structure where kohafield like 'items.%'"
 588         );
 589         $sth->execute;
 590         my $itemtag = $sth->fetchrow_hashref->{tagfield};
 591         $dbh->do(
 592 "delete from marc_subfield_table where bibid=$bibid and tag<>$itemtag"
 593         );
 594         $dbh->do(
 595 "delete from marc_word where bibid=$bibid and not (tagsubfield like \"$itemtag%\")"
 596         );
 597     }
 598     else {
 599         $dbh->do("delete from marc_biblio where bibid=$bibid");
 600         $dbh->do("delete from marc_subfield_table where bibid=$bibid");
 601         $dbh->do("delete from marc_word where bibid=$bibid");
 602     }
 603 }
 604
 605 sub MARCdelitem {
 606
 607     # delete the item passed in parameter in MARC tables.
 608     my ( $dbh, $bibid, $itemnumber ) = @_;
 609
 610     #    my $record = MARC::Record->new();
 611     # search MARC tagorder
 612     my $record = MARCgetitem( $dbh, $bibid, $itemnumber );
 613     my $copy2deleted =
 614       $dbh->prepare("update deleteditems set marc=? where itemnumber=?");
 615     $copy2deleted->execute( $record->as_usmarc(), $itemnumber );
 616
 617     my $sth2 =
 618       $dbh->prepare(
 619 "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=?"
 620     );
 621     $sth2->execute( $bibid, $itemnumber );
 622     my ($tagorder) = $sth2->fetchrow_array();
 623     my $sth =
 624       $dbh->prepare(
 625         "delete from marc_subfield_table where bibid=? and tagorder=?");
 626     $sth->execute( $bibid, $tagorder );
 627 }
 628
 629 sub MARCmoditem {
 630         my ($dbh,$record,$bibid,$itemnumber,$delete)=@_;
 631         my $biblionumber = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
 632         &MARCdelitem($dbh,$bibid,$itemnumber);
 633         &MARCadditem($dbh,$record,$biblionumber);
 634 }
 635
 636 sub MARCmodsubfield {
 637
 638     # Subroutine changes a subfield value given a subfieldid.
 639     my ( $dbh, $subfieldid, $subfieldvalue ) = @_;
 640     $dbh->do("lock tables marc_blob_subfield WRITE,marc_subfield_table WRITE");
 641     my $sth1 =
 642       $dbh->prepare(
 643         "select valuebloblink from marc_subfield_table where subfieldid=?");
 644     $sth1->execute($subfieldid);
 645     my ($oldvaluebloblink) = $sth1->fetchrow;
 646     $sth1->finish;
 647     my $sth;
 648
 649     # if too long, use a bloblink
 650     if ( length($subfieldvalue) > 255 ) {
 651
 652         # if already a bloblink, update it, otherwise, insert a new one.
 653         if ($oldvaluebloblink) {
 654             $sth =
 655               $dbh->prepare(
 656 "update marc_blob_subfield set subfieldvalue=? where blobidlink=?"
 657             );
 658             $sth->execute( $subfieldvalue, $oldvaluebloblink );
 659         }
 660         else {
 661             $sth =
 662               $dbh->prepare(
 663                 "insert into marc_blob_subfield (subfieldvalue) values (?)");
 664             $sth->execute($subfieldvalue);
 665             $sth =
 666               $dbh->prepare("select max(blobidlink) from marc_blob_subfield");
 667             $sth->execute;
 668             my ($res) = $sth->fetchrow;
 669             $sth =
 670               $dbh->prepare(
 671 "update marc_subfield_table set subfieldvalue=null, valuebloblink=? where subfieldid=?"
 672             );
 673             $sth->execute( $res, $subfieldid );
 674         }
 675     }
 676     else {
 677
 678 # note this can leave orphan bloblink. Not a big problem, but we should build somewhere a orphan deleting script...
 679         $sth =
 680           $dbh->prepare(
 681 "update marc_subfield_table set subfieldvalue=?,valuebloblink=null where subfieldid=?"
 682         );
 683         $sth->execute( $subfieldvalue, $subfieldid );
 684     }
 685     $dbh->do("unlock tables");
 686     $sth->finish;
 687     $sth =
 688       $dbh->prepare(
 689 "select bibid,tag,tagorder,subfieldcode,subfieldid,subfieldorder from marc_subfield_table where subfieldid=?"
 690     );
 691     $sth->execute($subfieldid);
 692     my ( $bibid, $tagid, $tagorder, $subfieldcode, $x, $subfieldorder ) =
 693       $sth->fetchrow;
 694     $subfieldid = $x;
 695     &MARCdelword( $dbh, $bibid, $tagid, $tagorder, $subfieldcode,
 696         $subfieldorder );
 697     &MARCaddword(
 698         $dbh,          $bibid,         $tagid,       $tagorder,
 699         $subfieldcode, $subfieldorder, $subfieldvalue
 700     );
 701     return ( $subfieldid, $subfieldvalue );
 702 }
 703
 704 sub MARCfindsubfield {
 705     my ( $dbh, $bibid, $tag, $subfieldcode, $subfieldorder, $subfieldvalue ) =
 706       @_;
 707     my $resultcounter = 0;
 708     my $subfieldid;
 709     my $lastsubfieldid;
 710     my $query =
 711 "select subfieldid from marc_subfield_table where bibid=? and tag=? and subfieldcode=?";
 712     my @bind_values = ( $bibid, $tag, $subfieldcode );
 713     if ($subfieldvalue) {
 714         $query .= " and subfieldvalue=?";
 715         push ( @bind_values, $subfieldvalue );
 716     }
 717     else {
 718         if ( $subfieldorder < 1 ) {
 719             $subfieldorder = 1;
 720         }
 721         $query .= " and subfieldorder=?";
 722         push ( @bind_values, $subfieldorder );
 723     }
 724     my $sti = $dbh->prepare($query);
 725     $sti->execute(@bind_values);
 726     while ( ($subfieldid) = $sti->fetchrow ) {
 727         $resultcounter++;
 728         $lastsubfieldid = $subfieldid;
 729     }
 730     if ( $resultcounter > 1 ) {
 731
 732 # Error condition.  Values given did not resolve into a unique record.  Don't know what to edit
 733 # should rarely occur (only if we use subfieldvalue with a value that exists twice, which is strange)
 734         return -1;
 735     }
 736     else {
 737         return $lastsubfieldid;
 738     }
 739 }
 740
 741 sub MARCfindsubfieldid {
 742     my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_;
 743     my $sth = $dbh->prepare( "select subfieldid from marc_subfield_table
 744                                 where bibid=? and tag=? and tagorder=?
 745                                         and subfieldcode=? and subfieldorder=?"
 746     );
 747     $sth->execute( $bibid, $tag, $tagorder, $subfield, $subfieldorder );
 748     my ($res) = $sth->fetchrow;
 749     unless ($res) {
 750         $sth = $dbh->prepare( "select subfieldid from marc_subfield_table
 751                                 where bibid=? and tag=? and tagorder=?
 752                                         and subfieldcode=?"
 753         );
 754         $sth->execute( $bibid, $tag, $tagorder, $subfield );
 755         ($res) = $sth->fetchrow;
 756     }
 757     return $res;
 758 }
 759
 760 sub MARCfind_frameworkcode {
 761     my ( $dbh, $biblionumber ) = @_;
 762     my $sth =
 763       $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
 764     $sth->execute($biblionumber);
 765     my ($frameworkcode) = $sth->fetchrow;
 766     return $frameworkcode;
 767 }
 768
 769 sub MARCdelsubfield {
 770
 771     # delete a subfield for $bibid / tag / tagorder / subfield / subfieldorder
 772     my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_;
 773         if ($subfieldorder) {
 774                 $dbh->do( "delete from marc_subfield_table where bibid='$bibid' and
 775                                 tag='$tag' and tagorder='$tagorder'
 776                                 and subfieldcode='$subfield' and subfieldorder='$subfieldorder'
 777                                 "
 778                 );
 779                 $dbh->do( "delete from marc_word where bibid='$bibid' and
 780                                 tagsubfield='$tag$subfield' and tagorder='$tagorder'
 781                                 and subfieldorder='$subfieldorder'
 782                                 "
 783                 );
 784         } else {
 785                 $dbh->do( "delete from marc_subfield_table where bibid='$bibid' and
 786                                 tag='$tag' and tagorder='$tagorder'
 787                                 and subfieldcode='$subfield'"
 788                 );
 789                 $dbh->do( "delete from marc_word where bibid='$bibid' and
 790                                 tagsubfield='$tag$subfield' and tagorder='$tagorder'"
 791                 );
 792         }
 793 }
 794
 795 sub MARCkoha2marcBiblio {
 796
 797     # this function builds partial MARC::Record from the old koha-DB fields
 798     my ( $dbh, $biblionumber, $biblioitemnumber ) = @_;
 799     my $sth =
 800       $dbh->prepare(
 801 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
 802     );
 803     my $record = MARC::Record->new();
 804
 805     #--- if bibid, then retrieve old-style koha data
 806     if ( $biblionumber > 0 ) {
 807         my $sth2 =
 808           $dbh->prepare(
 809 "select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp
 810                 from biblio where biblionumber=?"
 811         );
 812         $sth2->execute($biblionumber);
 813         my $row = $sth2->fetchrow_hashref;
 814         my $code;
 815         foreach $code ( keys %$row ) {
 816             if ( $row->{$code} ) {
 817                 &MARCkoha2marcOnefield( $sth, $record, "biblio." . $code,
 818                     $row->{$code}, '');
 819             }
 820         }
 821     }
 822
 823     #--- if biblioitem, then retrieve old-style koha data
 824     if ( $biblioitemnumber > 0 ) {
 825         my $sth2 =
 826           $dbh->prepare(
 827             " SELECT biblioitemnumber,biblionumber,volume,number,classification,
 828                                                 itemtype,url,isbn,issn,dewey,subclass,publicationyear,publishercode,
 829                                                 volumedate,volumeddesc,timestamp,illus,pages,notes AS bnotes,size,place
 830                                         FROM biblioitems
 831                                         WHERE biblioitemnumber=?
 832                                         "
 833         );
 834         $sth2->execute($biblioitemnumber);
 835         my $row = $sth2->fetchrow_hashref;
 836         my $code;
 837         foreach $code ( keys %$row ) {
 838             if ( $row->{$code} ) {
 839                 &MARCkoha2marcOnefield( $sth, $record, "biblioitems." . $code,
 840                     $row->{$code},'' );
 841             }
 842         }
 843     }
 844
 845     # other fields => additional authors, subjects, subtitles
 846     my $sth2 =
 847       $dbh->prepare(
 848         " SELECT author FROM additionalauthors WHERE biblionumber=?");
 849     $sth2->execute($biblionumber);
 850     while ( my $row = $sth2->fetchrow_hashref ) {
 851         &MARCkoha2marcOnefield( $sth, $record, "additionalauthors.author",
 852             $row->{'author'},'' );
 853     }
 854     $sth2 =
 855       $dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?");
 856     $sth2->execute($biblionumber);
 857     while ( my $row = $sth2->fetchrow_hashref ) {
 858         &MARCkoha2marcOnefield( $sth, $record, "bibliosubject.subject",
 859             $row->{'subject'},'' );
 860     }
 861     $sth2 =
 862       $dbh->prepare(
 863         " SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?");
 864     $sth2->execute($biblionumber);
 865     while ( my $row = $sth2->fetchrow_hashref ) {
 866         &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle",
 867             $row->{'subtitle'},'' );
 868     }
 869     return $record;
 870 }
 871
 872 sub MARCkoha2marcItem {
 873
 874     # this function builds partial MARC::Record from the old koha-DB fields
 875     my ( $dbh, $biblionumber, $itemnumber ) = @_;
 876
 877     #    my $dbh=&C4Connect;
 878     my $sth =
 879       $dbh->prepare(
 880 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
 881     );
 882     my $record = MARC::Record->new();
 883
 884     #--- if item, then retrieve old-style koha data
 885     if ( $itemnumber > 0 ) {
 886
 887         #       print STDERR "prepare $biblionumber,$itemnumber\n";
 888         my $sth2 =
 889           $dbh->prepare(
 890 "SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned,
 891                                                 booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
 892                                                 datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,itemcallnumber,issues,renewals,
 893                                         reserves,restricted,binding,itemnotes,holdingbranch,timestamp
 894                                         FROM items
 895                                         WHERE itemnumber=?"
 896         );
 897         $sth2->execute($itemnumber);
 898         my $row = $sth2->fetchrow_hashref;
 899         my $code;
 900         foreach $code ( keys %$row ) {
 901             if ( $row->{$code} ) {
 902                 &MARCkoha2marcOnefield( $sth, $record, "items." . $code,
 903                     $row->{$code},'' );
 904             }
 905         }
 906     }
 907     return $record;
 908 }
 909
 910 sub MARCkoha2marcSubtitle {
 911
 912     # this function builds partial MARC::Record from the old koha-DB fields
 913     my ( $dbh, $bibnum, $subtitle ) = @_;
 914     my $sth =
 915       $dbh->prepare(
 916 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
 917     );
 918     my $record = MARC::Record->new();
 919     &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle",
 920         $subtitle,'' );
 921     return $record;
 922 }
 923
 924 sub MARCkoha2marcOnefield {
 925     my ( $sth, $record, $kohafieldname, $value,$frameworkcode ) = @_;
 926     my $tagfield;
 927     my $tagsubfield;
 928     $sth->execute($frameworkcode,$kohafieldname);
 929     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
 930         if ( $record->field($tagfield) ) {
 931             my $tag = $record->field($tagfield);
 932             if ($tag) {
 933                 $tag->add_subfields( $tagsubfield, $value );
 934                 $record->delete_field($tag);
 935                 $record->add_fields($tag);
 936             }
 937         }
 938         else {
 939             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
 940         }
 941     }
 942     return $record;
 943 }
 944
 945 sub MARChtml2marc {
 946         my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
 947         my $prevtag = -1;
 948         my $record = MARC::Record->new();
 949 #       my %subfieldlist=();
 950         my $prevvalue; # if tag <10
 951         my $field; # if tag >=10
 952         for (my $i=0; $i< @$rtags; $i++) {
 953                 next unless @$rvalues[$i];
 954                 # rebuild MARC::Record
 955 #                       warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
 956                 if (@$rtags[$i] ne $prevtag) {
 957                         if ($prevtag < 10) {
 958                                 if ($prevvalue) {
 959                                         if ($prevtag ne '000') {
 960                                                 $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
 961                                         } else {
 962                                                 $record->leader($prevvalue);
 963                                         }
 964                                 }
 965                         } else {
 966                                 if ($field) {
 967                                         $record->add_fields($field);
 968                                 }
 969                         }
 970                         $indicators{@$rtags[$i]}.='  ';
 971                         if (@$rtags[$i] <10) {
 972                                 $prevvalue= @$rvalues[$i];
 973                                 undef $field;
 974                         } else {
 975                                 undef $prevvalue;
 976                                 $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
 977 #                       warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
 978                         }
 979                         $prevtag = @$rtags[$i];
 980                 } else {
 981                         if (@$rtags[$i] <10) {
 982                                 $prevvalue=@$rvalues[$i];
 983                         } else {
 984                                 if (length(@$rvalues[$i])>0) {
 985                                         $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
 986 #                       warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
 987                                 }
 988                         }
 989                         $prevtag= @$rtags[$i];
 990                 }
 991         }
 992         # the last has not been included inside the loop... do it now !
 993         $record->add_fields($field) if $field;
 994 #       warn "HTML2MARC=".$record->as_formatted;
 995         return $record;
 996 }
 997
 998 sub MARCmarc2koha {
 999         my ($dbh,$record,$frameworkcode) = @_;
1000         my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
1001         my $result;
1002         my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
1003         $sth2->execute;
1004         my $field;
1005         while (($field)=$sth2->fetchrow) {
1006                 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result,$frameworkcode);
1007         }
1008         $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
1009         $sth2->execute;
1010         while (($field)=$sth2->fetchrow) {
1011                 if ($field eq 'notes') { $field = 'bnotes'; }
1012                 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result,$frameworkcode);
1013         }
1014         $sth2=$dbh->prepare("SHOW COLUMNS from items");
1015         $sth2->execute;
1016         while (($field)=$sth2->fetchrow) {
1017                 $result=&MARCmarc2kohaOneField($sth,"items",$field,$record,$result,$frameworkcode);
1018         }
1019         # additional authors : specific
1020         $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result,$frameworkcode);
1021         $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result,$frameworkcode);
1022 # modify copyrightdate to keep only the 1st year found
1023         my $temp = $result->{'copyrightdate'};
1024         $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
1025         if ($1>0) {
1026                 $result->{'copyrightdate'} = $1;
1027         } else { # if no cYYYY, get the 1st date.
1028                 $temp =~ m/(\d\d\d\d)/;
1029                 $result->{'copyrightdate'} = $1;
1030         }
1031 # modify publicationyear to keep only the 1st year found
1032         $temp = $result->{'publicationyear'};
1033         $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
1034         if ($1>0) {
1035                 $result->{'publicationyear'} = $1;
1036         } else { # if no cYYYY, get the 1st date.
1037                 $temp =~ m/(\d\d\d\d)/;
1038                 $result->{'publicationyear'} = $1;
1039         }
1040         return $result;
1041 }
1042
1043 sub MARCmarc2kohaOneField {
1044
1045 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
1046     my ( $sth, $kohatable, $kohafield, $record, $result,$frameworkcode ) = @_;
1047     #    warn "kohatable / $kohafield / $result / ";
1048     my $res = "";
1049     my $tagfield;
1050     my $subfield;
1051     ( $tagfield, $subfield ) = MARCfind_marc_from_kohafield("",$kohatable.".".$kohafield,$frameworkcode);
1052     foreach my $field ( $record->field($tagfield) ) {
1053                 if ($field->tag()<10) {
1054                         if ($result->{$kohafield}) {
1055                                 $result->{$kohafield} .= " | ".$field->data();
1056                         } else {
1057                                 $result->{$kohafield} = $field->data();
1058                         }
1059                 } else {
1060                         if ( $field->subfields ) {
1061                                 my @subfields = $field->subfields();
1062                                 foreach my $subfieldcount ( 0 .. $#subfields ) {
1063                                         if ($subfields[$subfieldcount][0] eq $subfield) {
1064                                                 if ( $result->{$kohafield} ) {
1065                                                         $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
1066                                                 }
1067                                                 else {
1068                                                         $result->{$kohafield} = $subfields[$subfieldcount][1];
1069                                                 }
1070                                         }
1071                                 }
1072                         }
1073                 }
1074     }
1075 #       warn "OneField for $kohatable.$kohafield and $frameworkcode=> $tagfield, $subfield";
1076     return $result;
1077 }
1078
1079 sub MARCaddword {
1080
1081     # split a subfield string and adds it into the word table.
1082     # removes stopwords
1083     my (
1084         $dbh,        $bibid,         $tag,    $tagorder,
1085         $subfieldid, $subfieldorder, $sentence
1086       )
1087       = @_;
1088     $sentence =~ s/(\.|\?|\:|\!|\'|,|\-|\"|\(|\)|\[|\]|\{|\}|\/)/ /g;
1089     my @words = split / /, $sentence;
1090     my $stopwords = C4::Context->stopwords;
1091     my $sth       =
1092       $dbh->prepare(
1093 "insert into marc_word (bibid, tagsubfield, tagorder, subfieldorder, word, sndx_word)
1094                         values (?,concat(?,?),?,?,?,soundex(?))"
1095     );
1096     foreach my $word (@words) {
1097 # we record only words one char long and not in stopwords hash
1098         if (length($word)>=1 and !($stopwords->{uc($word)})) {
1099             $sth->execute($bibid,$tag,$subfieldid,$tagorder,$subfieldorder,$word,$word);
1100             if ($sth->err()) {
1101                 warn "ERROR ==> insert into marc_word (bibid, tagsubfield, tagorder, subfieldorder, word, sndx_word) values ($bibid,concat($tag,$subfieldid),$tagorder,$subfieldorder,$word,soundex($word))\n";
1102             }
1103         }
1104     }
1105 }
1106
1107 sub MARCdelword {
1108
1109 # delete words. this sub deletes all the words from a sentence. a subfield modif is done by a delete then a add
1110     my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_;
1111     my $sth =
1112       $dbh->prepare(
1113 "delete from marc_word where bibid=? and tagsubfield=concat(?,?) and tagorder=? and subfieldorder=?"
1114     );
1115     $sth->execute( $bibid, $tag, $subfield, $tagorder, $subfieldorder );
1116 }
1117
1118 #
1119 #
1120 # NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW
1121 #
1122 #
1123 # all the following subs are useful to manage MARC-DB with complete MARC records.
1124 # it's used with marcimport, and marc management tools
1125 #
1126
1127 =item ($bibid,$oldbibnum,$oldbibitemnum) = NEWnewbibilio($dbh,$MARCRecord,$frameworkcode);
1128
1129 creates a biblio from a MARC::Record.
1130
1131 =item NEWnewitem($dbh, $record,$bibid);
1132
1133 creates an item from a MARC::Record
1134
1135 =cut
1136
1137 sub NEWnewbiblio {
1138     my ( $dbh, $record, $frameworkcode ) = @_;
1139     my $biblionumber;
1140     my $biblioitemnumber;
1141     my $olddata = MARCmarc2koha( $dbh, $record,$frameworkcode );
1142         $olddata->{frameworkcode} = $frameworkcode;
1143     $biblionumber = OLDnewbiblio( $dbh, $olddata );
1144         $olddata->{biblionumber} = $biblionumber;
1145         # add biblionumber into the MARC record (it's the ID for zebra)
1146         my ( $tagfield, $tagsubfield ) =
1147                                         MARCfind_marc_from_kohafield( $dbh, "biblio.biblionumber",$frameworkcode );
1148         # create the field
1149         my $newfield;
1150         if ($tagfield<10) {
1151                 $newfield = MARC::Field->new(
1152                         $tagfield, $biblionumber,
1153                 );
1154         } else {
1155                 $newfield = MARC::Field->new(
1156                         $tagfield, '', '', "$tagsubfield" => $biblionumber,
1157                 );
1158         }
1159         # drop old field (just in case it already exist and create new one...
1160         my $old_field = $record->field($tagfield);
1161         $record->delete_field($old_field);
1162         $record->add_fields($newfield);
1163
1164         #create the marc entry, that stores the rax marc record in Koha 3.0
1165         $olddata->{marc} = $record->as_usmarc();
1166         $olddata->{marcxml} = $record->as_xml();
1167         # and create biblioitem, that's all folks !
1168     $biblioitemnumber = OLDnewbiblioitem( $dbh, $olddata );
1169
1170     # search subtiles, addiauthors and subjects
1171     ( $tagfield, $tagsubfield ) =
1172       MARCfind_marc_from_kohafield( $dbh, "additionalauthors.author",$frameworkcode );
1173     my @addiauthfields = $record->field($tagfield);
1174     foreach my $addiauthfield (@addiauthfields) {
1175         my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
1176         foreach my $subfieldcount ( 0 .. $#addiauthsubfields ) {
1177             OLDmodaddauthor( $dbh, $biblionumber,
1178                 $addiauthsubfields[$subfieldcount] );
1179         }
1180     }
1181     ( $tagfield, $tagsubfield ) =
1182       MARCfind_marc_from_kohafield( $dbh, "bibliosubtitle.subtitle",$frameworkcode );
1183     my @subtitlefields = $record->field($tagfield);
1184     foreach my $subtitlefield (@subtitlefields) {
1185         my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
1186         foreach my $subfieldcount ( 0 .. $#subtitlesubfields ) {
1187             OLDnewsubtitle( $dbh, $biblionumber,
1188                 $subtitlesubfields[$subfieldcount] );
1189         }
1190     }
1191     ( $tagfield, $tagsubfield ) =
1192       MARCfind_marc_from_kohafield( $dbh, "bibliosubject.subject",$frameworkcode );
1193     my @subj = $record->field($tagfield);
1194     my @subjects;
1195     foreach my $subject (@subj) {
1196         my @subjsubfield = $subject->subfield($tagsubfield);
1197         foreach my $subfieldcount ( 0 .. $#subjsubfield ) {
1198             push @subjects, $subjsubfield[$subfieldcount];
1199         }
1200     }
1201     OLDmodsubject( $dbh, $biblionumber, 1, @subjects );
1202     return ( $biblionumber, $biblioitemnumber );
1203 }
1204
1205 sub NEWmodbiblioframework {
1206         my ($dbh,$bibid,$frameworkcode) =@_;
1207         my $sth = $dbh->prepare("Update marc_biblio SET frameworkcode=? WHERE bibid=$bibid");
1208         $sth->execute($frameworkcode);
1209         return 1;
1210 }
1211
1212 sub NEWmodbiblio {
1213         my ($dbh,$record,$biblionumber,$frameworkcode) =@_;
1214         $frameworkcode="" unless $frameworkcode;
1215 #       &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,0);
1216         my $oldbiblio = MARCmarc2koha($dbh,$record,$frameworkcode);
1217
1218         $oldbiblio->{frameworkcode} = $frameworkcode;
1219         #create the marc entry, that stores the rax marc record in Koha 3.0
1220         $oldbiblio->{marc} = $record->as_usmarc();
1221         $oldbiblio->{marcxml} = $record->as_xml();
1222
1223         OLDmodbiblio($dbh,$oldbiblio);
1224         OLDmodbibitem($dbh,$oldbiblio);
1225         # now, modify addi authors, subject, addititles.
1226         my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author",$frameworkcode);
1227         my @addiauthfields = $record->field($tagfield);
1228         foreach my $addiauthfield (@addiauthfields) {
1229                 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
1230                 foreach my $subfieldcount (0..$#addiauthsubfields) {
1231                         OLDmodaddauthor($dbh,$biblionumber,$addiauthsubfields[$subfieldcount]);
1232                 }
1233         }
1234         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle",$frameworkcode);
1235         my @subtitlefields = $record->field($tagfield);
1236         foreach my $subtitlefield (@subtitlefields) {
1237                 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
1238                 # delete & create subtitle again because OLDmodsubtitle can't handle new subtitles
1239                 # between 2 modifs
1240                 $dbh->do("delete from bibliosubtitle where biblionumber=$biblionumber");
1241                 foreach my $subfieldcount (0..$#subtitlesubfields) {
1242                         foreach my $subtit(split /\||#/,$subtitlesubfields[$subfieldcount]) {
1243                                 OLDnewsubtitle($dbh,$biblionumber,$subtit);
1244                         }
1245                 }
1246         }
1247         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject",$frameworkcode);
1248         my @subj = $record->field($tagfield);
1249         my @subjects;
1250         foreach my $subject (@subj) {
1251                 my @subjsubfield = $subject->subfield($tagsubfield);
1252                 foreach my $subfieldcount (0..$#subjsubfield) {
1253                         push @subjects,$subjsubfield[$subfieldcount];
1254                 }
1255         }
1256         OLDmodsubject($dbh,$biblionumber,1,@subjects);
1257         return 1;
1258 }
1259
1260 sub NEWdelbiblio {
1261     my ( $dbh, $bibid ) = @_;
1262     my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
1263     &OLDdelbiblio( $dbh, $biblio );
1264     my $sth =
1265       $dbh->prepare(
1266         "select biblioitemnumber from biblioitems where biblionumber=?");
1267     $sth->execute($biblio);
1268     while ( my ($biblioitemnumber) = $sth->fetchrow ) {
1269         OLDdeletebiblioitem( $dbh, $biblioitemnumber );
1270     }
1271     &MARCdelbiblio( $dbh, $bibid, 0 );
1272 }
1273
1274 sub NEWnewitem {
1275     my ( $dbh, $record, $bibid ) = @_;
1276
1277     # add item in old-DB
1278         my $frameworkcode=MARCfind_frameworkcode($dbh,$bibid);
1279     my $item = &MARCmarc2koha( $dbh, $record,$frameworkcode );
1280     # needs old biblionumber and biblioitemnumber
1281     $item->{'biblionumber'} =
1282       MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
1283     my $sth =
1284       $dbh->prepare(
1285         "select biblioitemnumber from biblioitems where biblionumber=?");
1286     $sth->execute( $item->{'biblionumber'} );
1287     ( $item->{'biblioitemnumber'} ) = $sth->fetchrow;
1288     my ( $itemnumber, $error ) = &OLDnewitems( $dbh, $item, $item->{barcode} );
1289
1290     # add itemnumber to MARC::Record before adding the item.
1291     $sth =
1292       $dbh->prepare(
1293 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
1294     );
1295     &MARCkoha2marcOnefield( $sth, $record, "items.itemnumber", $itemnumber,$frameworkcode );
1296
1297     # add the item
1298     my $bib = &MARCadditem( $dbh, $record, $item->{'biblionumber'} );
1299 }
1300
1301 sub NEWmoditem {
1302     my ( $dbh, $record, $bibid, $itemnumber, $delete ) = @_;
1303
1304         &MARCmoditem( $dbh, $record, $bibid, $itemnumber, $delete );
1305         my $frameworkcode=MARCfind_frameworkcode($dbh,$bibid);
1306     my $olditem = MARCmarc2koha( $dbh, $record,$frameworkcode );
1307     OLDmoditem( $dbh, $olditem );
1308 }
1309
1310 sub NEWdelitem {
1311     my ( $dbh, $bibid, $itemnumber ) = @_;
1312     my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
1313     &OLDdelitem( $dbh, $itemnumber );
1314     &MARCdelitem( $dbh, $bibid, $itemnumber );
1315 }
1316
1317 #
1318 #
1319 # OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD
1320 #
1321 #
1322
1323 =item $biblionumber = OLDnewbiblio($dbh,$biblio);
1324
1325 adds a record in biblio table. Datas are in the hash $biblio.
1326
1327 =item $biblionumber = OLDmodbiblio($dbh,$biblio);
1328
1329 modify a record in biblio table. Datas are in the hash $biblio.
1330
1331 =item OLDmodsubtitle($dbh,$bibnum,$subtitle);
1332
1333 modify subtitles in bibliosubtitle table.
1334
1335 =item OLDmodaddauthor($dbh,$bibnum,$author);
1336
1337 adds or modify additional authors
1338 NOTE :  Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
1339
1340 =item $errors = OLDmodsubject($dbh,$bibnum, $force, @subject);
1341
1342 modify/adds subjects
1343
1344 =item OLDmodbibitem($dbh, $biblioitem);
1345
1346 modify a biblioitem
1347
1348 =item OLDmodnote($dbh,$bibitemnum,$note
1349
1350 modify a note for a biblioitem
1351
1352 =item OLDnewbiblioitem($dbh,$biblioitem);
1353
1354 adds a biblioitem ($biblioitem is a hash with the values)
1355
1356 =item OLDnewsubject($dbh,$bibnum);
1357
1358 adds a subject
1359
1360 =item OLDnewsubtitle($dbh,$bibnum,$subtitle);
1361
1362 create a new subtitle
1363
1364 =item ($itemnumber,$errors)= OLDnewitems($dbh,$item,$barcode);
1365
1366 create a item. $item is a hash and $barcode the barcode.
1367
1368 =item OLDmoditem($dbh,$item);
1369
1370 modify item
1371
1372 =item OLDdelitem($dbh,$itemnum);
1373
1374 delete item
1375
1376 =item OLDdeletebiblioitem($dbh,$biblioitemnumber);
1377
1378 deletes a biblioitem
1379 NOTE : not standard sub name. Should be OLDdelbiblioitem()
1380
1381 =item OLDdelbiblio($dbh,$biblio);
1382
1383 delete a biblio
1384
1385 =cut
1386
1387 sub OLDnewbiblio {
1388     my ( $dbh, $biblio ) = @_;
1389
1390         $dbh->do('lock tables biblio WRITE');
1391     my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
1392     $sth->execute;
1393     my $data   = $sth->fetchrow_arrayref;
1394     my $bibnum = $$data[0] + 1;
1395     my $series = 0;
1396
1397     if ( $biblio->{'seriestitle'} ) { $series = 1 }
1398     $sth->finish;
1399     $sth =
1400       $dbh->prepare("insert into biblio set     biblionumber=?, title=?,                author=?,       copyrightdate=?,
1401                                                                                         serial=?,               seriestitle=?,  notes=?,        abstract=?,
1402                                                                                         unititle=?"
1403     );
1404     $sth->execute(
1405         $bibnum,             $biblio->{'title'},
1406         $biblio->{'author'}, $biblio->{'copyrightdate'},
1407         $biblio->{'serial'},             $biblio->{'seriestitle'},
1408         $biblio->{'notes'},  $biblio->{'abstract'},
1409                 $biblio->{'unititle'}
1410     );
1411
1412     $sth->finish;
1413         $dbh->do('unlock tables');
1414     return ($bibnum);
1415 }
1416
1417 sub OLDmodbiblio {
1418     my ( $dbh, $biblio ) = @_;
1419     my $sth = $dbh->prepare("Update biblio set  title=?,                author=?,       abstract=?,     copyrightdate=?,
1420                                                                                                 seriestitle=?,  serial=?,       unititle=?,     notes=?,        frameworkcode=?
1421                                                                                         where biblionumber = ?"
1422     );
1423     $sth->execute(
1424                 $biblio->{'title'},       $biblio->{'author'},
1425                 $biblio->{'abstract'},    $biblio->{'copyrightdate'},
1426                 $biblio->{'seriestitle'}, $biblio->{'serial'},
1427                 $biblio->{'unititle'},    $biblio->{'notes'},
1428                 $biblio->{frameworkcode},
1429                 $biblio->{'biblionumber'}
1430     );
1431         $sth->finish;
1432         return ( $biblio->{'biblionumber'} );
1433 }    # sub modbiblio
1434
1435 sub OLDmodsubtitle {
1436     my ( $dbh, $bibnum, $subtitle ) = @_;
1437     my $sth =
1438       $dbh->prepare(
1439         "update bibliosubtitle set subtitle = ? where biblionumber = ?");
1440     $sth->execute( $subtitle, $bibnum );
1441     $sth->finish;
1442 }    # sub modsubtitle
1443
1444 sub OLDmodaddauthor {
1445     my ( $dbh, $bibnum, @authors ) = @_;
1446
1447     #    my $dbh   = C4Connect;
1448     my $sth =
1449       $dbh->prepare("Delete from additionalauthors where biblionumber = ?");
1450
1451     $sth->execute($bibnum);
1452     $sth->finish;
1453     foreach my $author (@authors) {
1454         if ( $author ne '' ) {
1455             $sth =
1456               $dbh->prepare(
1457                 "Insert into additionalauthors set author = ?, biblionumber = ?"
1458             );
1459
1460             $sth->execute( $author, $bibnum );
1461
1462             $sth->finish;
1463         }    # if
1464     }
1465 }    # sub modaddauthor
1466
1467 sub OLDmodsubject {
1468     my ( $dbh, $bibnum, $force, @subject ) = @_;
1469
1470     #  my $dbh   = C4Connect;
1471     my $count = @subject;
1472     my $error;
1473     for ( my $i = 0 ; $i < $count ; $i++ ) {
1474         $subject[$i] =~ s/^ //g;
1475         $subject[$i] =~ s/ $//g;
1476         my $sth =
1477           $dbh->prepare(
1478 "select * from catalogueentry where entrytype = 's' and catalogueentry = ?"
1479         );
1480         $sth->execute( $subject[$i] );
1481
1482         if ( my $data = $sth->fetchrow_hashref ) {
1483         }
1484         else {
1485             if ( $force eq $subject[$i] || $force == 1 ) {
1486
1487                 # subject not in aut, chosen to force anway
1488                 # so insert into cataloguentry so its in auth file
1489                 my $sth2 =
1490                   $dbh->prepare(
1491 "Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)"
1492                 );
1493
1494                 $sth2->execute( $subject[$i] ) if ( $subject[$i] );
1495                 $sth2->finish;
1496             }
1497             else {
1498                 $error =
1499                   "$subject[$i]\n does not exist in the subject authority file";
1500                 my $sth2 =
1501                   $dbh->prepare(
1502 "Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)"
1503                 );
1504                 $sth2->execute( "$subject[$i] %", "% $subject[$i] %",
1505                     "% $subject[$i]" );
1506                 while ( my $data = $sth2->fetchrow_hashref ) {
1507                     $error .= "<br>$data->{'catalogueentry'}";
1508                 }    # while
1509                 $sth2->finish;
1510             }    # else
1511         }    # else
1512         $sth->finish;
1513     }    # else
1514     if ( $error eq '' ) {
1515         my $sth =
1516           $dbh->prepare("Delete from bibliosubject where biblionumber = ?");
1517         $sth->execute($bibnum);
1518         $sth->finish;
1519         $sth =
1520           $dbh->prepare(
1521             "Insert into bibliosubject (subject,biblionumber) values (?,?)");
1522         my $query;
1523         foreach $query (@subject) {
1524             $sth->execute( $query, $bibnum ) if ( $query && $bibnum );
1525         }    # foreach
1526         $sth->finish;
1527     }    # if
1528
1529     #  $dbh->disconnect;
1530     return ($error);
1531 }    # sub modsubject
1532
1533 sub OLDmodbibitem {
1534     my ( $dbh, $biblioitem ) = @_;
1535     my $query;
1536
1537     my $sth = $dbh->prepare("update biblioitems set     itemtype=?,                     url=?,                          isbn=?, issn=?,
1538                                                                                 publishercode=?,        publicationyear=?,      classification=?,       dewey=?,
1539                                                                                 subclass=?,                     illus=?,                        pages=?,                        volumeddesc=?,
1540                                                                                 notes=?,                        size=?,                         place=?,                        marc=?,
1541                                                                                 marcxml=?
1542                                                         where biblioitemnumber=?");
1543         $sth->execute(  $biblioitem->{itemtype},                $biblioitem->{url},             $biblioitem->{isbn},    $biblioitem->{issn},
1544                                 $biblioitem->{publishercode},   $biblioitem->{publicationyear}, $biblioitem->{classification},  $biblioitem->{dewey},
1545                                 $biblioitem->{subclass},                $biblioitem->{illus},           $biblioitem->{pages},   $biblioitem->{volumeddesc},
1546                                 $biblioitem->{bnotes},                  $biblioitem->{size},            $biblioitem->{place},   $biblioitem->{marc},
1547                                         $biblioitem->{marcxml},                 $biblioitem->{biblioitemnumber});
1548 #       warn "MOD : $biblioitem->{biblioitemnumber} = ".$biblioitem->{marc};
1549 }    # sub modbibitem
1550
1551 sub OLDmodnote {
1552     my ( $dbh, $bibitemnum, $note ) = @_;
1553
1554     #  my $dbh=C4Connect;
1555     my $query = "update biblioitems set notes='$note' where
1556   biblioitemnumber='$bibitemnum'";
1557     my $sth = $dbh->prepare($query);
1558     $sth->execute;
1559     $sth->finish;
1560
1561     #  $dbh->disconnect;
1562 }
1563
1564 sub OLDnewbiblioitem {
1565     my ( $dbh, $biblioitem ) = @_;
1566
1567     #  my $dbh   = C4Connect;
1568     my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems");
1569     my $data;
1570     my $bibitemnum;
1571
1572     $sth->execute;
1573     $data       = $sth->fetchrow_arrayref;
1574     $bibitemnum = $$data[0] + 1;
1575
1576     $sth->finish;
1577
1578     $sth = $dbh->prepare( "insert into biblioitems set
1579                                                                         biblioitemnumber = ?,           biblionumber     = ?,
1580                                                                         volume           = ?,                   number           = ?,
1581                                                                         classification  = ?,                    itemtype         = ?,
1582                                                                         url              = ?,                           isbn             = ?,
1583                                                                         issn             = ?,                           dewey            = ?,
1584                                                                         subclass         = ?,                           publicationyear  = ?,
1585                                                                         publishercode    = ?,           volumedate       = ?,
1586                                                                         volumeddesc      = ?,           illus            = ?,
1587                                                                         pages            = ?,                           notes            = ?,
1588                                                                         size             = ?,                           lccn             = ?,
1589                                                                         marc             = ?,                           place            = ?,
1590                                                                         marcxml          = ?"
1591     );
1592     $sth->execute(
1593         $bibitemnum,                     $biblioitem->{'biblionumber'},
1594         $biblioitem->{'volume'},         $biblioitem->{'number'},
1595         $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
1596         $biblioitem->{'url'},            $biblioitem->{'isbn'},
1597         $biblioitem->{'issn'},           $biblioitem->{'dewey'},
1598         $biblioitem->{'subclass'},       $biblioitem->{'publicationyear'},
1599         $biblioitem->{'publishercode'},  $biblioitem->{'volumedate'},
1600         $biblioitem->{'volumeddesc'},    $biblioitem->{'illus'},
1601         $biblioitem->{'pages'},          $biblioitem->{'bnotes'},
1602         $biblioitem->{'size'},           $biblioitem->{'lccn'},
1603         $biblioitem->{'marc'},           $biblioitem->{'place'},
1604                 $biblioitem->{marcxml},
1605     );
1606     $sth->finish;
1607
1608     #    $dbh->disconnect;
1609     return ($bibitemnum);
1610 }
1611
1612 sub OLDnewsubject {
1613     my ( $dbh, $bibnum ) = @_;
1614     my $sth =
1615       $dbh->prepare("insert into bibliosubject (biblionumber) values (?)");
1616     $sth->execute($bibnum);
1617     $sth->finish;
1618 }
1619
1620 sub OLDnewsubtitle {
1621     my ( $dbh, $bibnum, $subtitle ) = @_;
1622     my $sth =
1623       $dbh->prepare(
1624         "insert into bibliosubtitle set biblionumber = ?, subtitle = ?");
1625     $sth->execute( $bibnum, $subtitle ) if $subtitle;
1626     $sth->finish;
1627 }
1628
1629 sub OLDnewitems {
1630     my ( $dbh, $item, $barcode ) = @_;
1631
1632     #  my $dbh   = C4Connect;
1633     my $sth = $dbh->prepare("Select max(itemnumber) from items");
1634     my $data;
1635     my $itemnumber;
1636     my $error = "";
1637
1638     $sth->execute;
1639     $data       = $sth->fetchrow_hashref;
1640     $itemnumber = $data->{'max(itemnumber)'} + 1;
1641     $sth->finish;
1642
1643 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
1644     if ( $item->{'loan'} ) {
1645         $item->{'notforloan'} = $item->{'loan'};
1646     }
1647
1648     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1649     if ( $item->{'dateaccessioned'} ) {
1650         $sth = $dbh->prepare( "Insert into items set
1651                                                         itemnumber           = ?,                       biblionumber         = ?,
1652                                                         multivolumepart      = ?,
1653                                                         biblioitemnumber     = ?,                       barcode              = ?,
1654                                                         booksellerid         = ?,                       dateaccessioned      = ?,
1655                                                         homebranch           = ?,                       holdingbranch        = ?,
1656                                                         price                = ?,                       replacementprice     = ?,
1657                                                         replacementpricedate = NOW(),           datelastseen            = NOW(),
1658                                                         multivolume                     = ?,                    stack                           = ?,
1659                                                         itemlost                        = ?,                    wthdrawn                        = ?,
1660                                                         paidfor                         = ?,                    itemnotes            = ?,
1661                                                         itemcallnumber  =?,                                                     notforloan = ?,
1662                                                         location = ?
1663                                                         "
1664         );
1665         $sth->execute(
1666                         $itemnumber,                            $item->{'biblionumber'},
1667                         $item->{'multivolumepart'},
1668                         $item->{'biblioitemnumber'},$barcode,
1669                         $item->{'booksellerid'},        $item->{'dateaccessioned'},
1670                         $item->{'homebranch'},          $item->{'holdingbranch'},
1671                         $item->{'price'},                       $item->{'replacementprice'},
1672                         $item->{multivolume},           $item->{stack},
1673                         $item->{itemlost},                      $item->{wthdrawn},
1674                         $item->{paidfor},                       $item->{'itemnotes'},
1675                         $item->{'itemcallnumber'},      $item->{'notforloan'},
1676                         $item->{'location'}
1677         );
1678     }
1679     else {
1680         $sth = $dbh->prepare( "Insert into items set
1681                                                         itemnumber           = ?,                       biblionumber         = ?,
1682                                                         multivolumepart      = ?,
1683                                                         biblioitemnumber     = ?,                       barcode              = ?,
1684                                                         booksellerid         = ?,                       dateaccessioned      = NOW(),
1685                                                         homebranch           = ?,                       holdingbranch        = ?,
1686                                                         price                = ?,                       replacementprice     = ?,
1687                                                         replacementpricedate = NOW(),           datelastseen            = NOW(),
1688                                                         multivolume                     = ?,                    stack                           = ?,
1689                                                         itemlost                        = ?,                    wthdrawn                        = ?,
1690                                                         paidfor                         = ?,                    itemnotes            = ?,
1691                                                         itemcallnumber  =?,                                                     notforloan = ?,
1692                                                         location = ?
1693                                                         "
1694         );
1695         $sth->execute(
1696                         $itemnumber,                            $item->{'biblionumber'},
1697                         $item->{'multivolumepart'},
1698                         $item->{'biblioitemnumber'},$barcode,
1699                         $item->{'booksellerid'},
1700                         $item->{'homebranch'},          $item->{'holdingbranch'},
1701                         $item->{'price'},                       $item->{'replacementprice'},
1702                         $item->{multivolume},           $item->{stack},
1703                         $item->{itemlost},                      $item->{wthdrawn},
1704                         $item->{paidfor},                       $item->{'itemnotes'},
1705                         $item->{'itemcallnumber'},      $item->{'notforloan'},
1706                         $item->{'location'}
1707         );
1708     }
1709     if ( defined $sth->errstr ) {
1710         $error .= $sth->errstr;
1711     }
1712     $sth->finish;
1713     return ( $itemnumber, $error );
1714 }
1715
1716 sub OLDmoditem {
1717     my ( $dbh, $item ) = @_;
1718     $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
1719     my $query = "update items set  barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1720     my @bind = (
1721         $item->{'barcode'},                     $item->{'notes'},
1722         $item->{'itemcallnumber'},      $item->{'notforloan'},
1723         $item->{'location'},            $item->{multivolumepart},
1724                 $item->{multivolume},           $item->{stack},
1725                 $item->{wthdrawn},
1726     );
1727     if ( $item->{'lost'} ne '' ) {
1728         $query = "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
1729                                                         itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
1730                                                         location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1731         @bind = (
1732             $item->{'bibitemnum'},     $item->{'barcode'},
1733             $item->{'notes'},          $item->{'homebranch'},
1734             $item->{'lost'},           $item->{'wthdrawn'},
1735             $item->{'itemcallnumber'}, $item->{'notforloan'},
1736             $item->{'location'},                $item->{multivolumepart},
1737                         $item->{multivolume},           $item->{stack},
1738                         $item->{wthdrawn},
1739         );
1740                 if ($item->{homebranch}) {
1741                         $query.=",homebranch=?";
1742                         push @bind, $item->{homebranch};
1743                 }
1744                 if ($item->{holdingbranch}) {
1745                         $query.=",holdingbranch=?";
1746                         push @bind, $item->{holdingbranch};
1747                 }
1748     }
1749         $query.=" where itemnumber=?";
1750         push @bind,$item->{'itemnum'};
1751    if ( $item->{'replacement'} ne '' ) {
1752         $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1753     }
1754     my $sth = $dbh->prepare($query);
1755     $sth->execute(@bind);
1756     $sth->finish;
1757
1758     #  $dbh->disconnect;
1759 }
1760
1761 sub OLDdelitem {
1762     my ( $dbh, $itemnum ) = @_;
1763
1764     #  my $dbh=C4Connect;
1765     my $sth = $dbh->prepare("select * from items where itemnumber=?");
1766     $sth->execute($itemnum);
1767     my $data = $sth->fetchrow_hashref;
1768     $sth->finish;
1769     my $query = "Insert into deleteditems set ";
1770     my @bind  = ();
1771     foreach my $temp ( keys %$data ) {
1772         $query .= "$temp = ?,";
1773         push ( @bind, $data->{$temp} );
1774     }
1775     $query =~ s/\,$//;
1776
1777     #  print $query;
1778     $sth = $dbh->prepare($query);
1779     $sth->execute(@bind);
1780     $sth->finish;
1781     $sth = $dbh->prepare("Delete from items where itemnumber=?");
1782     $sth->execute($itemnum);
1783     $sth->finish;
1784
1785     #  $dbh->disconnect;
1786 }
1787
1788 sub OLDdeletebiblioitem {
1789     my ( $dbh, $biblioitemnumber ) = @_;
1790
1791     #    my $dbh   = C4Connect;
1792     my $sth = $dbh->prepare( "Select * from biblioitems
1793 where biblioitemnumber = ?"
1794     );
1795     my $results;
1796
1797     $sth->execute($biblioitemnumber);
1798
1799     if ( $results = $sth->fetchrow_hashref ) {
1800         $sth->finish;
1801         $sth =
1802           $dbh->prepare(
1803 "Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
1804                                         isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
1805                                         pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
1806         );
1807
1808         $sth->execute(
1809             $results->{biblioitemnumber}, $results->{biblionumber},
1810             $results->{volume},           $results->{number},
1811             $results->{classification},   $results->{itemtype},
1812             $results->{isbn},             $results->{issn},
1813             $results->{dewey},            $results->{subclass},
1814             $results->{publicationyear},  $results->{publishercode},
1815             $results->{volumedate},       $results->{volumeddesc},
1816             $results->{timestamp},        $results->{illus},
1817             $results->{pages},            $results->{notes},
1818             $results->{size},             $results->{url},
1819             $results->{lccn}
1820         );
1821         my $sth2 =
1822           $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?");
1823         $sth2->execute($biblioitemnumber);
1824         $sth2->finish();
1825     }    # if
1826     $sth->finish;
1827
1828     # Now delete all the items attached to the biblioitem
1829     $sth = $dbh->prepare("Select * from items where biblioitemnumber = ?");
1830     $sth->execute($biblioitemnumber);
1831     my @results;
1832     while ( my $data = $sth->fetchrow_hashref ) {
1833         my $query = "Insert into deleteditems set ";
1834         my @bind  = ();
1835         foreach my $temp ( keys %$data ) {
1836             $query .= "$temp = ?,";
1837             push ( @bind, $data->{$temp} );
1838         }
1839         $query =~ s/\,$//;
1840         my $sth2 = $dbh->prepare($query);
1841         $sth2->execute(@bind);
1842     }    # while
1843     $sth->finish;
1844     $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
1845     $sth->execute($biblioitemnumber);
1846     $sth->finish();
1847
1848     #    $dbh->disconnect;
1849 }    # sub deletebiblioitem
1850
1851 sub OLDdelbiblio {
1852     my ( $dbh, $biblio ) = @_;
1853     my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
1854     $sth->execute($biblio);
1855     if ( my $data = $sth->fetchrow_hashref ) {
1856         $sth->finish;
1857         my $query = "Insert into deletedbiblio set ";
1858         my @bind  = ();
1859         foreach my $temp ( keys %$data ) {
1860             $query .= "$temp = ?,";
1861             push ( @bind, $data->{$temp} );
1862         }
1863
1864         #replacing the last , by ",?)"
1865         $query =~ s/\,$//;
1866         $sth = $dbh->prepare($query);
1867         $sth->execute(@bind);
1868         $sth->finish;
1869         $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
1870         $sth->execute($biblio);
1871         $sth->finish;
1872     }
1873     $sth->finish;
1874 }
1875
1876 #
1877 #
1878 # old functions
1879 #
1880 #
1881
1882 sub itemcount {
1883     my ($biblio) = @_;
1884     my $dbh = C4::Context->dbh;
1885
1886     #  print $query;
1887     my $sth = $dbh->prepare("Select count(*) from items where biblionumber=?");
1888     $sth->execute($biblio);
1889     my $data = $sth->fetchrow_hashref;
1890     $sth->finish;
1891     return ( $data->{'count(*)'} );
1892 }
1893
1894 sub newbiblio {
1895     my ($biblio) = @_;
1896     my $dbh    = C4::Context->dbh;
1897     my $bibnum = OLDnewbiblio( $dbh, $biblio );
1898     # finds new (MARC bibid
1899     #   my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1900     my $record = &MARCkoha2marcBiblio( $dbh, $bibnum );
1901     MARCaddbiblio( $dbh, $record, $bibnum,'' );
1902     return ($bibnum);
1903 }
1904
1905 =item modbiblio
1906
1907   $biblionumber = &modbiblio($biblio);
1908
1909 Update a biblio record.
1910
1911 C<$biblio> is a reference-to-hash whose keys are the fields in the
1912 biblio table in the Koha database. All fields must be present, not
1913 just the ones you wish to change.
1914
1915 C<&modbiblio> updates the record defined by
1916 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1917
1918 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1919 successful or not.
1920
1921 =cut
1922
1923 sub modbiblio {
1924         my ($biblio) = @_;
1925         my $dbh  = C4::Context->dbh;
1926         my $biblionumber=OLDmodbiblio($dbh,$biblio);
1927         my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
1928         # finds new (MARC bibid
1929         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
1930         MARCmodbiblio($dbh,$bibid,$record,"",0);
1931         return($biblionumber);
1932 } # sub modbiblio
1933
1934 =item modsubtitle
1935
1936   &modsubtitle($biblionumber, $subtitle);
1937
1938 Sets the subtitle of a book.
1939
1940 C<$biblionumber> is the biblionumber of the book to modify.
1941
1942 C<$subtitle> is the new subtitle.
1943
1944 =cut
1945
1946 sub modsubtitle {
1947     my ( $bibnum, $subtitle ) = @_;
1948     my $dbh = C4::Context->dbh;
1949     &OLDmodsubtitle( $dbh, $bibnum, $subtitle );
1950 }    # sub modsubtitle
1951
1952 =item modaddauthor
1953
1954   &modaddauthor($biblionumber, $author);
1955
1956 Replaces all additional authors for the book with biblio number
1957 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1958 C<&modaddauthor> deletes all additional authors.
1959
1960 =cut
1961
1962 sub modaddauthor {
1963     my ( $bibnum, @authors ) = @_;
1964     my $dbh = C4::Context->dbh;
1965     &OLDmodaddauthor( $dbh, $bibnum, @authors );
1966 }    # sub modaddauthor
1967
1968 =item modsubject
1969
1970   $error = &modsubject($biblionumber, $force, @subjects);
1971
1972 $force - a subject to force
1973
1974 $error - Error message, or undef if successful.
1975
1976 =cut
1977
1978 sub modsubject {
1979     my ( $bibnum, $force, @subject ) = @_;
1980     my $dbh = C4::Context->dbh;
1981     my $error = &OLDmodsubject( $dbh, $bibnum, $force, @subject );
1982     if ($error eq ''){
1983                 # When MARC is off, ensures that the MARC biblio table gets updated with new
1984                 # subjects, of course, it deletes the biblio in marc, and then recreates.
1985                 # This check is to ensure that no MARC data exists to lose.
1986                 if (C4::Context->preference("MARC") eq '0'){
1987                         my $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibnum);
1988                         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1989                         &MARCmodbiblio($dbh,$bibid, $MARCRecord);
1990                 }
1991         }
1992         return ($error);
1993 }    # sub modsubject
1994
1995 sub modbibitem {
1996     my ($biblioitem) = @_;
1997     my $dbh = C4::Context->dbh;
1998     &OLDmodbibitem( $dbh, $biblioitem );
1999 }    # sub modbibitem
2000
2001 sub modnote {
2002     my ( $bibitemnum, $note ) = @_;
2003     my $dbh = C4::Context->dbh;
2004     &OLDmodnote( $dbh, $bibitemnum, $note );
2005 }
2006
2007 sub newbiblioitem {
2008     my ($biblioitem) = @_;
2009     my $dbh        = C4::Context->dbh;
2010     my $bibitemnum = &OLDnewbiblioitem( $dbh, $biblioitem );
2011
2012     my $MARCbiblio =
2013       MARCkoha2marcBiblio( $dbh, 0, $bibitemnum )
2014       ; # the 0 means "do NOT retrieve biblio, only biblioitem, in the MARC record
2015     my $bibid =
2016       &MARCfind_MARCbibid_from_oldbiblionumber( $dbh,
2017         $biblioitem->{biblionumber} );
2018     &MARCaddbiblio( $dbh, $MARCbiblio, $biblioitem->{biblionumber}, '',$bibid );
2019     return ($bibitemnum);
2020 }
2021
2022 sub newsubject {
2023     my ($bibnum) = @_;
2024     my $dbh = C4::Context->dbh;
2025     &OLDnewsubject( $dbh, $bibnum );
2026 }
2027
2028 sub newsubtitle {
2029     my ( $bibnum, $subtitle ) = @_;
2030     my $dbh = C4::Context->dbh;
2031     &OLDnewsubtitle( $dbh, $bibnum, $subtitle );
2032 }
2033
2034 sub newitems {
2035     my ( $item, @barcodes ) = @_;
2036     my $dbh = C4::Context->dbh;
2037     my $errors;
2038     my $itemnumber;
2039     my $error;
2040     foreach my $barcode (@barcodes) {
2041         ( $itemnumber, $error ) = &OLDnewitems( $dbh, $item, uc($barcode) );
2042         $errors .= $error;
2043         my $MARCitem =
2044           &MARCkoha2marcItem( $dbh, $item->{biblionumber}, $itemnumber );
2045         &MARCadditem( $dbh, $MARCitem, $item->{biblionumber} );
2046     }
2047     return ($errors);
2048 }
2049
2050 sub moditem {
2051     my ($item) = @_;
2052     my $dbh = C4::Context->dbh;
2053     &OLDmoditem( $dbh, $item );
2054     my $MARCitem =
2055       &MARCkoha2marcItem( $dbh, $item->{'biblionumber'}, $item->{'itemnum'} );
2056     my $bibid =
2057       &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $item->{biblionumber} );
2058     &MARCmoditem( $dbh, $MARCitem, $bibid, $item->{itemnum}, 0 );
2059 }
2060
2061 sub checkitems {
2062     my ( $count, @barcodes ) = @_;
2063     my $dbh = C4::Context->dbh;
2064     my $error;
2065     my $sth = $dbh->prepare("Select * from items where barcode=?");
2066     for ( my $i = 0 ; $i < $count ; $i++ ) {
2067         $barcodes[$i] = uc $barcodes[$i];
2068         $sth->execute( $barcodes[$i] );
2069         if ( my $data = $sth->fetchrow_hashref ) {
2070             $error .= " Duplicate Barcode: $barcodes[$i]";
2071         }
2072     }
2073     $sth->finish;
2074     return ($error);
2075 }
2076
2077 sub countitems {
2078     my ($bibitemnum) = @_;
2079     my $dbh   = C4::Context->dbh;
2080     my $query = "";
2081     my $sth   =
2082       $dbh->prepare("Select count(*) from items where biblioitemnumber=?");
2083     $sth->execute($bibitemnum);
2084     my $data = $sth->fetchrow_hashref;
2085     $sth->finish;
2086     return ( $data->{'count(*)'} );
2087 }
2088
2089 sub delitem {
2090     my ($itemnum) = @_;
2091     my $dbh = C4::Context->dbh;
2092     &OLDdelitem( $dbh, $itemnum );
2093 }
2094
2095 sub deletebiblioitem {
2096     my ($biblioitemnumber) = @_;
2097     my $dbh = C4::Context->dbh;
2098     &OLDdeletebiblioitem( $dbh, $biblioitemnumber );
2099 }    # sub deletebiblioitem
2100
2101 sub delbiblio {
2102     my ($biblio) = @_;
2103     my $dbh = C4::Context->dbh;
2104     &OLDdelbiblio( $dbh, $biblio );
2105     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio );
2106     &MARCdelbiblio( $dbh, $bibid, 0 );
2107 }
2108
2109 sub getbiblio {
2110     my ($biblionumber) = @_;
2111     my $dbh = C4::Context->dbh;
2112     my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
2113
2114     # || die "Cannot prepare $query\n" . $dbh->errstr;
2115     my $count = 0;
2116     my @results;
2117
2118     $sth->execute($biblionumber);
2119
2120     # || die "Cannot execute $query\n" . $sth->errstr;
2121     while ( my $data = $sth->fetchrow_hashref ) {
2122         $results[$count] = $data;
2123         $count++;
2124     }    # while
2125
2126     $sth->finish;
2127     return ( $count, @results );
2128 }    # sub getbiblio
2129
2130 sub getbiblioitem {
2131     my ($biblioitemnum) = @_;
2132     my $dbh = C4::Context->dbh;
2133     my $sth = $dbh->prepare( "Select * from biblioitems where
2134 biblioitemnumber = ?"
2135     );
2136     my $count = 0;
2137     my @results;
2138
2139     $sth->execute($biblioitemnum);
2140
2141     while ( my $data = $sth->fetchrow_hashref ) {
2142         $results[$count] = $data;
2143         $count++;
2144     }    # while
2145
2146     $sth->finish;
2147     return ( $count, @results );
2148 }    # sub getbiblioitem
2149
2150 sub getbiblioitembybiblionumber {
2151     my ($biblionumber) = @_;
2152     my $dbh = C4::Context->dbh;
2153     my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
2154     my $count = 0;
2155     my @results;
2156
2157     $sth->execute($biblionumber);
2158
2159     while ( my $data = $sth->fetchrow_hashref ) {
2160         $results[$count] = $data;
2161         $count++;
2162     }    # while
2163
2164     $sth->finish;
2165     return ( $count, @results );
2166 }    # sub
2167
2168 sub getitemtypes {
2169     my $dbh   = C4::Context->dbh;
2170     my $query = "select * from itemtypes order by description";
2171     my $sth   = $dbh->prepare($query);
2172
2173     # || die "Cannot prepare $query" . $dbh->errstr;
2174     my $count = 0;
2175     my @results;
2176
2177     $sth->execute;
2178
2179     # || die "Cannot execute $query\n" . $sth->errstr;
2180     while ( my $data = $sth->fetchrow_hashref ) {
2181         $results[$count] = $data;
2182         $count++;
2183     }    # while
2184
2185     $sth->finish;
2186     return ( $count, @results );
2187 }    # sub getitemtypes
2188
2189 sub getitemsbybiblioitem {
2190     my ($biblioitemnum) = @_;
2191     my $dbh = C4::Context->dbh;
2192     my $sth = $dbh->prepare( "Select * from items, biblio where
2193 biblio.biblionumber = items.biblionumber and biblioitemnumber
2194 = ?"
2195     );
2196
2197     # || die "Cannot prepare $query\n" . $dbh->errstr;
2198     my $count = 0;
2199     my @results;
2200
2201     $sth->execute($biblioitemnum);
2202
2203     # || die "Cannot execute $query\n" . $sth->errstr;
2204     while ( my $data = $sth->fetchrow_hashref ) {
2205         $results[$count] = $data;
2206         $count++;
2207     }    # while
2208
2209     $sth->finish;
2210     return ( $count, @results );
2211 }    # sub getitemsbybiblioitem
2212
2213 sub logchange {
2214
2215     # Subroutine to log changes to databases
2216 # Eventually, this subroutine will be used to create a log of all changes made,
2217     # with the possibility of "undo"ing some changes
2218     my $database = shift;
2219     if ( $database eq 'kohadb' ) {
2220         my $type     = shift;
2221         my $section  = shift;
2222         my $item     = shift;
2223         my $original = shift;
2224         my $new      = shift;
2225
2226         #       print STDERR "KOHA: $type $section $item $original $new\n";
2227     }
2228     elsif ( $database eq 'marc' ) {
2229         my $type        = shift;
2230         my $Record_ID   = shift;
2231         my $tag         = shift;
2232         my $mark        = shift;
2233         my $subfield_ID = shift;
2234         my $original    = shift;
2235         my $new         = shift;
2236
2237 #       print STDERR "MARC: $type $Record_ID $tag $mark $subfield_ID $original $new\n";
2238     }
2239 }
2240
2241 #------------------------------------------------
2242
2243 #---------------------------------------
2244 # Find a biblio entry, or create a new one if it doesn't exist.
2245 #  If a "subtitle" entry is in hash, add it to subtitle table
2246 sub getoraddbiblio {
2247
2248     # input params
2249     my (
2250         $dbh,       # db handle
2251                     # FIXME - Unused argument
2252         $biblio,    # hash ref to fields
2253     ) = @_;
2254
2255     # return
2256     my $biblionumber;
2257
2258     my $debug = 0;
2259     my $sth;
2260     my $error;
2261
2262     #-----
2263     $dbh = C4::Context->dbh;
2264
2265     print "<PRE>Looking for biblio </PRE>\n" if $debug;
2266     $sth = $dbh->prepare( "select biblionumber
2267                 from biblio
2268                 where title=? and author=?
2269                   and copyrightdate=? and seriestitle=?"
2270     );
2271     $sth->execute(
2272         $biblio->{title},     $biblio->{author},
2273         $biblio->{copyright}, $biblio->{seriestitle}
2274     );
2275     if ( $sth->rows ) {
2276         ($biblionumber) = $sth->fetchrow;
2277         print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
2278     }
2279     else {
2280
2281         # Doesn't exist.  Add new one.
2282         print "<PRE>Adding biblio</PRE>\n" if $debug;
2283         ( $biblionumber, $error ) = &newbiblio($biblio);
2284         if ($biblionumber) {
2285             print "<PRE>Added with biblio number=$biblionumber</PRE>\n"
2286               if $debug;
2287             if ( $biblio->{subtitle} ) {
2288                 &newsubtitle( $biblionumber, $biblio->{subtitle} );
2289             }    # if subtitle
2290         }
2291         else {
2292             print "<PRE>Couldn't add biblio: $error</PRE>\n" if $debug;
2293         }    # if added
2294     }
2295
2296     return $biblionumber, $error;
2297
2298 }    # sub getoraddbiblio
2299
2300 sub char_decode {
2301
2302     # converts ISO 5426 coded string to ISO 8859-1
2303     # sloppy code : should be improved in next issue
2304     my ( $string, $encoding ) = @_;
2305     $_ = $string;
2306
2307     #   $encoding = C4::Context->preference("marcflavour") unless $encoding;
2308     if ( $encoding eq "UNIMARC" ) {
2309 #         s/\xe1/Æ/gm;
2310         s/\xe2/Ð/gm;
2311         s/\xe9/Ø/gm;
2312         s/\xec/þ/gm;
2313         s/\xf1/æ/gm;
2314         s/\xf3/ð/gm;
2315         s/\xf9/ø/gm;
2316         s/\xfb/ß/gm;
2317         s/\xc1\x61/à/gm;
2318         s/\xc1\x65/è/gm;
2319         s/\xc1\x69/ì/gm;
2320         s/\xc1\x6f/ò/gm;
2321         s/\xc1\x75/ù/gm;
2322         s/\xc1\x41/À/gm;
2323         s/\xc1\x45/È/gm;
2324         s/\xc1\x49/Ì/gm;
2325         s/\xc1\x4f/Ò/gm;
2326         s/\xc1\x55/Ù/gm;
2327         s/\xc2\x41/Á/gm;
2328         s/\xc2\x45/É/gm;
2329         s/\xc2\x49/Í/gm;
2330         s/\xc2\x4f/Ó/gm;
2331         s/\xc2\x55/Ú/gm;
2332         s/\xc2\x59/Ý/gm;
2333         s/\xc2\x61/á/gm;
2334         s/\xc2\x65/é/gm;
2335         s/\xc2\x69/í/gm;
2336         s/\xc2\x6f/ó/gm;
2337         s/\xc2\x75/ú/gm;
2338         s/\xc2\x79/ý/gm;
2339         s/\xc3\x41/Â/gm;
2340         s/\xc3\x45/Ê/gm;
2341         s/\xc3\x49/Î/gm;
2342         s/\xc3\x4f/Ô/gm;
2343         s/\xc3\x55/Û/gm;
2344         s/\xc3\x61/â/gm;
2345         s/\xc3\x65/ê/gm;
2346         s/\xc3\x69/î/gm;
2347         s/\xc3\x6f/ô/gm;
2348         s/\xc3\x75/û/gm;
2349         s/\xc4\x41/Ã/gm;
2350         s/\xc4\x4e/Ñ/gm;
2351         s/\xc4\x4f/Õ/gm;
2352         s/\xc4\x61/ã/gm;
2353         s/\xc4\x6e/ñ/gm;
2354         s/\xc4\x6f/õ/gm;
2355         s/\xc8\x41/Ä/gm;
2356         s/\xc8\x45/Ë/gm;
2357         s/\xc8\x49/Ï/gm;
2358         s/\xc8\x61/ä/gm;
2359         s/\xc8\x65/ë/gm;
2360         s/\xc8\x69/ï/gm;
2361         s/\xc8\x6F/ö/gm;
2362         s/\xc8\x75/ü/gm;
2363         s/\xc8\x76/ÿ/gm;
2364         s/\xc9\x41/Ä/gm;
2365         s/\xc9\x45/Ë/gm;
2366         s/\xc9\x49/Ï/gm;
2367         s/\xc9\x4f/Ö/gm;
2368         s/\xc9\x55/Ü/gm;
2369         s/\xc9\x61/ä/gm;
2370         s/\xc9\x6f/ö/gm;
2371         s/\xc9\x75/ü/gm;
2372         s/\xca\x41/Å/gm;
2373         s/\xca\x61/å/gm;
2374         s/\xd0\x43/Ç/gm;
2375         s/\xd0\x63/ç/gm;
2376
2377         # this handles non-sorting blocks (if implementation requires this)
2378         $string = nsb_clean($_);
2379     }
2380     elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2381         if (/[\xc1-\xff]/) {
2382             s/\xe1\x61/à/gm;
2383             s/\xe1\x65/è/gm;
2384             s/\xe1\x69/ì/gm;
2385             s/\xe1\x6f/ò/gm;
2386             s/\xe1\x75/ù/gm;
2387             s/\xe1\x41/À/gm;
2388             s/\xe1\x45/È/gm;
2389             s/\xe1\x49/Ì/gm;
2390             s/\xe1\x4f/Ò/gm;
2391             s/\xe1\x55/Ù/gm;
2392             s/\xe2\x41/Á/gm;
2393             s/\xe2\x45/É/gm;
2394             s/\xe2\x49/Í/gm;
2395             s/\xe2\x4f/Ó/gm;
2396             s/\xe2\x55/Ú/gm;
2397             s/\xe2\x59/Ý/gm;
2398             s/\xe2\x61/á/gm;
2399             s/\xe2\x65/é/gm;
2400             s/\xe2\x69/í/gm;
2401             s/\xe2\x6f/ó/gm;
2402             s/\xe2\x75/ú/gm;
2403             s/\xe2\x79/ý/gm;
2404             s/\xe3\x41/Â/gm;
2405             s/\xe3\x45/Ê/gm;
2406             s/\xe3\x49/Î/gm;
2407             s/\xe3\x4f/Ô/gm;
2408             s/\xe3\x55/Û/gm;
2409             s/\xe3\x61/â/gm;
2410             s/\xe3\x65/ê/gm;
2411             s/\xe3\x69/î/gm;
2412             s/\xe3\x6f/ô/gm;
2413             s/\xe3\x75/û/gm;
2414             s/\xe4\x41/Ã/gm;
2415             s/\xe4\x4e/Ñ/gm;
2416             s/\xe4\x4f/Õ/gm;
2417             s/\xe4\x61/ã/gm;
2418             s/\xe4\x6e/ñ/gm;
2419             s/\xe4\x6f/õ/gm;
2420             s/\xe8\x45/Ë/gm;
2421             s/\xe8\x49/Ï/gm;
2422             s/\xe8\x65/ë/gm;
2423             s/\xe8\x69/ï/gm;
2424             s/\xe8\x76/ÿ/gm;
2425             s/\xe9\x41/Ä/gm;
2426             s/\xe9\x4f/Ö/gm;
2427             s/\xe9\x55/Ü/gm;
2428             s/\xe9\x61/ä/gm;
2429             s/\xe9\x6f/ö/gm;
2430             s/\xe9\x75/ü/gm;
2431             s/\xea\x41/Å/gm;
2432             s/\xea\x61/å/gm;
2433
2434             # this handles non-sorting blocks (if implementation requires this)
2435             $string = nsb_clean($_);
2436         }
2437     }
2438     return ($string);
2439 }
2440
2441 sub nsb_clean {
2442     my $NSB = '\x88';    # NSB : begin Non Sorting Block
2443     my $NSE = '\x89';    # NSE : Non Sorting Block end
2444                          # handles non sorting blocks
2445     my ($string) = @_;
2446     $_ = $string;
2447     s/$NSB/(/gm;
2448     s/[ ]{0,1}$NSE/) /gm;
2449     $string = $_;
2450     return ($string);
2451 }
2452
2453 sub FindDuplicate {
2454         my ($record)=@_;
2455         my $dbh = C4::Context->dbh;
2456         my $result = MARCmarc2koha($dbh,$record,'');
2457         my $sth;
2458         my ($biblionumber,$bibid,$title);
2459         # search duplicate on ISBN, easy and fast...
2460         if ($result->{isbn}) {
2461                 $sth = $dbh->prepare("select biblio.biblionumber,bibid,title from biblio,biblioitems,marc_biblio where biblio.biblionumber=biblioitems.biblionumber and marc_biblio.biblionumber=biblioitems.biblionumber and isbn=?");
2462                 $sth->execute($result->{'isbn'});
2463                 ($biblionumber,$bibid,$title) = $sth->fetchrow;
2464                 return $biblionumber,$bibid,$title if ($biblionumber);
2465         }
2466         # a more complex search : build a request for SearchMarc::catalogsearch()
2467         my (@tags, @and_or, @excluding, @operator, @value, $offset,$length);
2468         # search on biblio.title
2469         my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.title","");
2470         if ($record->field($tag)) {
2471                 if ($record->field($tag)->subfields($subfield)) {
2472                         push @tags, "'".$tag.$subfield."'";
2473                         push @and_or, "and";
2474                         push @excluding, "";
2475                         push @operator, "contains";
2476                         push @value, $record->field($tag)->subfield($subfield);
2477 #                       warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2478                 }
2479         }
2480         # ... and on biblio.author
2481         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.author","");
2482         if ($record->field($tag)) {
2483                 if ($record->field($tag)->subfields($subfield)) {
2484                         push @tags, "'".$tag.$subfield."'";
2485                         push @and_or, "and";
2486                         push @excluding, "";
2487                         push @operator, "contains";
2488                         push @value, $record->field($tag)->subfield($subfield);
2489 #                       warn "for author, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2490                 }
2491         }
2492         # ... and on publicationyear.
2493         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publicationyear","");
2494         if ($record->field($tag)) {
2495                 if ($record->field($tag)->subfields($subfield)) {
2496                         push @tags, "'".$tag.$subfield."'";
2497                         push @and_or, "and";
2498                         push @excluding, "";
2499                         push @operator, "=";
2500                         push @value, $record->field($tag)->subfield($subfield);
2501 #                       warn "for publicationyear, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2502                 }
2503         }
2504         # ... and on size.
2505         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.size","");
2506         if ($record->field($tag)) {
2507                 if ($record->field($tag)->subfields($subfield)) {
2508                         push @tags, "'".$tag.$subfield."'";
2509                         push @and_or, "and";
2510                         push @excluding, "";
2511                         push @operator, "=";
2512                         push @value, $record->field($tag)->subfield($subfield);
2513 #                       warn "for size, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2514                 }
2515         }
2516         # ... and on publisher.
2517         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publishercode","");
2518         if ($record->field($tag)) {
2519                 if ($record->field($tag)->subfields($subfield)) {
2520                         push @tags, "'".$tag.$subfield."'";
2521                         push @and_or, "and";
2522                         push @excluding, "";
2523                         push @operator, "=";
2524                         push @value, $record->field($tag)->subfield($subfield);
2525 #                       warn "for publishercode, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2526                 }
2527         }
2528         # ... and on volume.
2529         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.volume","");
2530         if ($record->field($tag)) {
2531                 if ($record->field($tag)->subfields($subfield)) {
2532                         push @tags, "'".$tag.$subfield."'";
2533                         push @and_or, "and";
2534                         push @excluding, "";
2535                         push @operator, "=";
2536                         push @value, $record->field($tag)->subfield($subfield);
2537 #                       warn "for volume, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2538                 }
2539         }
2540
2541         my ($finalresult,$nbresult) = C4::SearchMarc::catalogsearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10);
2542         # there is at least 1 result => return the 1st one
2543         if ($nbresult) {
2544 #               warn "$nbresult => ".@$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2545                 return @$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2546         }
2547         # no result, returns nothing
2548         return;
2549 }
2550
2551 sub DisplayISBN {
2552         my ($isbn)=@_;
2553         my $seg1;
2554         if(substr($isbn, 0, 1) <=7) {
2555                 $seg1 = substr($isbn, 0, 1);
2556         } elsif(substr($isbn, 0, 2) <= 94) {
2557                 $seg1 = substr($isbn, 0, 2);
2558         } elsif(substr($isbn, 0, 3) <= 995) {
2559                 $seg1 = substr($isbn, 0, 3);
2560         } elsif(substr($isbn, 0, 4) <= 9989) {
2561                 $seg1 = substr($isbn, 0, 4);
2562         } else {
2563                 $seg1 = substr($isbn, 0, 5);
2564         }
2565         my $x = substr($isbn, length($seg1));
2566         my $seg2;
2567         if(substr($x, 0, 2) <= 19) {
2568 #               if(sTmp2 < 10) sTmp2 = "0" sTmp2;
2569                 $seg2 = substr($x, 0, 2);
2570         } elsif(substr($x, 0, 3) <= 699) {
2571                 $seg2 = substr($x, 0, 3);
2572         } elsif(substr($x, 0, 4) <= 8399) {
2573                 $seg2 = substr($x, 0, 4);
2574         } elsif(substr($x, 0, 5) <= 89999) {
2575                 $seg2 = substr($x, 0, 5);
2576         } elsif(substr($x, 0, 6) <= 9499999) {
2577                 $seg2 = substr($x, 0, 6);
2578         } else {
2579                 $seg2 = substr($x, 0, 7);
2580         }
2581         my $seg3=substr($x,length($seg2));
2582         $seg3=substr($seg3,0,length($seg3)-1) ;
2583         my $seg4 = substr($x, -1, 1);
2584         return "$seg1-$seg2-$seg3-$seg4";
2585 }
2586
2587
2588 END { }    # module clean-up code here (global destructor)
2589
2590 =back
2591
2592 =head1 AUTHOR
2593
2594 Koha Developement team <info@koha.org>
2595
2596 Paul POULAIN paul.poulain@free.fr
2597
2598 =cut
2599
2600 # $Id$
2601 # $Log$
2602 # Revision 1.124  2005/08/10 10:21:15  tipaul
2603 # continuing the road to zebra :
2604 # - the biblio add begins to work.
2605 # - the biblio modif begins to work.
2606 #
2607 # (still without doing anything on zebra)
2608 # (no new change in updatedatabase)
2609 #
2610 # Revision 1.123  2005/08/09 14:10:28  tipaul
2611 # 1st commit to go to zebra.
2612 # don't update your cvs if you want to have a working head...
2613 #
2614 # this commit contains :
2615 # * updater/updatedatabase : get rid with marc_* tables, but DON'T remove them. As a lot of things uses them, it would not be a good idea for instance to drop them. If you really want to play, you can rename them to test head without them but being still able to reintroduce them...
2616 # * Biblio.pm : modify MARCgetbiblio to find the raw marc record in biblioitems.marc field, not from marc_subfield_table, modify MARCfindframeworkcode to find frameworkcode in biblio.frameworkcode, modify some other subs to use biblio.biblionumber & get rid of bibid.
2617 # * other files : get rid of bibid and use biblionumber instead.
2618 #
2619 # What is broken :
2620 # * does not do anything on zebra yet.
2621 # * if you rename marc_subfield_table, you can't search anymore.
2622 # * you can view a biblio & bibliodetails, go to MARC editor, but NOT save any modif.
2623 # * don't try to add a biblio, it would add data poorly... (don't try to delete either, it may work, but that would be a surprise ;-) )
2624 #
2625 # IMPORTANT NOTE : you need MARC::XML package (http://search.cpan.org/~esummers/MARC-XML-0.7/lib/MARC/File/XML.pm), that requires a recent version of MARC::Record
2626 # Updatedatabase stores the iso2709 data in biblioitems.marc field & an xml version in biblioitems.marcxml Not sure we will keep it when releasing the stable version, but I think it's a good idea to have something readable in sql, at least for development stage.
2627 #
2628 # Revision 1.122  2005/08/04 13:27:48  tipaul
2629 # synch'ing 2.2 and head
2630 #
2631 # Revision 1.115.2.18  2005/08/02 07:45:44  tipaul
2632 # fix for bug http://bugs.koha.org/cgi-bin/bugzilla/show_bug.cgi?id=1009
2633 # (Not all items fields mapped to MARC)
2634 #
2635 # Revision 1.115.2.17  2005/08/01 15:15:43  tipaul
2636 # adding decoder for Ä string
2637 #
2638 # Revision 1.115.2.16  2005/07/28 19:56:15  tipaul
2639 # * removing a useless & CPU consuming call to MARCgetbiblio
2640 # * Leader management.
2641 # If you create a MARC tag "000", with a subfield '@', it will be managed as the leader.
2642 # Seems to work correctly.
2643 #
2644 # Now going to create a plugin for leader()
2645 #
2646 # Revision 1.115.2.15  2005/07/19 15:25:40  tipaul
2647 # * fixing a bug in subfield order when MARCgetbiblio
2648 # * getting rid with the limit "biblionumber & biblioitemnumber must be in the same tag". So, we can put biblionumber in 001 (field that has no subfields, so we can't put biblioitemnumber in this field), and use biblionumber as identifier in the MARC biblio too. Still to be deeply tested.
2649 # * adding some diacritic decoding (Ä, Ü...)
2650 #
2651 # Revision 1.115.2.14  2005/06/27 23:24:06  hdl
2652 # Display dashed ISBN
2653 #
2654 # Revision 1.115.2.13  2005/05/31 12:44:26  tipaul
2655 # patch from Genji (Waylon R.) to update subjects in MARC tables when systempref has MARC=OFF
2656 #
2657 # Revision 1.115.2.12  2005/05/30 11:22:41  tipaul
2658 # fixing a bug : when a field was repeated, the last field was also repeated. (Was due to the "empty" field in html between fields : to separate fields, in html, an empty field is automatically added. in MARChtml2marc, this empty field was not discarded correctly)
2659 #
2660 # Revision 1.115.2.11  2005/05/25 15:48:43  tipaul
2661 # * removing my for variables already declared
2662 # * updating biblio.unititle  field as well as other fields in biblio table
2663 #
2664 # Revision 1.115.2.10  2005/05/25 09:30:50  hdl
2665 # Adding NEWmodbiblioframework feature
2666 # Used by addbiblio.pl when modifying a framework selection.
2667 #
2668 # Revision 1.115.2.9  2005/04/07 10:05:25  tipaul
2669 # adding / to the list of symbols that are replace by spaces for searches
2670 #
2671 # Revision 1.115.2.8  2005/03/25 16:23:49  tipaul
2672 # some improvements :
2673 # * return immediatly when a subfield is empty
2674 # * search duplicate on isbn must be done only when there is an isbn ;-)
2675 #
2676 # Revision 1.115.2.7  2005/03/10 15:52:28  tipaul
2677 # * adding glass to opac marc detail.
2678 # * changing glasses behaviour : It now appears only on subfields that have a "link" value. Avoid useless glasses and removes nothing. **** WARNING **** : if you don't change you MARC parameters, glasses DISAPPEAR, because no subfields have a link value. So you MUST "reactivate" them manually. If you want to enable the search glass on field 225$a (collection in UNIMARC), just put 225a to "link" field (Koha >> parameters >> framework >> 225 field >> subfield >> modify $a >> enter 225a in link input field (without quotes or anything else)
2679 # * fixing bug with libopac
2680 #
2681 # Revision 1.115.2.6  2005/03/09 15:56:01  tipaul
2682 # Changing MARCmoditem to be like MARCmodbiblio : a modif is a delete & create.
2683 # Longer, but solves problems with repeated subfields.
2684 #
2685 # The previous version was not buggy except under certain circumstances (a repeated subfield, that does not exist usually in items)
2686 #
2687 # Revision 1.115.2.5  2005/02/24 13:54:04  tipaul
2688 # exporting MARCdelsubfield sub. It's used in authority merging.
2689 # Modifying it too to enable deletion of all subfields from a given tag/subfield or just one.
2690 #
2691 # Revision 1.115.2.4  2005/02/17 12:44:25  tipaul
2692 # bug in acquisition : the title was also stored as subtitle.
2693 #
2694 # Revision 1.115.2.3  2005/02/10 13:14:36  tipaul
2695 # * multiple main authors are now correctly handled in simple (non-MARC) view
2696 #
2697 # Revision 1.115.2.2  2005/01/11 16:02:35  tipaul
2698 # in catalogue, modifs were not stored properly the non-MARC item DB. Affect only libraries without barcodes.
2699 #
2700 # Revision 1.115.2.1  2005/01/11 14:45:37  tipaul
2701 # bugfix : issn were not stored correctly in non-MARC DB on biblio modification
2702 #
2703 # Revision 1.115  2005/01/06 14:32:17  tipaul
2704 # improvement of speed for bulkmarcimport.
2705 # A sub had been forgotten to use the C4::Context->marcfromkohafield array, that caches DB datas.
2706 # this is only a little improvement for normal DB modif, but almost x2 the speed of bulkmarcimport... from 6records/seconds to more than 10.
2707 #
2708 # Revision 1.114  2005/01/03 10:48:33  tipaul
2709 # * bugfix for the search on a MARC detail, when you clic on the magnifying glass (caused an internal server error)
2710 # * partial support of the "linkage" MARC feature : if you enter a "link" on a MARC subfield, the magnifying glass won't search on the field, but on the linked field. I agree it's a partial support. Will be improved, but I need to investigate MARC21 & UNIMARC diffs on this topic.
2711 #
2712 # Revision 1.113  2004/12/10 16:27:53  tipaul
2713 # limiting the number of search term to 8. There was no limit before, but 8 words seems to be the upper limit mySQL can deal with (in less than a second. tested on a DB with 13 000 items)
2714 # In 2.4, a new DB structure will highly speed things and this limit will be removed.
2715 # FindDuplicate is activated again, the perf problems were due to this problem.
2716 #
2717 # Revision 1.112  2004/12/08 10:14:42  tipaul
2718 # * desactivate FindDuplicate
2719 # * fix from Genji
2720 #
2721 # Revision 1.111  2004/11/25 17:39:44  tipaul
2722 # removing useless &branches in package declaration
2723 #
2724 # Revision 1.110  2004/11/24 16:00:01  tipaul
2725 # removing sub branches (commited by chris for MARC=OFF bugfix, but sub branches is already in Acquisition.pm)
2726 #
2727 # Revision 1.109  2004/11/24 15:58:31  tipaul
2728 # * critical fix for acquisition (see RC3 release notes)
2729 # * critical fix for duplicate finder
2730 #
2731 # Revision 1.108  2004/11/19 19:41:22  rangi
2732 # Shifting branches() from deprecated C4::Catalogue to C4::Biblio
2733 # Allowing the non marc interface acquisitions to work.
2734 #
2735 # Revision 1.107  2004/11/05 10:15:27  tipaul
2736 # Improving FindDuplicate to find duplicate records on adding biblio
2737 #
2738 # Revision 1.106  2004/11/02 16:44:45  tipaul
2739 # new feature : checking for duplicate biblio.
2740 #
2741 # For instance, it's only done on ISBN only. Will be improved soon.
2742 #
2743 # When a duplicate is detected, the biblio is not saved, but the user is asked for a confirmations.
2744 #
2745 # Revision 1.105  2004/09/23 16:15:37  tipaul
2746 # indenting diff
2747 #
2748 # Revision 1.104  2004/09/16 15:06:46  tipaul
2749 # enabling # (| still possible too) for repeatable subfields
2750 #
2751 # Revision 1.103  2004/09/06 14:17:34  tipaul
2752 # some commented warning added + 1 major bugfix => drop empty fields, NOT fields containing 0
2753 #
2754 # Revision 1.102  2004/09/06 10:00:19  tipaul
2755 # adding a "location" field to the library.
2756 # This field is useful when the callnumber contains no information on the room where the item is stored.
2757 # With this field, we now have 3 levels of informations to find a book :
2758 # * the branch.
2759 # * the location.
2760 # * the callnumber.
2761 #
2762 # This should be versatile enough to solve any storing method.
2763 # This hack is quite simple, due to the nice Biblio.pm API. The MARC => koha db link is automatically managed. Just add the link in the parameters section.
2764 #
2765 # Revision 1.101  2004/08/18 16:01:37  tipaul
2766 # modifs to support frameworkcodes
2767 #
2768 # Revision 1.100  2004/08/13 16:37:25  tipaul
2769 # adding frameworkcode to API in some subs
2770 #
2771 # Revision 1.99  2004/07/30 13:54:50  doxulting
2772 # Beginning of serial commit
2773 #
2774 # Revision 1.98  2004/07/15 09:48:10  tipaul
2775 # * removing useless sub
2776 # * minor bugfix in moditem (managing homebranch & holdingbranch)
2777 #
2778 # Revision 1.97  2004/07/02 15:53:53  tipaul
2779 # bugfix (due to frameworkcode field)
2780 #
2781 # Revision 1.96  2004/06/29 16:07:10  tipaul
2782 # last sync for 2.1.0 release
2783 #
2784 # Revision 1.95  2004/06/26 23:19:59  rangi
2785 # Fixing modaddauthor, and adding getitemtypes.
2786 # Also tidying up formatting of code
2787 #
2788 # Revision 1.94  2004/06/17 08:16:32  tipaul
2789 # merging tag & subfield in marc_word for better perfs
2790 #
2791 # Revision 1.93  2004/06/11 15:38:06  joshferraro
2792 # Changes MARCaddword to index words >= 1 char ... needed for more accurate
2793 # searches using SearchMarc routines.
2794 #
2795 # Revision 1.92  2004/06/10 08:29:01  tipaul
2796 # MARC authority management (continued)
2797 #
2798 # Revision 1.91  2004/06/03 10:03:01  tipaul
2799 # * frameworks and itemtypes are independant
2800 # * in the MARC editor, showing the + to duplicate a tag only if the tag is repeatable
2801 #
2802 # Revision 1.90  2004/05/28 08:25:53  tipaul
2803 # hidding hidden & isurl constraints into MARC subfield structure
2804 #
2805 # Revision 1.89  2004/05/27 21:47:21  rangi
2806 # Fix for bug 787
2807 #
2808 # Revision 1.88  2004/05/18 15:23:49  tipaul
2809 # framework management : 1 MARC framework for each itemtype
2810 #
2811 # Revision 1.87  2004/05/18 11:54:07  tipaul
2812 # getitemtypes moved in Koha.pm
2813 #
2814 # Revision 1.86  2004/05/03 09:19:22  tipaul
2815 # some fixes for mysql prepare & execute
2816 #
2817 # Revision 1.85  2004/04/02 14:55:48  tipaul
2818 # renaming items.bulk field to items.itemcallnumber.
2819 # Will be used to store call number for libraries that don't use dewey classification.
2820 # Note it's related to ITEMS, not biblio.
2821 #
2822 # Revision 1.84  2004/03/24 17:18:30  joshferraro
2823 # Fixes bug 749 by removing the comma on line 1488.
2824 #
2825 # Revision 1.83  2004/03/15 14:31:50  tipaul
2826 # adding a minor check
2827 #
2828 # Revision 1.82  2004/03/07 05:47:31  acli
2829 # Various updates/fixes from rel_2_0
2830 # Fixes for bugs 721 (templating), 727, and 734
2831 #
2832 # Revision 1.81  2004/03/06 20:26:13  tipaul
2833 # adding seealso feature in MARC searches
2834 #
2835 # Revision 1.80  2004/02/12 13:40:56  tipaul
2836 # deleting subs duplicated by error
2837 #
2838 # Revision 1.79  2004/02/11 08:40:09  tipaul
2839 # synch'ing 2.0.0 branch and head
2840 #
2841 # Revision 1.78.2.3  2004/02/10 13:15:46  tipaul
2842 # removing 2 warnings
2843 #
2844 # Revision 1.78.2.2  2004/01/26 10:38:06  tipaul
2845 # dealing correctly "bulk" field
2846 #
2847 # Revision 1.78.2.1  2004/01/13 17:29:53  tipaul
2848 # * minor html fixes
2849 # * adding publisher in acquisition process (& ordering basket by publisher)
2850 #
2851 # Revision 1.78  2003/12/09 15:57:28  tipaul
2852 # rolling back to working char_decode sub
2853 #
2854 # Revision 1.77  2003/12/03 17:47:14  tipaul
2855 # bugfixes for biblio deletion
2856 #
2857 # Revision 1.76  2003/12/03 01:43:41  slef
2858 # conflict markers?
2859 #
2860 # Revision 1.75  2003/12/03 01:42:03  slef
2861 # bug 662 fixes securing DBI
2862 #
2863 # Revision 1.74  2003/11/28 09:48:33  tipaul
2864 # bugfix : misusing prepare & execute => now using prepare(?) and execute($var)
2865 #
2866 # Revision 1.73  2003/11/28 09:45:25  tipaul
2867 # bugfix for iso2709 file import in the "notforloan" field.
2868 #
2869 # But notforloan field called "loan" somewhere, so in case "loan" is used, copied to "notforloan" to avoid a bug.
2870 #
2871 # Revision 1.72  2003/11/24 17:40:14  tipaul
2872 # fix for #385
2873 #
2874 # Revision 1.71  2003/11/24 16:28:49  tipaul
2875 # biblio & item deletion now works fine in MARC editor.
2876 # Stores deleted biblio/item in the marc field of the deletedbiblio/deleteditem table.
2877 #
2878 # Revision 1.70  2003/11/24 13:29:55  tipaul
2879 # moving $id from beginning to end of file (70 commits... huge comments...)
2880 #
2881 # Revision 1.69  2003/11/24 13:27:17  tipaul
2882 # fix for #380 (bibliosubject)
2883 #
2884 # Revision 1.68  2003/11/06 17:18:30  tipaul
2885 # bugfix for #384
2886 #
2887 # 1st draft for MARC biblio deletion.
2888 # Still does not work well, but at least, Biblio.pm compiles & it should'nt break too many things
2889 # (Note the trash in the MARCdetail, but don't use it, please :-) )
2890 #
2891 # Revision 1.67  2003/10/25 08:46:27  tipaul
2892 # minor fixes for bilbio deletion (still buggy)
2893 #
2894 # Revision 1.66  2003/10/17 10:02:56  tipaul
2895 # Indexing only words longer than 2 letters. Was >=2 before, & 2 letters words usually means nothing.
2896 #
2897 # Revision 1.65  2003/10/14 09:45:29  tipaul
2898 # 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)
2899 #
2900 # Revision 1.64  2003/10/06 15:20:51  tipaul
2901 # fix for 536 (subtitle error)
2902 #
2903 # Revision 1.63  2003/10/01 13:25:49  tipaul
2904 # seems a char encoding problem modified something in char_decode sub... changing back to something that works...
2905 #
2906 # Revision 1.62  2003/09/17 14:21:13  tipaul
2907 # fixing bug that makes a MARC biblio disappear when using full acquisition (order => recieve ==> MARC editor).
2908 # Before this 2 lines fix, the MARC biblio was deleted during recieve, and had to be entirely recreated :-(
2909 #
2910 # Revision 1.61  2003/09/17 10:24:39  tipaul
2911 # notforloan value in itemtype was overwritting notforloan value in a given item.
2912 # I changed this behaviour :
2913 # if notforloan is set for a given item, and NOT for all items from this itemtype, the notforloan is kept.
2914 # If notforloan is set for itemtype, it's used (and impossible to loan a specific item from this itemtype)
2915 #
2916 # Revision 1.60  2003/09/04 14:11:23  tipaul
2917 # fix for 593 (data duplication in MARC-DB)
2918 #
2919 # Revision 1.58  2003/08/06 12:54:52  tipaul
2920 # fix for publicationyear : extracting numeric value from MARC string, like for copyrightdate.
2921 # (note that copyrightdate still extracted to get numeric format)
2922 #
2923 # Revision 1.57  2003/07/15 23:09:18  slef
2924 # change show columns to use biblioitems bnotes too
2925 #
2926 # Revision 1.56  2003/07/15 11:34:52  slef
2927 # fixes from paul email
2928 #
2929 # Revision 1.55  2003/07/15 00:02:49  slef
2930 # Work on bug 515... can we do a single-side rename of notes to bnotes?
2931 #
2932 # Revision 1.54  2003/07/11 11:51:32  tipaul
2933 # *** empty log message ***
2934 #
2935 # Revision 1.52  2003/07/10 10:37:19  tipaul
2936 # fix for copyrightdate problem, #514
2937 #
2938 # Revision 1.51  2003/07/02 14:47:17  tipaul
2939 # fix for #519 : items.dateaccessioned imports incorrectly
2940 #
2941 # Revision 1.49  2003/06/17 11:21:13  tipaul
2942 # improvments/fixes for z3950 support.
2943 # * Works now even on ADD, not only on MODIFY
2944 # * able to search on ISBN, author, title
2945 #
2946 # Revision 1.48  2003/06/16 09:22:53  rangi
2947 # Just added an order clause to getitemtypes
2948 #
2949 # Revision 1.47  2003/05/20 16:22:44  tipaul
2950 # fixing typo in Biblio.pm POD
2951 #
2952 # Revision 1.46  2003/05/19 13:45:18  tipaul
2953 # support for subtitles, additional authors, subject.
2954 # 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.
2955 # Note that some OLD-DB subs are strange (dummy ?) see OLDmodsubject, OLDmodsubtitle, OLDmodaddiauthor in C4/Biblio.pm
2956 # 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.
2957 #
2958 # Revision 1.45  2003/04/29 16:50:49  tipaul
2959 # really proud of this commit :-)
2960 # z3950 search and import seems to works fine.
2961 # Let me explain how :
2962 # * a "search z3950" button is added in the addbiblio template.
2963 # * when clicked, a popup appears and z3950/search.pl is called
2964 # * z3950/search.pl calls addz3950search in the DB
2965 # * the z3950 daemon retrieve the records and stores them in z3950results AND in marc_breeding table.
2966 # * as long as there as searches pending, the popup auto refresh every 2 seconds, and says how many searches are pending.
2967 # * when the user clicks on a z3950 result => the parent popup is called with the requested biblio, and auto-filled
2968 #
2969 # Note :
2970 # * 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.
2971 # * 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.
2972 #
2973 # Revision 1.44  2003/04/28 13:07:14  tipaul
2974 # Those fixes solves the "internal server error" with MARC::Record 1.12.
2975 # It was due to an illegal contruction in Koha : we tried to retrive subfields from <10 tags.
2976 # That's not possible. MARC::Record accepted this in 0.93 version, but it was fixed after.
2977 # Now, the construct/retrieving is OK !
2978 #
2979 # Revision 1.43  2003/04/10 13:56:02  tipaul
2980 # Fix some bugs :
2981 # * worked in 1.9.0, but not in 1.9.1 :
2982 # - modif of a biblio didn't work
2983 # - 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.
2984 #
2985 # * did not work before :
2986 # - repeatable subfields now works correctly. Enter 2 subfields separated by | and they will be splitted during saving.
2987 # - dropped the last subfield of the MARC form :-(
2988 #
2989 # Internal changes :
2990 # - 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.
2991 # Note the MARCdelbiblio has been rewritted to enable deletion of a biblio WITHOUT deleting items.
2992 #
2993 # Revision 1.42  2003/04/04 08:41:11  tipaul
2994 # last commits before 1.9.1
2995 #
2996 # Revision 1.41  2003/04/01 12:26:43  tipaul
2997 # fixes
2998 #
2999 # Revision 1.40  2003/03/11 15:14:03  tipaul
3000 # pod updating
3001 #
3002 # Revision 1.39  2003/03/07 16:35:42  tipaul
3003 # * moving generic functions to Koha.pm
3004 # * improvement of SearchMarc.pm
3005 # * bugfixes
3006 # * code cleaning
3007 #
3008 # Revision 1.38  2003/02/27 16:51:59  tipaul
3009 # * moving prepare / execute to ? form.
3010 # * some # cleaning
3011 # * little bugfix.
3012 # * road to 1.9.2 => acquisition and cataloguing merging
3013 #
3014 # Revision 1.37  2003/02/12 11:03:03  tipaul
3015 # Support for 000 -> 010 fields.
3016 # Those fields doesn't have subfields.
3017 # In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@".
3018 # 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.
3019 #
3020 # Revision 1.36  2003/02/12 11:01:01  tipaul
3021 # Support for 000 -> 010 fields.
3022 # Those fields doesn't have subfields.
3023 # In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@".
3024 # 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.
3025 #
3026 # Revision 1.35  2003/02/03 18:46:00  acli
3027 # Minor factoring in C4/Biblio.pm, plus change to export the per-tag
3028 # 'mandatory' property to a per-subfield 'tag_mandatory' template parameter,
3029 # so that addbiblio.tmpl can distinguish between mandatory subfields in a
3030 # mandatory tag and mandatory subfields in an optional tag
3031 #
3032 # Not-minor factoring in acqui.simple/addbiblio.pl to make the if-else blocks
3033 # smaller, and to add some POD; need further testing for this
3034 #
3035 # Added function to check if a MARC subfield name is "koha-internal" (instead
3036 # of checking it for 'lib' and 'tag' everywhere); temporarily added to Koha.pm
3037 #
3038 # Use above function in acqui.simple/additem.pl and search.marc/search.pl
3039 #
3040 # Revision 1.34  2003/01/28 14:50:04  tipaul
3041 # fixing MARCmodbiblio API and reindenting code
3042 #
3043 # Revision 1.33  2003/01/23 12:22:37  tipaul
3044 # adding char_decode to decode MARC21 or UNIMARC extended chars
3045 #
3046 # Revision 1.32  2002/12/16 15:08:50  tipaul
3047 # small but important bugfix (fixes a problem in export)
3048 #
3049 # Revision 1.31  2002/12/13 16:22:04  tipaul
3050 # 1st draft of marc export
3051 #
3052 # Revision 1.30  2002/12/12 21:26:35  tipaul
3053 # YAB ! (Yet Another Bugfix) => related to biblio modif
3054 # (some warning cleaning too)
3055 #
3056 # Revision 1.29  2002/12/12 16:35:00  tipaul
3057 # adding authentification with Auth.pm and
3058 # MAJOR BUGFIX on marc biblio modification
3059 #
3060 # Revision 1.28  2002/12/10 13:30:03  tipaul
3061 # fugfixes from Dombes Abbey work
3062 #
3063 # Revision 1.27  2002/11/19 12:36:16  tipaul
3064 # road to 1.3.2
3065 # various bugfixes, improvments, and migration from acquisition.pm to biblio.pm
3066 #
3067 # Revision 1.26  2002/11/12 15:58:43  tipaul
3068 # road to 1.3.2 :
3069 # * many bugfixes
3070 # * 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)
3071 #
3072 # Revision 1.25  2002/10/25 10:58:26  tipaul
3073 # Road to 1.3.2
3074 # * bugfixes and improvements
3075 #
3076 # Revision 1.24  2002/10/24 12:09:01  arensb
3077 # Fixed "no title" warning when generating HTML documentation from POD.
3078 #
3079 # Revision 1.23  2002/10/16 12:43:08  arensb
3080 # Added some FIXME comments.
3081 #
3082 # Revision 1.22  2002/10/15 13:39:17  tipaul
3083 # removing Acquisition.pm
3084 # deleting unused code in biblio.pm, rewriting POD and answering most FIXME comments
3085 #
3086 # Revision 1.21  2002/10/13 11:34:14  arensb
3087 # Replaced expressions of the form "$x = $x <op> $y" with "$x <op>= $y".
3088 # Thus, $x = $x+2 becomes $x += 2, and so forth.
3089 #
3090 # Revision 1.20  2002/10/13 08:28:32  arensb
3091 # Deleted unused variables.
3092 # Removed trailing whitespace.
3093 #
3094 # Revision 1.19  2002/10/13 05:56:10  arensb
3095 # Added some FIXME comments.
3096 #
3097 # Revision 1.18  2002/10/11 12:34:53  arensb
3098 # Replaced &requireDBI with C4::Context->dbh
3099 #
3100 # Revision 1.17  2002/10/10 14:48:25  tipaul
3101 # bugfixes
3102 #
3103 # Revision 1.16  2002/10/07 14:04:26  tipaul
3104 # road to 1.3.1 : viewing MARC biblio
3105 #
3106 # Revision 1.15  2002/10/05 09:49:25  arensb
3107 # Merged with arensb-context branch: use C4::Context->dbh instead of
3108 # &C4Connect, and generally prefer C4::Context over C4::Database.
3109 #
3110 # Revision 1.14  2002/10/03 11:28:18  tipaul
3111 # Extending Context.pm to add stopword management and using it in MARC-API.
3112 # First benchmarks show a medium speed improvement, which  is nice as this part is heavily called.
3113 #
3114 # Revision 1.13  2002/10/02 16:26:44  tipaul
3115 # road to 1.3.1
3116 #
3117 # Revision 1.12.2.4  2002/10/05 07:09:31  arensb
3118 # Merged in changes from main branch.
3119 #
3120 # Revision 1.12.2.3  2002/10/05 06:12:10  arensb
3121 # Added a whole mess of FIXME comments.
3122 #
3123 # Revision 1.12.2.2  2002/10/05 04:03:14  arensb
3124 # Added some missing semicolons.
3125 #
3126 # Revision 1.12.2.1  2002/10/04 02:24:01  arensb
3127 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
3128 # C4Connect.
3129 #
3130 # Revision 1.12.2.3  2002/10/05 06:12:10  arensb
3131 # Added a whole mess of FIXME comments.
3132 #
3133 # Revision 1.12.2.2  2002/10/05 04:03:14  arensb
3134 # Added some missing semicolons.
3135 #
3136 # Revision 1.12.2.1  2002/10/04 02:24:01  arensb
3137 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
3138 # C4Connect.
3139 #
3140 # Revision 1.12  2002/10/01 11:48:51  arensb
3141 # Added some FIXME comments, mostly marking duplicate functions.
3142 #
3143 # Revision 1.11  2002/09/24 13:49:26  tipaul
3144 # long WAS the road to 1.3.0...
3145 # coming VERY SOON NOW...
3146 # modifying installer and buildrelease to update the DB
3147 #
3148 # Revision 1.10  2002/09/22 16:50:08  arensb
3149 # Added some FIXME comments.
3150 #
3151 # Revision 1.9  2002/09/20 12:57:46  tipaul
3152 # long is the road to 1.4.0
3153 # * MARCadditem and MARCmoditem now wroks
3154 # * various bugfixes in MARC management
3155 # !!! 1.3.0 should be released very soon now. Be careful !!!
3156 #
3157 # Revision 1.8  2002/09/10 13:53:52  tipaul
3158 # MARC API continued...
3159 # * some bugfixes
3160 # * 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)
3161 #
3162 # Note : it should not be hard for marcimport and marcexport to re-link fields from internal tag/subfield to "legal" tag/subfield.
3163 #
3164 # Revision 1.7  2002/08/14 18:12:51  tonnesen
3165 # Added copyright statement to all .pl and .pm files
3166 #
3167 # Revision 1.6  2002/07/25 13:40:31  tipaul
3168 # pod documenting the API.
3169 #
3170 # Revision 1.5  2002/07/24 16:11:37  tipaul
3171 # Now, the API...
3172 # Database.pm and Output.pm are almost not modified (var test...)
3173 #
3174 # Biblio.pm is almost completly rewritten.
3175 #
3176 # WHAT DOES IT ??? ==> END of Hitchcock suspens
3177 #
3178 # 1st, it does... nothing...
3179 # 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 ...
3180 #
3181 # All old-API functions have been cloned. for example, the "newbiblio" sub, now has become :
3182 # * a "newbiblio" sub, with the same parameters. It just call a sub named OLDnewbiblio
3183 # * 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.
3184 # * 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.
3185 # 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 ;-)
3186 #
3187 # 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.
3188 # Note we have decided with steve that a old-biblio <=> a MARC-Biblio.
3189 #