C4/Biblio.pm

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