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 C4::Date;
  25 use MARC::Record;
  26 use MARC::File::USMARC;
  27 use MARC::File::XML;
  28 use ZOOM;
  29
  30 use vars qw($VERSION @ISA @EXPORT);
  31
  32 # set the version for version checking
  33 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
  34                 shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
  35
  36 @ISA = qw(Exporter);
  37
  38 #
  39 # don't forget MARCxxx subs are exported only for testing purposes. Should not be used
  40 # as the old-style API and the NEW one are the only public functions.
  41 #
  42 @EXPORT = qw(
  43   &newbiblio &newbiblioitem
  44   &newsubject &newsubtitle &newitems
  45
  46   &modbiblio &checkitems &modbibitem
  47   &modsubtitle &modsubject &modaddauthor &moditem
  48
  49   &delitem &deletebiblioitem &delbiblio
  50
  51   &getbiblio &bibdata &bibitems &bibitemdata
  52   &barcodes &ItemInfo &itemdata &itemissues &itemcount
  53   &getsubject &getaddauthor &getsubtitle
  54   &getwebbiblioitems &getwebsites
  55   &getbiblioitembybiblionumber
  56   &getbiblioitem &getitemsbybiblioitem
  57
  58   &MARCfind_marc_from_kohafield
  59   &MARCfind_frameworkcode
  60   &find_biblioitemnumber
  61   &MARCgettagslib
  62
  63   &NEWnewbiblio &NEWnewitem
  64   &NEWmodbiblio &NEWmoditem
  65   &NEWdelbiblio &NEWdelitem
  66   &NEWmodbiblioframework
  67
  68   &MARCkoha2marcBiblio &MARCmarc2koha
  69   &MARCkoha2marcItem &MARChtml2marc
  70   &MARCgetbiblio &MARCgetitem
  71   &XMLgetbiblio
  72
  73   &FindDuplicate
  74   &DisplayISBN
  75
  76   &z3950_extended_services
  77   &set_service_options
  78
  79   &get_item_from_barcode
  80   &MARCfind_MARCbibid_from_oldbiblionumber
  81
  82 );
  83
  84 =head1 NAME
  85
  86 C4::Biblio - Acquisitions, Catalog Management Functions
  87
  88 =head1 SYNOPSIS
  89
  90 ( lot of changes for Koha 3.X)
  91
  92 Koha 1.2 and previous versions used a specific API to manage biblios. This API uses old-DB style parameters.
  93 They are based on a hash, and store data in biblio/biblioitems/items tables (plus additionalauthors,
  94 bibliosubject and bibliosubtitle where applicable).
  95
  96 In Koha 2.X, we introduced a MARC-DB.
  97
  98 In Koha 3.X, we removed this MARC-DB for search as we wanted to use Zebra as search system.
  99
 100 So in Koha 3.X, saving a record means :
 101
 102  - storing the raw marc record (iso2709) in biblioitems.marc field. It contains both biblio & items information.
 103  - storing the "decoded information" in biblio/biblioitems/items as previously.
 104  - using zebra to manage search & indexing on the MARC data.
 105
 106  In Koha, there is a systempreference for "MARC=ON" or "MARC=OFF" :
 107
 108  * MARC=ON : when MARC=ON, Koha uses a MARC::Record object (in sub parameters). Saving information in the DB means :
 109
 110  - transform the MARC record into a hash
 111  - add the raw MARC record into the hash
 112  - store them & update Zebra
 113
 114  * MARC=OFF : when MARC=OFF, Koha uses a hash object (in sub parameters). Saving information in the DB means :
 115
 116  - transform the hash into a MARC record
 117  - add the raw marc record into the hash
 118  - store them & update zebra
 119
 120 That's why we need 3 types of subs :
 121
 122 =head2 REALxxx subs
 123
 124 all I<subs beginning by REAL> do the effective storage of information (with a hash, one field of the hash being the raw marc record). Those subs also update the record in Zebra. REAL subs should be only for internal use (called by NEW or "something else" subs).
 125
 126 =head2 NEWxxx related subs
 127
 128 =over 4
 129
 130 all I<subs beginning by NEW> use MARC::Record as parameters. It's the API that MUST be used in the MARC acquisition system. They just create the hash, add it the raw marc record. Then, they call REALxxx sub.
 131
 132 all subs requires/use $dbh as 1st parameter and a MARC::Record object as 2nd parameter. They sometimes require another parameter.
 133
 134 =back
 135
 136 =head2 something_elsexxx related subs
 137
 138 =over 4
 139
 140 all I<subs beginning by seomething else> are the old-style API. They use a hash as parameter, transform the hash into a -small- marc record, and call REAL subs.
 141
 142 all subs require/use $dbh as 1st parameter and a hash as 2nd parameter.
 143
 144 =back
 145
 146 =head1 FUNCTIONS
 147
 148 =head2 z3950_extended_services
 149
 150 z3950_extended_services($Zconn,$serviceType,$serviceOptions,$record);
 151
 152         z3950_extended_services is used to handle all interactions with Zebra's extended serices package.
 153
 154 C<$Zconn> a connection object to the Zebra server
 155
 156 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
 157
 158 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
 159
 160         action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
 161
 162 and maybe
 163
 164         recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
 165         syntax => the record syntax (transfer syntax)
 166         databaseName = Database from connection object
 167
 168         To set serviceOptions, call set_service_options($serviceType)
 169
 170 C<$record> the record, if one is needed for the service type
 171
 172         A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
 173
 174 =cut
 175 sub z3950_extended_services {
 176         my ($Zconn,$serviceType,$serviceOptions,$record) = @_;
 177
 178         # create a new package object
 179         my $Zpackage = $Zconn->package();
 180
 181         # set our options
 182         $Zpackage->option(action => $serviceOptions->{'action'});
 183
 184         if ($serviceOptions->{'databaseName'}) {
 185                 $Zpackage->option(databaseName => $serviceOptions->{'databaseName'});
 186         }
 187         if ($serviceOptions->{'recordIdNumber'}) {
 188                 $Zpackage->option(recordIdNumber => $serviceOptions->{'recordIdNumber'});
 189         }
 190         if ($serviceOptions->{'recordIdOpaque'}) {
 191                 $Zpackage->option(recordIdOpaque => $serviceOptions->{'recordIdOpaque'});
 192         }
 193
 194         # this is an ILL request (Zebra doesn't support it)
 195         #if ($serviceType eq 'itemorder') {
 196         #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
 197         #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
 198         #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
 199         #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
 200         #}
 201
 202         if ($record) {
 203                 my $xmlrecord = marc2xml($record);
 204                 $Zpackage->option(record => $xmlrecord);
 205                 if ($serviceOptions->{'syntax'}) {
 206                         $Zpackage->option(syntax => $serviceOptions->{'syntax'});
 207                 }
 208         }
 209
 210         # send the request, handle any exception encountered
 211         eval { $Zpackage->send($serviceType) };
 212                 if ($@ && $@->isa("ZOOM::Exception")) {
 213                         print "Oops!  ", $@->message(), "\n";
 214                         return $@->code();
 215                 }
 216         # free up package resources
 217         $Zpackage->destroy();
 218 }
 219
 220 =head2 set_service_options
 221
 222 my $serviceOptions = set_service_options($serviceType);
 223
 224 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
 225
 226 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
 227
 228 =cut
 229
 230 sub set_service_options {
 231         my ($serviceType) = @_;
 232         my $serviceOptions;
 233
 234         if ($serviceType eq 'update') {
 235                 $serviceOptions->{ 'action' } = 'specialUpdate';
 236
 237         # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
 238         #       $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
 239         }
 240
 241         if ($serviceType eq 'commit') {
 242         # nothing to do
 243
 244         }
 245         if ($serviceType eq 'create') {
 246         # nothing to do
 247         }
 248         if ($serviceType eq 'drop') {
 249                 die "ERROR: 'drop' not currently supported (by Zebra)";
 250         }
 251         return $serviceOptions;
 252 }
 253
 254 =head2 marc2xml
 255
 256 my $xmlrecord = marc2xml($record);
 257
 258 Convert from MARC to XML. Note that MARC::File::XML will automatically encode from MARC-8 to UTF-8 as of version .8
 259
 260 C<$record> a MARC record
 261
 262 =cut
 263
 264 sub marc2xml {
 265         my ($record) = @_;
 266         my $xmlrecord;
 267         eval { $xmlrecord=$record->as_xml() };
 268         #TODO: better error handling here
 269         if ($@){
 270                 warn "ERROR: I suspect a badly formatted MARC record";
 271         }
 272         return $xmlrecord;
 273 }
 274
 275 =head2 MARCgettagslib
 276
 277 @tagslib = &MARCgettagslib($dbh,1|0,$frameworkcode);
 278
 279 =over 4
 280
 281 2nd param is 1 for liblibrarian and 0 for libopac
 282 $frameworkcode contains the framework reference. If empty or does not exist, the default one is used
 283
 284 returns a hash with all values for all fields and subfields for a given MARC framework :
 285         $res->{$tag}->{lib}        = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 286                     ->{tab}        = "";            # XXX
 287                     ->{mandatory}  = $mandatory;
 288                     ->{repeatable} = $repeatable;
 289                     ->{$subfield}->{lib}              = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 290                                  ->{tab}              = $tab;
 291                                  ->{mandatory}        = $mandatory;
 292                                  ->{repeatable}       = $repeatable;
 293                                  ->{authorised_value} = $authorised_value;
 294                                  ->{authtypecode}     = $authtypecode;
 295                                  ->{value_builder}    = $value_builder;
 296                                  ->{kohafield}        = $kohafield;
 297                                  ->{seealso}          = $seealso;
 298                                  ->{hidden}           = $hidden;
 299                                  ->{isurl}            = $isurl;
 300                                  ->{link}            = $link;
 301
 302 =back
 303
 304 =cut
 305
 306 sub MARCgettagslib {
 307     my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
 308     $frameworkcode = "" unless $frameworkcode;
 309     $forlibrarian = 1 unless $forlibrarian;
 310     my $sth;
 311     my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
 312
 313     # check that framework exists
 314     $sth =
 315       $dbh->prepare(
 316         "select count(*) from marc_tag_structure where frameworkcode=?");
 317     $sth->execute($frameworkcode);
 318     my ($total) = $sth->fetchrow;
 319     $frameworkcode = "" unless ( $total > 0 );
 320     $sth =
 321       $dbh->prepare(
 322 "select tagfield,liblibrarian,libopac,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield"
 323     );
 324     $sth->execute($frameworkcode);
 325     my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
 326
 327     while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
 328         $res->{$tag}->{lib}        = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 329         $res->{$tag}->{tab}        = "";            # XXX
 330         $res->{$tag}->{mandatory}  = $mandatory;
 331         $res->{$tag}->{repeatable} = $repeatable;
 332     }
 333
 334     $sth =
 335       $dbh->prepare(
 336 "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"
 337     );
 338     $sth->execute($frameworkcode);
 339
 340     my $subfield;
 341     my $authorised_value;
 342     my $authtypecode;
 343     my $value_builder;
 344     my $kohafield;
 345     my $seealso;
 346     my $hidden;
 347     my $isurl;
 348         my $link;
 349
 350     while (
 351         ( $tag,         $subfield,   $liblibrarian,   , $libopac,      $tab,
 352         $mandatory,     $repeatable, $authorised_value, $authtypecode,
 353         $value_builder, $kohafield,  $seealso,          $hidden,
 354         $isurl,                 $link )
 355         = $sth->fetchrow
 356       )
 357     {
 358         $res->{$tag}->{$subfield}->{lib}              = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 359         $res->{$tag}->{$subfield}->{tab}              = $tab;
 360         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
 361         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
 362         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
 363         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
 364         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
 365         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
 366         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
 367         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
 368         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
 369         $res->{$tag}->{$subfield}->{link}            = $link;
 370     }
 371     return $res;
 372 }
 373
 374 =head2 MARCfind_marc_from_kohafield
 375
 376 ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
 377
 378 =over 4
 379
 380 finds MARC tag and subfield for a given kohafield
 381 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
 382
 383 =back
 384
 385 =cut
 386
 387 sub MARCfind_marc_from_kohafield {
 388     my ( $dbh, $kohafield,$frameworkcode ) = @_;
 389     return 0, 0 unless $kohafield;
 390     $frameworkcode='' unless $frameworkcode;
 391         my $relations = C4::Context->marcfromkohafield;
 392         return ($relations->{$frameworkcode}->{$kohafield}->[0],$relations->{$frameworkcode}->{$kohafield}->[1]);
 393 }
 394
 395 =head2 MARCgetbiblio
 396
 397 $MARCRecord = &MARCgetbiblio($dbh,$biblionumber);
 398
 399 =over 4
 400
 401 Returns a MARC::Record for the biblio $biblionumber.
 402
 403 =cut
 404
 405 sub MARCgetbiblio {
 406
 407     # Returns MARC::Record of the biblio passed in parameter.
 408     my ( $dbh, $biblionumber ) = @_;
 409         my $sth = $dbh->prepare('select marc from biblioitems where biblionumber=?');
 410         $sth->execute($biblionumber);
 411         my ($marc) = $sth->fetchrow;
 412         my $record = MARC::Record::new_from_usmarc($marc);
 413     return $record;
 414 }
 415
 416 =head2 XMLgetbiblio
 417
 418 $XML = &XMLgetbiblio($dbh,$biblionumber);
 419
 420 =over 4
 421
 422 Returns a raw XML for the biblio $biblionumber.
 423
 424 =cut
 425
 426 sub XMLgetbiblio {
 427
 428     # Returns MARC::Record of the biblio passed in parameter.
 429     my ( $dbh, $biblionumber ) = @_;
 430         my $sth = $dbh->prepare('select marcxml,marc from biblioitems where biblionumber=?');
 431         $sth->execute($biblionumber);
 432         my ($XML,$marc) = $sth->fetchrow;
 433 #       my $record =MARC::Record::new_from_usmarc($marc);
 434 #       warn "MARC : \n*-************************\n".$record->as_xml."\n*-************************\n";
 435     return $XML;
 436 }
 437
 438 =head2 MARCgetitem
 439
 440 $MARCrecord = &MARCgetitem($dbh,$biblionumber);
 441
 442 =over 4
 443
 444 Returns a MARC::Record with all items of biblio # $biblionumber
 445
 446 =back
 447
 448 =cut
 449
 450 sub MARCgetitem {
 451
 452     my ( $dbh, $biblionumber, $itemnumber ) = @_;
 453         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
 454         # get the complete MARC record
 455         my $sth = $dbh->prepare("select marc from biblioitems where biblionumber=?");
 456         $sth->execute($biblionumber);
 457         my ($rawmarc) = $sth->fetchrow;
 458         my $record = MARC::File::USMARC::decode($rawmarc);
 459         # now, find the relevant itemnumber
 460         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
 461         # prepare the new item record
 462         my $itemrecord = MARC::Record->new();
 463         # parse all fields fields from the complete record
 464         foreach ($record->field($itemnumberfield)) {
 465                 # when the item field is found, save it
 466                 if ($_->subfield($itemnumbersubfield) == $itemnumber) {
 467                         $itemrecord->append_fields($_);
 468                 }
 469         }
 470
 471     return $itemrecord;
 472 }
 473
 474 =head2 find_biblioitemnumber
 475
 476 my $biblioitemnumber = find_biblioitemnumber($dbh,$biblionumber);
 477
 478 =over 4
 479
 480 Returns the 1st biblioitemnumber related to $biblionumber. When MARC=ON we should have 1 biblionumber = 1 and only 1 biblioitemnumber
 481 This sub is useless when MARC=OFF
 482
 483 =back
 484
 485 =cut
 486 sub find_biblioitemnumber {
 487         my ( $dbh, $biblionumber ) = @_;
 488         my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
 489         $sth->execute($biblionumber);
 490         my ($biblioitemnumber) = $sth->fetchrow;
 491         return $biblioitemnumber;
 492 }
 493
 494 =head2 MARCfind_frameworkcode
 495
 496 my $frameworkcode = MARCfind_frameworkcode($dbh,$biblionumber);
 497
 498 =over 4
 499
 500 returns the framework of a given biblio
 501
 502 =back
 503
 504 =cut
 505
 506 sub MARCfind_frameworkcode {
 507         my ( $dbh, $biblionumber ) = @_;
 508         my $sth = $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
 509         $sth->execute($biblionumber);
 510         my ($frameworkcode) = $sth->fetchrow;
 511         return $frameworkcode;
 512 }
 513
 514 =head2 MARCkoha2marcBiblio
 515
 516 $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibliohash);
 517
 518 =over 4
 519
 520 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem :
 521 all entries of the hash are transformed into their matching MARC field/subfield.
 522
 523 =back
 524
 525 =cut
 526
 527 sub MARCkoha2marcBiblio {
 528
 529         # this function builds partial MARC::Record from the old koha-DB fields
 530         my ( $dbh, $bibliohash ) = @_;
 531         # we don't have biblio entries in the hash, so we add them first
 532         my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
 533         $sth->execute($bibliohash->{biblionumber});
 534         my $biblio = $sth->fetchrow_hashref;
 535         foreach (keys %$biblio) {
 536                 $bibliohash->{$_}=$biblio->{$_};
 537         }
 538         $sth = $dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
 539         my $record = MARC::Record->new();
 540         foreach ( keys %$bibliohash ) {
 541                 &MARCkoha2marcOnefield( $sth, $record, "biblio." . $_, $bibliohash->{$_}, '') if $bibliohash->{$_};
 542                 &MARCkoha2marcOnefield( $sth, $record, "biblioitems." . $_, $bibliohash->{$_}, '') if $bibliohash->{$_};
 543         }
 544
 545         # other fields => additional authors, subjects, subtitles
 546         my $sth2 = $dbh->prepare(" SELECT author FROM additionalauthors WHERE biblionumber=?");
 547         $sth2->execute($bibliohash->{biblionumber});
 548         while ( my $row = $sth2->fetchrow_hashref ) {
 549                 &MARCkoha2marcOnefield( $sth, $record, "additionalauthors.author", $bibliohash->{'author'},'' );
 550         }
 551         $sth2 = $dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?");
 552         $sth2->execute($bibliohash->{biblionumber});
 553         while ( my $row = $sth2->fetchrow_hashref ) {
 554                 &MARCkoha2marcOnefield( $sth, $record, "bibliosubject.subject", $row->{'subject'},'' );
 555         }
 556         $sth2 = $dbh->prepare(" SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?");
 557         $sth2->execute($bibliohash->{biblionumber});
 558         while ( my $row = $sth2->fetchrow_hashref ) {
 559                 &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle", $row->{'subtitle'},'' );
 560         }
 561
 562         return $record;
 563 }
 564
 565 =head2 MARCkoha2marcItem
 566
 567 $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);
 568
 569 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB items :
 570 all entries of the hash are transformed into their matching MARC field/subfield.
 571
 572 =over 4
 573
 574 =back
 575
 576 =cut
 577
 578 sub MARCkoha2marcItem {
 579
 580     # this function builds partial MARC::Record from the old koha-DB fields
 581     my ( $dbh, $item ) = @_;
 582
 583     #    my $dbh=&C4Connect;
 584     my $sth = $dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
 585     my $record = MARC::Record->new();
 586
 587         foreach( keys %$item ) {
 588                 if ( $item->{$_} ) {
 589                         &MARCkoha2marcOnefield( $sth, $record, "items." . $_,
 590                                 $item->{$_},'' );
 591                 }
 592         }
 593     return $record;
 594 }
 595
 596 =head2 MARCkoha2marcOnefield
 597
 598 =over 4
 599
 600 This sub is for internal use only, used by koha2marcBiblio & koha2marcItem
 601
 602 =back
 603
 604 =cut
 605
 606 sub MARCkoha2marcOnefield {
 607     my ( $sth, $record, $kohafieldname, $value,$frameworkcode ) = @_;
 608     my $tagfield;
 609     my $tagsubfield;
 610     $sth->execute($frameworkcode,$kohafieldname);
 611     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
 612         if ( $record->field($tagfield) ) {
 613             my $tag = $record->field($tagfield);
 614             if ($tag) {
 615                 $tag->add_subfields( $tagsubfield, $value );
 616                 $record->delete_field($tag);
 617                 $record->add_fields($tag);
 618             }
 619         }
 620         else {
 621             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
 622         }
 623     }
 624     return $record;
 625 }
 626
 627 =head2 MARChtml2marc
 628
 629 $MARCrecord = MARChtml2marc($dbh,$rtags,$rsubfields,$rvalues,%indicators);
 630
 631 =over 4
 632
 633 transforms the parameters (coming from HTML form) into a MARC::Record
 634 parameters with r are references to arrays.
 635
 636 FIXME : should be improved for 3.0, to avoid having 4 differents arrays
 637
 638 =back
 639
 640 =cut
 641
 642 sub MARChtml2marc {
 643         my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
 644         my $prevtag = -1;
 645         my $record = MARC::Record->new();
 646 #       my %subfieldlist=();
 647         my $prevvalue; # if tag <10
 648         my $field; # if tag >=10
 649         for (my $i=0; $i< @$rtags; $i++) {
 650                 next unless @$rvalues[$i];
 651                 # rebuild MARC::Record
 652 #                       warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
 653                 if (@$rtags[$i] ne $prevtag) {
 654                         if ($prevtag < 10) {
 655                                 if ($prevvalue) {
 656                                         if ($prevtag ne '000') {
 657                                                 $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
 658                                         } else {
 659                                                 $record->leader($prevvalue);
 660                                         }
 661                                 }
 662                         } else {
 663                                 if ($field) {
 664                                         $record->add_fields($field);
 665                                 }
 666                         }
 667                         $indicators{@$rtags[$i]}.='  ';
 668                         if (@$rtags[$i] <10) {
 669                                 $prevvalue= @$rvalues[$i];
 670                                 undef $field;
 671                         } else {
 672                                 undef $prevvalue;
 673                                 $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
 674 #                       warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
 675                         }
 676                         $prevtag = @$rtags[$i];
 677                 } else {
 678                         if (@$rtags[$i] <10) {
 679                                 $prevvalue=@$rvalues[$i];
 680                         } else {
 681                                 if (length(@$rvalues[$i])>0) {
 682                                         $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
 683 #                       warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
 684                                 }
 685                         }
 686                         $prevtag= @$rtags[$i];
 687                 }
 688         }
 689         # the last has not been included inside the loop... do it now !
 690         $record->add_fields($field) if $field;
 691 #       warn "HTML2MARC=".$record->as_formatted;
 692         return $record;
 693 }
 694
 695
 696 =head2 MARCmarc2koha
 697
 698 $hash = &MARCmarc2koha($dbh,$MARCRecord);
 699
 700 =over 4
 701
 702 builds a hash with old-db datas from a MARC::Record
 703
 704 =back
 705
 706 =cut
 707
 708 sub MARCmarc2koha {
 709         my ($dbh,$record,$frameworkcode) = @_;
 710         my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
 711         my $result;
 712         my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
 713         $sth2->execute;
 714         my $field;
 715         while (($field)=$sth2->fetchrow) {
 716 #               warn "biblio.".$field;
 717                 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result,$frameworkcode);
 718         }
 719         $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
 720         $sth2->execute;
 721         while (($field)=$sth2->fetchrow) {
 722                 if ($field eq 'notes') { $field = 'bnotes'; }
 723 #               warn "biblioitems".$field;
 724                 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result,$frameworkcode);
 725         }
 726         $sth2=$dbh->prepare("SHOW COLUMNS from items");
 727         $sth2->execute;
 728         while (($field)=$sth2->fetchrow) {
 729 #               warn "items".$field;
 730                 $result=&MARCmarc2kohaOneField($sth,"items",$field,$record,$result,$frameworkcode);
 731         }
 732         # additional authors : specific
 733         $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result,$frameworkcode);
 734         $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result,$frameworkcode);
 735 # modify copyrightdate to keep only the 1st year found
 736         my $temp = $result->{'copyrightdate'};
 737         if ($temp){
 738                 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
 739                 if ($1>0) {
 740                         $result->{'copyrightdate'} = $1;
 741                 } else { # if no cYYYY, get the 1st date.
 742                         $temp =~ m/(\d\d\d\d)/;
 743                         $result->{'copyrightdate'} = $1;
 744                 }
 745         }
 746 # modify publicationyear to keep only the 1st year found
 747         $temp = $result->{'publicationyear'};
 748         $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
 749         if ($1>0) {
 750                 $result->{'publicationyear'} = $1;
 751         } else { # if no cYYYY, get the 1st date.
 752                 $temp =~ m/(\d\d\d\d)/;
 753                 $result->{'publicationyear'} = $1;
 754         }
 755         return $result;
 756 }
 757
 758 sub MARCmarc2kohaOneField {
 759
 760 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
 761     my ( $sth, $kohatable, $kohafield, $record, $result,$frameworkcode ) = @_;
 762     #    warn "kohatable / $kohafield / $result / ";
 763     my $res = "";
 764     my $tagfield;
 765     my $subfield;
 766     ( $tagfield, $subfield ) = MARCfind_marc_from_kohafield("",$kohatable.".".$kohafield,$frameworkcode);
 767     foreach my $field ( $record->field($tagfield) ) {
 768                 if ($field->tag()<10) {
 769                         if ($result->{$kohafield}) {
 770                                 # Reverse array filled with elements from repeated subfields
 771                                 # from first to last to avoid last to first concatenation of
 772                                 # elements in Koha DB.  -- thd.
 773                                 $result->{$kohafield} .= " | ".reverse($field->data());
 774                         } else {
 775                                 $result->{$kohafield} = $field->data();
 776                         }
 777                 } else {
 778                         if ( $field->subfields ) {
 779                                 my @subfields = $field->subfields();
 780                                 foreach my $subfieldcount ( 0 .. $#subfields ) {
 781                                         if ($subfields[$subfieldcount][0] eq $subfield) {
 782                                                 if ( $result->{$kohafield} ) {
 783                                                         $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
 784                                                 }
 785                                                 else {
 786                                                         $result->{$kohafield} = $subfields[$subfieldcount][1];
 787                                                 }
 788                                         }
 789                                 }
 790                         }
 791                 }
 792     }
 793 #       warn "OneField for $kohatable.$kohafield and $frameworkcode=> $tagfield, $subfield";
 794     return $result;
 795 }
 796
 797 =head2 NEWnewbibilio
 798
 799 ($biblionumber,$biblioitemnumber) = NEWnewbibilio($dbh,$MARCRecord,$frameworkcode);
 800
 801 =over 4
 802
 803 creates a biblio from a MARC::Record.
 804
 805 =back
 806
 807 =cut
 808
 809 sub NEWnewbiblio {
 810     my ( $dbh,$Zconn,$record,$frameworkcode ) = @_;
 811     my $biblionumber;
 812     my $biblioitemnumber;
 813     my $olddata = MARCmarc2koha( $dbh, $record,$frameworkcode );
 814         $olddata->{frameworkcode} = $frameworkcode;
 815     $biblionumber = REALnewbiblio( $dbh, $olddata );
 816         $olddata->{biblionumber} = $biblionumber;
 817         # add biblionumber into the MARC record (it's the ID for zebra)
 818         my ( $tagfield, $tagsubfield ) =
 819                                         MARCfind_marc_from_kohafield( $dbh, "biblio.biblionumber",$frameworkcode );
 820         # create the field
 821         my $newfield;
 822         if ($tagfield<10) {
 823                 $newfield = MARC::Field->new(
 824                         $tagfield, $biblionumber,
 825                 );
 826         } else {
 827                 $newfield = MARC::Field->new(
 828                         $tagfield, '', '', "$tagsubfield" => $biblionumber,
 829                 );
 830         }
 831         # drop old field (just in case it already exist and create new one...
 832         my $old_field = $record->field($tagfield);
 833         $record->delete_field($old_field);
 834         $record->add_fields($newfield);
 835
 836         #create the marc entry, that stores the rax marc record in Koha 3.0
 837         $olddata->{marc} = $record->as_usmarc();
 838         $olddata->{marcxml} = $record->as_xml();
 839         # and create biblioitem, that's all folks !
 840     $biblioitemnumber = REALnewbiblioitem( $dbh, $Zconn, $olddata );
 841
 842     # search subtiles, addiauthors and subjects
 843     ( $tagfield, $tagsubfield ) =
 844       MARCfind_marc_from_kohafield( $dbh, "additionalauthors.author",$frameworkcode );
 845     my @addiauthfields = $record->field($tagfield);
 846     foreach my $addiauthfield (@addiauthfields) {
 847         my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
 848         foreach my $subfieldcount ( 0 .. $#addiauthsubfields ) {
 849             REALmodaddauthor( $dbh, $biblionumber,
 850                 $addiauthsubfields[$subfieldcount] );
 851         }
 852     }
 853     ( $tagfield, $tagsubfield ) =
 854       MARCfind_marc_from_kohafield( $dbh, "bibliosubtitle.subtitle",$frameworkcode );
 855     my @subtitlefields = $record->field($tagfield);
 856     foreach my $subtitlefield (@subtitlefields) {
 857         my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
 858         foreach my $subfieldcount ( 0 .. $#subtitlesubfields ) {
 859             REALnewsubtitle( $dbh, $biblionumber,
 860                 $subtitlesubfields[$subfieldcount] );
 861         }
 862     }
 863     ( $tagfield, $tagsubfield ) =
 864       MARCfind_marc_from_kohafield( $dbh, "bibliosubject.subject",$frameworkcode );
 865     my @subj = $record->field($tagfield);
 866     my @subjects;
 867     foreach my $subject (@subj) {
 868         my @subjsubfield = $subject->subfield($tagsubfield);
 869         foreach my $subfieldcount ( 0 .. $#subjsubfield ) {
 870             push @subjects, $subjsubfield[$subfieldcount];
 871         }
 872     }
 873     REALmodsubject( $dbh, $biblionumber, 1, @subjects );
 874     return ( $biblionumber, $biblioitemnumber );
 875 }
 876
 877 =head2 NEWmodbilbioframework
 878
 879 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
 880
 881 =over 4
 882
 883 modify the framework of a biblio
 884
 885 =back
 886
 887 =cut
 888
 889 sub NEWmodbiblioframework {
 890         my ($dbh,$biblionumber,$frameworkcode) =@_;
 891         my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE biblionumber=?");
 892         $sth->execute($frameworkcode,$biblionumber);
 893         return 1;
 894 }
 895
 896 =head2 NEWmodbiblio
 897
 898 NEWmodbiblio($dbh,$Zconn,$MARCrecord,$biblionumber,$frameworkcode);
 899
 900 =over 4
 901
 902 modify a biblio (MARC=ON)
 903
 904 =back
 905
 906 =cut
 907
 908 sub NEWmodbiblio {
 909         my ($dbh,$Zconn,$record,$biblionumber,$frameworkcode) =@_;
 910         $frameworkcode="" unless $frameworkcode;
 911 #       &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,0);
 912         my $oldbiblio = MARCmarc2koha($dbh,$record,$frameworkcode);
 913
 914         $oldbiblio->{frameworkcode} = $frameworkcode;
 915         #create the marc entry, that stores the rax marc record in Koha 3.0
 916         $oldbiblio->{biblionumber} = $biblionumber unless $oldbiblio->{biblionumber};
 917         $oldbiblio->{marc} = $record->as_usmarc();
 918         $oldbiblio->{marcxml} = $record->as_xml();
 919         warn "dans NEWmodbiblio $biblionumber = ".$oldbiblio->{biblionumber}." = ".$oldbiblio->{marcxml};
 920         REALmodbiblio($dbh,$oldbiblio);
 921         REALmodbiblioitem($dbh,$Zconn,$oldbiblio);
 922         # now, modify addi authors, subject, addititles.
 923         my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author",$frameworkcode);
 924         my @addiauthfields = $record->field($tagfield);
 925         foreach my $addiauthfield (@addiauthfields) {
 926                 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
 927                 $dbh->do("delete from additionalauthors where biblionumber=$biblionumber");
 928                 foreach my $subfieldcount (0..$#addiauthsubfields) {
 929                         REALmodaddauthor($dbh,$biblionumber,$addiauthsubfields[$subfieldcount]);
 930                 }
 931         }
 932         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle",$frameworkcode);
 933         my @subtitlefields = $record->field($tagfield);
 934         foreach my $subtitlefield (@subtitlefields) {
 935                 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
 936                 # delete & create subtitle again because REALmodsubtitle can't handle new subtitles
 937                 # between 2 modifs
 938                 $dbh->do("delete from bibliosubtitle where biblionumber=$biblionumber");
 939                 foreach my $subfieldcount (0..$#subtitlesubfields) {
 940                         foreach my $subtit(split /\||#/,$subtitlesubfields[$subfieldcount]) {
 941                                 REALnewsubtitle($dbh,$biblionumber,$subtit);
 942                         }
 943                 }
 944         }
 945         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject",$frameworkcode);
 946         my @subj = $record->field($tagfield);
 947         my @subjects;
 948         foreach my $subject (@subj) {
 949                 my @subjsubfield = $subject->subfield($tagsubfield);
 950                 foreach my $subfieldcount (0..$#subjsubfield) {
 951                         push @subjects,$subjsubfield[$subfieldcount];
 952                 }
 953         }
 954         REALmodsubject($dbh,$biblionumber,1,@subjects);
 955         return 1;
 956 }
 957
 958 =head2 NEWmodbilbioframework
 959
 960 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
 961
 962 =over 4
 963
 964 delete a biblio
 965
 966 =back
 967
 968 =cut
 969
 970 sub NEWdelbiblio {
 971     my ( $dbh, $bibid ) = @_;
 972     my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
 973     &REALdelbiblio( $dbh, $biblio );
 974     my $sth =
 975       $dbh->prepare(
 976         "select biblioitemnumber from biblioitems where biblionumber=?");
 977     $sth->execute($biblio);
 978     while ( my ($biblioitemnumber) = $sth->fetchrow ) {
 979         REALdelbiblioitem( $dbh, $biblioitemnumber );
 980     }
 981     &MARCdelbiblio( $dbh, $bibid, 0 );
 982 }
 983
 984 =head2 NEWnewitem
 985
 986 $itemnumber = NEWnewitem($dbh, $Zconn, $record, $biblionumber, $biblioitemnumber);
 987
 988 =over 4
 989
 990 creates an item from a MARC::Record
 991
 992 =back
 993
 994 =cut
 995
 996 sub NEWnewitem {
 997     my ( $dbh,$Zconn,$record,$biblionumber,$biblioitemnumber ) = @_;
 998
 999     # add item in old-DB
1000         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
1001     my $item = &MARCmarc2koha( $dbh,$record,$frameworkcode );
1002     # needs old biblionumber and biblioitemnumber
1003     $item->{'biblionumber'} = $biblionumber;
1004     $item->{'biblioitemnumber'}=$biblioitemnumber;
1005     $item->{marc} = $record->as_usmarc();
1006     warn $item->{marc};
1007     my ( $itemnumber, $error ) = &REALnewitems( $dbh, $Zconn, $item, $item->{barcode} );
1008         return $itemnumber;
1009 }
1010
1011
1012 =head2 NEWmoditem
1013
1014 $itemnumber = NEWmoditem($dbh, $Zconn, $record, $biblionumber, $biblioitemnumber,$itemnumber);
1015
1016 =over 4
1017
1018 Modify an item
1019
1020 =back
1021
1022 =cut
1023
1024 sub NEWmoditem {
1025     my ( $dbh, $Zconn, $record, $biblionumber, $biblioitemnumber, $itemnumber) = @_;
1026
1027         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
1028     my $olditem = MARCmarc2koha( $dbh, $record,$frameworkcode );
1029         # add MARC record
1030         $olditem->{marc} = $record->as_usmarc();
1031         $olditem->{biblionumber} = $biblionumber;
1032         $olditem->{biblioitemnumber} = $biblioitemnumber;
1033         # and modify item
1034     REALmoditem( $dbh, $Zconn, $olditem );
1035 }
1036
1037
1038 =head2 NEWdelitem
1039
1040 $itemnumber = NEWdelitem($dbh, $biblionumber, $biblioitemnumber, $itemnumber);
1041
1042 =over 4
1043
1044 delete an item
1045
1046 =back
1047
1048 =cut
1049
1050 sub NEWdelitem {
1051     my ( $dbh, $bibid, $itemnumber ) = @_;
1052     my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
1053     &REALdelitem( $dbh, $itemnumber );
1054     &MARCdelitem( $dbh, $bibid, $itemnumber );
1055 }
1056
1057
1058 =head2 REALnewbiblio
1059
1060 $biblionumber = REALnewbiblio($dbh,$biblio);
1061
1062 =over 4
1063
1064 adds a record in biblio table. Datas are in the hash $biblio.
1065
1066 =back
1067
1068 =cut
1069
1070 sub REALnewbiblio {
1071     my ( $dbh, $biblio ) = @_;
1072
1073         $dbh->do('lock tables biblio WRITE');
1074     my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
1075     $sth->execute;
1076     my $data   = $sth->fetchrow_arrayref;
1077     my $bibnum = $$data[0] + 1;
1078     my $series = 0;
1079
1080     if ( $biblio->{'seriestitle'} ) { $series = 1 }
1081     $sth->finish;
1082     $sth =
1083       $dbh->prepare("insert into biblio set     biblionumber=?, title=?,                author=?,       copyrightdate=?,
1084                                                                                         serial=?,               seriestitle=?,  notes=?,        abstract=?,
1085                                                                                         unititle=?"
1086     );
1087     $sth->execute(
1088         $bibnum,             $biblio->{'title'},
1089         $biblio->{'author'}, $biblio->{'copyrightdate'},
1090         $biblio->{'serial'},             $biblio->{'seriestitle'},
1091         $biblio->{'notes'},  $biblio->{'abstract'},
1092                 $biblio->{'unititle'}
1093     );
1094
1095     $sth->finish;
1096         $dbh->do('unlock tables');
1097     return ($bibnum);
1098 }
1099
1100 =head2 REALmodbiblio
1101
1102 $biblionumber = REALmodbiblio($dbh,$biblio);
1103
1104 =over 4
1105
1106 modify a record in biblio table. Datas are in the hash $biblio.
1107
1108 =back
1109
1110 =cut
1111
1112 sub REALmodbiblio {
1113     my ( $dbh, $biblio ) = @_;
1114     my $sth = $dbh->prepare("Update biblio set  title=?,                author=?,       abstract=?,     copyrightdate=?,
1115                                                                                                 seriestitle=?,  serial=?,       unititle=?,     notes=?,        frameworkcode=?
1116                                                                                         where biblionumber = ?"
1117     );
1118     $sth->execute(
1119                 $biblio->{'title'},       $biblio->{'author'},
1120                 $biblio->{'abstract'},    $biblio->{'copyrightdate'},
1121                 $biblio->{'seriestitle'}, $biblio->{'serial'},
1122                 $biblio->{'unititle'},    $biblio->{'notes'},
1123                 $biblio->{frameworkcode},
1124                 $biblio->{'biblionumber'}
1125     );
1126         $sth->finish;
1127         return ( $biblio->{'biblionumber'} );
1128 }    # sub modbiblio
1129
1130 =head2 REALmodsubtitle
1131
1132 REALmodsubtitle($dbh,$bibnum,$subtitle);
1133
1134 =over 4
1135
1136 modify subtitles in bibliosubtitle table.
1137
1138 =back
1139
1140 =cut
1141
1142 sub REALmodsubtitle {
1143     my ( $dbh, $bibnum, $subtitle ) = @_;
1144     my $sth =
1145       $dbh->prepare(
1146         "update bibliosubtitle set subtitle = ? where biblionumber = ?");
1147     $sth->execute( $subtitle, $bibnum );
1148     $sth->finish;
1149 }    # sub modsubtitle
1150
1151 =head2 REALmodaddauthor
1152
1153 REALmodaddauthor($dbh,$bibnum,$author);
1154
1155 =over 4
1156
1157 adds or modify additional authors
1158 NOTE :  Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
1159
1160 =back
1161
1162 =cut
1163
1164 sub REALmodaddauthor {
1165     my ( $dbh, $bibnum, @authors ) = @_;
1166
1167     #    my $dbh   = C4Connect;
1168     my $sth =
1169       $dbh->prepare("Delete from additionalauthors where biblionumber = ?");
1170
1171     $sth->execute($bibnum);
1172     $sth->finish;
1173     foreach my $author (@authors) {
1174         if ( $author ne '' ) {
1175             $sth =
1176               $dbh->prepare(
1177                 "Insert into additionalauthors set author = ?, biblionumber = ?"
1178             );
1179
1180             $sth->execute( $author, $bibnum );
1181
1182             $sth->finish;
1183         }    # if
1184     }
1185 }    # sub modaddauthor
1186
1187 =head2 REALmodsubject
1188
1189 $errors = REALmodsubject($dbh,$bibnum, $force, @subject);
1190
1191 =over 4
1192
1193 modify/adds subjects
1194
1195 =back
1196
1197 =cut
1198 sub REALmodsubject {
1199     my ( $dbh, $bibnum, $force, @subject ) = @_;
1200
1201     #  my $dbh   = C4Connect;
1202     my $count = @subject;
1203     my $error="";
1204     for ( my $i = 0 ; $i < $count ; $i++ ) {
1205         $subject[$i] =~ s/^ //g;
1206         $subject[$i] =~ s/ $//g;
1207         my $sth =
1208           $dbh->prepare(
1209 "select * from catalogueentry where entrytype = 's' and catalogueentry = ?"
1210         );
1211         $sth->execute( $subject[$i] );
1212
1213         if ( my $data = $sth->fetchrow_hashref ) {
1214         }
1215         else {
1216             if ( $force eq $subject[$i] || $force == 1 ) {
1217
1218                 # subject not in aut, chosen to force anway
1219                 # so insert into cataloguentry so its in auth file
1220                 my $sth2 =
1221                   $dbh->prepare(
1222 "Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)"
1223                 );
1224
1225                 $sth2->execute( $subject[$i] ) if ( $subject[$i] );
1226                 $sth2->finish;
1227             }
1228             else {
1229                 $error =
1230                   "$subject[$i]\n does not exist in the subject authority file";
1231                 my $sth2 =
1232                   $dbh->prepare(
1233 "Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)"
1234                 );
1235                 $sth2->execute( "$subject[$i] %", "% $subject[$i] %",
1236                     "% $subject[$i]" );
1237                 while ( my $data = $sth2->fetchrow_hashref ) {
1238                     $error .= "<br>$data->{'catalogueentry'}";
1239                 }    # while
1240                 $sth2->finish;
1241             }    # else
1242         }    # else
1243         $sth->finish;
1244     }    # else
1245     if ($error eq '') {
1246         my $sth =
1247           $dbh->prepare("Delete from bibliosubject where biblionumber = ?");
1248         $sth->execute($bibnum);
1249         $sth->finish;
1250         $sth =
1251           $dbh->prepare(
1252             "Insert into bibliosubject (subject,biblionumber) values (?,?)");
1253         my $query;
1254         foreach $query (@subject) {
1255             $sth->execute( $query, $bibnum ) if ( $query && $bibnum );
1256         }    # foreach
1257         $sth->finish;
1258     }    # if
1259
1260     #  $dbh->disconnect;
1261     return ($error);
1262 }    # sub modsubject
1263
1264 =head2 REALmodbiblioitem
1265
1266 REALmodbiblioitem($dbh, $biblioitem);
1267
1268 =over 4
1269
1270 modify a biblioitem
1271
1272 =back
1273
1274 =cut
1275 sub REALmodbiblioitem {
1276     my ( $dbh, $Zconn, $biblioitem ) = @_;
1277     my $query;
1278
1279     my $sth = $dbh->prepare("update biblioitems set number=?,volume=?,                  volumedate=?,           lccn=?,
1280                                                                                 itemtype=?,                     url=?,                          isbn=?,                         issn=?,
1281                                                                                 publishercode=?,        publicationyear=?,      classification=?,       dewey=?,
1282                                                                                 subclass=?,                     illus=?,                        pages=?,                        volumeddesc=?,
1283                                                                                 notes=?,                        size=?,                         place=?,                        marc=?,
1284                                                                                 marcxml=?
1285                                                         where biblioitemnumber=?");
1286         $sth->execute(  $biblioitem->{number},                  $biblioitem->{volume},  $biblioitem->{volumedate},      $biblioitem->{lccn},
1287                                         $biblioitem->{itemtype},                $biblioitem->{url},             $biblioitem->{isbn},    $biblioitem->{issn},
1288                                 $biblioitem->{publishercode},   $biblioitem->{publicationyear}, $biblioitem->{classification},  $biblioitem->{dewey},
1289                                 $biblioitem->{subclass},                $biblioitem->{illus},           $biblioitem->{pages},   $biblioitem->{volumeddesc},
1290                                 $biblioitem->{bnotes},                  $biblioitem->{size},            $biblioitem->{place},   $biblioitem->{marc},
1291                                         $biblioitem->{marcxml},                 $biblioitem->{biblioitemnumber});
1292         my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1293
1294         #my $Zconn = C4::Context->Zconn or die "unable to set Zconn";
1295         z3950_extended_services($Zconn,'update',set_service_options('update'),$record);
1296          #z3950_extended_services($Zconn,'commit',set_service_options('commit'));
1297
1298
1299 #       warn "MOD : $biblioitem->{biblioitemnumber} = ".$biblioitem->{marc};
1300 }    # sub modbibitem
1301
1302 =head2 REALnewbiblioitem
1303
1304 REALnewbiblioitem($dbh,$Zconn,$biblioitem);
1305
1306 =over 4
1307
1308 adds a biblioitem ($biblioitem is a hash with the values)
1309
1310 =back
1311
1312 =cut
1313
1314 sub REALnewbiblioitem {
1315         my ( $dbh, $Zconn, $biblioitem ) = @_;
1316
1317         $dbh->do("lock tables biblioitems WRITE, biblio WRITE, marc_subfield_structure READ");
1318         my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems");
1319         my $data;
1320         my $biblioitemnumber;
1321
1322         $sth->execute;
1323         $data       = $sth->fetchrow_arrayref;
1324         $biblioitemnumber = $$data[0] + 1;
1325
1326         # Insert biblioitemnumber in MARC record, we need it to manage items later...
1327         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblioitem->{biblionumber});
1328         my ($biblioitemnumberfield,$biblioitemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'biblioitems.biblioitemnumber',$frameworkcode);
1329         my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1330         my $field=$record->field($biblioitemnumberfield);
1331         $field->update($biblioitemnumbersubfield => "$biblioitemnumber");
1332         $biblioitem->{marc} = $record->as_usmarc();
1333         $biblioitem->{marcxml} = $record->as_xml();
1334
1335         $sth = $dbh->prepare( "insert into biblioitems set
1336                                                                         biblioitemnumber = ?,           biblionumber     = ?,
1337                                                                         volume           = ?,                   number           = ?,
1338                                                                         classification  = ?,                    itemtype         = ?,
1339                                                                         url              = ?,                           isbn             = ?,
1340                                                                         issn             = ?,                           dewey            = ?,
1341                                                                         subclass         = ?,                           publicationyear  = ?,
1342                                                                         publishercode    = ?,           volumedate       = ?,
1343                                                                         volumeddesc      = ?,           illus            = ?,
1344                                                                         pages            = ?,                           notes            = ?,
1345                                                                         size             = ?,                           lccn             = ?,
1346                                                                         marc             = ?,                           place            = ?,
1347                                                                         marcxml          = ?"
1348         );
1349         $sth->execute(
1350                 $biblioitemnumber,               $biblioitem->{'biblionumber'},
1351                 $biblioitem->{'volume'},         $biblioitem->{'number'},
1352                 $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
1353                 $biblioitem->{'url'},            $biblioitem->{'isbn'},
1354                 $biblioitem->{'issn'},           $biblioitem->{'dewey'},
1355                 $biblioitem->{'subclass'},       $biblioitem->{'publicationyear'},
1356                 $biblioitem->{'publishercode'},  $biblioitem->{'volumedate'},
1357                 $biblioitem->{'volumeddesc'},    $biblioitem->{'illus'},
1358                 $biblioitem->{'pages'},          $biblioitem->{'bnotes'},
1359                 $biblioitem->{'size'},           $biblioitem->{'lccn'},
1360                 $biblioitem->{'marc'},           $biblioitem->{'place'},
1361                 $biblioitem->{marcxml},
1362         );
1363         $dbh->do("unlock tables");
1364         #my $Zconn = C4::Context->Zconn or die "unable to set Zconn";
1365         z3950_extended_services($Zconn,'update',set_service_options('update'),$record);
1366         #z3950_extended_services($Zconn,'commit',set_service_options('commit'));
1367         #zebra_create($biblioitem->{biblionumber}, $record);
1368         return ($biblioitemnumber);
1369 }
1370
1371 =head2 REALnewsubtitle
1372
1373 REALnewsubtitle($dbh,$bibnum,$subtitle);
1374
1375 =over 4
1376
1377 create a new subtitle
1378
1379 =back
1380
1381 =cut
1382 sub REALnewsubtitle {
1383     my ( $dbh, $bibnum, $subtitle ) = @_;
1384     my $sth =
1385       $dbh->prepare(
1386         "insert into bibliosubtitle set biblionumber = ?, subtitle = ?");
1387     $sth->execute( $bibnum, $subtitle ) if $subtitle;
1388     $sth->finish;
1389 }
1390
1391 =head2 REALnewitems
1392
1393 ($itemnumber,$errors)= REALnewitems($dbh,$Zconn,$item,$barcode);
1394
1395 =over 4
1396
1397 create a item. $item is a hash and $barcode the barcode.
1398
1399 =back
1400
1401 =cut
1402
1403 sub REALnewitems {
1404     my ( $dbh, $Zconn,$item, $barcode ) = @_;
1405
1406 #       warn "OLDNEWITEMS";
1407
1408         $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE,marc_subfield_structure WRITE');
1409     my $sth = $dbh->prepare("Select max(itemnumber) from items");
1410     my $data;
1411     my $itemnumber;
1412     my $error = "";
1413     $sth->execute;
1414     $data       = $sth->fetchrow_hashref;
1415     $itemnumber = $data->{'max(itemnumber)'} + 1;
1416
1417 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
1418     if ( $item->{'loan'} ) {
1419         $item->{'notforloan'} = $item->{'loan'};
1420     }
1421         $item->{'biblioitemnumber'} = 1;
1422     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1423     if ( $item->{'dateaccessioned'} ) {
1424         $sth = $dbh->prepare( "Insert into items set
1425                                                         itemnumber           = ?,                       biblionumber         = ?,
1426                                                         multivolumepart      = ?,
1427                                                         biblioitemnumber     = ?,                       barcode              = ?,
1428                                                         booksellerid         = ?,                       dateaccessioned      = ?,
1429                                                         homebranch           = ?,                       holdingbranch        = ?,
1430                                                         price                = ?,                       replacementprice     = ?,
1431                                                         replacementpricedate = NOW(),           datelastseen            = NOW(),
1432                                                         multivolume                     = ?,                    stack                           = ?,
1433                                                         itemlost                        = ?,                    wthdrawn                        = ?,
1434                                                         paidfor                         = ?,                    itemnotes            = ?,
1435                                                         itemcallnumber  =?,                                                     notforloan = ?,
1436                                                         location = ?
1437                                                         "
1438         );
1439         $sth->execute(
1440                         $itemnumber,                            $item->{'biblionumber'},
1441                         $item->{'multivolumepart'},
1442                         $item->{'biblioitemnumber'},$item->{barcode},
1443                         $item->{'booksellerid'},        $item->{'dateaccessioned'},
1444                         $item->{'homebranch'},          $item->{'holdingbranch'},
1445                         $item->{'price'},                       $item->{'replacementprice'},
1446                         $item->{multivolume},           $item->{stack},
1447                         $item->{itemlost},                      $item->{wthdrawn},
1448                         $item->{paidfor},                       $item->{'itemnotes'},
1449                         $item->{'itemcallnumber'},      $item->{'notforloan'},
1450                         $item->{'location'}
1451         );
1452                 if ( defined $sth->errstr ) {
1453                         $error .= $sth->errstr;
1454                 }
1455     }
1456     else {
1457         $sth = $dbh->prepare( "Insert into items set
1458                                                         itemnumber           = ?,                       biblionumber         = ?,
1459                                                         multivolumepart      = ?,
1460                                                         biblioitemnumber     = ?,                       barcode              = ?,
1461                                                         booksellerid         = ?,                       dateaccessioned      = NOW(),
1462                                                         homebranch           = ?,                       holdingbranch        = ?,
1463                                                         price                = ?,                       replacementprice     = ?,
1464                                                         replacementpricedate = NOW(),           datelastseen            = NOW(),
1465                                                         multivolume                     = ?,                    stack                           = ?,
1466                                                         itemlost                        = ?,                    wthdrawn                        = ?,
1467                                                         paidfor                         = ?,                    itemnotes            = ?,
1468                                                         itemcallnumber  =?,                                                     notforloan = ?,
1469                                                         location = ?
1470                                                         "
1471         );
1472         $sth->execute(
1473                         $itemnumber,                            $item->{'biblionumber'},
1474                         $item->{'multivolumepart'},
1475                         $item->{'biblioitemnumber'},$item->{barcode},
1476                         $item->{'booksellerid'},
1477                         $item->{'homebranch'},          $item->{'holdingbranch'},
1478                         $item->{'price'},                       $item->{'replacementprice'},
1479                         $item->{multivolume},           $item->{stack},
1480                         $item->{itemlost},                      $item->{wthdrawn},
1481                         $item->{paidfor},                       $item->{'itemnotes'},
1482                         $item->{'itemcallnumber'},      $item->{'notforloan'},
1483                         $item->{'location'}
1484         );
1485                 if ( defined $sth->errstr ) {
1486                         $error .= $sth->errstr;
1487                 }
1488     }
1489         # item stored, now, deal with the marc part...
1490         $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1491                                                         where   biblio.biblionumber=biblioitems.biblionumber and
1492                                                                         biblio.biblionumber=?");
1493         $sth->execute($item->{biblionumber});
1494     if ( defined $sth->errstr ) {
1495         $error .= $sth->errstr;
1496     }
1497         my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1498         warn "ERROR IN REALnewitem, MARC record not found FOR $item->{biblionumber} => $rawmarc <=" unless $rawmarc;
1499         my $record = MARC::File::USMARC::decode($rawmarc);
1500         # ok, we have the marc record, add item number to the item field (in {marc}, and add the field to the record)
1501         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1502         my $itemrecord = MARC::Record->new_from_usmarc($item->{marc});
1503         warn $itemrecord;
1504         warn $itemnumberfield;
1505         warn $itemrecord->field($itemnumberfield);
1506         my $itemfield = $itemrecord->field($itemnumberfield);
1507         $itemfield->add_subfields($itemnumbersubfield => "$itemnumber");
1508         $record->insert_grouped_field($itemfield);
1509         # save the record into biblioitem
1510         $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=?");
1511         $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber});
1512     if ( defined $sth->errstr ) {
1513         $error .= $sth->errstr;
1514     }
1515         #my $Zconn = C4::Context->Zconn or die "unable to set Zconn";
1516          z3950_extended_services($Zconn,'update',set_service_options('update'),$record);
1517          # z3950_extended_services($Zconn,'commit',set_service_options('commit'));
1518          #zebra_create($item->{biblionumber},$record);
1519         $dbh->do('unlock tables');
1520     return ( $itemnumber, $error );
1521 }
1522
1523 =head2 REALmoditem($dbh,$Zconn,$item);
1524
1525 =over 4
1526
1527 modify item
1528
1529 =back
1530
1531 =cut
1532
1533 sub REALmoditem {
1534     my ( $dbh, $Zconn, $item ) = @_;
1535     $item->{'bibitemnum'} = 1;
1536         my $error;
1537         $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE');
1538     $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
1539     my $query = "update items set  barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1540     my @bind = (
1541         $item->{'barcode'},                     $item->{'itemnotes'},
1542         $item->{'itemcallnumber'},      $item->{'notforloan'},
1543         $item->{'location'},            $item->{multivolumepart},
1544                 $item->{multivolume},           $item->{stack},
1545                 $item->{wthdrawn},
1546     );
1547     if ( $item->{'lost'} ne '' ) {
1548         $query = "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
1549                                                         itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
1550                                                         location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1551         @bind = (
1552             $item->{'bibitemnum'},     $item->{'barcode'},
1553             $item->{'itemnotes'},          $item->{'homebranch'},
1554             $item->{'lost'},           $item->{'wthdrawn'},
1555             $item->{'itemcallnumber'}, $item->{'notforloan'},
1556             $item->{'location'},                $item->{multivolumepart},
1557                         $item->{multivolume},           $item->{stack},
1558                         $item->{wthdrawn},
1559         );
1560                 if ($item->{homebranch}) {
1561                         $query.=",homebranch=?";
1562                         push @bind, $item->{homebranch};
1563                 }
1564                 if ($item->{holdingbranch}) {
1565                         $query.=",holdingbranch=?";
1566                         push @bind, $item->{holdingbranch};
1567                 }
1568     }
1569         $query.=" where itemnumber=?";
1570         push @bind,$item->{'itemnum'};
1571    if ( $item->{'replacement'} ne '' ) {
1572         $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1573     }
1574     my $sth = $dbh->prepare($query);
1575     $sth->execute(@bind);
1576
1577         # item stored, now, deal with the marc part...
1578         $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1579                                                         where   biblio.biblionumber=biblioitems.biblionumber and
1580                                                                         biblio.biblionumber=? and
1581                                                                         biblioitems.biblioitemnumber=?");
1582         $sth->execute($item->{biblionumber},$item->{biblioitemnumber});
1583     if ( defined $sth->errstr ) {
1584         $error .= $sth->errstr;
1585     }
1586         my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1587         warn "ERROR IN REALmoditem, MARC record not found" unless $rawmarc;
1588         my $record = MARC::File::USMARC::decode($rawmarc);
1589         # ok, we have the marc record, find the previous item record for this itemnumber and delete it
1590         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1591         # prepare the new item record
1592         my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1593         my $itemfield = $itemrecord->field($itemnumberfield);
1594         $itemfield->add_subfields($itemnumbersubfield => '$itemnumber');
1595         # parse all fields fields from the complete record
1596         foreach ($record->field($itemnumberfield)) {
1597                 # when the previous field is found, replace by the new one
1598                 if ($_->subfield($itemnumbersubfield) == $item->{itemnum}) {
1599                         $_->replace_with($itemfield);
1600                 }
1601         }
1602 #       $record->insert_grouped_field($itemfield);
1603         # save the record into biblioitem
1604         $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=? and biblioitemnumber=?");
1605         $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber},$item->{biblioitemnumber});
1606         #my $Zconn = C4::Context->Zconn or die "unable to set Zconn";
1607          z3950_extended_services($Zconn,'update',set_service_options('update'),$record);
1608          # z3950_extended_services($Zconn,'commit',set_service_options('commit'));
1609          #zebra_create($item->biblionumber,$record);
1610     if ( defined $sth->errstr ) {
1611         $error .= $sth->errstr;
1612     }
1613         $dbh->do('unlock tables');
1614
1615     #  $dbh->disconnect;
1616 }
1617
1618 =head2 REALdelitem($dbh,$itemnum);
1619
1620 =over 4
1621
1622 delete item
1623
1624 =back
1625
1626 =cut
1627
1628 sub REALdelitem {
1629     my ( $dbh, $itemnum ) = @_;
1630
1631     #  my $dbh=C4Connect;
1632     my $sth = $dbh->prepare("select * from items where itemnumber=?");
1633     $sth->execute($itemnum);
1634     my $data = $sth->fetchrow_hashref;
1635     $sth->finish;
1636     my $query = "Insert into deleteditems set ";
1637     my @bind  = ();
1638     foreach my $temp ( keys %$data ) {
1639         $query .= "$temp = ?,";
1640         push ( @bind, $data->{$temp} );
1641     }
1642     $query =~ s/\,$//;
1643
1644     #  print $query;
1645     $sth = $dbh->prepare($query);
1646     $sth->execute(@bind);
1647     $sth->finish;
1648     $sth = $dbh->prepare("Delete from items where itemnumber=?");
1649     $sth->execute($itemnum);
1650     $sth->finish;
1651
1652     #  $dbh->disconnect;
1653 }
1654
1655 =head2 REALdelbiblioitem($dbh,$biblioitemnumber);
1656
1657 =over 4
1658
1659 deletes a biblioitem
1660 NOTE : not standard sub name. Should be REALdelbiblioitem()
1661
1662 =back
1663
1664 =cut
1665
1666 sub REALdelbiblioitem {
1667     my ( $dbh, $biblioitemnumber ) = @_;
1668
1669     #    my $dbh   = C4Connect;
1670     my $sth = $dbh->prepare( "Select * from biblioitems
1671 where biblioitemnumber = ?"
1672     );
1673     my $results;
1674
1675     $sth->execute($biblioitemnumber);
1676
1677     if ( $results = $sth->fetchrow_hashref ) {
1678         $sth->finish;
1679         $sth =
1680           $dbh->prepare(
1681 "Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
1682                                         isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
1683                                         pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
1684         );
1685
1686         $sth->execute(
1687             $results->{biblioitemnumber}, $results->{biblionumber},
1688             $results->{volume},           $results->{number},
1689             $results->{classification},   $results->{itemtype},
1690             $results->{isbn},             $results->{issn},
1691             $results->{dewey},            $results->{subclass},
1692             $results->{publicationyear},  $results->{publishercode},
1693             $results->{volumedate},       $results->{volumeddesc},
1694             $results->{timestamp},        $results->{illus},
1695             $results->{pages},            $results->{notes},
1696             $results->{size},             $results->{url},
1697             $results->{lccn}
1698         );
1699         my $sth2 =
1700           $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?");
1701         $sth2->execute($biblioitemnumber);
1702         $sth2->finish();
1703     }    # if
1704     $sth->finish;
1705
1706     # Now delete all the items attached to the biblioitem
1707     $sth = $dbh->prepare("Select * from items where biblioitemnumber = ?");
1708     $sth->execute($biblioitemnumber);
1709     my @results;
1710     while ( my $data = $sth->fetchrow_hashref ) {
1711         my $query = "Insert into deleteditems set ";
1712         my @bind  = ();
1713         foreach my $temp ( keys %$data ) {
1714             $query .= "$temp = ?,";
1715             push ( @bind, $data->{$temp} );
1716         }
1717         $query =~ s/\,$//;
1718         my $sth2 = $dbh->prepare($query);
1719         $sth2->execute(@bind);
1720     }    # while
1721     $sth->finish;
1722     $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
1723     $sth->execute($biblioitemnumber);
1724     $sth->finish();
1725
1726     #    $dbh->disconnect;
1727 }    # sub deletebiblioitem
1728
1729 =head2 REALdelbiblio($dbh,$biblio);
1730
1731 =over 4
1732
1733 delete a biblio
1734
1735 =back
1736
1737 =cut
1738
1739 sub REALdelbiblio {
1740     my ( $dbh, $biblio ) = @_;
1741     my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
1742     $sth->execute($biblio);
1743     if ( my $data = $sth->fetchrow_hashref ) {
1744         $sth->finish;
1745         my $query = "Insert into deletedbiblio set ";
1746         my @bind  = ();
1747         foreach my $temp ( keys %$data ) {
1748             $query .= "$temp = ?,";
1749             push ( @bind, $data->{$temp} );
1750         }
1751
1752         #replacing the last , by ",?)"
1753         $query =~ s/\,$//;
1754         $sth = $dbh->prepare($query);
1755         $sth->execute(@bind);
1756         $sth->finish;
1757         $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
1758         $sth->execute($biblio);
1759         $sth->finish;
1760     }
1761     $sth->finish;
1762 }
1763
1764 =head2 itemcount
1765
1766 $number = itemcount($biblio);
1767
1768 =over 4
1769
1770 returns the number of items attached to a biblio
1771
1772 =back
1773
1774 =cut
1775
1776 sub itemcount {
1777     my ($biblio) = @_;
1778     my $dbh = C4::Context->dbh;
1779
1780     #  print $query;
1781     my $sth = $dbh->prepare("Select count(*) from items where biblionumber=?");
1782     $sth->execute($biblio);
1783     my $data = $sth->fetchrow_hashref;
1784     $sth->finish;
1785     return ( $data->{'count(*)'} );
1786 }
1787
1788 =head2 newbiblio
1789
1790 $biblionumber = newbiblio($biblio);
1791
1792 =over 4
1793
1794 create a biblio. The parameter is a hash
1795
1796 =back
1797
1798 =cut
1799
1800 sub newbiblio {
1801     my ($biblio) = @_;
1802     my $dbh    = C4::Context->dbh;
1803     my $bibnum = REALnewbiblio( $dbh, $biblio );
1804     # finds new (MARC bibid
1805     #   my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1806 #     my $record = &MARCkoha2marcBiblio( $dbh, $bibnum );
1807 #     MARCaddbiblio( $dbh, $record, $bibnum,'' );
1808     return ($bibnum);
1809 }
1810
1811 =head2  modbiblio
1812
1813 $biblionumber = &modbiblio($biblio);
1814
1815 =over 4
1816
1817 Update a biblio record.
1818
1819 C<$biblio> is a reference-to-hash whose keys are the fields in the
1820 biblio table in the Koha database. All fields must be present, not
1821 just the ones you wish to change.
1822
1823 C<&modbiblio> updates the record defined by
1824 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1825
1826 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1827 successful or not.
1828
1829 =back
1830
1831 =cut
1832
1833 sub modbiblio {
1834         my ($biblio) = @_;
1835         my $dbh  = C4::Context->dbh;
1836         my $biblionumber=REALmodbiblio($dbh,$biblio);
1837         my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
1838         # finds new (MARC bibid
1839         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
1840         MARCmodbiblio($dbh,$bibid,$record,"",0);
1841         return($biblionumber);
1842 } # sub modbiblio
1843
1844 =head2 &modsubtitle($biblionumber, $subtitle);
1845
1846 =over 4
1847
1848 Sets the subtitle of a book.
1849
1850 C<$biblionumber> is the biblionumber of the book to modify.
1851
1852 C<$subtitle> is the new subtitle.
1853
1854 =back
1855
1856 =cut
1857
1858 sub modsubtitle {
1859     my ( $bibnum, $subtitle ) = @_;
1860     my $dbh = C4::Context->dbh;
1861     &REALmodsubtitle( $dbh, $bibnum, $subtitle );
1862 }    # sub modsubtitle
1863
1864 =head2 &modaddauthor($biblionumber, $author);
1865
1866 =over 4
1867
1868 Replaces all additional authors for the book with biblio number
1869 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1870 C<&modaddauthor> deletes all additional authors.
1871
1872 =back
1873
1874 =cut
1875
1876 sub modaddauthor {
1877     my ( $bibnum, @authors ) = @_;
1878     my $dbh = C4::Context->dbh;
1879     &REALmodaddauthor( $dbh, $bibnum, @authors );
1880 }    # sub modaddauthor
1881
1882 =head2 modsubject
1883
1884 $error = &modsubject($biblionumber, $force, @subjects);
1885
1886 =over 4
1887
1888 $force - a subject to force
1889 $error - Error message, or undef if successful.
1890
1891 =back
1892
1893 =cut
1894
1895 sub modsubject {
1896     my ( $bibnum, $force, @subject ) = @_;
1897     my $dbh = C4::Context->dbh;
1898     my $error = &REALmodsubject( $dbh, $bibnum, $force, @subject );
1899     if ($error eq ''){
1900                 # When MARC is off, ensures that the MARC biblio table gets updated with new
1901                 # subjects, of course, it deletes the biblio in marc, and then recreates.
1902                 # This check is to ensure that no MARC data exists to lose.
1903 #               if (C4::Context->preference("MARC") eq '0'){
1904 #               warn "in modSUBJECT";
1905 #                       my $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibnum);
1906 #                       my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1907 #                       &MARCmodbiblio($dbh,$bibid, $MARCRecord);
1908 #               }
1909         }
1910         return ($error);
1911 }    # sub modsubject
1912
1913 =head2 modbibitem($dbh, $Zconn,$biblioitem);
1914
1915 =over 4
1916
1917 modify a biblioitem. The parameter is a hash
1918
1919 =back
1920
1921 =cut
1922
1923 sub modbibitem {
1924     my ($dbh, $Zconn, $biblioitem) = @_;
1925     #my $dbh = C4::Context->dbh;
1926     &REALmodbiblioitem( $dbh, $Zconn, $biblioitem );
1927 }    # sub modbibitem
1928
1929 =head2 newbiblioitem
1930
1931 $biblioitemnumber = newbiblioitem($biblioitem)
1932
1933 =over 4
1934
1935 create a biblioitem, the parameter is a hash
1936
1937 =back
1938
1939 =cut
1940
1941 sub newbiblioitem {
1942     my ($dbh, $Zconn, $biblioitem) = @_;
1943     #my $dbh        = C4::Context->dbh;
1944         # add biblio information to the hash
1945     my $MARCbiblio = MARCkoha2marcBiblio( $dbh, $biblioitem );
1946         $biblioitem->{marc} = $MARCbiblio->as_usmarc();
1947     my $bibitemnum = &REALnewbiblioitem( $dbh, $Zconn, $biblioitem );
1948     return ($bibitemnum);
1949 }
1950
1951 =head2 newsubtitle($biblionumber,$subtitle);
1952
1953 =over 4
1954
1955 insert a subtitle for $biblionumber biblio
1956
1957 =back
1958
1959 =cut
1960
1961
1962 sub newsubtitle {
1963     my ( $bibnum, $subtitle ) = @_;
1964     my $dbh = C4::Context->dbh;
1965     &REALnewsubtitle( $dbh, $bibnum, $subtitle );
1966 }
1967
1968 =head2 newitems
1969
1970 $errors = newitems($dbh, $Zconn, $item, @barcodes);
1971
1972 =over 4
1973
1974 insert items ($item is a hash)
1975
1976 =back
1977
1978 =cut
1979
1980
1981 sub newitems {
1982     my ( $dbh, $Zconn, $item, @barcodes ) = @_;
1983     #my $dbh = C4::Context->dbh;
1984     my $errors;
1985     my $itemnumber;
1986     my $error;
1987     foreach my $barcode (@barcodes) {
1988                 # add items, one by one for each barcode.
1989                 my $oneitem=$item;
1990                 $oneitem->{barcode}= $barcode;
1991         my $MARCitem = &MARCkoha2marcItem( $dbh, $oneitem);
1992                 $oneitem->{marc} = $MARCitem->as_usmarc;
1993         ( $itemnumber, $error ) = &REALnewitems( $dbh,$Zconn,$oneitem);
1994 #         $errors .= $error;
1995 #         &MARCadditem( $dbh, $MARCitem, $item->{biblionumber} );
1996     }
1997     return ($errors);
1998 }
1999
2000 =head2 moditem($dbh,$Zconn,$item);
2001
2002 =over 4
2003
2004 modify an item ($item is a hash with all item informations)
2005
2006 =back
2007
2008 =cut
2009
2010
2011 sub moditem {
2012     my ($dbh,$Zconn,$item) = @_;
2013     #my $dbh = C4::Context->dbh;
2014     &REALmoditem( $dbh, $Zconn, $item );
2015     my $MARCitem =
2016       &MARCkoha2marcItem( $dbh, $item->{'biblionumber'}, $item->{'itemnum'} );
2017     my $bibid =
2018       &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $item->{biblionumber} );
2019     &MARCmoditem( $dbh, $MARCitem, $bibid, $item->{itemnum}, 0 );
2020 }
2021
2022 =head2 checkitems
2023
2024 $error = checkitems($count,@barcodes);
2025
2026 =over 4
2027
2028 check for each @barcode entry that the barcode is not a duplicate
2029
2030 =back
2031
2032 =cut
2033
2034 sub checkitems {
2035     my ( $count, @barcodes ) = @_;
2036     my $dbh = C4::Context->dbh;
2037     my $error;
2038     my $sth = $dbh->prepare("Select * from items where barcode=?");
2039     for ( my $i = 0 ; $i < $count ; $i++ ) {
2040         $barcodes[$i] = uc $barcodes[$i];
2041         $sth->execute( $barcodes[$i] );
2042         if ( my $data = $sth->fetchrow_hashref ) {
2043             $error .= " Duplicate Barcode: $barcodes[$i]";
2044         }
2045     }
2046     $sth->finish;
2047     return ($error);
2048 }
2049
2050 =head2 delitem($itemnum);
2051
2052 =over 4
2053
2054 delete item $itemnum being the item number to delete
2055
2056 =back
2057
2058 =cut
2059
2060 sub delitem {
2061     my ($itemnum) = @_;
2062     my $dbh = C4::Context->dbh;
2063     &REALdelitem( $dbh, $itemnum );
2064 }
2065
2066 =head2 deletebiblioitem($biblioitemnumber);
2067
2068 =over 4
2069
2070 delete the biblioitem $biblioitemnumber
2071
2072 =back
2073
2074 =cut
2075
2076 sub deletebiblioitem {
2077     my ($biblioitemnumber) = @_;
2078     my $dbh = C4::Context->dbh;
2079     &REALdelbiblioitem( $dbh, $biblioitemnumber );
2080 }    # sub deletebiblioitem
2081
2082 =head2 delbiblio($biblionumber)
2083
2084 =over 4
2085
2086 delete biblio $biblionumber
2087
2088 =back
2089
2090 =cut
2091
2092 sub delbiblio {
2093     my ($biblio) = @_;
2094     my $dbh = C4::Context->dbh;
2095     &REALdelbiblio( $dbh, $biblio );
2096     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio );
2097     &MARCdelbiblio( $dbh, $bibid, 0 );
2098 }
2099
2100 =head2 getbiblio
2101
2102 ($count,@results) = getbiblio($biblionumber);
2103
2104 =over 4
2105
2106 return an array with hash of biblios.
2107
2108 FIXME : biblionumber being the primary key, this sub will always return only 1 result, API should be modified...
2109
2110 =back
2111
2112 =cut
2113
2114 sub getbiblio {
2115     my ($biblionumber) = @_;
2116     my $dbh = C4::Context->dbh;
2117     my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
2118
2119     # || die "Cannot prepare $query\n" . $dbh->errstr;
2120     my $count = 0;
2121     my @results;
2122
2123     $sth->execute($biblionumber);
2124
2125     # || die "Cannot execute $query\n" . $sth->errstr;
2126     while ( my $data = $sth->fetchrow_hashref ) {
2127         $results[$count] = $data;
2128         $count++;
2129     }    # while
2130
2131     $sth->finish;
2132     return ( $count, @results );
2133 }    # sub getbiblio
2134
2135 =item bibdata
2136
2137   $data = &bibdata($biblionumber, $type);
2138
2139 Returns information about the book with the given biblionumber.
2140
2141 C<$type> is ignored.
2142
2143 C<&bibdata> returns a reference-to-hash. The keys are the fields in
2144 the C<biblio>, C<biblioitems>, and C<bibliosubtitle> tables in the
2145 Koha database.
2146
2147 In addition, C<$data-E<gt>{subject}> is the list of the book's
2148 subjects, separated by C<" , "> (space, comma, space).
2149
2150 If there are multiple biblioitems with the given biblionumber, only
2151 the first one is considered.
2152
2153 =cut
2154 #'
2155 sub bibdata {
2156         my ($bibnum, $type) = @_;
2157         my $dbh   = C4::Context->dbh;
2158         my $sth   = $dbh->prepare("Select *, biblioitems.notes AS bnotes, biblio.notes
2159                                                                 from biblio
2160                                                                 left join biblioitems on biblioitems.biblionumber = biblio.biblionumber
2161                                                                 left join bibliosubtitle on
2162                                                                 biblio.biblionumber = bibliosubtitle.biblionumber
2163                                                                 left join itemtypes on biblioitems.itemtype=itemtypes.itemtype
2164                                                                 where biblio.biblionumber = ?
2165                                                                 ");
2166         $sth->execute($bibnum);
2167         my $data;
2168         $data  = $sth->fetchrow_hashref;
2169         $sth->finish;
2170         # handle management of repeated subtitle
2171         $sth   = $dbh->prepare("Select * from bibliosubtitle where biblionumber = ?");
2172         $sth->execute($bibnum);
2173         my @subtitles;
2174         while (my $dat = $sth->fetchrow_hashref){
2175                 my %line;
2176                 $line{subtitle} = $dat->{subtitle};
2177                 push @subtitles, \%line;
2178         } # while
2179         $data->{subtitles} = \@subtitles;
2180         $sth->finish;
2181         $sth   = $dbh->prepare("Select * from bibliosubject where biblionumber = ?");
2182         $sth->execute($bibnum);
2183         my @subjects;
2184         while (my $dat = $sth->fetchrow_hashref){
2185                 my %line;
2186                 $line{subject} = $dat->{'subject'};
2187                 push @subjects, \%line;
2188         } # while
2189         $data->{subjects} = \@subjects;
2190         $sth->finish;
2191         $sth   = $dbh->prepare("Select * from additionalauthors where biblionumber = ?");
2192         $sth->execute($bibnum);
2193         while (my $dat = $sth->fetchrow_hashref){
2194                 $data->{'additionalauthors'} .= "$dat->{'author'} - ";
2195         } # while
2196         chop $data->{'additionalauthors'};
2197         chop $data->{'additionalauthors'};
2198         chop $data->{'additionalauthors'};
2199         $sth->finish;
2200         return($data);
2201 } # sub bibdata
2202
2203 =head2 getbiblioitem
2204
2205 ($count,@results) = getbiblioitem($biblioitemnumber);
2206
2207 =over 4
2208
2209 return an array with hash of biblioitemss.
2210
2211 FIXME : biblioitemnumber being unique, this sub will always return only 1 result, API should be modified...
2212
2213 =back
2214
2215 =cut
2216
2217 sub getbiblioitem {
2218     my ($biblioitemnum) = @_;
2219     my $dbh = C4::Context->dbh;
2220     my $sth = $dbh->prepare( "Select * from biblioitems where
2221 biblioitemnumber = ?"
2222     );
2223     my $count = 0;
2224     my @results;
2225
2226     $sth->execute($biblioitemnum);
2227
2228     while ( my $data = $sth->fetchrow_hashref ) {
2229         $results[$count] = $data;
2230         $count++;
2231     }    # while
2232
2233     $sth->finish;
2234     return ( $count, @results );
2235 }    # sub getbiblioitem
2236
2237 =head2 getbiblioitembybiblionumber
2238
2239 ($count,@results) = getbiblioitembybiblionumber($biblionumber);
2240
2241 =over 4
2242
2243 return an array with hash of biblioitems for the given biblionumber.
2244
2245 =back
2246
2247 =cut
2248
2249 sub getbiblioitembybiblionumber {
2250     my ($biblionumber) = @_;
2251     my $dbh = C4::Context->dbh;
2252     my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
2253     my $count = 0;
2254     my @results;
2255
2256     $sth->execute($biblionumber);
2257
2258     while ( my $data = $sth->fetchrow_hashref ) {
2259         $results[$count] = $data;
2260         $count++;
2261     }    # while
2262
2263     $sth->finish;
2264     return ( $count, @results );
2265 }    # sub
2266
2267 =head2 getitemsbybiblioitem
2268
2269 ($count,@results) = getitemsbybiblioitem($biblionumber);
2270
2271 =over 4
2272
2273 returns an array with hash of items
2274
2275 =back
2276
2277 =cut
2278
2279 sub getitemsbybiblioitem {
2280     my ($biblioitemnum) = @_;
2281     my $dbh = C4::Context->dbh;
2282     my $sth = $dbh->prepare( "Select * from items, biblio where
2283 biblio.biblionumber = items.biblionumber and biblioitemnumber
2284 = ?"
2285     );
2286
2287     # || die "Cannot prepare $query\n" . $dbh->errstr;
2288     my $count = 0;
2289     my @results;
2290
2291     $sth->execute($biblioitemnum);
2292
2293     # || die "Cannot execute $query\n" . $sth->errstr;
2294     while ( my $data = $sth->fetchrow_hashref ) {
2295         $results[$count] = $data;
2296         $count++;
2297     }    # while
2298
2299     $sth->finish;
2300     return ( $count, @results );
2301 }    # sub getitemsbybiblioitem
2302
2303 =item ItemInfo
2304
2305   @results = &ItemInfo($env, $biblionumber, $type);
2306
2307 Returns information about books with the given biblionumber.
2308
2309 C<$type> may be either C<intra> or anything else. If it is not set to
2310 C<intra>, then the search will exclude lost, very overdue, and
2311 withdrawn items.
2312
2313 C<$env> is ignored.
2314
2315 C<&ItemInfo> returns a list of references-to-hash. Each element
2316 contains a number of keys. Most of them are table items from the
2317 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
2318 Koha database. Other keys include:
2319
2320 =over 4
2321
2322 =item C<$data-E<gt>{branchname}>
2323
2324 The name (not the code) of the branch to which the book belongs.
2325
2326 =item C<$data-E<gt>{datelastseen}>
2327
2328 This is simply C<items.datelastseen>, except that while the date is
2329 stored in YYYY-MM-DD format in the database, here it is converted to
2330 DD/MM/YYYY format. A NULL date is returned as C<//>.
2331
2332 =item C<$data-E<gt>{datedue}>
2333
2334 =item C<$data-E<gt>{class}>
2335
2336 This is the concatenation of C<biblioitems.classification>, the book's
2337 Dewey code, and C<biblioitems.subclass>.
2338
2339 =item C<$data-E<gt>{ocount}>
2340
2341 I think this is the number of copies of the book available.
2342
2343 =item C<$data-E<gt>{order}>
2344
2345 If this is set, it is set to C<One Order>.
2346
2347 =back
2348
2349 =cut
2350 #'
2351 sub ItemInfo {
2352         my ($env,$biblionumber,$type) = @_;
2353         my $dbh   = C4::Context->dbh;
2354         my $query = "SELECT *,items.notforloan as itemnotforloan FROM items, biblio, biblioitems
2355                                         left join itemtypes on biblioitems.itemtype = itemtypes.itemtype
2356                                         WHERE items.biblionumber = ?
2357                                         AND biblioitems.biblioitemnumber = items.biblioitemnumber
2358                                         AND biblio.biblionumber = items.biblionumber";
2359         $query .= " order by items.dateaccessioned desc";
2360         my $sth=$dbh->prepare($query);
2361         $sth->execute($biblionumber);
2362         my $i=0;
2363         my @results;
2364         while (my $data=$sth->fetchrow_hashref){
2365                 my $datedue = '';
2366                 my $isth=$dbh->prepare("Select issues.*,borrowers.cardnumber from issues,borrowers where itemnumber = ? and returndate is null and issues.borrowernumber=borrowers.borrowernumber");
2367                 $isth->execute($data->{'itemnumber'});
2368                 if (my $idata=$isth->fetchrow_hashref){
2369                 $data->{borrowernumber} = $idata->{borrowernumber};
2370                 $data->{cardnumber} = $idata->{cardnumber};
2371                 $datedue = format_date($idata->{'date_due'});
2372                 }
2373                 if ($datedue eq ''){
2374                         my ($restype,$reserves)=C4::Reserves2::CheckReserves($data->{'itemnumber'});
2375                         if ($restype) {
2376                                 $datedue=$restype;
2377                         }
2378                 }
2379                 $isth->finish;
2380         #get branch information.....
2381                 my $bsth=$dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
2382                 $bsth->execute($data->{'holdingbranch'});
2383                 if (my $bdata=$bsth->fetchrow_hashref){
2384                         $data->{'branchname'} = $bdata->{'branchname'};
2385                 }
2386                 my $date=format_date($data->{'datelastseen'});
2387                 $data->{'datelastseen'}=$date;
2388                 $data->{'datedue'}=$datedue;
2389         # get notforloan complete status if applicable
2390                 my $sthnflstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.notforloan"');
2391                 $sthnflstatus->execute;
2392                 my ($authorised_valuecode) = $sthnflstatus->fetchrow;
2393                 if ($authorised_valuecode) {
2394                         $sthnflstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?");
2395                         $sthnflstatus->execute($authorised_valuecode,$data->{itemnotforloan});
2396                         my ($lib) = $sthnflstatus->fetchrow;
2397                         $data->{notforloan} = $lib;
2398                 }
2399                 $results[$i]=$data;
2400                 $i++;
2401         }
2402         $sth->finish;
2403         return(@results);
2404 }
2405
2406 =item bibitems
2407
2408   ($count, @results) = &bibitems($biblionumber);
2409
2410 Given the biblionumber for a book, C<&bibitems> looks up that book's
2411 biblioitems (different publications of the same book, the audio book
2412 and film versions, etc.).
2413
2414 C<$count> is the number of elements in C<@results>.
2415
2416 C<@results> is an array of references-to-hash; the keys are the fields
2417 of the C<biblioitems> and C<itemtypes> tables of the Koha database. In
2418 addition, C<itemlost> indicates the availability of the item: if it is
2419 "2", then all copies of the item are long overdue; if it is "1", then
2420 all copies are lost; otherwise, there is at least one copy available.
2421
2422 =cut
2423 #'
2424 sub bibitems {
2425     my ($bibnum) = @_;
2426     my $dbh   = C4::Context->dbh;
2427     my $sth   = $dbh->prepare("SELECT biblioitems.*,
2428                         itemtypes.*,
2429                         MIN(items.itemlost)        as itemlost,
2430                         MIN(items.dateaccessioned) as dateaccessioned
2431                           FROM biblioitems, itemtypes, items
2432                          WHERE biblioitems.biblionumber     = ?
2433                            AND biblioitems.itemtype         = itemtypes.itemtype
2434                            AND biblioitems.biblioitemnumber = items.biblioitemnumber
2435                       GROUP BY items.biblioitemnumber");
2436     my $count = 0;
2437     my @results;
2438     $sth->execute($bibnum);
2439     while (my $data = $sth->fetchrow_hashref) {
2440         $results[$count] = $data;
2441         $count++;
2442     } # while
2443     $sth->finish;
2444     return($count, @results);
2445 } # sub bibitems
2446
2447
2448 =item bibitemdata
2449
2450   $itemdata = &bibitemdata($biblioitemnumber);
2451
2452 Looks up the biblioitem with the given biblioitemnumber. Returns a
2453 reference-to-hash. The keys are the fields from the C<biblio>,
2454 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
2455 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
2456
2457 =cut
2458 #'
2459 sub bibitemdata {
2460     my ($bibitem) = @_;
2461     my $dbh   = C4::Context->dbh;
2462     my $sth   = $dbh->prepare("Select *,biblioitems.notes as bnotes from biblio, biblioitems,itemtypes where biblio.biblionumber = biblioitems.biblionumber and biblioitemnumber = ? and biblioitems.itemtype = itemtypes.itemtype");
2463     my $data;
2464
2465     $sth->execute($bibitem);
2466
2467     $data = $sth->fetchrow_hashref;
2468
2469     $sth->finish;
2470     return($data);
2471 } # sub bibitemdata
2472
2473
2474 =item getbibliofromitemnumber
2475
2476   $item = &getbibliofromitemnumber($env, $dbh, $itemnumber);
2477
2478 Looks up the item with the given itemnumber.
2479
2480 C<$env> and C<$dbh> are ignored.
2481
2482 C<&itemnodata> returns a reference-to-hash whose keys are the fields
2483 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
2484 database.
2485
2486 =cut
2487 #'
2488 sub getbibliofromitemnumber {
2489   my ($env,$dbh,$itemnumber) = @_;
2490   $dbh = C4::Context->dbh;
2491   my $sth=$dbh->prepare("Select * from biblio,items,biblioitems
2492     where items.itemnumber = ?
2493     and biblio.biblionumber = items.biblionumber
2494     and biblioitems.biblioitemnumber = items.biblioitemnumber");
2495 #  print $query;
2496   $sth->execute($itemnumber);
2497   my $data=$sth->fetchrow_hashref;
2498   $sth->finish;
2499   return($data);
2500 }
2501
2502 =item barcodes
2503
2504   @barcodes = &barcodes($biblioitemnumber);
2505
2506 Given a biblioitemnumber, looks up the corresponding items.
2507
2508 Returns an array of references-to-hash; the keys are C<barcode> and
2509 C<itemlost>.
2510
2511 The returned items include very overdue items, but not lost ones.
2512
2513 =cut
2514 #'
2515 sub barcodes{
2516     #called from request.pl
2517     my ($biblioitemnumber)=@_;
2518     my $dbh = C4::Context->dbh;
2519     my $sth=$dbh->prepare("SELECT barcode, itemlost, holdingbranch FROM items
2520                            WHERE biblioitemnumber = ?
2521                              AND (wthdrawn <> 1 OR wthdrawn IS NULL)");
2522     $sth->execute($biblioitemnumber);
2523     my @barcodes;
2524     my $i=0;
2525     while (my $data=$sth->fetchrow_hashref){
2526         $barcodes[$i]=$data;
2527         $i++;
2528     }
2529     $sth->finish;
2530     return(@barcodes);
2531 }
2532
2533
2534 =item itemdata
2535
2536   $item = &itemdata($barcode);
2537
2538 Looks up the item with the given barcode, and returns a
2539 reference-to-hash containing information about that item. The keys of
2540 the hash are the fields from the C<items> and C<biblioitems> tables in
2541 the Koha database.
2542
2543 =cut
2544 #'
2545 sub get_item_from_barcode {
2546   my ($barcode)=@_;
2547   my $dbh = C4::Context->dbh;
2548   my $sth=$dbh->prepare("Select * from items,biblioitems where barcode=?
2549   and items.biblioitemnumber=biblioitems.biblioitemnumber");
2550   $sth->execute($barcode);
2551   my $data=$sth->fetchrow_hashref;
2552   $sth->finish;
2553   return($data);
2554 }
2555
2556
2557 =item itemissues
2558
2559   @issues = &itemissues($biblioitemnumber, $biblio);
2560
2561 Looks up information about who has borrowed the bookZ<>(s) with the
2562 given biblioitemnumber.
2563
2564 C<$biblio> is ignored.
2565
2566 C<&itemissues> returns an array of references-to-hash. The keys
2567 include the fields from the C<items> table in the Koha database.
2568 Additional keys include:
2569
2570 =over 4
2571
2572 =item C<date_due>
2573
2574 If the item is currently on loan, this gives the due date.
2575
2576 If the item is not on loan, then this is either "Available" or
2577 "Cancelled", if the item has been withdrawn.
2578
2579 =item C<card>
2580
2581 If the item is currently on loan, this gives the card number of the
2582 patron who currently has the item.
2583
2584 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
2585
2586 These give the timestamp for the last three times the item was
2587 borrowed.
2588
2589 =item C<card0>, C<card1>, C<card2>
2590
2591 The card number of the last three patrons who borrowed this item.
2592
2593 =item C<borrower0>, C<borrower1>, C<borrower2>
2594
2595 The borrower number of the last three patrons who borrowed this item.
2596
2597 =back
2598
2599 =cut
2600 #'
2601 sub itemissues {
2602     my ($bibitem, $biblio)=@_;
2603     my $dbh   = C4::Context->dbh;
2604     # FIXME - If this function die()s, the script will abort, and the
2605     # user won't get anything; depending on how far the script has
2606     # gotten, the user might get a blank page. It would be much better
2607     # to at least print an error message. The easiest way to do this
2608     # is to set $SIG{__DIE__}.
2609     my $sth   = $dbh->prepare("Select * from items where
2610 items.biblioitemnumber = ?")
2611       || die $dbh->errstr;
2612     my $i     = 0;
2613     my @results;
2614
2615     $sth->execute($bibitem)
2616       || die $sth->errstr;
2617
2618     while (my $data = $sth->fetchrow_hashref) {
2619         # Find out who currently has this item.
2620         # FIXME - Wouldn't it be better to do this as a left join of
2621         # some sort? Currently, this code assumes that if
2622         # fetchrow_hashref() fails, then the book is on the shelf.
2623         # fetchrow_hashref() can fail for any number of reasons (e.g.,
2624         # database server crash), not just because no items match the
2625         # search criteria.
2626         my $sth2   = $dbh->prepare("select * from issues,borrowers
2627 where itemnumber = ?
2628 and returndate is NULL
2629 and issues.borrowernumber = borrowers.borrowernumber");
2630
2631         $sth2->execute($data->{'itemnumber'});
2632         if (my $data2 = $sth2->fetchrow_hashref) {
2633             $data->{'date_due'} = $data2->{'date_due'};
2634             $data->{'card'}     = $data2->{'cardnumber'};
2635             $data->{'borrower'}     = $data2->{'borrowernumber'};
2636         } else {
2637             if ($data->{'wthdrawn'} eq '1') {
2638                 $data->{'date_due'} = 'Cancelled';
2639             } else {
2640                 $data->{'date_due'} = 'Available';
2641             } # else
2642         } # else
2643
2644         $sth2->finish;
2645
2646         # Find the last 3 people who borrowed this item.
2647         $sth2 = $dbh->prepare("select * from issues, borrowers
2648                                                 where itemnumber = ?
2649                                                                         and issues.borrowernumber = borrowers.borrowernumber
2650                                                                         and returndate is not NULL
2651                                                                         order by returndate desc,timestamp desc") || die $dbh->errstr;
2652         $sth2->execute($data->{'itemnumber'}) || die $sth2->errstr;
2653         for (my $i2 = 0; $i2 < 2; $i2++) { # FIXME : error if there is less than 3 pple borrowing this item
2654             if (my $data2 = $sth2->fetchrow_hashref) {
2655                 $data->{"timestamp$i2"} = $data2->{'timestamp'};
2656                 $data->{"card$i2"}      = $data2->{'cardnumber'};
2657                 $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
2658             } # if
2659         } # for
2660
2661         $sth2->finish;
2662         $results[$i] = $data;
2663         $i++;
2664     }
2665
2666     $sth->finish;
2667     return(@results);
2668 }
2669
2670 =item getsubject
2671
2672   ($count, $subjects) = &getsubject($biblionumber);
2673
2674 Looks up the subjects of the book with the given biblionumber. Returns
2675 a two-element list. C<$subjects> is a reference-to-array, where each
2676 element is a subject of the book, and C<$count> is the number of
2677 elements in C<$subjects>.
2678
2679 =cut
2680 #'
2681 sub getsubject {
2682   my ($bibnum)=@_;
2683   my $dbh = C4::Context->dbh;
2684   my $sth=$dbh->prepare("Select * from bibliosubject where biblionumber=?");
2685   $sth->execute($bibnum);
2686   my @results;
2687   my $i=0;
2688   while (my $data=$sth->fetchrow_hashref){
2689     $results[$i]=$data;
2690     $i++;
2691   }
2692   $sth->finish;
2693   return($i,\@results);
2694 }
2695
2696 =item getaddauthor
2697
2698   ($count, $authors) = &getaddauthor($biblionumber);
2699
2700 Looks up the additional authors for the book with the given
2701 biblionumber.
2702
2703 Returns a two-element list. C<$authors> is a reference-to-array, where
2704 each element is an additional author, and C<$count> is the number of
2705 elements in C<$authors>.
2706
2707 =cut
2708 #'
2709 sub getaddauthor {
2710   my ($bibnum)=@_;
2711   my $dbh = C4::Context->dbh;
2712   my $sth=$dbh->prepare("Select * from additionalauthors where biblionumber=?");
2713   $sth->execute($bibnum);
2714   my @results;
2715   my $i=0;
2716   while (my $data=$sth->fetchrow_hashref){
2717     $results[$i]=$data;
2718     $i++;
2719   }
2720   $sth->finish;
2721   return($i,\@results);
2722 }
2723
2724
2725 =item getsubtitle
2726
2727   ($count, $subtitles) = &getsubtitle($biblionumber);
2728
2729 Looks up the subtitles for the book with the given biblionumber.
2730
2731 Returns a two-element list. C<$subtitles> is a reference-to-array,
2732 where each element is a subtitle, and C<$count> is the number of
2733 elements in C<$subtitles>.
2734
2735 =cut
2736 #'
2737 sub getsubtitle {
2738   my ($bibnum)=@_;
2739   my $dbh = C4::Context->dbh;
2740   my $sth=$dbh->prepare("Select * from bibliosubtitle where biblionumber=?");
2741   $sth->execute($bibnum);
2742   my @results;
2743   my $i=0;
2744   while (my $data=$sth->fetchrow_hashref){
2745     $results[$i]=$data;
2746     $i++;
2747   }
2748   $sth->finish;
2749   return($i,\@results);
2750 }
2751
2752
2753 =item getwebsites
2754
2755   ($count, @websites) = &getwebsites($biblionumber);
2756
2757 Looks up the web sites pertaining to the book with the given
2758 biblionumber.
2759
2760 C<$count> is the number of elements in C<@websites>.
2761
2762 C<@websites> is an array of references-to-hash; the keys are the
2763 fields from the C<websites> table in the Koha database.
2764
2765 =cut
2766 #FIXME : could maybe be deleted. Otherwise, would be better in a Websites.pm package
2767 #(with add / modify / delete subs)
2768
2769 sub getwebsites {
2770     my ($biblionumber) = @_;
2771     my $dbh   = C4::Context->dbh;
2772     my $sth   = $dbh->prepare("Select * from websites where biblionumber = ?");
2773     my $count = 0;
2774     my @results;
2775
2776     $sth->execute($biblionumber);
2777     while (my $data = $sth->fetchrow_hashref) {
2778         # FIXME - The URL scheme shouldn't be stripped off, at least
2779         # not here, since it's part of the URL, and will be useful in
2780         # constructing a link to the site. If you don't want the user
2781         # to see the "http://" part, strip that off when building the
2782         # HTML code.
2783         $data->{'url'} =~ s/^http:\/\///;       # FIXME - Leaning toothpick
2784                                                 # syndrome
2785         $results[$count] = $data;
2786         $count++;
2787     } # while
2788
2789     $sth->finish;
2790     return($count, @results);
2791 } # sub getwebsites
2792
2793 =item getwebbiblioitems
2794
2795   ($count, @results) = &getwebbiblioitems($biblionumber);
2796
2797 Given a book's biblionumber, looks up the web versions of the book
2798 (biblioitems with itemtype C<WEB>).
2799
2800 C<$count> is the number of items in C<@results>. C<@results> is an
2801 array of references-to-hash; the keys are the items from the
2802 C<biblioitems> table of the Koha database.
2803
2804 =cut
2805 #'
2806 sub getwebbiblioitems {
2807     my ($biblionumber) = @_;
2808     my $dbh   = C4::Context->dbh;
2809     my $sth   = $dbh->prepare("Select * from biblioitems where biblionumber = ?
2810 and itemtype = 'WEB'");
2811     my $count = 0;
2812     my @results;
2813
2814     $sth->execute($biblionumber);
2815     while (my $data = $sth->fetchrow_hashref) {
2816         $data->{'url'} =~ s/^http:\/\///;
2817         $results[$count] = $data;
2818         $count++;
2819     } # while
2820
2821     $sth->finish;
2822     return($count, @results);
2823 } # sub getwebbiblioitems
2824
2825 sub nsb_clean {
2826     my $NSB = '\x88';    # NSB : begin Non Sorting Block
2827     my $NSE = '\x89';    # NSE : Non Sorting Block end
2828                          # handles non sorting blocks
2829     my ($string) = @_;
2830     $_ = $string;
2831     s/$NSB/(/gm;
2832     s/[ ]{0,1}$NSE/) /gm;
2833     $string = $_;
2834     return ($string);
2835 }
2836
2837 sub FindDuplicate {
2838         my ($record)=@_;
2839         my $dbh = C4::Context->dbh;
2840         my $result = MARCmarc2koha($dbh,$record,'');
2841         my $sth;
2842         my ($biblionumber,$bibid,$title);
2843         # search duplicate on ISBN, easy and fast...
2844         if ($result->{isbn}) {
2845                 $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=?");
2846                 $sth->execute($result->{'isbn'});
2847                 ($biblionumber,$bibid,$title) = $sth->fetchrow;
2848                 return $biblionumber,$bibid,$title if ($biblionumber);
2849         }
2850         # a more complex search : build a request for SearchMarc::catalogsearch()
2851         my (@tags, @and_or, @excluding, @operator, @value, $offset,$length);
2852         # search on biblio.title
2853         my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.title","");
2854         if ($record->field($tag)) {
2855                 if ($record->field($tag)->subfields($subfield)) {
2856                         push @tags, "'".$tag.$subfield."'";
2857                         push @and_or, "and";
2858                         push @excluding, "";
2859                         push @operator, "contains";
2860                         push @value, $record->field($tag)->subfield($subfield);
2861 #                       warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2862                 }
2863         }
2864         # ... and on biblio.author
2865         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.author","");
2866         if ($record->field($tag)) {
2867                 if ($record->field($tag)->subfields($subfield)) {
2868                         push @tags, "'".$tag.$subfield."'";
2869                         push @and_or, "and";
2870                         push @excluding, "";
2871                         push @operator, "contains";
2872                         push @value, $record->field($tag)->subfield($subfield);
2873 #                       warn "for author, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2874                 }
2875         }
2876         # ... and on publicationyear.
2877         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publicationyear","");
2878         if ($record->field($tag)) {
2879                 if ($record->field($tag)->subfields($subfield)) {
2880                         push @tags, "'".$tag.$subfield."'";
2881                         push @and_or, "and";
2882                         push @excluding, "";
2883                         push @operator, "=";
2884                         push @value, $record->field($tag)->subfield($subfield);
2885 #                       warn "for publicationyear, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2886                 }
2887         }
2888         # ... and on size.
2889         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.size","");
2890         if ($record->field($tag)) {
2891                 if ($record->field($tag)->subfields($subfield)) {
2892                         push @tags, "'".$tag.$subfield."'";
2893                         push @and_or, "and";
2894                         push @excluding, "";
2895                         push @operator, "=";
2896                         push @value, $record->field($tag)->subfield($subfield);
2897 #                       warn "for size, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2898                 }
2899         }
2900         # ... and on publisher.
2901         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publishercode","");
2902         if ($record->field($tag)) {
2903                 if ($record->field($tag)->subfields($subfield)) {
2904                         push @tags, "'".$tag.$subfield."'";
2905                         push @and_or, "and";
2906                         push @excluding, "";
2907                         push @operator, "=";
2908                         push @value, $record->field($tag)->subfield($subfield);
2909 #                       warn "for publishercode, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2910                 }
2911         }
2912         # ... and on volume.
2913         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.volume","");
2914         if ($record->field($tag)) {
2915                 if ($record->field($tag)->subfields($subfield)) {
2916                         push @tags, "'".$tag.$subfield."'";
2917                         push @and_or, "and";
2918                         push @excluding, "";
2919                         push @operator, "=";
2920                         push @value, $record->field($tag)->subfield($subfield);
2921 #                       warn "for volume, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2922                 }
2923         }
2924
2925         my ($finalresult,$nbresult) = C4::SearchMarc::catalogsearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10);
2926         # there is at least 1 result => return the 1st one
2927         if ($nbresult) {
2928 #               warn "$nbresult => ".@$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2929                 return @$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2930         }
2931         # no result, returns nothing
2932         return;
2933 }
2934
2935 sub DisplayISBN {
2936         my ($isbn)=@_;
2937         my $seg1;
2938         if(substr($isbn, 0, 1) <=7) {
2939                 $seg1 = substr($isbn, 0, 1);
2940         } elsif(substr($isbn, 0, 2) <= 94) {
2941                 $seg1 = substr($isbn, 0, 2);
2942         } elsif(substr($isbn, 0, 3) <= 995) {
2943                 $seg1 = substr($isbn, 0, 3);
2944         } elsif(substr($isbn, 0, 4) <= 9989) {
2945                 $seg1 = substr($isbn, 0, 4);
2946         } else {
2947                 $seg1 = substr($isbn, 0, 5);
2948         }
2949         my $x = substr($isbn, length($seg1));
2950         my $seg2;
2951         if(substr($x, 0, 2) <= 19) {
2952 #               if(sTmp2 < 10) sTmp2 = "0" sTmp2;
2953                 $seg2 = substr($x, 0, 2);
2954         } elsif(substr($x, 0, 3) <= 699) {
2955                 $seg2 = substr($x, 0, 3);
2956         } elsif(substr($x, 0, 4) <= 8399) {
2957                 $seg2 = substr($x, 0, 4);
2958         } elsif(substr($x, 0, 5) <= 89999) {
2959                 $seg2 = substr($x, 0, 5);
2960         } elsif(substr($x, 0, 6) <= 9499999) {
2961                 $seg2 = substr($x, 0, 6);
2962         } else {
2963                 $seg2 = substr($x, 0, 7);
2964         }
2965         my $seg3=substr($x,length($seg2));
2966         $seg3=substr($seg3,0,length($seg3)-1) ;
2967         my $seg4 = substr($x, -1, 1);
2968         return "$seg1-$seg2-$seg3-$seg4";
2969 }
2970
2971
2972 END { }    # module clean-up code here (global destructor)
2973
2974 =back
2975
2976 =head1 AUTHOR
2977
2978 Koha Developement team <info@koha.org>
2979
2980 Paul POULAIN paul.poulain@free.fr
2981
2982 =cut
2983
2984 # $Id$
2985 # $Log$
2986 # Revision 1.152  2006/02/25 21:17:20  kados
2987 # Purely documentation change: converted all =head2 entries to use function
2988 # name as title rather than usage as title
2989 #
2990 # Revision 1.151  2006/02/25 21:02:20  kados
2991 #
2992 # Further cleanup, convering new routines to 4-chars
2993 #
2994 # Revision 1.150  2006/02/25 20:49:15  kados
2995 # Better documentation, added warning if serviceType is 'drop' since it's
2996 # not supported in Zebra.
2997 #
2998 # Revision 1.149  2006/02/25 20:30:32  kados
2999 # IMPORTANT: Paul, I've removed the decode_char routine because it's no
3000 # longer necessary. If we need to convert from MARC-8 for display, we should:
3001 #
3002 # 1. use utf-8
3003 # 2. do it with MARC::Charset
3004 #
3005 # If you still need it, let me know and I'll put it back in.
3006 #
3007 # Revision 1.148  2006/02/25 19:23:01  kados
3008 # cleaning up POD docs, deleting zebra_create as it's no longer used (
3009 # replaced by z3950_extended_services).
3010 #
3011 # Revision 1.147  2006/02/25 19:09:59  kados
3012 # readding some lost subs
3013 #
3014 # Revision 1.145  2006/02/22 01:02:39  kados
3015 # Replacing all calls to zebra_update with calls to
3016 # z3950_extended_services. More work coming, but it's
3017 # working now.
3018 #
3019 # Revision 1.144  2006/02/20 14:22:38  kados
3020 # typo
3021 #
3022 # Revision 1.143  2006/02/20 13:26:11  kados
3023 # A new subroutine to handle Z39.50 extended services. You pass it a
3024 # connection object, service type, service options, and a record, and
3025 # it performs the service and handles any exception found.
3026 #
3027 # Revision 1.142  2006/02/16 20:49:56  kados
3028 # destroy a connection after we're done -- we really should just have one
3029 # connection object and not destroy it until the whole transaction is
3030 # finished -- but this will do for now
3031 #
3032 # Revision 1.141  2006/02/16 19:47:22  rangi
3033 # Trying to error trap a little more.
3034 #
3035 # Revision 1.140  2006/02/14 21:36:03  kados
3036 # adding a 'use ZOOM' to biblio.pm, needed for non-mod_perl install.
3037 # also adding diagnostic error if not able to connect to Zebra
3038 #
3039 # Revision 1.139  2006/02/14 19:53:25  rangi
3040 # Just a little missing my
3041 #
3042 # Seems to be working great Paul, and I like what you did with zebradb
3043 #
3044 # Revision 1.138  2006/02/14 11:25:22  tipaul
3045 # road to 3.0 : updating a biblio in zebra seems to work. Still working on it, there are probably some bugs !
3046 #
3047 # Revision 1.137  2006/02/13 16:34:26  tipaul
3048 # fixing some warnings (perl -w should be quiet)
3049 #
3050 # Revision 1.136  2006/01/10 17:01:29  tipaul
3051 # adding a XMLgetbiblio in Biblio.pm (1st draft, to use with zebra)
3052 #
3053 # Revision 1.135  2006/01/06 16:39:37  tipaul
3054 # synch'ing head and rel_2_2 (from 2.2.5, including npl templates)
3055 # Seems not to break too many things, but i'm probably wrong here.
3056 # at least, new features/bugfixes from 2.2.5 are here (tested on some features on my head local copy)
3057 #
3058 # - removing useless directories (koha-html and koha-plucene)
3059 #
3060 # Revision 1.134  2006/01/04 15:54:55  tipaul
3061 # utf8 is a : go for beta test in HEAD.
3062 # some explanations :
3063 # - updater/updatedatabase => will transform all tables in innoDB (not related to utf8, just to warn you) AND collate them in utf8 / utf8_general_ci. The SQL command is : ALTER TABLE tablename DEFAULT CHARACTER SET utf8 COLLATE utf8_general_ci.
3064 # - *-top.inc will show the pages in utf8
3065 # - THE HARD THING : for me, mysql-client and mysql-server were set up to communicate in iso8859-1, whatever the mysql collation ! Thus, pages were improperly shown, as datas were transmitted in iso8859-1 format ! After a full day of investigation, someone on usenet pointed "set NAMES 'utf8'" to explain that I wanted utf8. I could put this in my.cnf, but if I do that, ALL databases will "speak" in utf8, that's not what we want. Thus, I added a line in Context.pm : everytime a DB handle is opened, the communication is set to utf8.
3066 # - using marcxml field and no more the iso2709 raw marc biblioitems.marc field.
3067 #
3068 # Revision 1.133  2005/12/12 14:25:51  thd
3069 #
3070 #
3071 # Reverse array filled with elements from repeated subfields
3072 # to avoid last to first concatenation of elements in Koha DB.-
3073 #
3074 # Revision 1.132  2005-10-26 09:12:33  tipaul
3075 # big commit, still breaking things...
3076 #
3077 # * synch with rel_2_2. Probably the last non manual synch, as rel_2_2 should not be modified deeply.
3078 # * code cleaning (cleaning warnings from perl -w) continued
3079 #
3080 # Revision 1.131  2005/09/22 10:01:45  tipaul
3081 # see mail on koha-devel : code cleaning on Search.pm + normalizing API + use of biblionumber everywhere (instead of bn, biblio, ...)
3082 #
3083 # Revision 1.130  2005/09/02 14:34:14  tipaul
3084 # continuing the work to move to zebra. Begin of work for MARC=OFF support.
3085 # IMPORTANT NOTE : the MARCkoha2marc sub API has been modified. Instead of biblionumber & biblioitemnumber, it now gets a hash.
3086 # The sub is used only in Biblio.pm, so the API change should be harmless (except for me, but i'm aware ;-) )
3087 #
3088 # Revision 1.129  2005/08/12 13:50:31  tipaul
3089 # removing useless sub declarations
3090 #
3091 # Revision 1.128  2005/08/11 16:12:47  tipaul
3092 # Playing with the zebra...
3093 #
3094 # * go to koha cvs home directory
3095 # * in misc/zebra there is a unimarc directory. I suggest that marc21 libraries create a marc21 directory
3096 # * put your zebra.cfg files here & create your database.
3097 # * from koha cvs home directory, ln -s misc/zebra/marc21 zebra (I mean create a symbolic link to YOUR zebra directory)
3098 # * now, everytime you add/modify a biblio/item your zebra DB is updated correctly.
3099 #
3100 # NOTE :
3101 # * this uses a system call in perl. CPU consumming, but we are waiting for indexdata Perl/zoom
3102 # * deletion still not work
3103 # * UNIMARC zebra config files are provided in misc/zebra/unimarc directory. The most important line being :
3104 # in zebra.cfg :
3105 # recordId: (bib1,Local-number)
3106 # storeKeys:1
3107 #
3108 # in .abs file :
3109 # elm 090            Local-number            -
3110 # elm 090/?          Local-number            -
3111 # elm 090/?/9        Local-number            !:w
3112 #
3113 # (090$9 being the field mapped to biblio.biblionumber in Koha)
3114 #
3115 # Revision 1.127  2005/08/11 14:37:32  tipaul
3116 # * POD documenting
3117 # * removing useless subs
3118 # * removing some subs that are also elsewhere
3119 # * renaming all OLDxxx subs to REALxxx subs (should not change anything, as OLDxxx, as well as REAL, are supposed to be for Biblio.pm internal use only)
3120 #
3121 # Revision 1.126  2005/08/11 09:13:28  tipaul
3122 # just removing useless subs (a lot !!!) for code cleaning
3123 #
3124 # Revision 1.125  2005/08/11 09:00:07  tipaul
3125 # Ok guys, this time, it seems that item add and modif begin working as expected...
3126 # Still a lot of bugs to fix, of course
3127 #
3128 # Revision 1.124  2005/08/10 10:21:15  tipaul
3129 # continuing the road to zebra :
3130 # - the biblio add begins to work.
3131 # - the biblio modif begins to work.
3132 #
3133 # (still without doing anything on zebra)
3134 # (no new change in updatedatabase)
3135 #
3136 # Revision 1.123  2005/08/09 14:10:28  tipaul
3137 # 1st commit to go to zebra.
3138 # don't update your cvs if you want to have a working head...
3139 #
3140 # this commit contains :
3141 # * updater/updatedatabase : get rid with marc_* tables, but DON'T remove them. As a lot of things uses them, it would not be a good idea for instance to drop them. If you really want to play, you can rename them to test head without them but being still able to reintroduce them...
3142 # * Biblio.pm : modify MARCgetbiblio to find the raw marc record in biblioitems.marc field, not from marc_subfield_table, modify MARCfindframeworkcode to find frameworkcode in biblio.frameworkcode, modify some other subs to use biblio.biblionumber & get rid of bibid.
3143 # * other files : get rid of bibid and use biblionumber instead.
3144 #
3145 # What is broken :
3146 # * does not do anything on zebra yet.
3147 # * if you rename marc_subfield_table, you can't search anymore.
3148 # * you can view a biblio & bibliodetails, go to MARC editor, but NOT save any modif.
3149 # * don't try to add a biblio, it would add data poorly... (don't try to delete either, it may work, but that would be a surprise ;-) )
3150 #
3151 # IMPORTANT NOTE : you need MARC::XML package (http://search.cpan.org/~esummers/MARC-XML-0.7/lib/MARC/File/XML.pm), that requires a recent version of MARC::Record
3152 # Updatedatabase stores the iso2709 data in biblioitems.marc field & an xml version in biblioitems.marcxml Not sure we will keep it when releasing the stable version, but I think it's a good idea to have something readable in sql, at least for development stage.
3153
3154 # tipaul cutted previous commit notes