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