C4/Biblio.pm

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