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