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