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