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   &find_biblioitemnumber
  59   &MARCgettagslib
  60
  61   &NEWnewbiblio &NEWnewitem
  62   &NEWmodbiblio &NEWmoditem
  63   &NEWdelbiblio &NEWdelitem
  64   &NEWmodbiblioframework
  65
  66   &MARCaddbiblio &MARCadditem
  67   &MARCmodsubfield &MARCaddsubfield
  68   &MARCmodbiblio &MARCmoditem
  69   &MARCkoha2marcBiblio &MARCmarc2koha
  70   &MARCkoha2marcItem &MARChtml2marc
  71   &MARCgetbiblio &MARCgetitem
  72   &MARCaddword &MARCdelword
  73   &MARCdelsubfield
  74   &char_decode
  75
  76   &FindDuplicate
  77   &DisplayISBN
  78 );
  79
  80 #
  81 #
  82 # MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC
  83 #
  84 #
  85 # all the following subs takes a MARC::Record as parameter and manage
  86 # the MARC-DB. They are called by the 1.0/1.2 xxx subs, and by the
  87 # NEWxxx subs (xxx deals with old-DB parameters, the NEWxxx deals with MARC-DB parameter)
  88
  89 =head1 NAME
  90
  91 C4::Biblio - acquisition, catalog  management functions
  92
  93 =head1 SYNOPSIS
  94
  95 move from 1.2 to 1.4 version :
  96 1.2 and previous version uses a specific API to manage biblios. This API uses old-DB style parameters.
  97 In the 1.4 version, we want to do 2 differents things :
  98  - keep populating the old-DB, that has a LOT less datas than MARC
  99  - populate the MARC-DB
 100 To populate the DBs we have 2 differents sources :
 101  - the standard acquisition system (through book sellers), that does'nt use MARC data
 102  - the MARC acquisition system, that uses MARC data.
 103
 104 Thus, we have 2 differents cases :
 105 - 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
 106 - 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
 107
 108 That's why we need 4 subs :
 109 all I<subs beginning by MARC> manage only MARC tables. They manage MARC-DB with MARC::Record parameters
 110 all I<subs beginning by OLD> manage only OLD-DB tables. They manage old-DB with old-DB parameters
 111 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
 112 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.
 113
 114 - NEW and old-style API should be used in koha to manage biblio
 115 - MARCsubs are divided in 2 parts :
 116 * some of them manage MARC parameters. They are heavily used in koha.
 117 * some of them manage MARC biblio : they are mostly used by NEW and old-style subs.
 118 - OLD are used internally only
 119
 120 all subs requires/use $dbh as 1st parameter.
 121
 122 I<NEWxxx related subs>
 123
 124 all subs requires/use $dbh as 1st parameter.
 125 those subs are used by the MARC-compliant version of koha : marc import, or marc management.
 126
 127 I<OLDxxx related subs>
 128
 129 all subs requires/use $dbh as 1st parameter.
 130 those subs are used by the MARC-compliant version of koha : marc import, or marc management.
 131
 132 They all are the exact copy of 1.0/1.2 version of the sub without the OLD.
 133 The OLDxxx is called by the original xxx sub.
 134 the 1.4 xxx sub also builds MARC::Record an calls the MARCxxx
 135
 136 WARNING : there is 1 difference between initialxxx and OLDxxx :
 137 the db header $dbh is always passed as parameter to avoid over-DB connexion
 138
 139 =head1 DESCRIPTION
 140
 141 =over 4
 142
 143 =item @tagslib = &MARCgettagslib($dbh,1|0,$itemtype);
 144
 145 last param is 1 for liblibrarian and 0 for libopac
 146 $itemtype contains the itemtype framework reference. If empty or does not exist, the default one is used
 147 returns a hash with tag/subfield meaning
 148 =item ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
 149
 150 finds MARC tag and subfield for a given kohafield
 151 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
 152
 153 =item $biblionumber = &MARCfind_oldbiblionumber_from_MARCbibid($dbh,$MARCbibi);
 154
 155 finds a old-db biblio number for a given MARCbibid number
 156
 157 =item $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$oldbiblionumber);
 158
 159 finds a MARC bibid from a old-db biblionumber
 160
 161 =item $MARCRecord = &MARCkoha2marcBiblio($dbh,$biblionumber,biblioitemnumber);
 162
 163 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem
 164
 165 =item $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);
 166
 167 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB item
 168
 169 =item $MARCRecord = &MARCkoha2marcSubtitle($dbh,$biblionumber,$subtitle);
 170
 171 MARCkoha2marcSubtitle is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB subtitle
 172
 173 =item $olddb = &MARCmarc2koha($dbh,$MARCRecord);
 174
 175 builds a hash with old-db datas from a MARC::Record
 176
 177 =item &MARCaddbiblio($dbh,$MARC::Record,$biblionumber);
 178
 179 creates a biblio (in the MARC tables only). $biblionumber is the old-db biblionumber of the biblio
 180
 181 =item &MARCaddsubfield($dbh,$bibid,$tagid,$indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
 182
 183 adds a subfield in a biblio (in the MARC tables only).
 184
 185 =item $MARCRecord = &MARCgetbiblio($dbh,$bibid);
 186
 187 Returns a MARC::Record for the biblio $bibid.
 188
 189 =item &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,$delete);
 190
 191 MARCmodbiblio changes a biblio for a biblio,MARC::Record passed as parameter
 192 It 1st delete the biblio, then recreates it.
 193 WARNING : the $delete parameter is not used anymore (too much unsolvable cases).
 194 =item ($subfieldid,$subfieldvalue) = &MARCmodsubfield($dbh,$subfieldid,$subfieldvalue);
 195
 196 MARCmodsubfield changes the value of a given subfield
 197
 198 =item $subfieldid = &MARCfindsubfield($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue);
 199
 200 MARCfindsubfield returns a subfield number given a bibid/tag/subfieldvalue values.
 201 Returns -1 if more than 1 answer
 202
 203 =item $subfieldid = &MARCfindsubfieldid($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
 204
 205 MARCfindsubfieldid find a subfieldid for a bibid/tag/tagorder/subfield/subfieldorder
 206
 207 =item &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
 208
 209 MARCdelsubfield delete a subfield for a bibid/tag/tagorder/subfield/subfieldorder
 210 If $subfieldorder is not set, delete all the $tag$subfield subfields
 211
 212 =item &MARCdelbiblio($dbh,$bibid);
 213
 214 MARCdelbiblio delete biblio $bibid
 215
 216 =item &MARCkoha2marcOnefield
 217
 218 used by MARCkoha2marc and should not be useful elsewhere
 219
 220 =item &MARCmarc2kohaOnefield
 221
 222 used by MARCmarc2koha and should not be useful elsewhere
 223
 224 =item MARCaddword
 225
 226 used to manage MARC_word table and should not be useful elsewhere
 227
 228 =item MARCdelword
 229
 230 used to manage MARC_word table and should not be useful elsewhere
 231
 232 =cut
 233
 234 sub MARCgettagslib {
 235     my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
 236     $frameworkcode = "" unless $frameworkcode;
 237     my $sth;
 238     my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
 239
 240     # check that framework exists
 241     $sth =
 242       $dbh->prepare(
 243         "select count(*) from marc_tag_structure where frameworkcode=?");
 244     $sth->execute($frameworkcode);
 245     my ($total) = $sth->fetchrow;
 246     $frameworkcode = "" unless ( $total > 0 );
 247     $sth =
 248       $dbh->prepare(
 249 "select tagfield,liblibrarian,libopac,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield"
 250     );
 251     $sth->execute($frameworkcode);
 252     my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
 253
 254     while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
 255         $res->{$tag}->{lib}        = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 256         $res->{$tab}->{tab}        = "";            # XXX
 257         $res->{$tag}->{mandatory}  = $mandatory;
 258         $res->{$tag}->{repeatable} = $repeatable;
 259     }
 260
 261     $sth =
 262       $dbh->prepare(
 263 "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"
 264     );
 265     $sth->execute($frameworkcode);
 266
 267     my $subfield;
 268     my $authorised_value;
 269     my $authtypecode;
 270     my $value_builder;
 271     my $kohafield;
 272     my $seealso;
 273     my $hidden;
 274     my $isurl;
 275         my $link;
 276
 277     while (
 278         ( $tag,         $subfield,   $liblibrarian,   , $libopac,      $tab,
 279         $mandatory,     $repeatable, $authorised_value, $authtypecode,
 280         $value_builder, $kohafield,  $seealso,          $hidden,
 281         $isurl,                 $link )
 282         = $sth->fetchrow
 283       )
 284     {
 285         $res->{$tag}->{$subfield}->{lib}              = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 286         $res->{$tag}->{$subfield}->{tab}              = $tab;
 287         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
 288         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
 289         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
 290         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
 291         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
 292         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
 293         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
 294         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
 295         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
 296         $res->{$tag}->{$subfield}->{link}            = $link;
 297     }
 298     return $res;
 299 }
 300
 301 sub MARCfind_marc_from_kohafield {
 302     my ( $dbh, $kohafield,$frameworkcode ) = @_;
 303     return 0, 0 unless $kohafield;
 304         my $relations = C4::Context->marcfromkohafield;
 305         return ($relations->{$frameworkcode}->{$kohafield}->[0],$relations->{$frameworkcode}->{$kohafield}->[1]);
 306 }
 307
 308 sub MARCfind_oldbiblionumber_from_MARCbibid {
 309     my ( $dbh, $MARCbibid ) = @_;
 310     my $sth =
 311       $dbh->prepare("select biblionumber from marc_biblio where bibid=?");
 312     $sth->execute($MARCbibid);
 313     my ($biblionumber) = $sth->fetchrow;
 314     return $biblionumber;
 315 }
 316
 317 sub MARCfind_MARCbibid_from_oldbiblionumber {
 318     my ( $dbh, $oldbiblionumber ) = @_;
 319     my $sth =
 320       $dbh->prepare("select bibid from marc_biblio where biblionumber=?");
 321     $sth->execute($oldbiblionumber);
 322     my ($bibid) = $sth->fetchrow;
 323     return $bibid;
 324 }
 325
 326 sub MARCaddbiblio {
 327
 328 # pass the MARC::Record to this function, and it will create the records in the marc tables
 329         my ($dbh,$record,$biblionumber,$frameworkcode,$bibid) = @_;
 330         my @fields=$record->fields();
 331 # my $bibid;
 332 # adding main table, and retrieving bibid
 333 # if bibid is sent, then it's not a true add, it's only a re-add, after a delete (ie, a mod)
 334     # if bibid empty => true add, find a new bibid number
 335     unless ($bibid) {
 336         $dbh->do(
 337 "lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ"
 338         );
 339         my $sth =
 340           $dbh->prepare(
 341 "insert into marc_biblio (datecreated,biblionumber,frameworkcode) values (now(),?,?)"
 342         );
 343         $sth->execute( $biblionumber, $frameworkcode );
 344         $sth = $dbh->prepare("select max(bibid) from marc_biblio");
 345         $sth->execute;
 346         ($bibid) = $sth->fetchrow;
 347         $sth->finish;
 348     }
 349     my $fieldcount = 0;
 350
 351     # now, add subfields...
 352     foreach my $field (@fields) {
 353         $fieldcount++;
 354         if ( $field->tag() < 10 ) {
 355             &MARCaddsubfield( $dbh, $bibid, $field->tag(), '', $fieldcount, '',
 356                 1, $field->data() );
 357         }
 358         else {
 359             my @subfields = $field->subfields();
 360             foreach my $subfieldcount ( 0 .. $#subfields ) {
 361                 &MARCaddsubfield(
 362                     $dbh,
 363                     $bibid,
 364                     $field->tag(),
 365                     $field->indicator(1) . $field->indicator(2),
 366                     $fieldcount,
 367                     $subfields[$subfieldcount][0],
 368                     $subfieldcount + 1,
 369                     $subfields[$subfieldcount][1]
 370                 );
 371             }
 372         }
 373     }
 374         # save leader
 375         &MARCaddsubfield($dbh,$bibid,'000','',$fieldcount+1,'',1,$record->leader);
 376     $dbh->do("unlock tables");
 377     return $bibid;
 378 }
 379
 380 sub MARCadditem {
 381
 382 # pass the MARC::Record to this function, and it will create the records in the marc tables
 383     my ($dbh,$record,$biblionumber) = @_;
 384 # search for MARC biblionumber
 385     $dbh->do("lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ");
 386     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
 387     my @fields=$record->fields();
 388     my $sth = $dbh->prepare("select max(tagorder) from marc_subfield_table where bibid=?");
 389     $sth->execute($bibid);
 390     my ($fieldcount) = $sth->fetchrow;
 391
 392     # now, add subfields...
 393     foreach my $field (@fields) {
 394         my @subfields = $field->subfields();
 395         $fieldcount++;
 396         foreach my $subfieldcount ( 0 .. $#subfields ) {
 397             &MARCaddsubfield(
 398                 $dbh,
 399                 $bibid,
 400                 $field->tag(),
 401                 $field->indicator(1) . $field->indicator(2),
 402                 $fieldcount,
 403                 $subfields[$subfieldcount][0],
 404                 $subfieldcount + 1,
 405                 $subfields[$subfieldcount][1]
 406             );
 407         }
 408     }
 409     $dbh->do("unlock tables");
 410     return $bibid;
 411 }
 412
 413 sub MARCaddsubfield {
 414
 415     # Add a new subfield to a tag into the DB.
 416     my (
 417         $dbh,      $bibid,        $tagid,         $tag_indicator,
 418         $tagorder, $subfieldcode, $subfieldorder, $subfieldvalues
 419       )
 420       = @_;
 421           return unless $subfieldvalues;
 422 # warn "$tagid / $subfieldcode / $subfieldvalues";
 423     # if not value, end of job, we do nothing
 424 #     if ( length($subfieldvalues) == 0 ) {
 425 #         return;
 426 #     }
 427     if ( not($subfieldcode) ) {
 428         $subfieldcode = ' ';
 429     }
 430     my @subfieldvalues = split /\||#/, $subfieldvalues;
 431     foreach my $subfieldvalue (@subfieldvalues) {
 432         if ( length($subfieldvalue) > 255 ) {
 433             $dbh->do(
 434 "lock tables marc_blob_subfield WRITE, marc_subfield_table WRITE"
 435             );
 436             my $sth =
 437               $dbh->prepare(
 438                 "insert into marc_blob_subfield (subfieldvalue) values (?)");
 439             $sth->execute($subfieldvalue);
 440             $sth =
 441               $dbh->prepare("select max(blobidlink)from marc_blob_subfield");
 442             $sth->execute;
 443             my ($res) = $sth->fetchrow;
 444             $sth =
 445               $dbh->prepare(
 446 "insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,valuebloblink) values (?,?,?,?,?,?,?)"
 447             );
 448             $sth->execute( $bibid, ( sprintf "%03s", $tagid ), $tagorder,
 449                 $tag_indicator, $subfieldcode, $subfieldorder, $res );
 450
 451             if ( $sth->errstr ) {
 452                 warn
 453 "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
 454             }
 455             $dbh->do("unlock tables");
 456         }
 457         else {
 458             my $sth =
 459               $dbh->prepare(
 460 "insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values (?,?,?,?,?,?,?)"
 461             );
 462             $sth->execute(
 463                 $bibid,        ( sprintf "%03s", $tagid ),
 464                 $tagorder,     $tag_indicator,
 465                 $subfieldcode, $subfieldorder,
 466                 $subfieldvalue
 467             );
 468             if ( $sth->errstr ) {
 469                 warn
 470 "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
 471             }
 472         }
 473         &MARCaddword(
 474             $dbh,          $bibid,         $tagid,       $tagorder,
 475             $subfieldcode, $subfieldorder, $subfieldvalue
 476         );
 477     }
 478 }
 479
 480 sub MARCgetbiblio {
 481
 482     # Returns MARC::Record of the biblio passed in parameter.
 483     my ( $dbh, $biblionumber ) = @_;
 484         my $sth = $dbh->prepare('select marc from biblioitems where biblionumber=?');
 485         $sth->execute($biblionumber);
 486         my ($marc) = $sth->fetchrow;
 487         my $record = MARC::File::USMARC::decode($marc);
 488     return $record;
 489 }
 490
 491 sub MARCgetitem {
 492
 493     my ( $dbh, $biblionumber, $itemnumber ) = @_;
 494         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
 495         # get the complete MARC record
 496         my $sth = $dbh->prepare("select marc from biblioitems where biblionumber=?");
 497         $sth->execute($biblionumber);
 498         my ($rawmarc) = $sth->fetchrow;
 499         my $record = MARC::File::USMARC::decode($rawmarc);
 500         # now, find the relevant itemnumber
 501         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
 502         # prepare the new item record
 503         my $itemrecord = MARC::Record->new();
 504         # parse all fields fields from the complete record
 505         foreach ($record->field($itemnumberfield)) {
 506                 # when the item field is found, save it
 507                 if ($_->subfield($itemnumbersubfield) == $itemnumber) {
 508                         $itemrecord->append_fields($_);
 509                 }
 510         }
 511
 512     return $itemrecord;
 513 }
 514
 515 sub MARCmodbiblio {
 516         my ($dbh,$bibid,$record,$frameworkcode,$delete)=@_;
 517 # 1st delete the biblio,
 518 # 2nd recreate it
 519         my $biblionumber = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
 520         &MARCdelbiblio($dbh,$bibid,1);
 521         &MARCaddbiblio($dbh,$record,$biblionumber,$frameworkcode,$bibid);
 522 }
 523
 524 sub MARCdelbiblio {
 525     my ( $dbh, $bibid, $keep_items ) = @_;
 526
 527     # if the keep_item is set to 1, then all items are preserved.
 528     # This flag is set when the delbiblio is called by modbiblio
 529     # due to a too complex structure of MARC (repeatable fields and subfields),
 530     # the best solution for a modif is to delete / recreate the record.
 531
 532 # 1st of all, copy the MARC::Record to deletedbiblio table => if a true deletion, MARC data will be kept.
 533 # if deletion called before MARCmodbiblio => won't do anything, as the oldbiblionumber doesn't
 534     # exist in deletedbiblio table
 535     my $record = MARCgetbiblio( $dbh, $bibid );
 536     my $oldbiblionumber =
 537       MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
 538     my $copy2deleted =
 539       $dbh->prepare("update deletedbiblio set marc=? where biblionumber=?");
 540     $copy2deleted->execute( $record->as_usmarc(), $oldbiblionumber );
 541
 542     # now, delete in MARC tables.
 543     if ( $keep_items eq 1 ) {
 544
 545         #search item field code
 546         my $sth =
 547           $dbh->prepare(
 548 "select tagfield from marc_subfield_structure where kohafield like 'items.%'"
 549         );
 550         $sth->execute;
 551         my $itemtag = $sth->fetchrow_hashref->{tagfield};
 552         $dbh->do(
 553 "delete from marc_subfield_table where bibid=$bibid and tag<>$itemtag"
 554         );
 555         $dbh->do(
 556 "delete from marc_word where bibid=$bibid and not (tagsubfield like \"$itemtag%\")"
 557         );
 558     }
 559     else {
 560         $dbh->do("delete from marc_biblio where bibid=$bibid");
 561         $dbh->do("delete from marc_subfield_table where bibid=$bibid");
 562         $dbh->do("delete from marc_word where bibid=$bibid");
 563     }
 564 }
 565
 566 sub MARCdelitem {
 567
 568     # delete the item passed in parameter in MARC tables.
 569     my ( $dbh, $bibid, $itemnumber ) = @_;
 570
 571     #    my $record = MARC::Record->new();
 572     # search MARC tagorder
 573     my $record = MARCgetitem( $dbh, $bibid, $itemnumber );
 574     my $copy2deleted =
 575       $dbh->prepare("update deleteditems set marc=? where itemnumber=?");
 576     $copy2deleted->execute( $record->as_usmarc(), $itemnumber );
 577
 578     my $sth2 =
 579       $dbh->prepare(
 580 "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=?"
 581     );
 582     $sth2->execute( $bibid, $itemnumber );
 583     my ($tagorder) = $sth2->fetchrow_array();
 584     my $sth =
 585       $dbh->prepare(
 586         "delete from marc_subfield_table where bibid=? and tagorder=?");
 587     $sth->execute( $bibid, $tagorder );
 588 }
 589
 590 sub MARCmoditem {
 591         my ($dbh,$record,$bibid,$itemnumber,$delete)=@_;
 592         my $biblionumber = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
 593         &MARCdelitem($dbh,$bibid,$itemnumber);
 594         &MARCadditem($dbh,$record,$biblionumber);
 595 }
 596
 597 sub MARCmodsubfield {
 598
 599     # Subroutine changes a subfield value given a subfieldid.
 600     my ( $dbh, $subfieldid, $subfieldvalue ) = @_;
 601     $dbh->do("lock tables marc_blob_subfield WRITE,marc_subfield_table WRITE");
 602     my $sth1 =
 603       $dbh->prepare(
 604         "select valuebloblink from marc_subfield_table where subfieldid=?");
 605     $sth1->execute($subfieldid);
 606     my ($oldvaluebloblink) = $sth1->fetchrow;
 607     $sth1->finish;
 608     my $sth;
 609
 610     # if too long, use a bloblink
 611     if ( length($subfieldvalue) > 255 ) {
 612
 613         # if already a bloblink, update it, otherwise, insert a new one.
 614         if ($oldvaluebloblink) {
 615             $sth =
 616               $dbh->prepare(
 617 "update marc_blob_subfield set subfieldvalue=? where blobidlink=?"
 618             );
 619             $sth->execute( $subfieldvalue, $oldvaluebloblink );
 620         }
 621         else {
 622             $sth =
 623               $dbh->prepare(
 624                 "insert into marc_blob_subfield (subfieldvalue) values (?)");
 625             $sth->execute($subfieldvalue);
 626             $sth =
 627               $dbh->prepare("select max(blobidlink) from marc_blob_subfield");
 628             $sth->execute;
 629             my ($res) = $sth->fetchrow;
 630             $sth =
 631               $dbh->prepare(
 632 "update marc_subfield_table set subfieldvalue=null, valuebloblink=? where subfieldid=?"
 633             );
 634             $sth->execute( $res, $subfieldid );
 635         }
 636     }
 637     else {
 638
 639 # note this can leave orphan bloblink. Not a big problem, but we should build somewhere a orphan deleting script...
 640         $sth =
 641           $dbh->prepare(
 642 "update marc_subfield_table set subfieldvalue=?,valuebloblink=null where subfieldid=?"
 643         );
 644         $sth->execute( $subfieldvalue, $subfieldid );
 645     }
 646     $dbh->do("unlock tables");
 647     $sth->finish;
 648     $sth =
 649       $dbh->prepare(
 650 "select bibid,tag,tagorder,subfieldcode,subfieldid,subfieldorder from marc_subfield_table where subfieldid=?"
 651     );
 652     $sth->execute($subfieldid);
 653     my ( $bibid, $tagid, $tagorder, $subfieldcode, $x, $subfieldorder ) =
 654       $sth->fetchrow;
 655     $subfieldid = $x;
 656     &MARCdelword( $dbh, $bibid, $tagid, $tagorder, $subfieldcode,
 657         $subfieldorder );
 658     &MARCaddword(
 659         $dbh,          $bibid,         $tagid,       $tagorder,
 660         $subfieldcode, $subfieldorder, $subfieldvalue
 661     );
 662     return ( $subfieldid, $subfieldvalue );
 663 }
 664
 665 sub MARCfindsubfield {
 666     my ( $dbh, $bibid, $tag, $subfieldcode, $subfieldorder, $subfieldvalue ) =
 667       @_;
 668     my $resultcounter = 0;
 669     my $subfieldid;
 670     my $lastsubfieldid;
 671     my $query =
 672 "select subfieldid from marc_subfield_table where bibid=? and tag=? and subfieldcode=?";
 673     my @bind_values = ( $bibid, $tag, $subfieldcode );
 674     if ($subfieldvalue) {
 675         $query .= " and subfieldvalue=?";
 676         push ( @bind_values, $subfieldvalue );
 677     }
 678     else {
 679         if ( $subfieldorder < 1 ) {
 680             $subfieldorder = 1;
 681         }
 682         $query .= " and subfieldorder=?";
 683         push ( @bind_values, $subfieldorder );
 684     }
 685     my $sti = $dbh->prepare($query);
 686     $sti->execute(@bind_values);
 687     while ( ($subfieldid) = $sti->fetchrow ) {
 688         $resultcounter++;
 689         $lastsubfieldid = $subfieldid;
 690     }
 691     if ( $resultcounter > 1 ) {
 692
 693 # Error condition.  Values given did not resolve into a unique record.  Don't know what to edit
 694 # should rarely occur (only if we use subfieldvalue with a value that exists twice, which is strange)
 695         return -1;
 696     }
 697     else {
 698         return $lastsubfieldid;
 699     }
 700 }
 701
 702 sub MARCfindsubfieldid {
 703         my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_;
 704         my $sth = $dbh->prepare( "select subfieldid from marc_subfield_table
 705                                 where bibid=? and tag=? and tagorder=?
 706                                         and subfieldcode=? and subfieldorder=?"
 707         );
 708         $sth->execute( $bibid, $tag, $tagorder, $subfield, $subfieldorder );
 709         my ($res) = $sth->fetchrow;
 710         unless ($res) {
 711                 $sth = $dbh->prepare( "select subfieldid from marc_subfield_table
 712                                 where bibid=? and tag=? and tagorder=?
 713                                         and subfieldcode=?"
 714                 );
 715                 $sth->execute( $bibid, $tag, $tagorder, $subfield );
 716                 ($res) = $sth->fetchrow;
 717         }
 718         return $res;
 719 }
 720
 721 sub find_biblioitemnumber {
 722         my ( $dbh, $biblionumber ) = @_;
 723         my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
 724         $sth->execute($biblionumber);
 725         my ($biblioitemnumber) = $sth->fetchrow;
 726         return $biblioitemnumber;
 727 }
 728
 729 sub MARCfind_frameworkcode {
 730         my ( $dbh, $biblionumber ) = @_;
 731         my $sth = $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
 732         $sth->execute($biblionumber);
 733         my ($frameworkcode) = $sth->fetchrow;
 734         return $frameworkcode;
 735 }
 736
 737 sub MARCdelsubfield {
 738
 739     # delete a subfield for $bibid / tag / tagorder / subfield / subfieldorder
 740     my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_;
 741         if ($subfieldorder) {
 742                 $dbh->do( "delete from marc_subfield_table where bibid='$bibid' and
 743                                 tag='$tag' and tagorder='$tagorder'
 744                                 and subfieldcode='$subfield' and subfieldorder='$subfieldorder'
 745                                 "
 746                 );
 747                 $dbh->do( "delete from marc_word where bibid='$bibid' and
 748                                 tagsubfield='$tag$subfield' and tagorder='$tagorder'
 749                                 and subfieldorder='$subfieldorder'
 750                                 "
 751                 );
 752         } else {
 753                 $dbh->do( "delete from marc_subfield_table where bibid='$bibid' and
 754                                 tag='$tag' and tagorder='$tagorder'
 755                                 and subfieldcode='$subfield'"
 756                 );
 757                 $dbh->do( "delete from marc_word where bibid='$bibid' and
 758                                 tagsubfield='$tag$subfield' and tagorder='$tagorder'"
 759                 );
 760         }
 761 }
 762
 763 sub MARCkoha2marcBiblio {
 764
 765     # this function builds partial MARC::Record from the old koha-DB fields
 766     my ( $dbh, $biblionumber, $biblioitemnumber ) = @_;
 767     my $sth =
 768       $dbh->prepare(
 769 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
 770     );
 771     my $record = MARC::Record->new();
 772
 773     #--- if bibid, then retrieve old-style koha data
 774     if ( $biblionumber > 0 ) {
 775         my $sth2 =
 776           $dbh->prepare(
 777 "select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp
 778                 from biblio where biblionumber=?"
 779         );
 780         $sth2->execute($biblionumber);
 781         my $row = $sth2->fetchrow_hashref;
 782         my $code;
 783         foreach $code ( keys %$row ) {
 784             if ( $row->{$code} ) {
 785                 &MARCkoha2marcOnefield( $sth, $record, "biblio." . $code,
 786                     $row->{$code}, '');
 787             }
 788         }
 789     }
 790
 791     #--- if biblioitem, then retrieve old-style koha data
 792     if ( $biblioitemnumber > 0 ) {
 793         my $sth2 =
 794           $dbh->prepare(
 795             " SELECT biblioitemnumber,biblionumber,volume,number,classification,
 796                                                 itemtype,url,isbn,issn,dewey,subclass,publicationyear,publishercode,
 797                                                 volumedate,volumeddesc,timestamp,illus,pages,notes AS bnotes,size,place
 798                                         FROM biblioitems
 799                                         WHERE biblioitemnumber=?
 800                                         "
 801         );
 802         $sth2->execute($biblioitemnumber);
 803         my $row = $sth2->fetchrow_hashref;
 804         my $code;
 805         foreach $code ( keys %$row ) {
 806             if ( $row->{$code} ) {
 807                 &MARCkoha2marcOnefield( $sth, $record, "biblioitems." . $code,
 808                     $row->{$code},'' );
 809             }
 810         }
 811     }
 812
 813     # other fields => additional authors, subjects, subtitles
 814     my $sth2 =
 815       $dbh->prepare(
 816         " SELECT author FROM additionalauthors WHERE biblionumber=?");
 817     $sth2->execute($biblionumber);
 818     while ( my $row = $sth2->fetchrow_hashref ) {
 819         &MARCkoha2marcOnefield( $sth, $record, "additionalauthors.author",
 820             $row->{'author'},'' );
 821     }
 822     $sth2 =
 823       $dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?");
 824     $sth2->execute($biblionumber);
 825     while ( my $row = $sth2->fetchrow_hashref ) {
 826         &MARCkoha2marcOnefield( $sth, $record, "bibliosubject.subject",
 827             $row->{'subject'},'' );
 828     }
 829     $sth2 =
 830       $dbh->prepare(
 831         " SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?");
 832     $sth2->execute($biblionumber);
 833     while ( my $row = $sth2->fetchrow_hashref ) {
 834         &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle",
 835             $row->{'subtitle'},'' );
 836     }
 837     return $record;
 838 }
 839
 840 sub MARCkoha2marcItem {
 841
 842     # this function builds partial MARC::Record from the old koha-DB fields
 843     my ( $dbh, $biblionumber, $itemnumber ) = @_;
 844
 845     #    my $dbh=&C4Connect;
 846     my $sth =
 847       $dbh->prepare(
 848 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
 849     );
 850     my $record = MARC::Record->new();
 851
 852     #--- if item, then retrieve old-style koha data
 853     if ( $itemnumber > 0 ) {
 854
 855         #       print STDERR "prepare $biblionumber,$itemnumber\n";
 856         my $sth2 =
 857           $dbh->prepare(
 858 "SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned,
 859                                                 booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
 860                                                 datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,itemcallnumber,issues,renewals,
 861                                         reserves,restricted,binding,itemnotes,holdingbranch,timestamp
 862                                         FROM items
 863                                         WHERE itemnumber=?"
 864         );
 865         $sth2->execute($itemnumber);
 866         my $row = $sth2->fetchrow_hashref;
 867         my $code;
 868         foreach $code ( keys %$row ) {
 869             if ( $row->{$code} ) {
 870                 &MARCkoha2marcOnefield( $sth, $record, "items." . $code,
 871                     $row->{$code},'' );
 872             }
 873         }
 874     }
 875     return $record;
 876 }
 877
 878 sub MARCkoha2marcSubtitle {
 879
 880     # this function builds partial MARC::Record from the old koha-DB fields
 881     my ( $dbh, $bibnum, $subtitle ) = @_;
 882     my $sth =
 883       $dbh->prepare(
 884 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
 885     );
 886     my $record = MARC::Record->new();
 887     &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle",
 888         $subtitle,'' );
 889     return $record;
 890 }
 891
 892 sub MARCkoha2marcOnefield {
 893     my ( $sth, $record, $kohafieldname, $value,$frameworkcode ) = @_;
 894     my $tagfield;
 895     my $tagsubfield;
 896     $sth->execute($frameworkcode,$kohafieldname);
 897     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
 898         if ( $record->field($tagfield) ) {
 899             my $tag = $record->field($tagfield);
 900             if ($tag) {
 901                 $tag->add_subfields( $tagsubfield, $value );
 902                 $record->delete_field($tag);
 903                 $record->add_fields($tag);
 904             }
 905         }
 906         else {
 907             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
 908         }
 909     }
 910     return $record;
 911 }
 912
 913 sub MARChtml2marc {
 914         my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
 915         my $prevtag = -1;
 916         my $record = MARC::Record->new();
 917 #       my %subfieldlist=();
 918         my $prevvalue; # if tag <10
 919         my $field; # if tag >=10
 920         for (my $i=0; $i< @$rtags; $i++) {
 921                 next unless @$rvalues[$i];
 922                 # rebuild MARC::Record
 923 #                       warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
 924                 if (@$rtags[$i] ne $prevtag) {
 925                         if ($prevtag < 10) {
 926                                 if ($prevvalue) {
 927                                         if ($prevtag ne '000') {
 928                                                 $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
 929                                         } else {
 930                                                 $record->leader($prevvalue);
 931                                         }
 932                                 }
 933                         } else {
 934                                 if ($field) {
 935                                         $record->add_fields($field);
 936                                 }
 937                         }
 938                         $indicators{@$rtags[$i]}.='  ';
 939                         if (@$rtags[$i] <10) {
 940                                 $prevvalue= @$rvalues[$i];
 941                                 undef $field;
 942                         } else {
 943                                 undef $prevvalue;
 944                                 $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
 945 #                       warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
 946                         }
 947                         $prevtag = @$rtags[$i];
 948                 } else {
 949                         if (@$rtags[$i] <10) {
 950                                 $prevvalue=@$rvalues[$i];
 951                         } else {
 952                                 if (length(@$rvalues[$i])>0) {
 953                                         $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
 954 #                       warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
 955                                 }
 956                         }
 957                         $prevtag= @$rtags[$i];
 958                 }
 959         }
 960         # the last has not been included inside the loop... do it now !
 961         $record->add_fields($field) if $field;
 962 #       warn "HTML2MARC=".$record->as_formatted;
 963         return $record;
 964 }
 965
 966 sub MARCmarc2koha {
 967         my ($dbh,$record,$frameworkcode) = @_;
 968         my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
 969         my $result;
 970         my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
 971         $sth2->execute;
 972         my $field;
 973         while (($field)=$sth2->fetchrow) {
 974                 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result,$frameworkcode);
 975         }
 976         $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
 977         $sth2->execute;
 978         while (($field)=$sth2->fetchrow) {
 979                 if ($field eq 'notes') { $field = 'bnotes'; }
 980                 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result,$frameworkcode);
 981         }
 982         $sth2=$dbh->prepare("SHOW COLUMNS from items");
 983         $sth2->execute;
 984         while (($field)=$sth2->fetchrow) {
 985                 $result=&MARCmarc2kohaOneField($sth,"items",$field,$record,$result,$frameworkcode);
 986         }
 987         # additional authors : specific
 988         $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result,$frameworkcode);
 989         $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result,$frameworkcode);
 990 # modify copyrightdate to keep only the 1st year found
 991         my $temp = $result->{'copyrightdate'};
 992         $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
 993         if ($1>0) {
 994                 $result->{'copyrightdate'} = $1;
 995         } else { # if no cYYYY, get the 1st date.
 996                 $temp =~ m/(\d\d\d\d)/;
 997                 $result->{'copyrightdate'} = $1;
 998         }
 999 # modify publicationyear to keep only the 1st year found
1000         $temp = $result->{'publicationyear'};
1001         $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
1002         if ($1>0) {
1003                 $result->{'publicationyear'} = $1;
1004         } else { # if no cYYYY, get the 1st date.
1005                 $temp =~ m/(\d\d\d\d)/;
1006                 $result->{'publicationyear'} = $1;
1007         }
1008         return $result;
1009 }
1010
1011 sub MARCmarc2kohaOneField {
1012
1013 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
1014     my ( $sth, $kohatable, $kohafield, $record, $result,$frameworkcode ) = @_;
1015     #    warn "kohatable / $kohafield / $result / ";
1016     my $res = "";
1017     my $tagfield;
1018     my $subfield;
1019     ( $tagfield, $subfield ) = MARCfind_marc_from_kohafield("",$kohatable.".".$kohafield,$frameworkcode);
1020     foreach my $field ( $record->field($tagfield) ) {
1021                 if ($field->tag()<10) {
1022                         if ($result->{$kohafield}) {
1023                                 $result->{$kohafield} .= " | ".$field->data();
1024                         } else {
1025                                 $result->{$kohafield} = $field->data();
1026                         }
1027                 } else {
1028                         if ( $field->subfields ) {
1029                                 my @subfields = $field->subfields();
1030                                 foreach my $subfieldcount ( 0 .. $#subfields ) {
1031                                         if ($subfields[$subfieldcount][0] eq $subfield) {
1032                                                 if ( $result->{$kohafield} ) {
1033                                                         $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
1034                                                 }
1035                                                 else {
1036                                                         $result->{$kohafield} = $subfields[$subfieldcount][1];
1037                                                 }
1038                                         }
1039                                 }
1040                         }
1041                 }
1042     }
1043 #       warn "OneField for $kohatable.$kohafield and $frameworkcode=> $tagfield, $subfield";
1044     return $result;
1045 }
1046
1047 sub MARCaddword {
1048
1049     # split a subfield string and adds it into the word table.
1050     # removes stopwords
1051     my (
1052         $dbh,        $bibid,         $tag,    $tagorder,
1053         $subfieldid, $subfieldorder, $sentence
1054       )
1055       = @_;
1056     $sentence =~ s/(\.|\?|\:|\!|\'|,|\-|\"|\(|\)|\[|\]|\{|\}|\/)/ /g;
1057     my @words = split / /, $sentence;
1058     my $stopwords = C4::Context->stopwords;
1059     my $sth       =
1060       $dbh->prepare(
1061 "insert into marc_word (bibid, tagsubfield, tagorder, subfieldorder, word, sndx_word)
1062                         values (?,concat(?,?),?,?,?,soundex(?))"
1063     );
1064     foreach my $word (@words) {
1065 # we record only words one char long and not in stopwords hash
1066         if (length($word)>=1 and !($stopwords->{uc($word)})) {
1067             $sth->execute($bibid,$tag,$subfieldid,$tagorder,$subfieldorder,$word,$word);
1068             if ($sth->err()) {
1069                 warn "ERROR ==> insert into marc_word (bibid, tagsubfield, tagorder, subfieldorder, word, sndx_word) values ($bibid,concat($tag,$subfieldid),$tagorder,$subfieldorder,$word,soundex($word))\n";
1070             }
1071         }
1072     }
1073 }
1074
1075 sub MARCdelword {
1076
1077 # delete words. this sub deletes all the words from a sentence. a subfield modif is done by a delete then a add
1078     my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_;
1079     my $sth =
1080       $dbh->prepare(
1081 "delete from marc_word where bibid=? and tagsubfield=concat(?,?) and tagorder=? and subfieldorder=?"
1082     );
1083     $sth->execute( $bibid, $tag, $subfield, $tagorder, $subfieldorder );
1084 }
1085
1086 #
1087 #
1088 # NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW
1089 #
1090 #
1091 # all the following subs are useful to manage MARC-DB with complete MARC records.
1092 # it's used with marcimport, and marc management tools
1093 #
1094
1095 =item ($bibid,$oldbibnum,$oldbibitemnum) = NEWnewbibilio($dbh,$MARCRecord,$frameworkcode);
1096
1097 creates a biblio from a MARC::Record.
1098
1099 =item NEWnewitem($dbh, $record,$bibid);
1100
1101 creates an item from a MARC::Record
1102
1103 =cut
1104
1105 sub NEWnewbiblio {
1106     my ( $dbh, $record, $frameworkcode ) = @_;
1107     my $biblionumber;
1108     my $biblioitemnumber;
1109     my $olddata = MARCmarc2koha( $dbh, $record,$frameworkcode );
1110         $olddata->{frameworkcode} = $frameworkcode;
1111     $biblionumber = OLDnewbiblio( $dbh, $olddata );
1112         $olddata->{biblionumber} = $biblionumber;
1113         # add biblionumber into the MARC record (it's the ID for zebra)
1114         my ( $tagfield, $tagsubfield ) =
1115                                         MARCfind_marc_from_kohafield( $dbh, "biblio.biblionumber",$frameworkcode );
1116         # create the field
1117         my $newfield;
1118         if ($tagfield<10) {
1119                 $newfield = MARC::Field->new(
1120                         $tagfield, $biblionumber,
1121                 );
1122         } else {
1123                 $newfield = MARC::Field->new(
1124                         $tagfield, '', '', "$tagsubfield" => $biblionumber,
1125                 );
1126         }
1127         # drop old field (just in case it already exist and create new one...
1128         my $old_field = $record->field($tagfield);
1129         $record->delete_field($old_field);
1130         $record->add_fields($newfield);
1131
1132         #create the marc entry, that stores the rax marc record in Koha 3.0
1133         $olddata->{marc} = $record->as_usmarc();
1134         $olddata->{marcxml} = $record->as_xml();
1135         # and create biblioitem, that's all folks !
1136     $biblioitemnumber = OLDnewbiblioitem( $dbh, $olddata );
1137
1138     # search subtiles, addiauthors and subjects
1139     ( $tagfield, $tagsubfield ) =
1140       MARCfind_marc_from_kohafield( $dbh, "additionalauthors.author",$frameworkcode );
1141     my @addiauthfields = $record->field($tagfield);
1142     foreach my $addiauthfield (@addiauthfields) {
1143         my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
1144         foreach my $subfieldcount ( 0 .. $#addiauthsubfields ) {
1145             OLDmodaddauthor( $dbh, $biblionumber,
1146                 $addiauthsubfields[$subfieldcount] );
1147         }
1148     }
1149     ( $tagfield, $tagsubfield ) =
1150       MARCfind_marc_from_kohafield( $dbh, "bibliosubtitle.subtitle",$frameworkcode );
1151     my @subtitlefields = $record->field($tagfield);
1152     foreach my $subtitlefield (@subtitlefields) {
1153         my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
1154         foreach my $subfieldcount ( 0 .. $#subtitlesubfields ) {
1155             OLDnewsubtitle( $dbh, $biblionumber,
1156                 $subtitlesubfields[$subfieldcount] );
1157         }
1158     }
1159     ( $tagfield, $tagsubfield ) =
1160       MARCfind_marc_from_kohafield( $dbh, "bibliosubject.subject",$frameworkcode );
1161     my @subj = $record->field($tagfield);
1162     my @subjects;
1163     foreach my $subject (@subj) {
1164         my @subjsubfield = $subject->subfield($tagsubfield);
1165         foreach my $subfieldcount ( 0 .. $#subjsubfield ) {
1166             push @subjects, $subjsubfield[$subfieldcount];
1167         }
1168     }
1169     OLDmodsubject( $dbh, $biblionumber, 1, @subjects );
1170     return ( $biblionumber, $biblioitemnumber );
1171 }
1172
1173 sub NEWmodbiblioframework {
1174         my ($dbh,$bibid,$frameworkcode) =@_;
1175         my $sth = $dbh->prepare("Update marc_biblio SET frameworkcode=? WHERE bibid=$bibid");
1176         $sth->execute($frameworkcode);
1177         return 1;
1178 }
1179
1180 sub NEWmodbiblio {
1181         my ($dbh,$record,$biblionumber,$frameworkcode) =@_;
1182         $frameworkcode="" unless $frameworkcode;
1183 #       &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,0);
1184         my $oldbiblio = MARCmarc2koha($dbh,$record,$frameworkcode);
1185
1186         $oldbiblio->{frameworkcode} = $frameworkcode;
1187         #create the marc entry, that stores the rax marc record in Koha 3.0
1188         $oldbiblio->{marc} = $record->as_usmarc();
1189         $oldbiblio->{marcxml} = $record->as_xml();
1190
1191         OLDmodbiblio($dbh,$oldbiblio);
1192         OLDmodbibitem($dbh,$oldbiblio);
1193         # now, modify addi authors, subject, addititles.
1194         my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author",$frameworkcode);
1195         my @addiauthfields = $record->field($tagfield);
1196         foreach my $addiauthfield (@addiauthfields) {
1197                 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
1198                 foreach my $subfieldcount (0..$#addiauthsubfields) {
1199                         OLDmodaddauthor($dbh,$biblionumber,$addiauthsubfields[$subfieldcount]);
1200                 }
1201         }
1202         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle",$frameworkcode);
1203         my @subtitlefields = $record->field($tagfield);
1204         foreach my $subtitlefield (@subtitlefields) {
1205                 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
1206                 # delete & create subtitle again because OLDmodsubtitle can't handle new subtitles
1207                 # between 2 modifs
1208                 $dbh->do("delete from bibliosubtitle where biblionumber=$biblionumber");
1209                 foreach my $subfieldcount (0..$#subtitlesubfields) {
1210                         foreach my $subtit(split /\||#/,$subtitlesubfields[$subfieldcount]) {
1211                                 OLDnewsubtitle($dbh,$biblionumber,$subtit);
1212                         }
1213                 }
1214         }
1215         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject",$frameworkcode);
1216         my @subj = $record->field($tagfield);
1217         my @subjects;
1218         foreach my $subject (@subj) {
1219                 my @subjsubfield = $subject->subfield($tagsubfield);
1220                 foreach my $subfieldcount (0..$#subjsubfield) {
1221                         push @subjects,$subjsubfield[$subfieldcount];
1222                 }
1223         }
1224         OLDmodsubject($dbh,$biblionumber,1,@subjects);
1225         return 1;
1226 }
1227
1228 sub NEWdelbiblio {
1229     my ( $dbh, $bibid ) = @_;
1230     my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
1231     &OLDdelbiblio( $dbh, $biblio );
1232     my $sth =
1233       $dbh->prepare(
1234         "select biblioitemnumber from biblioitems where biblionumber=?");
1235     $sth->execute($biblio);
1236     while ( my ($biblioitemnumber) = $sth->fetchrow ) {
1237         OLDdeletebiblioitem( $dbh, $biblioitemnumber );
1238     }
1239     &MARCdelbiblio( $dbh, $bibid, 0 );
1240 }
1241
1242 sub NEWnewitem {
1243     my ( $dbh, $record, $biblionumber, $biblioitemnumber ) = @_;
1244
1245     # add item in old-DB
1246         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
1247     my $item = &MARCmarc2koha( $dbh, $record,$frameworkcode );
1248     # needs old biblionumber and biblioitemnumber
1249     $item->{'biblionumber'} = $biblionumber;
1250     $item->{'biblioitemnumber'}=$biblioitemnumber;
1251         $item->{marc} = $record->as_usmarc();
1252     my ( $itemnumber, $error ) = &OLDnewitems( $dbh, $item, $item->{barcode} );
1253         return $itemnumber;
1254 }
1255
1256 sub NEWmoditem {
1257     my ( $dbh, $record, $biblionumber, $biblioitemnumber, $itemnumber, $delete ) = @_;
1258
1259 #       &MARCmoditem( $dbh, $record, $bibid, $itemnumber, $delete );
1260         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
1261     my $olditem = MARCmarc2koha( $dbh, $record,$frameworkcode );
1262         # add MARC record
1263         $olditem->{marc} = $record->as_usmarc();
1264         $olditem->{biblionumber} = $biblionumber;
1265         $olditem->{biblioitemnumber} = $biblioitemnumber;
1266         # and modify item
1267     OLDmoditem( $dbh, $olditem );
1268 }
1269
1270 sub NEWdelitem {
1271     my ( $dbh, $bibid, $itemnumber ) = @_;
1272     my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
1273     &OLDdelitem( $dbh, $itemnumber );
1274     &MARCdelitem( $dbh, $bibid, $itemnumber );
1275 }
1276
1277 #
1278 #
1279 # OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD
1280 #
1281 #
1282
1283 =item $biblionumber = OLDnewbiblio($dbh,$biblio);
1284
1285 adds a record in biblio table. Datas are in the hash $biblio.
1286
1287 =item $biblionumber = OLDmodbiblio($dbh,$biblio);
1288
1289 modify a record in biblio table. Datas are in the hash $biblio.
1290
1291 =item OLDmodsubtitle($dbh,$bibnum,$subtitle);
1292
1293 modify subtitles in bibliosubtitle table.
1294
1295 =item OLDmodaddauthor($dbh,$bibnum,$author);
1296
1297 adds or modify additional authors
1298 NOTE :  Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
1299
1300 =item $errors = OLDmodsubject($dbh,$bibnum, $force, @subject);
1301
1302 modify/adds subjects
1303
1304 =item OLDmodbibitem($dbh, $biblioitem);
1305
1306 modify a biblioitem
1307
1308 =item OLDmodnote($dbh,$bibitemnum,$note
1309
1310 modify a note for a biblioitem
1311
1312 =item OLDnewbiblioitem($dbh,$biblioitem);
1313
1314 adds a biblioitem ($biblioitem is a hash with the values)
1315
1316 =item OLDnewsubject($dbh,$bibnum);
1317
1318 adds a subject
1319
1320 =item OLDnewsubtitle($dbh,$bibnum,$subtitle);
1321
1322 create a new subtitle
1323
1324 =item ($itemnumber,$errors)= OLDnewitems($dbh,$item,$barcode);
1325
1326 create a item. $item is a hash and $barcode the barcode.
1327
1328 =item OLDmoditem($dbh,$item);
1329
1330 modify item
1331
1332 =item OLDdelitem($dbh,$itemnum);
1333
1334 delete item
1335
1336 =item OLDdeletebiblioitem($dbh,$biblioitemnumber);
1337
1338 deletes a biblioitem
1339 NOTE : not standard sub name. Should be OLDdelbiblioitem()
1340
1341 =item OLDdelbiblio($dbh,$biblio);
1342
1343 delete a biblio
1344
1345 =cut
1346
1347 sub OLDnewbiblio {
1348     my ( $dbh, $biblio ) = @_;
1349
1350         $dbh->do('lock tables biblio WRITE');
1351     my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
1352     $sth->execute;
1353     my $data   = $sth->fetchrow_arrayref;
1354     my $bibnum = $$data[0] + 1;
1355     my $series = 0;
1356
1357     if ( $biblio->{'seriestitle'} ) { $series = 1 }
1358     $sth->finish;
1359     $sth =
1360       $dbh->prepare("insert into biblio set     biblionumber=?, title=?,                author=?,       copyrightdate=?,
1361                                                                                         serial=?,               seriestitle=?,  notes=?,        abstract=?,
1362                                                                                         unititle=?"
1363     );
1364     $sth->execute(
1365         $bibnum,             $biblio->{'title'},
1366         $biblio->{'author'}, $biblio->{'copyrightdate'},
1367         $biblio->{'serial'},             $biblio->{'seriestitle'},
1368         $biblio->{'notes'},  $biblio->{'abstract'},
1369                 $biblio->{'unititle'}
1370     );
1371
1372     $sth->finish;
1373         $dbh->do('unlock tables');
1374     return ($bibnum);
1375 }
1376
1377 sub OLDmodbiblio {
1378     my ( $dbh, $biblio ) = @_;
1379     my $sth = $dbh->prepare("Update biblio set  title=?,                author=?,       abstract=?,     copyrightdate=?,
1380                                                                                                 seriestitle=?,  serial=?,       unititle=?,     notes=?,        frameworkcode=?
1381                                                                                         where biblionumber = ?"
1382     );
1383     $sth->execute(
1384                 $biblio->{'title'},       $biblio->{'author'},
1385                 $biblio->{'abstract'},    $biblio->{'copyrightdate'},
1386                 $biblio->{'seriestitle'}, $biblio->{'serial'},
1387                 $biblio->{'unititle'},    $biblio->{'notes'},
1388                 $biblio->{frameworkcode},
1389                 $biblio->{'biblionumber'}
1390     );
1391         $sth->finish;
1392         return ( $biblio->{'biblionumber'} );
1393 }    # sub modbiblio
1394
1395 sub OLDmodsubtitle {
1396     my ( $dbh, $bibnum, $subtitle ) = @_;
1397     my $sth =
1398       $dbh->prepare(
1399         "update bibliosubtitle set subtitle = ? where biblionumber = ?");
1400     $sth->execute( $subtitle, $bibnum );
1401     $sth->finish;
1402 }    # sub modsubtitle
1403
1404 sub OLDmodaddauthor {
1405     my ( $dbh, $bibnum, @authors ) = @_;
1406
1407     #    my $dbh   = C4Connect;
1408     my $sth =
1409       $dbh->prepare("Delete from additionalauthors where biblionumber = ?");
1410
1411     $sth->execute($bibnum);
1412     $sth->finish;
1413     foreach my $author (@authors) {
1414         if ( $author ne '' ) {
1415             $sth =
1416               $dbh->prepare(
1417                 "Insert into additionalauthors set author = ?, biblionumber = ?"
1418             );
1419
1420             $sth->execute( $author, $bibnum );
1421
1422             $sth->finish;
1423         }    # if
1424     }
1425 }    # sub modaddauthor
1426
1427 sub OLDmodsubject {
1428     my ( $dbh, $bibnum, $force, @subject ) = @_;
1429
1430     #  my $dbh   = C4Connect;
1431     my $count = @subject;
1432     my $error;
1433     for ( my $i = 0 ; $i < $count ; $i++ ) {
1434         $subject[$i] =~ s/^ //g;
1435         $subject[$i] =~ s/ $//g;
1436         my $sth =
1437           $dbh->prepare(
1438 "select * from catalogueentry where entrytype = 's' and catalogueentry = ?"
1439         );
1440         $sth->execute( $subject[$i] );
1441
1442         if ( my $data = $sth->fetchrow_hashref ) {
1443         }
1444         else {
1445             if ( $force eq $subject[$i] || $force == 1 ) {
1446
1447                 # subject not in aut, chosen to force anway
1448                 # so insert into cataloguentry so its in auth file
1449                 my $sth2 =
1450                   $dbh->prepare(
1451 "Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)"
1452                 );
1453
1454                 $sth2->execute( $subject[$i] ) if ( $subject[$i] );
1455                 $sth2->finish;
1456             }
1457             else {
1458                 $error =
1459                   "$subject[$i]\n does not exist in the subject authority file";
1460                 my $sth2 =
1461                   $dbh->prepare(
1462 "Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)"
1463                 );
1464                 $sth2->execute( "$subject[$i] %", "% $subject[$i] %",
1465                     "% $subject[$i]" );
1466                 while ( my $data = $sth2->fetchrow_hashref ) {
1467                     $error .= "<br>$data->{'catalogueentry'}";
1468                 }    # while
1469                 $sth2->finish;
1470             }    # else
1471         }    # else
1472         $sth->finish;
1473     }    # else
1474     if ( $error eq '' ) {
1475         my $sth =
1476           $dbh->prepare("Delete from bibliosubject where biblionumber = ?");
1477         $sth->execute($bibnum);
1478         $sth->finish;
1479         $sth =
1480           $dbh->prepare(
1481             "Insert into bibliosubject (subject,biblionumber) values (?,?)");
1482         my $query;
1483         foreach $query (@subject) {
1484             $sth->execute( $query, $bibnum ) if ( $query && $bibnum );
1485         }    # foreach
1486         $sth->finish;
1487     }    # if
1488
1489     #  $dbh->disconnect;
1490     return ($error);
1491 }    # sub modsubject
1492
1493 sub OLDmodbibitem {
1494     my ( $dbh, $biblioitem ) = @_;
1495     my $query;
1496
1497     my $sth = $dbh->prepare("update biblioitems set     itemtype=?,                     url=?,                          isbn=?, issn=?,
1498                                                                                 publishercode=?,        publicationyear=?,      classification=?,       dewey=?,
1499                                                                                 subclass=?,                     illus=?,                        pages=?,                        volumeddesc=?,
1500                                                                                 notes=?,                        size=?,                         place=?,                        marc=?,
1501                                                                                 marcxml=?
1502                                                         where biblioitemnumber=?");
1503         $sth->execute(  $biblioitem->{itemtype},                $biblioitem->{url},             $biblioitem->{isbn},    $biblioitem->{issn},
1504                                 $biblioitem->{publishercode},   $biblioitem->{publicationyear}, $biblioitem->{classification},  $biblioitem->{dewey},
1505                                 $biblioitem->{subclass},                $biblioitem->{illus},           $biblioitem->{pages},   $biblioitem->{volumeddesc},
1506                                 $biblioitem->{bnotes},                  $biblioitem->{size},            $biblioitem->{place},   $biblioitem->{marc},
1507                                         $biblioitem->{marcxml},                 $biblioitem->{biblioitemnumber});
1508 #       warn "MOD : $biblioitem->{biblioitemnumber} = ".$biblioitem->{marc};
1509 }    # sub modbibitem
1510
1511 sub OLDmodnote {
1512     my ( $dbh, $bibitemnum, $note ) = @_;
1513
1514     #  my $dbh=C4Connect;
1515     my $query = "update biblioitems set notes='$note' where
1516   biblioitemnumber='$bibitemnum'";
1517     my $sth = $dbh->prepare($query);
1518     $sth->execute;
1519     $sth->finish;
1520
1521     #  $dbh->disconnect;
1522 }
1523
1524 sub OLDnewbiblioitem {
1525         my ( $dbh, $biblioitem ) = @_;
1526
1527         $dbh->do("lock tables biblioitems WRITE, biblio WRITE");
1528         my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems");
1529         my $data;
1530         my $biblioitemnumber;
1531
1532         $sth->execute;
1533         $data       = $sth->fetchrow_arrayref;
1534         $biblioitemnumber = $$data[0] + 1;
1535
1536         # Insert biblioitemnumber in MARC record, we need it to manage items later...
1537         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblioitem->{biblionumber});
1538         my ($biblioitemnumberfield,$biblioitemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'biblioitems.biblioitemnumber',$frameworkcode);
1539         my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1540         my $field=$record->field($biblioitemnumberfield);
1541         $field->update($biblioitemnumbersubfield => "$biblioitemnumber");
1542         $biblioitem->{marc} = $record->as_usmarc();
1543         $biblioitem->{marcxml} = $record->as_xml();
1544
1545         $sth = $dbh->prepare( "insert into biblioitems set
1546                                                                         biblioitemnumber = ?,           biblionumber     = ?,
1547                                                                         volume           = ?,                   number           = ?,
1548                                                                         classification  = ?,                    itemtype         = ?,
1549                                                                         url              = ?,                           isbn             = ?,
1550                                                                         issn             = ?,                           dewey            = ?,
1551                                                                         subclass         = ?,                           publicationyear  = ?,
1552                                                                         publishercode    = ?,           volumedate       = ?,
1553                                                                         volumeddesc      = ?,           illus            = ?,
1554                                                                         pages            = ?,                           notes            = ?,
1555                                                                         size             = ?,                           lccn             = ?,
1556                                                                         marc             = ?,                           place            = ?,
1557                                                                         marcxml          = ?"
1558         );
1559         $sth->execute(
1560                 $biblioitemnumber,               $biblioitem->{'biblionumber'},
1561                 $biblioitem->{'volume'},         $biblioitem->{'number'},
1562                 $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
1563                 $biblioitem->{'url'},            $biblioitem->{'isbn'},
1564                 $biblioitem->{'issn'},           $biblioitem->{'dewey'},
1565                 $biblioitem->{'subclass'},       $biblioitem->{'publicationyear'},
1566                 $biblioitem->{'publishercode'},  $biblioitem->{'volumedate'},
1567                 $biblioitem->{'volumeddesc'},    $biblioitem->{'illus'},
1568                 $biblioitem->{'pages'},          $biblioitem->{'bnotes'},
1569                 $biblioitem->{'size'},           $biblioitem->{'lccn'},
1570                 $biblioitem->{'marc'},           $biblioitem->{'place'},
1571                 $biblioitem->{marcxml},
1572         );
1573         $dbh->do("unlock tables");
1574         return ($biblioitemnumber);
1575 }
1576
1577 sub OLDnewsubject {
1578     my ( $dbh, $bibnum ) = @_;
1579     my $sth =
1580       $dbh->prepare("insert into bibliosubject (biblionumber) values (?)");
1581     $sth->execute($bibnum);
1582     $sth->finish;
1583 }
1584
1585 sub OLDnewsubtitle {
1586     my ( $dbh, $bibnum, $subtitle ) = @_;
1587     my $sth =
1588       $dbh->prepare(
1589         "insert into bibliosubtitle set biblionumber = ?, subtitle = ?");
1590     $sth->execute( $bibnum, $subtitle ) if $subtitle;
1591     $sth->finish;
1592 }
1593
1594 sub OLDnewitems {
1595     my ( $dbh, $item, $barcode ) = @_;
1596
1597 #       warn "OLDNEWITEMS";
1598
1599         $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE');
1600     my $sth = $dbh->prepare("Select max(itemnumber) from items");
1601     my $data;
1602     my $itemnumber;
1603     my $error = "";
1604     $sth->execute;
1605     $data       = $sth->fetchrow_hashref;
1606     $itemnumber = $data->{'max(itemnumber)'} + 1;
1607
1608 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
1609     if ( $item->{'loan'} ) {
1610         $item->{'notforloan'} = $item->{'loan'};
1611     }
1612
1613     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1614     if ( $item->{'dateaccessioned'} ) {
1615         $sth = $dbh->prepare( "Insert into items set
1616                                                         itemnumber           = ?,                       biblionumber         = ?,
1617                                                         multivolumepart      = ?,
1618                                                         biblioitemnumber     = ?,                       barcode              = ?,
1619                                                         booksellerid         = ?,                       dateaccessioned      = ?,
1620                                                         homebranch           = ?,                       holdingbranch        = ?,
1621                                                         price                = ?,                       replacementprice     = ?,
1622                                                         replacementpricedate = NOW(),           datelastseen            = NOW(),
1623                                                         multivolume                     = ?,                    stack                           = ?,
1624                                                         itemlost                        = ?,                    wthdrawn                        = ?,
1625                                                         paidfor                         = ?,                    itemnotes            = ?,
1626                                                         itemcallnumber  =?,                                                     notforloan = ?,
1627                                                         location = ?
1628                                                         "
1629         );
1630         $sth->execute(
1631                         $itemnumber,                            $item->{'biblionumber'},
1632                         $item->{'multivolumepart'},
1633                         $item->{'biblioitemnumber'},$barcode,
1634                         $item->{'booksellerid'},        $item->{'dateaccessioned'},
1635                         $item->{'homebranch'},          $item->{'holdingbranch'},
1636                         $item->{'price'},                       $item->{'replacementprice'},
1637                         $item->{multivolume},           $item->{stack},
1638                         $item->{itemlost},                      $item->{wthdrawn},
1639                         $item->{paidfor},                       $item->{'itemnotes'},
1640                         $item->{'itemcallnumber'},      $item->{'notforloan'},
1641                         $item->{'location'}
1642         );
1643                 if ( defined $sth->errstr ) {
1644                         $error .= $sth->errstr;
1645                 }
1646     }
1647     else {
1648         $sth = $dbh->prepare( "Insert into items set
1649                                                         itemnumber           = ?,                       biblionumber         = ?,
1650                                                         multivolumepart      = ?,
1651                                                         biblioitemnumber     = ?,                       barcode              = ?,
1652                                                         booksellerid         = ?,                       dateaccessioned      = NOW(),
1653                                                         homebranch           = ?,                       holdingbranch        = ?,
1654                                                         price                = ?,                       replacementprice     = ?,
1655                                                         replacementpricedate = NOW(),           datelastseen            = NOW(),
1656                                                         multivolume                     = ?,                    stack                           = ?,
1657                                                         itemlost                        = ?,                    wthdrawn                        = ?,
1658                                                         paidfor                         = ?,                    itemnotes            = ?,
1659                                                         itemcallnumber  =?,                                                     notforloan = ?,
1660                                                         location = ?
1661                                                         "
1662         );
1663         $sth->execute(
1664                         $itemnumber,                            $item->{'biblionumber'},
1665                         $item->{'multivolumepart'},
1666                         $item->{'biblioitemnumber'},$barcode,
1667                         $item->{'booksellerid'},
1668                         $item->{'homebranch'},          $item->{'holdingbranch'},
1669                         $item->{'price'},                       $item->{'replacementprice'},
1670                         $item->{multivolume},           $item->{stack},
1671                         $item->{itemlost},                      $item->{wthdrawn},
1672                         $item->{paidfor},                       $item->{'itemnotes'},
1673                         $item->{'itemcallnumber'},      $item->{'notforloan'},
1674                         $item->{'location'}
1675         );
1676                 if ( defined $sth->errstr ) {
1677                         $error .= $sth->errstr;
1678                 }
1679     }
1680         # item stored, now, deal with the marc part...
1681         $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1682                                                         where   biblio.biblionumber=biblioitems.biblionumber and
1683                                                                         biblio.biblionumber=?");
1684         $sth->execute($item->{biblionumber});
1685     if ( defined $sth->errstr ) {
1686         $error .= $sth->errstr;
1687     }
1688         my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1689         warn "ERROR IN OLDnewitem, MARC record not found FOR $item->{biblionumber} => $rawmarc <=" unless $rawmarc;
1690         my $record = MARC::File::USMARC::decode($rawmarc);
1691         # ok, we have the marc record, add item number to the item field (in {marc}, and add the field to the record)
1692         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1693         my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1694         my $itemfield = $itemrecord->field($itemnumberfield);
1695         $itemfield->add_subfields($itemnumbersubfield => "$itemnumber");
1696         $record->insert_grouped_field($itemfield);
1697         # save the record into biblioitem
1698         $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=?");
1699         $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber});
1700     if ( defined $sth->errstr ) {
1701         $error .= $sth->errstr;
1702     }
1703         $dbh->do('unlock tables');
1704     return ( $itemnumber, $error );
1705 }
1706
1707 sub OLDmoditem {
1708     my ( $dbh, $item ) = @_;
1709         my $error;
1710         $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE');
1711     $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
1712     my $query = "update items set  barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1713     my @bind = (
1714         $item->{'barcode'},                     $item->{'notes'},
1715         $item->{'itemcallnumber'},      $item->{'notforloan'},
1716         $item->{'location'},            $item->{multivolumepart},
1717                 $item->{multivolume},           $item->{stack},
1718                 $item->{wthdrawn},
1719     );
1720     if ( $item->{'lost'} ne '' ) {
1721         $query = "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
1722                                                         itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
1723                                                         location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1724         @bind = (
1725             $item->{'bibitemnum'},     $item->{'barcode'},
1726             $item->{'notes'},          $item->{'homebranch'},
1727             $item->{'lost'},           $item->{'wthdrawn'},
1728             $item->{'itemcallnumber'}, $item->{'notforloan'},
1729             $item->{'location'},                $item->{multivolumepart},
1730                         $item->{multivolume},           $item->{stack},
1731                         $item->{wthdrawn},
1732         );
1733                 if ($item->{homebranch}) {
1734                         $query.=",homebranch=?";
1735                         push @bind, $item->{homebranch};
1736                 }
1737                 if ($item->{holdingbranch}) {
1738                         $query.=",holdingbranch=?";
1739                         push @bind, $item->{holdingbranch};
1740                 }
1741     }
1742         $query.=" where itemnumber=?";
1743         push @bind,$item->{'itemnum'};
1744    if ( $item->{'replacement'} ne '' ) {
1745         $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1746     }
1747     my $sth = $dbh->prepare($query);
1748     $sth->execute(@bind);
1749
1750         # item stored, now, deal with the marc part...
1751         $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1752                                                         where   biblio.biblionumber=biblioitems.biblionumber and
1753                                                                         biblio.biblionumber=? and
1754                                                                         biblioitems.biblioitemnumber=?");
1755         $sth->execute($item->{biblionumber},$item->{biblioitemnumber});
1756     if ( defined $sth->errstr ) {
1757         $error .= $sth->errstr;
1758     }
1759         my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1760         warn "ERROR IN OLDmoditem, MARC record not found" unless $rawmarc;
1761         my $record = MARC::File::USMARC::decode($rawmarc);
1762         # ok, we have the marc record, find the previous item record for this itemnumber and delete it
1763         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1764         # prepare the new item record
1765         my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1766         my $itemfield = $itemrecord->field($itemnumberfield);
1767         $itemfield->add_subfields($itemnumbersubfield => '$itemnumber');
1768         # parse all fields fields from the complete record
1769         foreach ($record->field($itemnumberfield)) {
1770                 # when the previous field is found, replace by the new one
1771                 if ($_->subfield($itemnumbersubfield) == $item->{itemnum}) {
1772                         $_->replace_with($itemfield);
1773                 }
1774         }
1775 #       $record->insert_grouped_field($itemfield);
1776         # save the record into biblioitem
1777         $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=? and biblioitemnumber=?");
1778         $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber},$item->{biblioitemnumber});
1779     if ( defined $sth->errstr ) {
1780         $error .= $sth->errstr;
1781     }
1782         $dbh->do('unlock tables');
1783
1784     #  $dbh->disconnect;
1785 }
1786
1787 sub OLDdelitem {
1788     my ( $dbh, $itemnum ) = @_;
1789
1790     #  my $dbh=C4Connect;
1791     my $sth = $dbh->prepare("select * from items where itemnumber=?");
1792     $sth->execute($itemnum);
1793     my $data = $sth->fetchrow_hashref;
1794     $sth->finish;
1795     my $query = "Insert into deleteditems set ";
1796     my @bind  = ();
1797     foreach my $temp ( keys %$data ) {
1798         $query .= "$temp = ?,";
1799         push ( @bind, $data->{$temp} );
1800     }
1801     $query =~ s/\,$//;
1802
1803     #  print $query;
1804     $sth = $dbh->prepare($query);
1805     $sth->execute(@bind);
1806     $sth->finish;
1807     $sth = $dbh->prepare("Delete from items where itemnumber=?");
1808     $sth->execute($itemnum);
1809     $sth->finish;
1810
1811     #  $dbh->disconnect;
1812 }
1813
1814 sub OLDdeletebiblioitem {
1815     my ( $dbh, $biblioitemnumber ) = @_;
1816
1817     #    my $dbh   = C4Connect;
1818     my $sth = $dbh->prepare( "Select * from biblioitems
1819 where biblioitemnumber = ?"
1820     );
1821     my $results;
1822
1823     $sth->execute($biblioitemnumber);
1824
1825     if ( $results = $sth->fetchrow_hashref ) {
1826         $sth->finish;
1827         $sth =
1828           $dbh->prepare(
1829 "Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
1830                                         isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
1831                                         pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
1832         );
1833
1834         $sth->execute(
1835             $results->{biblioitemnumber}, $results->{biblionumber},
1836             $results->{volume},           $results->{number},
1837             $results->{classification},   $results->{itemtype},
1838             $results->{isbn},             $results->{issn},
1839             $results->{dewey},            $results->{subclass},
1840             $results->{publicationyear},  $results->{publishercode},
1841             $results->{volumedate},       $results->{volumeddesc},
1842             $results->{timestamp},        $results->{illus},
1843             $results->{pages},            $results->{notes},
1844             $results->{size},             $results->{url},
1845             $results->{lccn}
1846         );
1847         my $sth2 =
1848           $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?");
1849         $sth2->execute($biblioitemnumber);
1850         $sth2->finish();
1851     }    # if
1852     $sth->finish;
1853
1854     # Now delete all the items attached to the biblioitem
1855     $sth = $dbh->prepare("Select * from items where biblioitemnumber = ?");
1856     $sth->execute($biblioitemnumber);
1857     my @results;
1858     while ( my $data = $sth->fetchrow_hashref ) {
1859         my $query = "Insert into deleteditems set ";
1860         my @bind  = ();
1861         foreach my $temp ( keys %$data ) {
1862             $query .= "$temp = ?,";
1863             push ( @bind, $data->{$temp} );
1864         }
1865         $query =~ s/\,$//;
1866         my $sth2 = $dbh->prepare($query);
1867         $sth2->execute(@bind);
1868     }    # while
1869     $sth->finish;
1870     $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
1871     $sth->execute($biblioitemnumber);
1872     $sth->finish();
1873
1874     #    $dbh->disconnect;
1875 }    # sub deletebiblioitem
1876
1877 sub OLDdelbiblio {
1878     my ( $dbh, $biblio ) = @_;
1879     my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
1880     $sth->execute($biblio);
1881     if ( my $data = $sth->fetchrow_hashref ) {
1882         $sth->finish;
1883         my $query = "Insert into deletedbiblio set ";
1884         my @bind  = ();
1885         foreach my $temp ( keys %$data ) {
1886             $query .= "$temp = ?,";
1887             push ( @bind, $data->{$temp} );
1888         }
1889
1890         #replacing the last , by ",?)"
1891         $query =~ s/\,$//;
1892         $sth = $dbh->prepare($query);
1893         $sth->execute(@bind);
1894         $sth->finish;
1895         $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
1896         $sth->execute($biblio);
1897         $sth->finish;
1898     }
1899     $sth->finish;
1900 }
1901
1902 #
1903 #
1904 # old functions
1905 #
1906 #
1907
1908 sub itemcount {
1909     my ($biblio) = @_;
1910     my $dbh = C4::Context->dbh;
1911
1912     #  print $query;
1913     my $sth = $dbh->prepare("Select count(*) from items where biblionumber=?");
1914     $sth->execute($biblio);
1915     my $data = $sth->fetchrow_hashref;
1916     $sth->finish;
1917     return ( $data->{'count(*)'} );
1918 }
1919
1920 sub newbiblio {
1921     my ($biblio) = @_;
1922     my $dbh    = C4::Context->dbh;
1923     my $bibnum = OLDnewbiblio( $dbh, $biblio );
1924     # finds new (MARC bibid
1925     #   my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1926     my $record = &MARCkoha2marcBiblio( $dbh, $bibnum );
1927     MARCaddbiblio( $dbh, $record, $bibnum,'' );
1928     return ($bibnum);
1929 }
1930
1931 =item modbiblio
1932
1933   $biblionumber = &modbiblio($biblio);
1934
1935 Update a biblio record.
1936
1937 C<$biblio> is a reference-to-hash whose keys are the fields in the
1938 biblio table in the Koha database. All fields must be present, not
1939 just the ones you wish to change.
1940
1941 C<&modbiblio> updates the record defined by
1942 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1943
1944 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1945 successful or not.
1946
1947 =cut
1948
1949 sub modbiblio {
1950         my ($biblio) = @_;
1951         my $dbh  = C4::Context->dbh;
1952         my $biblionumber=OLDmodbiblio($dbh,$biblio);
1953         my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
1954         # finds new (MARC bibid
1955         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
1956         MARCmodbiblio($dbh,$bibid,$record,"",0);
1957         return($biblionumber);
1958 } # sub modbiblio
1959
1960 =item modsubtitle
1961
1962   &modsubtitle($biblionumber, $subtitle);
1963
1964 Sets the subtitle of a book.
1965
1966 C<$biblionumber> is the biblionumber of the book to modify.
1967
1968 C<$subtitle> is the new subtitle.
1969
1970 =cut
1971
1972 sub modsubtitle {
1973     my ( $bibnum, $subtitle ) = @_;
1974     my $dbh = C4::Context->dbh;
1975     &OLDmodsubtitle( $dbh, $bibnum, $subtitle );
1976 }    # sub modsubtitle
1977
1978 =item modaddauthor
1979
1980   &modaddauthor($biblionumber, $author);
1981
1982 Replaces all additional authors for the book with biblio number
1983 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1984 C<&modaddauthor> deletes all additional authors.
1985
1986 =cut
1987
1988 sub modaddauthor {
1989     my ( $bibnum, @authors ) = @_;
1990     my $dbh = C4::Context->dbh;
1991     &OLDmodaddauthor( $dbh, $bibnum, @authors );
1992 }    # sub modaddauthor
1993
1994 =item modsubject
1995
1996   $error = &modsubject($biblionumber, $force, @subjects);
1997
1998 $force - a subject to force
1999
2000 $error - Error message, or undef if successful.
2001
2002 =cut
2003
2004 sub modsubject {
2005     my ( $bibnum, $force, @subject ) = @_;
2006     my $dbh = C4::Context->dbh;
2007     my $error = &OLDmodsubject( $dbh, $bibnum, $force, @subject );
2008     if ($error eq ''){
2009                 # When MARC is off, ensures that the MARC biblio table gets updated with new
2010                 # subjects, of course, it deletes the biblio in marc, and then recreates.
2011                 # This check is to ensure that no MARC data exists to lose.
2012                 if (C4::Context->preference("MARC") eq '0'){
2013                         my $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibnum);
2014                         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
2015                         &MARCmodbiblio($dbh,$bibid, $MARCRecord);
2016                 }
2017         }
2018         return ($error);
2019 }    # sub modsubject
2020
2021 sub modbibitem {
2022     my ($biblioitem) = @_;
2023     my $dbh = C4::Context->dbh;
2024     &OLDmodbibitem( $dbh, $biblioitem );
2025 }    # sub modbibitem
2026
2027 sub modnote {
2028     my ( $bibitemnum, $note ) = @_;
2029     my $dbh = C4::Context->dbh;
2030     &OLDmodnote( $dbh, $bibitemnum, $note );
2031 }
2032
2033 sub newbiblioitem {
2034     my ($biblioitem) = @_;
2035     my $dbh        = C4::Context->dbh;
2036     my $bibitemnum = &OLDnewbiblioitem( $dbh, $biblioitem );
2037
2038     my $MARCbiblio =
2039       MARCkoha2marcBiblio( $dbh, 0, $bibitemnum )
2040       ; # the 0 means "do NOT retrieve biblio, only biblioitem, in the MARC record
2041     my $bibid =
2042       &MARCfind_MARCbibid_from_oldbiblionumber( $dbh,
2043         $biblioitem->{biblionumber} );
2044     &MARCaddbiblio( $dbh, $MARCbiblio, $biblioitem->{biblionumber}, '',$bibid );
2045     return ($bibitemnum);
2046 }
2047
2048 sub newsubject {
2049     my ($bibnum) = @_;
2050     my $dbh = C4::Context->dbh;
2051     &OLDnewsubject( $dbh, $bibnum );
2052 }
2053
2054 sub newsubtitle {
2055     my ( $bibnum, $subtitle ) = @_;
2056     my $dbh = C4::Context->dbh;
2057     &OLDnewsubtitle( $dbh, $bibnum, $subtitle );
2058 }
2059
2060 sub newitems {
2061     my ( $item, @barcodes ) = @_;
2062     my $dbh = C4::Context->dbh;
2063     my $errors;
2064     my $itemnumber;
2065     my $error;
2066     foreach my $barcode (@barcodes) {
2067         ( $itemnumber, $error ) = &OLDnewitems( $dbh, $item, uc($barcode) );
2068         $errors .= $error;
2069         my $MARCitem =
2070           &MARCkoha2marcItem( $dbh, $item->{biblionumber}, $itemnumber );
2071         &MARCadditem( $dbh, $MARCitem, $item->{biblionumber} );
2072     }
2073     return ($errors);
2074 }
2075
2076 sub moditem {
2077     my ($item) = @_;
2078     my $dbh = C4::Context->dbh;
2079     &OLDmoditem( $dbh, $item );
2080     my $MARCitem =
2081       &MARCkoha2marcItem( $dbh, $item->{'biblionumber'}, $item->{'itemnum'} );
2082     my $bibid =
2083       &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $item->{biblionumber} );
2084     &MARCmoditem( $dbh, $MARCitem, $bibid, $item->{itemnum}, 0 );
2085 }
2086
2087 sub checkitems {
2088     my ( $count, @barcodes ) = @_;
2089     my $dbh = C4::Context->dbh;
2090     my $error;
2091     my $sth = $dbh->prepare("Select * from items where barcode=?");
2092     for ( my $i = 0 ; $i < $count ; $i++ ) {
2093         $barcodes[$i] = uc $barcodes[$i];
2094         $sth->execute( $barcodes[$i] );
2095         if ( my $data = $sth->fetchrow_hashref ) {
2096             $error .= " Duplicate Barcode: $barcodes[$i]";
2097         }
2098     }
2099     $sth->finish;
2100     return ($error);
2101 }
2102
2103 sub countitems {
2104     my ($bibitemnum) = @_;
2105     my $dbh   = C4::Context->dbh;
2106     my $query = "";
2107     my $sth   =
2108       $dbh->prepare("Select count(*) from items where biblioitemnumber=?");
2109     $sth->execute($bibitemnum);
2110     my $data = $sth->fetchrow_hashref;
2111     $sth->finish;
2112     return ( $data->{'count(*)'} );
2113 }
2114
2115 sub delitem {
2116     my ($itemnum) = @_;
2117     my $dbh = C4::Context->dbh;
2118     &OLDdelitem( $dbh, $itemnum );
2119 }
2120
2121 sub deletebiblioitem {
2122     my ($biblioitemnumber) = @_;
2123     my $dbh = C4::Context->dbh;
2124     &OLDdeletebiblioitem( $dbh, $biblioitemnumber );
2125 }    # sub deletebiblioitem
2126
2127 sub delbiblio {
2128     my ($biblio) = @_;
2129     my $dbh = C4::Context->dbh;
2130     &OLDdelbiblio( $dbh, $biblio );
2131     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio );
2132     &MARCdelbiblio( $dbh, $bibid, 0 );
2133 }
2134
2135 sub getbiblio {
2136     my ($biblionumber) = @_;
2137     my $dbh = C4::Context->dbh;
2138     my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
2139
2140     # || die "Cannot prepare $query\n" . $dbh->errstr;
2141     my $count = 0;
2142     my @results;
2143
2144     $sth->execute($biblionumber);
2145
2146     # || die "Cannot execute $query\n" . $sth->errstr;
2147     while ( my $data = $sth->fetchrow_hashref ) {
2148         $results[$count] = $data;
2149         $count++;
2150     }    # while
2151
2152     $sth->finish;
2153     return ( $count, @results );
2154 }    # sub getbiblio
2155
2156 sub getbiblioitem {
2157     my ($biblioitemnum) = @_;
2158     my $dbh = C4::Context->dbh;
2159     my $sth = $dbh->prepare( "Select * from biblioitems where
2160 biblioitemnumber = ?"
2161     );
2162     my $count = 0;
2163     my @results;
2164
2165     $sth->execute($biblioitemnum);
2166
2167     while ( my $data = $sth->fetchrow_hashref ) {
2168         $results[$count] = $data;
2169         $count++;
2170     }    # while
2171
2172     $sth->finish;
2173     return ( $count, @results );
2174 }    # sub getbiblioitem
2175
2176 sub getbiblioitembybiblionumber {
2177     my ($biblionumber) = @_;
2178     my $dbh = C4::Context->dbh;
2179     my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
2180     my $count = 0;
2181     my @results;
2182
2183     $sth->execute($biblionumber);
2184
2185     while ( my $data = $sth->fetchrow_hashref ) {
2186         $results[$count] = $data;
2187         $count++;
2188     }    # while
2189
2190     $sth->finish;
2191     return ( $count, @results );
2192 }    # sub
2193
2194 sub getitemtypes {
2195     my $dbh   = C4::Context->dbh;
2196     my $query = "select * from itemtypes order by description";
2197     my $sth   = $dbh->prepare($query);
2198
2199     # || die "Cannot prepare $query" . $dbh->errstr;
2200     my $count = 0;
2201     my @results;
2202
2203     $sth->execute;
2204
2205     # || die "Cannot execute $query\n" . $sth->errstr;
2206     while ( my $data = $sth->fetchrow_hashref ) {
2207         $results[$count] = $data;
2208         $count++;
2209     }    # while
2210
2211     $sth->finish;
2212     return ( $count, @results );
2213 }    # sub getitemtypes
2214
2215 sub getitemsbybiblioitem {
2216     my ($biblioitemnum) = @_;
2217     my $dbh = C4::Context->dbh;
2218     my $sth = $dbh->prepare( "Select * from items, biblio where
2219 biblio.biblionumber = items.biblionumber and biblioitemnumber
2220 = ?"
2221     );
2222
2223     # || die "Cannot prepare $query\n" . $dbh->errstr;
2224     my $count = 0;
2225     my @results;
2226
2227     $sth->execute($biblioitemnum);
2228
2229     # || die "Cannot execute $query\n" . $sth->errstr;
2230     while ( my $data = $sth->fetchrow_hashref ) {
2231         $results[$count] = $data;
2232         $count++;
2233     }    # while
2234
2235     $sth->finish;
2236     return ( $count, @results );
2237 }    # sub getitemsbybiblioitem
2238
2239 sub logchange {
2240
2241     # Subroutine to log changes to databases
2242 # Eventually, this subroutine will be used to create a log of all changes made,
2243     # with the possibility of "undo"ing some changes
2244     my $database = shift;
2245     if ( $database eq 'kohadb' ) {
2246         my $type     = shift;
2247         my $section  = shift;
2248         my $item     = shift;
2249         my $original = shift;
2250         my $new      = shift;
2251
2252         #       print STDERR "KOHA: $type $section $item $original $new\n";
2253     }
2254     elsif ( $database eq 'marc' ) {
2255         my $type        = shift;
2256         my $Record_ID   = shift;
2257         my $tag         = shift;
2258         my $mark        = shift;
2259         my $subfield_ID = shift;
2260         my $original    = shift;
2261         my $new         = shift;
2262
2263 #       print STDERR "MARC: $type $Record_ID $tag $mark $subfield_ID $original $new\n";
2264     }
2265 }
2266
2267 #------------------------------------------------
2268
2269 #---------------------------------------
2270 # Find a biblio entry, or create a new one if it doesn't exist.
2271 #  If a "subtitle" entry is in hash, add it to subtitle table
2272 sub getoraddbiblio {
2273
2274     # input params
2275     my (
2276         $dbh,       # db handle
2277                     # FIXME - Unused argument
2278         $biblio,    # hash ref to fields
2279     ) = @_;
2280
2281     # return
2282     my $biblionumber;
2283
2284     my $debug = 0;
2285     my $sth;
2286     my $error;
2287
2288     #-----
2289     $dbh = C4::Context->dbh;
2290
2291     print "<PRE>Looking for biblio </PRE>\n" if $debug;
2292     $sth = $dbh->prepare( "select biblionumber
2293                 from biblio
2294                 where title=? and author=?
2295                   and copyrightdate=? and seriestitle=?"
2296     );
2297     $sth->execute(
2298         $biblio->{title},     $biblio->{author},
2299         $biblio->{copyright}, $biblio->{seriestitle}
2300     );
2301     if ( $sth->rows ) {
2302         ($biblionumber) = $sth->fetchrow;
2303         print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
2304     }
2305     else {
2306
2307         # Doesn't exist.  Add new one.
2308         print "<PRE>Adding biblio</PRE>\n" if $debug;
2309         ( $biblionumber, $error ) = &newbiblio($biblio);
2310         if ($biblionumber) {
2311             print "<PRE>Added with biblio number=$biblionumber</PRE>\n"
2312               if $debug;
2313             if ( $biblio->{subtitle} ) {
2314                 &newsubtitle( $biblionumber, $biblio->{subtitle} );
2315             }    # if subtitle
2316         }
2317         else {
2318             print "<PRE>Couldn't add biblio: $error</PRE>\n" if $debug;
2319         }    # if added
2320     }
2321
2322     return $biblionumber, $error;
2323
2324 }    # sub getoraddbiblio
2325
2326 sub char_decode {
2327
2328     # converts ISO 5426 coded string to ISO 8859-1
2329     # sloppy code : should be improved in next issue
2330     my ( $string, $encoding ) = @_;
2331     $_ = $string;
2332
2333     #   $encoding = C4::Context->preference("marcflavour") unless $encoding;
2334     if ( $encoding eq "UNIMARC" ) {
2335 #         s/\xe1/Æ/gm;
2336         s/\xe2/Ð/gm;
2337         s/\xe9/Ø/gm;
2338         s/\xec/þ/gm;
2339         s/\xf1/æ/gm;
2340         s/\xf3/ð/gm;
2341         s/\xf9/ø/gm;
2342         s/\xfb/ß/gm;
2343         s/\xc1\x61/à/gm;
2344         s/\xc1\x65/è/gm;
2345         s/\xc1\x69/ì/gm;
2346         s/\xc1\x6f/ò/gm;
2347         s/\xc1\x75/ù/gm;
2348         s/\xc1\x41/À/gm;
2349         s/\xc1\x45/È/gm;
2350         s/\xc1\x49/Ì/gm;
2351         s/\xc1\x4f/Ò/gm;
2352         s/\xc1\x55/Ù/gm;
2353         s/\xc2\x41/Á/gm;
2354         s/\xc2\x45/É/gm;
2355         s/\xc2\x49/Í/gm;
2356         s/\xc2\x4f/Ó/gm;
2357         s/\xc2\x55/Ú/gm;
2358         s/\xc2\x59/Ý/gm;
2359         s/\xc2\x61/á/gm;
2360         s/\xc2\x65/é/gm;
2361         s/\xc2\x69/í/gm;
2362         s/\xc2\x6f/ó/gm;
2363         s/\xc2\x75/ú/gm;
2364         s/\xc2\x79/ý/gm;
2365         s/\xc3\x41/Â/gm;
2366         s/\xc3\x45/Ê/gm;
2367         s/\xc3\x49/Î/gm;
2368         s/\xc3\x4f/Ô/gm;
2369         s/\xc3\x55/Û/gm;
2370         s/\xc3\x61/â/gm;
2371         s/\xc3\x65/ê/gm;
2372         s/\xc3\x69/î/gm;
2373         s/\xc3\x6f/ô/gm;
2374         s/\xc3\x75/û/gm;
2375         s/\xc4\x41/Ã/gm;
2376         s/\xc4\x4e/Ñ/gm;
2377         s/\xc4\x4f/Õ/gm;
2378         s/\xc4\x61/ã/gm;
2379         s/\xc4\x6e/ñ/gm;
2380         s/\xc4\x6f/õ/gm;
2381         s/\xc8\x41/Ä/gm;
2382         s/\xc8\x45/Ë/gm;
2383         s/\xc8\x49/Ï/gm;
2384         s/\xc8\x61/ä/gm;
2385         s/\xc8\x65/ë/gm;
2386         s/\xc8\x69/ï/gm;
2387         s/\xc8\x6F/ö/gm;
2388         s/\xc8\x75/ü/gm;
2389         s/\xc8\x76/ÿ/gm;
2390         s/\xc9\x41/Ä/gm;
2391         s/\xc9\x45/Ë/gm;
2392         s/\xc9\x49/Ï/gm;
2393         s/\xc9\x4f/Ö/gm;
2394         s/\xc9\x55/Ü/gm;
2395         s/\xc9\x61/ä/gm;
2396         s/\xc9\x6f/ö/gm;
2397         s/\xc9\x75/ü/gm;
2398         s/\xca\x41/Å/gm;
2399         s/\xca\x61/å/gm;
2400         s/\xd0\x43/Ç/gm;
2401         s/\xd0\x63/ç/gm;
2402
2403         # this handles non-sorting blocks (if implementation requires this)
2404         $string = nsb_clean($_);
2405     }
2406     elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2407         if (/[\xc1-\xff]/) {
2408             s/\xe1\x61/à/gm;
2409             s/\xe1\x65/è/gm;
2410             s/\xe1\x69/ì/gm;
2411             s/\xe1\x6f/ò/gm;
2412             s/\xe1\x75/ù/gm;
2413             s/\xe1\x41/À/gm;
2414             s/\xe1\x45/È/gm;
2415             s/\xe1\x49/Ì/gm;
2416             s/\xe1\x4f/Ò/gm;
2417             s/\xe1\x55/Ù/gm;
2418             s/\xe2\x41/Á/gm;
2419             s/\xe2\x45/É/gm;
2420             s/\xe2\x49/Í/gm;
2421             s/\xe2\x4f/Ó/gm;
2422             s/\xe2\x55/Ú/gm;
2423             s/\xe2\x59/Ý/gm;
2424             s/\xe2\x61/á/gm;
2425             s/\xe2\x65/é/gm;
2426             s/\xe2\x69/í/gm;
2427             s/\xe2\x6f/ó/gm;
2428             s/\xe2\x75/ú/gm;
2429             s/\xe2\x79/ý/gm;
2430             s/\xe3\x41/Â/gm;
2431             s/\xe3\x45/Ê/gm;
2432             s/\xe3\x49/Î/gm;
2433             s/\xe3\x4f/Ô/gm;
2434             s/\xe3\x55/Û/gm;
2435             s/\xe3\x61/â/gm;
2436             s/\xe3\x65/ê/gm;
2437             s/\xe3\x69/î/gm;
2438             s/\xe3\x6f/ô/gm;
2439             s/\xe3\x75/û/gm;
2440             s/\xe4\x41/Ã/gm;
2441             s/\xe4\x4e/Ñ/gm;
2442             s/\xe4\x4f/Õ/gm;
2443             s/\xe4\x61/ã/gm;
2444             s/\xe4\x6e/ñ/gm;
2445             s/\xe4\x6f/õ/gm;
2446             s/\xe8\x45/Ë/gm;
2447             s/\xe8\x49/Ï/gm;
2448             s/\xe8\x65/ë/gm;
2449             s/\xe8\x69/ï/gm;
2450             s/\xe8\x76/ÿ/gm;
2451             s/\xe9\x41/Ä/gm;
2452             s/\xe9\x4f/Ö/gm;
2453             s/\xe9\x55/Ü/gm;
2454             s/\xe9\x61/ä/gm;
2455             s/\xe9\x6f/ö/gm;
2456             s/\xe9\x75/ü/gm;
2457             s/\xea\x41/Å/gm;
2458             s/\xea\x61/å/gm;
2459
2460             # this handles non-sorting blocks (if implementation requires this)
2461             $string = nsb_clean($_);
2462         }
2463     }
2464     return ($string);
2465 }
2466
2467 sub nsb_clean {
2468     my $NSB = '\x88';    # NSB : begin Non Sorting Block
2469     my $NSE = '\x89';    # NSE : Non Sorting Block end
2470                          # handles non sorting blocks
2471     my ($string) = @_;
2472     $_ = $string;
2473     s/$NSB/(/gm;
2474     s/[ ]{0,1}$NSE/) /gm;
2475     $string = $_;
2476     return ($string);
2477 }
2478
2479 sub FindDuplicate {
2480         my ($record)=@_;
2481         my $dbh = C4::Context->dbh;
2482         my $result = MARCmarc2koha($dbh,$record,'');
2483         my $sth;
2484         my ($biblionumber,$bibid,$title);
2485         # search duplicate on ISBN, easy and fast...
2486         if ($result->{isbn}) {
2487                 $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=?");
2488                 $sth->execute($result->{'isbn'});
2489                 ($biblionumber,$bibid,$title) = $sth->fetchrow;
2490                 return $biblionumber,$bibid,$title if ($biblionumber);
2491         }
2492         # a more complex search : build a request for SearchMarc::catalogsearch()
2493         my (@tags, @and_or, @excluding, @operator, @value, $offset,$length);
2494         # search on biblio.title
2495         my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.title","");
2496         if ($record->field($tag)) {
2497                 if ($record->field($tag)->subfields($subfield)) {
2498                         push @tags, "'".$tag.$subfield."'";
2499                         push @and_or, "and";
2500                         push @excluding, "";
2501                         push @operator, "contains";
2502                         push @value, $record->field($tag)->subfield($subfield);
2503 #                       warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2504                 }
2505         }
2506         # ... and on biblio.author
2507         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.author","");
2508         if ($record->field($tag)) {
2509                 if ($record->field($tag)->subfields($subfield)) {
2510                         push @tags, "'".$tag.$subfield."'";
2511                         push @and_or, "and";
2512                         push @excluding, "";
2513                         push @operator, "contains";
2514                         push @value, $record->field($tag)->subfield($subfield);
2515 #                       warn "for author, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2516                 }
2517         }
2518         # ... and on publicationyear.
2519         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publicationyear","");
2520         if ($record->field($tag)) {
2521                 if ($record->field($tag)->subfields($subfield)) {
2522                         push @tags, "'".$tag.$subfield."'";
2523                         push @and_or, "and";
2524                         push @excluding, "";
2525                         push @operator, "=";
2526                         push @value, $record->field($tag)->subfield($subfield);
2527 #                       warn "for publicationyear, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2528                 }
2529         }
2530         # ... and on size.
2531         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.size","");
2532         if ($record->field($tag)) {
2533                 if ($record->field($tag)->subfields($subfield)) {
2534                         push @tags, "'".$tag.$subfield."'";
2535                         push @and_or, "and";
2536                         push @excluding, "";
2537                         push @operator, "=";
2538                         push @value, $record->field($tag)->subfield($subfield);
2539 #                       warn "for size, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2540                 }
2541         }
2542         # ... and on publisher.
2543         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publishercode","");
2544         if ($record->field($tag)) {
2545                 if ($record->field($tag)->subfields($subfield)) {
2546                         push @tags, "'".$tag.$subfield."'";
2547                         push @and_or, "and";
2548                         push @excluding, "";
2549                         push @operator, "=";
2550                         push @value, $record->field($tag)->subfield($subfield);
2551 #                       warn "for publishercode, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2552                 }
2553         }
2554         # ... and on volume.
2555         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.volume","");
2556         if ($record->field($tag)) {
2557                 if ($record->field($tag)->subfields($subfield)) {
2558                         push @tags, "'".$tag.$subfield."'";
2559                         push @and_or, "and";
2560                         push @excluding, "";
2561                         push @operator, "=";
2562                         push @value, $record->field($tag)->subfield($subfield);
2563 #                       warn "for volume, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2564                 }
2565         }
2566
2567         my ($finalresult,$nbresult) = C4::SearchMarc::catalogsearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10);
2568         # there is at least 1 result => return the 1st one
2569         if ($nbresult) {
2570 #               warn "$nbresult => ".@$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2571                 return @$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2572         }
2573         # no result, returns nothing
2574         return;
2575 }
2576
2577 sub DisplayISBN {
2578         my ($isbn)=@_;
2579         my $seg1;
2580         if(substr($isbn, 0, 1) <=7) {
2581                 $seg1 = substr($isbn, 0, 1);
2582         } elsif(substr($isbn, 0, 2) <= 94) {
2583                 $seg1 = substr($isbn, 0, 2);
2584         } elsif(substr($isbn, 0, 3) <= 995) {
2585                 $seg1 = substr($isbn, 0, 3);
2586         } elsif(substr($isbn, 0, 4) <= 9989) {
2587                 $seg1 = substr($isbn, 0, 4);
2588         } else {
2589                 $seg1 = substr($isbn, 0, 5);
2590         }
2591         my $x = substr($isbn, length($seg1));
2592         my $seg2;
2593         if(substr($x, 0, 2) <= 19) {
2594 #               if(sTmp2 < 10) sTmp2 = "0" sTmp2;
2595                 $seg2 = substr($x, 0, 2);
2596         } elsif(substr($x, 0, 3) <= 699) {
2597                 $seg2 = substr($x, 0, 3);
2598         } elsif(substr($x, 0, 4) <= 8399) {
2599                 $seg2 = substr($x, 0, 4);
2600         } elsif(substr($x, 0, 5) <= 89999) {
2601                 $seg2 = substr($x, 0, 5);
2602         } elsif(substr($x, 0, 6) <= 9499999) {
2603                 $seg2 = substr($x, 0, 6);
2604         } else {
2605                 $seg2 = substr($x, 0, 7);
2606         }
2607         my $seg3=substr($x,length($seg2));
2608         $seg3=substr($seg3,0,length($seg3)-1) ;
2609         my $seg4 = substr($x, -1, 1);
2610         return "$seg1-$seg2-$seg3-$seg4";
2611 }
2612
2613
2614 END { }    # module clean-up code here (global destructor)
2615
2616 =back
2617
2618 =head1 AUTHOR
2619
2620 Koha Developement team <info@koha.org>
2621
2622 Paul POULAIN paul.poulain@free.fr
2623
2624 =cut
2625
2626 # $Id$
2627 # $Log$
2628 # Revision 1.125  2005/08/11 09:00:07  tipaul
2629 # Ok guys, this time, it seems that item add and modif begin working as expected...
2630 # Still a lot of bugs to fix, of course
2631 #
2632 # Revision 1.124  2005/08/10 10:21:15  tipaul
2633 # continuing the road to zebra :
2634 # - the biblio add begins to work.
2635 # - the biblio modif begins to work.
2636 #
2637 # (still without doing anything on zebra)
2638 # (no new change in updatedatabase)
2639 #
2640 # Revision 1.123  2005/08/09 14:10:28  tipaul
2641 # 1st commit to go to zebra.
2642 # don't update your cvs if you want to have a working head...
2643 #
2644 # this commit contains :
2645 # * 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...
2646 # * 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.
2647 # * other files : get rid of bibid and use biblionumber instead.
2648 #
2649 # What is broken :
2650 # * does not do anything on zebra yet.
2651 # * if you rename marc_subfield_table, you can't search anymore.
2652 # * you can view a biblio & bibliodetails, go to MARC editor, but NOT save any modif.
2653 # * 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 ;-) )
2654 #
2655 # 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
2656 # 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.
2657
2658 # tipaul cutted previous commit notes