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