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