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