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     warn "heres the record to delete $bibid";
1000     z3950_extended_services('update',set_service_options('update','recordDelete',$bibid));
1001     z3950_extended_services('commit');
1002 }
1003
1004 =head2 NEWnewitem
1005
1006 $itemnumber = NEWnewitem($dbh, $record, $biblionumber, $biblioitemnumber);
1007
1008 =over 4
1009
1010 creates an item from a MARC::Record
1011
1012 =back
1013
1014 =cut
1015
1016 sub NEWnewitem {
1017     my ( $dbh,$record,$biblionumber,$biblioitemnumber ) = @_;
1018
1019     # add item in old-DB
1020         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
1021     my $item = &MARCmarc2koha( $dbh,$record,$frameworkcode );
1022     # needs old biblionumber and biblioitemnumber
1023     $item->{'biblionumber'} = $biblionumber;
1024     $item->{'biblioitemnumber'}=$biblioitemnumber;
1025     $item->{marc} = $record->as_usmarc();
1026     #warn $item->{marc};
1027     my ( $itemnumber, $error ) = &REALnewitems( $dbh, $item, $item->{barcode} );
1028         return $itemnumber;
1029 }
1030
1031
1032 =head2 NEWmoditem
1033
1034 $itemnumber = NEWmoditem($dbh, $record, $biblionumber, $biblioitemnumber,$itemnumber);
1035
1036 =over 4
1037
1038 Modify an item
1039
1040 =back
1041
1042 =cut
1043
1044 sub NEWmoditem {
1045     my ( $dbh, $record, $biblionumber, $biblioitemnumber, $itemnumber) = @_;
1046
1047         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
1048     my $olditem = MARCmarc2koha( $dbh, $record,$frameworkcode );
1049         # add MARC record
1050         $olditem->{marc} = $record->as_usmarc();
1051         $olditem->{biblionumber} = $biblionumber;
1052         $olditem->{biblioitemnumber} = $biblioitemnumber;
1053         # and modify item
1054     REALmoditem( $dbh, $olditem );
1055 }
1056
1057
1058 =head2 NEWdelitem
1059
1060 $itemnumber = NEWdelitem($dbh, $biblionumber, $biblioitemnumber, $itemnumber);
1061
1062 =over 4
1063
1064 delete an item
1065
1066 =back
1067
1068 =cut
1069
1070 sub NEWdelitem {
1071     my ( $dbh, $bibid, $itemnumber ) = @_;
1072     &REALdelitem( $dbh, $itemnumber );
1073 #    &MARCdelitem( $dbh, $bibid, $itemnumber );
1074     # we must now delete the item data from zebra
1075 }
1076
1077
1078 =head2 REALnewbiblio
1079
1080 $biblionumber = REALnewbiblio($dbh,$biblio);
1081
1082 =over 4
1083
1084 adds a record in biblio table. Datas are in the hash $biblio.
1085
1086 =back
1087
1088 =cut
1089
1090 sub REALnewbiblio {
1091     my ( $dbh, $biblio ) = @_;
1092
1093         $dbh->do('lock tables biblio WRITE');
1094     my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
1095     $sth->execute;
1096     my $data   = $sth->fetchrow_arrayref;
1097     my $bibnum = $$data[0] + 1;
1098     my $series = 0;
1099
1100     if ( $biblio->{'seriestitle'} ) { $series = 1 }
1101     $sth->finish;
1102     $sth =
1103       $dbh->prepare("insert into biblio set     biblionumber=?, title=?,                author=?,       copyrightdate=?,
1104                                                                                         serial=?,               seriestitle=?,  notes=?,        abstract=?,
1105                                                                                         unititle=?"
1106     );
1107     $sth->execute(
1108         $bibnum,             $biblio->{'title'},
1109         $biblio->{'author'}, $biblio->{'copyrightdate'},
1110         $biblio->{'serial'},             $biblio->{'seriestitle'},
1111         $biblio->{'notes'},  $biblio->{'abstract'},
1112                 $biblio->{'unititle'}
1113     );
1114
1115     $sth->finish;
1116         $dbh->do('unlock tables');
1117     return ($bibnum);
1118 }
1119
1120 =head2 REALmodbiblio
1121
1122 $biblionumber = REALmodbiblio($dbh,$biblio);
1123
1124 =over 4
1125
1126 modify a record in biblio table. Datas are in the hash $biblio.
1127
1128 =back
1129
1130 =cut
1131
1132 sub REALmodbiblio {
1133     my ( $dbh, $biblio ) = @_;
1134     my $sth = $dbh->prepare("Update biblio set  title=?,                author=?,       abstract=?,     copyrightdate=?,
1135                                                                                                 seriestitle=?,  serial=?,       unititle=?,     notes=?,        frameworkcode=?
1136                                                                                         where biblionumber = ?"
1137     );
1138     $sth->execute(
1139                 $biblio->{'title'},       $biblio->{'author'},
1140                 $biblio->{'abstract'},    $biblio->{'copyrightdate'},
1141                 $biblio->{'seriestitle'}, $biblio->{'serial'},
1142                 $biblio->{'unititle'},    $biblio->{'notes'},
1143                 $biblio->{frameworkcode},
1144                 $biblio->{'biblionumber'}
1145     );
1146         $sth->finish;
1147         return ( $biblio->{'biblionumber'} );
1148 }    # sub modbiblio
1149
1150 =head2 REALmodsubtitle
1151
1152 REALmodsubtitle($dbh,$bibnum,$subtitle);
1153
1154 =over 4
1155
1156 modify subtitles in bibliosubtitle table.
1157
1158 =back
1159
1160 =cut
1161
1162 sub REALmodsubtitle {
1163     my ( $dbh, $bibnum, $subtitle ) = @_;
1164     my $sth =
1165       $dbh->prepare(
1166         "update bibliosubtitle set subtitle = ? where biblionumber = ?");
1167     $sth->execute( $subtitle, $bibnum );
1168     $sth->finish;
1169 }    # sub modsubtitle
1170
1171 =head2 REALmodaddauthor
1172
1173 REALmodaddauthor($dbh,$bibnum,$author);
1174
1175 =over 4
1176
1177 adds or modify additional authors
1178 NOTE :  Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
1179
1180 =back
1181
1182 =cut
1183
1184 sub REALmodaddauthor {
1185     my ( $dbh, $bibnum, @authors ) = @_;
1186
1187     #    my $dbh   = C4Connect;
1188     my $sth =
1189       $dbh->prepare("Delete from additionalauthors where biblionumber = ?");
1190
1191     $sth->execute($bibnum);
1192     $sth->finish;
1193     foreach my $author (@authors) {
1194         if ( $author ne '' ) {
1195             $sth =
1196               $dbh->prepare(
1197                 "Insert into additionalauthors set author = ?, biblionumber = ?"
1198             );
1199
1200             $sth->execute( $author, $bibnum );
1201
1202             $sth->finish;
1203         }    # if
1204     }
1205 }    # sub modaddauthor
1206
1207 =head2 REALmodsubject
1208
1209 $errors = REALmodsubject($dbh,$bibnum, $force, @subject);
1210
1211 =over 4
1212
1213 modify/adds subjects
1214
1215 =back
1216
1217 =cut
1218 sub REALmodsubject {
1219     my ( $dbh, $bibnum, $force, @subject ) = @_;
1220
1221     #  my $dbh   = C4Connect;
1222     my $count = @subject;
1223     my $error="";
1224     for ( my $i = 0 ; $i < $count ; $i++ ) {
1225         $subject[$i] =~ s/^ //g;
1226         $subject[$i] =~ s/ $//g;
1227         my $sth =
1228           $dbh->prepare(
1229 "select * from catalogueentry where entrytype = 's' and catalogueentry = ?"
1230         );
1231         $sth->execute( $subject[$i] );
1232
1233         if ( my $data = $sth->fetchrow_hashref ) {
1234         }
1235         else {
1236             if ( $force eq $subject[$i] || $force == 1 ) {
1237
1238                 # subject not in aut, chosen to force anway
1239                 # so insert into cataloguentry so its in auth file
1240                 my $sth2 =
1241                   $dbh->prepare(
1242 "Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)"
1243                 );
1244
1245                 $sth2->execute( $subject[$i] ) if ( $subject[$i] );
1246                 $sth2->finish;
1247             }
1248             else {
1249                 $error =
1250                   "$subject[$i]\n does not exist in the subject authority file";
1251                 my $sth2 =
1252                   $dbh->prepare(
1253 "Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)"
1254                 );
1255                 $sth2->execute( "$subject[$i] %", "% $subject[$i] %",
1256                     "% $subject[$i]" );
1257                 while ( my $data = $sth2->fetchrow_hashref ) {
1258                     $error .= "<br>$data->{'catalogueentry'}";
1259                 }    # while
1260                 $sth2->finish;
1261             }    # else
1262         }    # else
1263         $sth->finish;
1264     }    # else
1265     if ($error eq '') {
1266         my $sth =
1267           $dbh->prepare("Delete from bibliosubject where biblionumber = ?");
1268         $sth->execute($bibnum);
1269         $sth->finish;
1270         $sth =
1271           $dbh->prepare(
1272             "Insert into bibliosubject (subject,biblionumber) values (?,?)");
1273         my $query;
1274         foreach $query (@subject) {
1275             $sth->execute( $query, $bibnum ) if ( $query && $bibnum );
1276         }    # foreach
1277         $sth->finish;
1278     }    # if
1279
1280     #  $dbh->disconnect;
1281     return ($error);
1282 }    # sub modsubject
1283
1284 =head2 REALmodbiblioitem
1285
1286 REALmodbiblioitem($dbh, $biblioitem);
1287
1288 =over 4
1289
1290 modify a biblioitem
1291
1292 =back
1293
1294 =cut
1295 sub REALmodbiblioitem {
1296     my ( $dbh, $biblioitem ) = @_;
1297     my $query;
1298
1299     my $sth = $dbh->prepare("update biblioitems set number=?,volume=?,                  volumedate=?,           lccn=?,
1300                                                                                 itemtype=?,                     url=?,                          isbn=?,                         issn=?,
1301                                                                                 publishercode=?,        publicationyear=?,      classification=?,       dewey=?,
1302                                                                                 subclass=?,                     illus=?,                        pages=?,                        volumeddesc=?,
1303                                                                                 notes=?,                        size=?,                         place=?,                        marc=?,
1304                                                                                 marcxml=?
1305                                                         where biblioitemnumber=?");
1306         $sth->execute(  $biblioitem->{number},                  $biblioitem->{volume},  $biblioitem->{volumedate},      $biblioitem->{lccn},
1307                                         $biblioitem->{itemtype},                $biblioitem->{url},             $biblioitem->{isbn},    $biblioitem->{issn},
1308                                 $biblioitem->{publishercode},   $biblioitem->{publicationyear}, $biblioitem->{classification},  $biblioitem->{dewey},
1309                                 $biblioitem->{subclass},                $biblioitem->{illus},           $biblioitem->{pages},   $biblioitem->{volumeddesc},
1310                                 $biblioitem->{bnotes},                  $biblioitem->{size},            $biblioitem->{place},   $biblioitem->{marc},
1311                                         $biblioitem->{marcxml},                 $biblioitem->{biblioitemnumber});
1312
1313         my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1314
1315         z3950_extended_services('update',set_service_options('update'),$record);
1316         z3950_extended_services('commit');
1317
1318
1319 #       warn "MOD : $biblioitem->{biblioitemnumber} = ".$biblioitem->{marc};
1320 }    # sub modbibitem
1321
1322 =head2 REALnewbiblioitem
1323
1324 REALnewbiblioitem($dbh,$biblioitem);
1325
1326 =over 4
1327
1328 adds a biblioitem ($biblioitem is a hash with the values)
1329
1330 =back
1331
1332 =cut
1333
1334 sub REALnewbiblioitem {
1335         my ( $dbh, $biblioitem ) = @_;
1336
1337         $dbh->do("lock tables biblioitems WRITE, biblio WRITE, marc_subfield_structure READ");
1338         my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems");
1339         my $data;
1340         my $biblioitemnumber;
1341
1342         $sth->execute;
1343         $data       = $sth->fetchrow_arrayref;
1344         $biblioitemnumber = $$data[0] + 1;
1345
1346         # Insert biblioitemnumber in MARC record, we need it to manage items later...
1347         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblioitem->{biblionumber});
1348         my ($biblioitemnumberfield,$biblioitemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'biblioitems.biblioitemnumber',$frameworkcode);
1349         my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1350         my $field=$record->field($biblioitemnumberfield);
1351         $field->update($biblioitemnumbersubfield => "$biblioitemnumber");
1352         $biblioitem->{marc} = $record->as_usmarc();
1353         $biblioitem->{marcxml} = $record->as_xml();
1354
1355         $sth = $dbh->prepare( "insert into biblioitems set
1356                                                                         biblioitemnumber = ?,           biblionumber     = ?,
1357                                                                         volume           = ?,                   number           = ?,
1358                                                                         classification  = ?,                    itemtype         = ?,
1359                                                                         url              = ?,                           isbn             = ?,
1360                                                                         issn             = ?,                           dewey            = ?,
1361                                                                         subclass         = ?,                           publicationyear  = ?,
1362                                                                         publishercode    = ?,           volumedate       = ?,
1363                                                                         volumeddesc      = ?,           illus            = ?,
1364                                                                         pages            = ?,                           notes            = ?,
1365                                                                         size             = ?,                           lccn             = ?,
1366                                                                         marc             = ?,                           place            = ?,
1367                                                                         marcxml          = ?"
1368         );
1369         $sth->execute(
1370                 $biblioitemnumber,               $biblioitem->{'biblionumber'},
1371                 $biblioitem->{'volume'},         $biblioitem->{'number'},
1372                 $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
1373                 $biblioitem->{'url'},            $biblioitem->{'isbn'},
1374                 $biblioitem->{'issn'},           $biblioitem->{'dewey'},
1375                 $biblioitem->{'subclass'},       $biblioitem->{'publicationyear'},
1376                 $biblioitem->{'publishercode'},  $biblioitem->{'volumedate'},
1377                 $biblioitem->{'volumeddesc'},    $biblioitem->{'illus'},
1378                 $biblioitem->{'pages'},          $biblioitem->{'bnotes'},
1379                 $biblioitem->{'size'},           $biblioitem->{'lccn'},
1380                 $biblioitem->{'marc'},           $biblioitem->{'place'},
1381                 $biblioitem->{marcxml},
1382         );
1383         $dbh->do("unlock tables");
1384         z3950_extended_services('update',set_service_options('update'),$record);
1385         z3950_extended_services('commit');
1386         return ($biblioitemnumber);
1387 }
1388
1389 =head2 REALnewsubtitle
1390
1391 REALnewsubtitle($dbh,$bibnum,$subtitle);
1392
1393 =over 4
1394
1395 create a new subtitle
1396
1397 =back
1398
1399 =cut
1400 sub REALnewsubtitle {
1401     my ( $dbh, $bibnum, $subtitle ) = @_;
1402     my $sth =
1403       $dbh->prepare(
1404         "insert into bibliosubtitle set biblionumber = ?, subtitle = ?");
1405     $sth->execute( $bibnum, $subtitle ) if $subtitle;
1406     $sth->finish;
1407 }
1408
1409 =head2 REALnewitems
1410
1411 ($itemnumber,$errors)= REALnewitems($dbh,$item,$barcode);
1412
1413 =over 4
1414
1415 create a item. $item is a hash and $barcode the barcode.
1416
1417 =back
1418
1419 =cut
1420
1421 sub REALnewitems {
1422     my ( $dbh, $item, $barcode ) = @_;
1423
1424 #       warn "OLDNEWITEMS";
1425
1426         $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE,marc_subfield_structure WRITE');
1427     my $sth = $dbh->prepare("Select max(itemnumber) from items");
1428     my $data;
1429     my $itemnumber;
1430     my $error = "";
1431     $sth->execute;
1432     $data       = $sth->fetchrow_hashref;
1433     $itemnumber = $data->{'max(itemnumber)'} + 1;
1434
1435 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
1436     if ( $item->{'loan'} ) {
1437         $item->{'notforloan'} = $item->{'loan'};
1438     }
1439         $item->{'biblioitemnumber'} = 1;
1440     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1441     if ( $item->{'dateaccessioned'} ) {
1442         $sth = $dbh->prepare( "Insert into items set
1443                                                         itemnumber           = ?,                       biblionumber         = ?,
1444                                                         multivolumepart      = ?,
1445                                                         biblioitemnumber     = ?,                       barcode              = ?,
1446                                                         booksellerid         = ?,                       dateaccessioned      = ?,
1447                                                         homebranch           = ?,                       holdingbranch        = ?,
1448                                                         price                = ?,                       replacementprice     = ?,
1449                                                         replacementpricedate = NOW(),           datelastseen            = NOW(),
1450                                                         multivolume                     = ?,                    stack                           = ?,
1451                                                         itemlost                        = ?,                    wthdrawn                        = ?,
1452                                                         paidfor                         = ?,                    itemnotes            = ?,
1453                                                         itemcallnumber  =?,                                                     notforloan = ?,
1454                                                         location = ?
1455                                                         "
1456         );
1457         $sth->execute(
1458                         $itemnumber,                            $item->{'biblionumber'},
1459                         $item->{'multivolumepart'},
1460                         $item->{'biblioitemnumber'},$item->{barcode},
1461                         $item->{'booksellerid'},        $item->{'dateaccessioned'},
1462                         $item->{'homebranch'},          $item->{'holdingbranch'},
1463                         $item->{'price'},                       $item->{'replacementprice'},
1464                         $item->{multivolume},           $item->{stack},
1465                         $item->{itemlost},                      $item->{wthdrawn},
1466                         $item->{paidfor},                       $item->{'itemnotes'},
1467                         $item->{'itemcallnumber'},      $item->{'notforloan'},
1468                         $item->{'location'}
1469         );
1470                 if ( defined $sth->errstr ) {
1471                         $error .= $sth->errstr;
1472                 }
1473     }
1474     else {
1475         $sth = $dbh->prepare( "Insert into items set
1476                                                         itemnumber           = ?,                       biblionumber         = ?,
1477                                                         multivolumepart      = ?,
1478                                                         biblioitemnumber     = ?,                       barcode              = ?,
1479                                                         booksellerid         = ?,                       dateaccessioned      = NOW(),
1480                                                         homebranch           = ?,                       holdingbranch        = ?,
1481                                                         price                = ?,                       replacementprice     = ?,
1482                                                         replacementpricedate = NOW(),           datelastseen            = NOW(),
1483                                                         multivolume                     = ?,                    stack                           = ?,
1484                                                         itemlost                        = ?,                    wthdrawn                        = ?,
1485                                                         paidfor                         = ?,                    itemnotes            = ?,
1486                                                         itemcallnumber  =?,                                                     notforloan = ?,
1487                                                         location = ?
1488                                                         "
1489         );
1490         $sth->execute(
1491                         $itemnumber,                            $item->{'biblionumber'},
1492                         $item->{'multivolumepart'},
1493                         $item->{'biblioitemnumber'},$item->{barcode},
1494                         $item->{'booksellerid'},
1495                         $item->{'homebranch'},          $item->{'holdingbranch'},
1496                         $item->{'price'},                       $item->{'replacementprice'},
1497                         $item->{multivolume},           $item->{stack},
1498                         $item->{itemlost},                      $item->{wthdrawn},
1499                         $item->{paidfor},                       $item->{'itemnotes'},
1500                         $item->{'itemcallnumber'},      $item->{'notforloan'},
1501                         $item->{'location'}
1502         );
1503                 if ( defined $sth->errstr ) {
1504                         $error .= $sth->errstr;
1505                 }
1506     }
1507         # item stored, now, deal with the marc part...
1508         $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1509                                                         where   biblio.biblionumber=biblioitems.biblionumber and
1510                                                                         biblio.biblionumber=?");
1511         $sth->execute($item->{biblionumber});
1512     if ( defined $sth->errstr ) {
1513         $error .= $sth->errstr;
1514     }
1515         my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1516         warn "ERROR IN REALnewitem, MARC record not found FOR $item->{biblionumber} => $rawmarc <=" unless $rawmarc;
1517         my $record = MARC::File::USMARC::decode($rawmarc);
1518         # ok, we have the marc record, add item number to the item field (in {marc}, and add the field to the record)
1519         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1520         my $itemrecord = MARC::Record->new_from_usmarc($item->{marc});
1521         #warn $itemrecord;
1522         #warn $itemnumberfield;
1523         #warn $itemrecord->field($itemnumberfield);
1524         my $itemfield = $itemrecord->field($itemnumberfield);
1525         $itemfield->add_subfields($itemnumbersubfield => "$itemnumber");
1526         $record->insert_grouped_field($itemfield);
1527         # save the record into biblioitem
1528         $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=?");
1529         $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber});
1530     if ( defined $sth->errstr ) {
1531         $error .= $sth->errstr;
1532     }
1533         z3950_extended_services('update',set_service_options('update'),$record);
1534         z3950_extended_services('commit');
1535         $dbh->do('unlock tables');
1536     return ( $itemnumber, $error );
1537 }
1538
1539 =head2 REALmoditem($dbh,$item);
1540
1541 =over 4
1542
1543 modify item
1544
1545 =back
1546
1547 =cut
1548
1549 sub REALmoditem {
1550     my ( $dbh, $item ) = @_;
1551     $item->{'bibitemnum'} = 1;
1552         my $error;
1553         $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE');
1554     $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
1555     my $query = "update items set  barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1556     my @bind = (
1557         $item->{'barcode'},                     $item->{'itemnotes'},
1558         $item->{'itemcallnumber'},      $item->{'notforloan'},
1559         $item->{'location'},            $item->{multivolumepart},
1560                 $item->{multivolume},           $item->{stack},
1561                 $item->{wthdrawn},
1562     );
1563     if ( $item->{'lost'} ne '' ) {
1564         $query = "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
1565                                                         itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
1566                                                         location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1567         @bind = (
1568             $item->{'bibitemnum'},     $item->{'barcode'},
1569             $item->{'itemnotes'},          $item->{'homebranch'},
1570             $item->{'lost'},           $item->{'wthdrawn'},
1571             $item->{'itemcallnumber'}, $item->{'notforloan'},
1572             $item->{'location'},                $item->{multivolumepart},
1573                         $item->{multivolume},           $item->{stack},
1574                         $item->{wthdrawn},
1575         );
1576                 if ($item->{homebranch}) {
1577                         $query.=",homebranch=?";
1578                         push @bind, $item->{homebranch};
1579                 }
1580                 if ($item->{holdingbranch}) {
1581                         $query.=",holdingbranch=?";
1582                         push @bind, $item->{holdingbranch};
1583                 }
1584     }
1585         $query.=" where itemnumber=?";
1586         push @bind,$item->{'itemnum'};
1587    if ( $item->{'replacement'} ne '' ) {
1588         $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1589     }
1590     my $sth = $dbh->prepare($query);
1591     $sth->execute(@bind);
1592
1593         # item stored, now, deal with the marc part...
1594         $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1595                                                         where   biblio.biblionumber=biblioitems.biblionumber and
1596                                                                         biblio.biblionumber=? and
1597                                                                         biblioitems.biblioitemnumber=?");
1598         $sth->execute($item->{biblionumber},$item->{biblioitemnumber});
1599     if ( defined $sth->errstr ) {
1600         $error .= $sth->errstr;
1601     }
1602         my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1603         warn "ERROR IN REALmoditem, MARC record not found" unless $rawmarc;
1604         my $record = MARC::File::USMARC::decode($rawmarc);
1605         # ok, we have the marc record, find the previous item record for this itemnumber and delete it
1606         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1607         # prepare the new item record
1608         my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1609         my $itemfield = $itemrecord->field($itemnumberfield);
1610         $itemfield->add_subfields($itemnumbersubfield => '$itemnumber');
1611         # parse all fields fields from the complete record
1612         foreach ($record->field($itemnumberfield)) {
1613                 # when the previous field is found, replace by the new one
1614                 if ($_->subfield($itemnumbersubfield) == $item->{itemnum}) {
1615                         $_->replace_with($itemfield);
1616                 }
1617         }
1618 #       $record->insert_grouped_field($itemfield);
1619         # save the record into biblioitem
1620         $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=? and biblioitemnumber=?");
1621         $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber},$item->{biblioitemnumber});
1622         z3950_extended_services('update',set_service_options('update'),$record);
1623         z3950_extended_services('commit');
1624     if ( defined $sth->errstr ) {
1625         $error .= $sth->errstr;
1626     }
1627         $dbh->do('unlock tables');
1628
1629 }
1630
1631 =head2 REALdelitem($dbh,$itemnum);
1632
1633 =over 4
1634
1635 delete item
1636
1637 =back
1638
1639 =cut
1640
1641 sub REALdelitem {
1642     my ( $dbh, $itemnum ) = @_;
1643
1644     #  my $dbh=C4Connect;
1645     my $sth = $dbh->prepare("select * from items where itemnumber=?");
1646     $sth->execute($itemnum);
1647     my $data = $sth->fetchrow_hashref;
1648     $sth->finish;
1649     my $query = "Insert into deleteditems set ";
1650     my @bind  = ();
1651     foreach my $temp ( keys %$data ) {
1652         $query .= "$temp = ?,";
1653         push ( @bind, $data->{$temp} );
1654     }
1655     $query =~ s/\,$//;
1656
1657     #  print $query;
1658     $sth = $dbh->prepare($query);
1659     $sth->execute(@bind);
1660     $sth->finish;
1661     $sth = $dbh->prepare("Delete from items where itemnumber=?");
1662     $sth->execute($itemnum);
1663     $sth->finish;
1664
1665     #  $dbh->disconnect;
1666 }
1667
1668 =head2 REALdelbiblioitem($dbh,$biblioitemnumber);
1669
1670 =over 4
1671
1672 deletes a biblioitem
1673 NOTE : not standard sub name. Should be REALdelbiblioitem()
1674
1675 =back
1676
1677 =cut
1678
1679 sub REALdelbiblioitem {
1680     my ( $dbh, $biblioitemnumber ) = @_;
1681
1682     #    my $dbh   = C4Connect;
1683     my $sth = $dbh->prepare( "Select * from biblioitems
1684 where biblioitemnumber = ?"
1685     );
1686     my $results;
1687
1688     $sth->execute($biblioitemnumber);
1689
1690     if ( $results = $sth->fetchrow_hashref ) {
1691         $sth->finish;
1692         $sth =
1693           $dbh->prepare(
1694 "Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
1695                                         isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
1696                                         pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
1697         );
1698
1699         $sth->execute(
1700             $results->{biblioitemnumber}, $results->{biblionumber},
1701             $results->{volume},           $results->{number},
1702             $results->{classification},   $results->{itemtype},
1703             $results->{isbn},             $results->{issn},
1704             $results->{dewey},            $results->{subclass},
1705             $results->{publicationyear},  $results->{publishercode},
1706             $results->{volumedate},       $results->{volumeddesc},
1707             $results->{timestamp},        $results->{illus},
1708             $results->{pages},            $results->{notes},
1709             $results->{size},             $results->{url},
1710             $results->{lccn}
1711         );
1712         my $sth2 =
1713           $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?");
1714         $sth2->execute($biblioitemnumber);
1715         $sth2->finish();
1716     }    # if
1717     $sth->finish;
1718
1719     # Now delete all the items attached to the biblioitem
1720     $sth = $dbh->prepare("Select * from items where biblioitemnumber = ?");
1721     $sth->execute($biblioitemnumber);
1722     my @results;
1723     while ( my $data = $sth->fetchrow_hashref ) {
1724         my $query = "Insert into deleteditems set ";
1725         my @bind  = ();
1726         foreach my $temp ( keys %$data ) {
1727             $query .= "$temp = ?,";
1728             push ( @bind, $data->{$temp} );
1729         }
1730         $query =~ s/\,$//;
1731         my $sth2 = $dbh->prepare($query);
1732         $sth2->execute(@bind);
1733     }    # while
1734     $sth->finish;
1735     $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
1736     $sth->execute($biblioitemnumber);
1737     $sth->finish();
1738
1739     #    $dbh->disconnect;
1740 }    # sub deletebiblioitem
1741
1742 =head2 REALdelbiblio($dbh,$biblio);
1743
1744 =over 4
1745
1746 delete a biblio
1747
1748 =back
1749
1750 =cut
1751
1752 sub REALdelbiblio {
1753     my ( $dbh, $biblio ) = @_;
1754     my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
1755     $sth->execute($biblio);
1756     if ( my $data = $sth->fetchrow_hashref ) {
1757         $sth->finish;
1758         my $query = "Insert into deletedbiblio set ";
1759         my @bind  = ();
1760         foreach my $temp ( keys %$data ) {
1761             $query .= "$temp = ?,";
1762             push ( @bind, $data->{$temp} );
1763         }
1764
1765         #replacing the last , by ",?)"
1766         $query =~ s/\,$//;
1767         $sth = $dbh->prepare($query);
1768         $sth->execute(@bind);
1769         $sth->finish;
1770         $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
1771         $sth->execute($biblio);
1772         $sth->finish;
1773     }
1774     $sth->finish;
1775 }
1776
1777 =head2 itemcount
1778
1779 $number = itemcount($biblio);
1780
1781 =over 4
1782
1783 returns the number of items attached to a biblio
1784
1785 =back
1786
1787 =cut
1788
1789 sub itemcount {
1790     my ($biblio) = @_;
1791     my $dbh = C4::Context->dbh;
1792
1793     #  print $query;
1794     my $sth = $dbh->prepare("Select count(*) from items where biblionumber=?");
1795     $sth->execute($biblio);
1796     my $data = $sth->fetchrow_hashref;
1797     $sth->finish;
1798     return ( $data->{'count(*)'} );
1799 }
1800
1801 =head2 newbiblio
1802
1803 $biblionumber = newbiblio($biblio);
1804
1805 =over 4
1806
1807 create a biblio. The parameter is a hash
1808
1809 =back
1810
1811 =cut
1812
1813 sub newbiblio {
1814     my ($biblio) = @_;
1815     my $dbh    = C4::Context->dbh;
1816     my $bibnum = REALnewbiblio( $dbh, $biblio );
1817     # finds new (MARC bibid
1818     #   my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1819 #     my $record = &MARCkoha2marcBiblio( $dbh, $bibnum );
1820 #     MARCaddbiblio( $dbh, $record, $bibnum,'' );
1821     return ($bibnum);
1822 }
1823
1824 =head2  modbiblio
1825
1826 $biblionumber = &modbiblio($biblio);
1827
1828 =over 4
1829
1830 Update a biblio record.
1831
1832 C<$biblio> is a reference-to-hash whose keys are the fields in the
1833 biblio table in the Koha database. All fields must be present, not
1834 just the ones you wish to change.
1835
1836 C<&modbiblio> updates the record defined by
1837 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1838
1839 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1840 successful or not.
1841
1842 =back
1843
1844 =cut
1845
1846 sub modbiblio {
1847         my ($biblio) = @_;
1848         my $dbh  = C4::Context->dbh;
1849         my $biblionumber=REALmodbiblio($dbh,$biblio);
1850         my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
1851         # finds new (MARC bibid
1852         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
1853         MARCmodbiblio($dbh,$bibid,$record,"",0);
1854         return($biblionumber);
1855 } # sub modbiblio
1856
1857 =head2 &modsubtitle($biblionumber, $subtitle);
1858
1859 =over 4
1860
1861 Sets the subtitle of a book.
1862
1863 C<$biblionumber> is the biblionumber of the book to modify.
1864
1865 C<$subtitle> is the new subtitle.
1866
1867 =back
1868
1869 =cut
1870
1871 sub modsubtitle {
1872     my ( $bibnum, $subtitle ) = @_;
1873     my $dbh = C4::Context->dbh;
1874     &REALmodsubtitle( $dbh, $bibnum, $subtitle );
1875 }    # sub modsubtitle
1876
1877 =head2 &modaddauthor($biblionumber, $author);
1878
1879 =over 4
1880
1881 Replaces all additional authors for the book with biblio number
1882 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1883 C<&modaddauthor> deletes all additional authors.
1884
1885 =back
1886
1887 =cut
1888
1889 sub modaddauthor {
1890     my ( $bibnum, @authors ) = @_;
1891     my $dbh = C4::Context->dbh;
1892     &REALmodaddauthor( $dbh, $bibnum, @authors );
1893 }    # sub modaddauthor
1894
1895 =head2 modsubject
1896
1897 $error = &modsubject($biblionumber, $force, @subjects);
1898
1899 =over 4
1900
1901 $force - a subject to force
1902 $error - Error message, or undef if successful.
1903
1904 =back
1905
1906 =cut
1907
1908 sub modsubject {
1909     my ( $bibnum, $force, @subject ) = @_;
1910     my $dbh = C4::Context->dbh;
1911     my $error = &REALmodsubject( $dbh, $bibnum, $force, @subject );
1912     if ($error eq ''){
1913                 # When MARC is off, ensures that the MARC biblio table gets updated with new
1914                 # subjects, of course, it deletes the biblio in marc, and then recreates.
1915                 # This check is to ensure that no MARC data exists to lose.
1916 #               if (C4::Context->preference("MARC") eq '0'){
1917 #               warn "in modSUBJECT";
1918 #                       my $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibnum);
1919 #                       my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1920 #                       &MARCmodbiblio($dbh,$bibid, $MARCRecord);
1921 #               }
1922         }
1923         return ($error);
1924 }    # sub modsubject
1925
1926 =head2 modbibitem($dbh, $biblioitem);
1927
1928 =over 4
1929
1930 modify a biblioitem. The parameter is a hash
1931
1932 =back
1933
1934 =cut
1935
1936 sub modbibitem {
1937     my ($dbh, $biblioitem) = @_;
1938     #my $dbh = C4::Context->dbh;
1939     &REALmodbiblioitem( $dbh, $biblioitem );
1940 }    # sub modbibitem
1941
1942 =head2 newbiblioitem
1943
1944 $biblioitemnumber = newbiblioitem($biblioitem)
1945
1946 =over 4
1947
1948 create a biblioitem, the parameter is a hash
1949
1950 =back
1951
1952 =cut
1953
1954 sub newbiblioitem {
1955     my ($dbh, $biblioitem) = @_;
1956     #my $dbh        = C4::Context->dbh;
1957         # add biblio information to the hash
1958     my $MARCbiblio = MARCkoha2marcBiblio( $dbh, $biblioitem );
1959         $biblioitem->{marc} = $MARCbiblio->as_usmarc();
1960     my $bibitemnum = &REALnewbiblioitem( $dbh, $biblioitem );
1961     return ($bibitemnum);
1962 }
1963
1964 =head2 newsubtitle($biblionumber,$subtitle);
1965
1966 =over 4
1967
1968 insert a subtitle for $biblionumber biblio
1969
1970 =back
1971
1972 =cut
1973
1974
1975 sub newsubtitle {
1976     my ( $bibnum, $subtitle ) = @_;
1977     my $dbh = C4::Context->dbh;
1978     &REALnewsubtitle( $dbh, $bibnum, $subtitle );
1979 }
1980
1981 =head2 newitems
1982
1983 $errors = newitems($dbh, $item, @barcodes);
1984
1985 =over 4
1986
1987 insert items ($item is a hash)
1988
1989 =back
1990
1991 =cut
1992
1993
1994 sub newitems {
1995     my ( $dbh, $item, @barcodes ) = @_;
1996     #my $dbh = C4::Context->dbh;
1997     my $errors;
1998     my $itemnumber;
1999     my $error;
2000     foreach my $barcode (@barcodes) {
2001                 # add items, one by one for each barcode.
2002                 my $oneitem=$item;
2003                 $oneitem->{barcode}= $barcode;
2004         my $MARCitem = &MARCkoha2marcItem( $dbh, $oneitem);
2005                 $oneitem->{marc} = $MARCitem->as_usmarc;
2006         ( $itemnumber, $error ) = &REALnewitems( $dbh, $oneitem);
2007 #         $errors .= $error;
2008 #         &MARCadditem( $dbh, $MARCitem, $item->{biblionumber} );
2009     }
2010     return ($errors);
2011 }
2012
2013 =head2 moditem($dbh,$item);
2014
2015 =over 4
2016
2017 modify an item ($item is a hash with all item informations)
2018
2019 =back
2020
2021 =cut
2022
2023
2024 sub moditem {
2025     my ($dbh, $item) = @_;
2026     #my $dbh = C4::Context->dbh;
2027     &REALmoditem( $dbh, $item );
2028     my $MARCitem =
2029       &MARCkoha2marcItem( $dbh, $item->{'biblionumber'}, $item->{'itemnum'} );
2030     my $bibid =
2031       &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $item->{biblionumber} );
2032     &MARCmoditem( $dbh, $MARCitem, $bibid, $item->{itemnum}, 0 );
2033 }
2034
2035 =head2 checkitems
2036
2037 $error = checkitems($count,@barcodes);
2038
2039 =over 4
2040
2041 check for each @barcode entry that the barcode is not a duplicate
2042
2043 =back
2044
2045 =cut
2046
2047 sub checkitems {
2048     my ( $count, @barcodes ) = @_;
2049     my $dbh = C4::Context->dbh;
2050     my $error;
2051     my $sth = $dbh->prepare("Select * from items where barcode=?");
2052     for ( my $i = 0 ; $i < $count ; $i++ ) {
2053         $barcodes[$i] = uc $barcodes[$i];
2054         $sth->execute( $barcodes[$i] );
2055         if ( my $data = $sth->fetchrow_hashref ) {
2056             $error .= " Duplicate Barcode: $barcodes[$i]";
2057         }
2058     }
2059     $sth->finish;
2060     return ($error);
2061 }
2062
2063 =head2 delitem($itemnum);
2064
2065 =over 4
2066
2067 delete item $itemnum being the item number to delete
2068
2069 =back
2070
2071 =cut
2072
2073 sub delitem {
2074     my ($itemnum) = @_;
2075     my $dbh = C4::Context->dbh;
2076     &REALdelitem( $dbh, $itemnum );
2077 }
2078
2079 =head2 deletebiblioitem($biblioitemnumber);
2080
2081 =over 4
2082
2083 delete the biblioitem $biblioitemnumber
2084
2085 =back
2086
2087 =cut
2088
2089 sub deletebiblioitem {
2090     my ($biblioitemnumber) = @_;
2091     my $dbh = C4::Context->dbh;
2092     &REALdelbiblioitem( $dbh, $biblioitemnumber );
2093 }    # sub deletebiblioitem
2094
2095 =head2 delbiblio($biblionumber)
2096
2097 =over 4
2098
2099 delete biblio $biblionumber
2100
2101 =back
2102
2103 =cut
2104
2105 sub delbiblio {
2106     my ($biblio) = @_;
2107     my $dbh = C4::Context->dbh;
2108     &REALdelbiblio( $dbh, $biblio );
2109     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio );
2110     &MARCdelbiblio( $dbh, $bibid, 0 );
2111 }
2112
2113 =head2 getbiblio
2114
2115 ($count,@results) = getbiblio($biblionumber);
2116
2117 =over 4
2118
2119 return an array with hash of biblios.
2120
2121 FIXME : biblionumber being the primary key, this sub will always return only 1 result, API should be modified...
2122
2123 =back
2124
2125 =cut
2126
2127 sub getbiblio {
2128     my ($biblionumber) = @_;
2129     my $dbh = C4::Context->dbh;
2130     my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
2131
2132     # || die "Cannot prepare $query\n" . $dbh->errstr;
2133     my $count = 0;
2134     my @results;
2135
2136     $sth->execute($biblionumber);
2137
2138     # || die "Cannot execute $query\n" . $sth->errstr;
2139     while ( my $data = $sth->fetchrow_hashref ) {
2140         $results[$count] = $data;
2141         $count++;
2142     }    # while
2143
2144     $sth->finish;
2145     return ( $count, @results );
2146 }    # sub getbiblio
2147
2148 =head2 bibdata
2149
2150   $data = &bibdata($biblionumber, $type);
2151
2152 Returns information about the book with the given biblionumber.
2153
2154 C<$type> is ignored.
2155
2156 C<&bibdata> returns a reference-to-hash. The keys are the fields in
2157 the C<biblio>, C<biblioitems>, and C<bibliosubtitle> tables in the
2158 Koha database.
2159
2160 In addition, C<$data-E<gt>{subject}> is the list of the book's
2161 subjects, separated by C<" , "> (space, comma, space).
2162
2163 If there are multiple biblioitems with the given biblionumber, only
2164 the first one is considered.
2165
2166 =cut
2167 #'
2168 sub bibdata {
2169         my ($bibnum, $type) = @_;
2170         my $dbh   = C4::Context->dbh;
2171         my $sth   = $dbh->prepare("Select *, biblioitems.notes AS bnotes, biblio.notes
2172                                                                 from biblio
2173                                                                 left join biblioitems on biblioitems.biblionumber = biblio.biblionumber
2174                                                                 left join bibliosubtitle on
2175                                                                 biblio.biblionumber = bibliosubtitle.biblionumber
2176                                                                 left join itemtypes on biblioitems.itemtype=itemtypes.itemtype
2177                                                                 where biblio.biblionumber = ?
2178                                                                 ");
2179         $sth->execute($bibnum);
2180         my $data;
2181         $data  = $sth->fetchrow_hashref;
2182         $sth->finish;
2183         # handle management of repeated subtitle
2184         $sth   = $dbh->prepare("Select * from bibliosubtitle where biblionumber = ?");
2185         $sth->execute($bibnum);
2186         my @subtitles;
2187         while (my $dat = $sth->fetchrow_hashref){
2188                 my %line;
2189                 $line{subtitle} = $dat->{subtitle};
2190                 push @subtitles, \%line;
2191         } # while
2192         $data->{subtitles} = \@subtitles;
2193         $sth->finish;
2194         $sth   = $dbh->prepare("Select * from bibliosubject where biblionumber = ?");
2195         $sth->execute($bibnum);
2196         my @subjects;
2197         while (my $dat = $sth->fetchrow_hashref){
2198                 my %line;
2199                 $line{subject} = $dat->{'subject'};
2200                 push @subjects, \%line;
2201         } # while
2202         $data->{subjects} = \@subjects;
2203         $sth->finish;
2204         $sth   = $dbh->prepare("Select * from additionalauthors where biblionumber = ?");
2205         $sth->execute($bibnum);
2206         while (my $dat = $sth->fetchrow_hashref){
2207                 $data->{'additionalauthors'} .= "$dat->{'author'} - ";
2208         } # while
2209         chop $data->{'additionalauthors'};
2210         chop $data->{'additionalauthors'};
2211         chop $data->{'additionalauthors'};
2212         $sth->finish;
2213         return($data);
2214 } # sub bibdata
2215
2216 =head2 getbiblioitem
2217
2218 ($count,@results) = getbiblioitem($biblioitemnumber);
2219
2220 =over 4
2221
2222 return an array with hash of biblioitemss.
2223
2224 FIXME : biblioitemnumber being unique, this sub will always return only 1 result, API should be modified...
2225
2226 =back
2227
2228 =cut
2229
2230 sub getbiblioitem {
2231     my ($biblioitemnum) = @_;
2232     my $dbh = C4::Context->dbh;
2233     my $sth = $dbh->prepare( "Select * from biblioitems where
2234 biblioitemnumber = ?"
2235     );
2236     my $count = 0;
2237     my @results;
2238
2239     $sth->execute($biblioitemnum);
2240
2241     while ( my $data = $sth->fetchrow_hashref ) {
2242         $results[$count] = $data;
2243         $count++;
2244     }    # while
2245
2246     $sth->finish;
2247     return ( $count, @results );
2248 }    # sub getbiblioitem
2249
2250 =head2 getbiblioitembybiblionumber
2251
2252 ($count,@results) = getbiblioitembybiblionumber($biblionumber);
2253
2254 =over 4
2255
2256 return an array with hash of biblioitems for the given biblionumber.
2257
2258 =back
2259
2260 =cut
2261
2262 sub getbiblioitembybiblionumber {
2263     my ($biblionumber) = @_;
2264     my $dbh = C4::Context->dbh;
2265     my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
2266     my $count = 0;
2267     my @results;
2268
2269     $sth->execute($biblionumber);
2270
2271     while ( my $data = $sth->fetchrow_hashref ) {
2272         $results[$count] = $data;
2273         $count++;
2274     }    # while
2275
2276     $sth->finish;
2277     return ( $count, @results );
2278 }    # sub
2279
2280 =head2 getitemsbybiblioitem
2281
2282 ($count,@results) = getitemsbybiblioitem($biblionumber);
2283
2284 =over 4
2285
2286 returns an array with hash of items
2287
2288 =back
2289
2290 =cut
2291
2292 sub getitemsbybiblioitem {
2293     my ($biblioitemnum) = @_;
2294     my $dbh = C4::Context->dbh;
2295     my $sth = $dbh->prepare( "Select * from items, biblio where
2296 biblio.biblionumber = items.biblionumber and biblioitemnumber
2297 = ?"
2298     );
2299
2300     # || die "Cannot prepare $query\n" . $dbh->errstr;
2301     my $count = 0;
2302     my @results;
2303
2304     $sth->execute($biblioitemnum);
2305
2306     # || die "Cannot execute $query\n" . $sth->errstr;
2307     while ( my $data = $sth->fetchrow_hashref ) {
2308         $results[$count] = $data;
2309         $count++;
2310     }    # while
2311
2312     $sth->finish;
2313     return ( $count, @results );
2314 }    # sub getitemsbybiblioitem
2315
2316 =head2 ItemInfo
2317
2318   @results = &ItemInfo($env, $biblionumber, $type);
2319
2320 Returns information about books with the given biblionumber.
2321
2322 C<$type> may be either C<intra> or anything else. If it is not set to
2323 C<intra>, then the search will exclude lost, very overdue, and
2324 withdrawn items.
2325
2326 C<$env> is ignored.
2327
2328 C<&ItemInfo> returns a list of references-to-hash. Each element
2329 contains a number of keys. Most of them are table items from the
2330 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
2331 Koha database. Other keys include:
2332
2333 =over 4
2334
2335 =item C<$data-E<gt>{branchname}>
2336
2337 The name (not the code) of the branch to which the book belongs.
2338
2339 =item C<$data-E<gt>{datelastseen}>
2340
2341 This is simply C<items.datelastseen>, except that while the date is
2342 stored in YYYY-MM-DD format in the database, here it is converted to
2343 DD/MM/YYYY format. A NULL date is returned as C<//>.
2344
2345 =item C<$data-E<gt>{datedue}>
2346
2347 =item C<$data-E<gt>{class}>
2348
2349 This is the concatenation of C<biblioitems.classification>, the book's
2350 Dewey code, and C<biblioitems.subclass>.
2351
2352 =item C<$data-E<gt>{ocount}>
2353
2354 I think this is the number of copies of the book available.
2355
2356 =item C<$data-E<gt>{order}>
2357
2358 If this is set, it is set to C<One Order>.
2359
2360 =back
2361
2362 =cut
2363 #'
2364 sub ItemInfo {
2365         my ($env,$biblionumber,$type) = @_;
2366         my $dbh   = C4::Context->dbh;
2367         my $query = "SELECT *,items.notforloan as itemnotforloan FROM items, biblio, biblioitems
2368                                         left join itemtypes on biblioitems.itemtype = itemtypes.itemtype
2369                                         WHERE items.biblionumber = ?
2370                                         AND biblioitems.biblioitemnumber = items.biblioitemnumber
2371                                         AND biblio.biblionumber = items.biblionumber";
2372         $query .= " order by items.dateaccessioned desc";
2373         my $sth=$dbh->prepare($query);
2374         $sth->execute($biblionumber);
2375         my $i=0;
2376         my @results;
2377         while (my $data=$sth->fetchrow_hashref){
2378                 my $datedue = '';
2379                 my $isth=$dbh->prepare("Select issues.*,borrowers.cardnumber from issues,borrowers where itemnumber = ? and returndate is null and issues.borrowernumber=borrowers.borrowernumber");
2380                 $isth->execute($data->{'itemnumber'});
2381                 if (my $idata=$isth->fetchrow_hashref){
2382                 $data->{borrowernumber} = $idata->{borrowernumber};
2383                 $data->{cardnumber} = $idata->{cardnumber};
2384                 $datedue = format_date($idata->{'date_due'});
2385                 }
2386                 if ($datedue eq ''){
2387                         my ($restype,$reserves)=C4::Reserves2::CheckReserves($data->{'itemnumber'});
2388                         if ($restype) {
2389                                 $datedue=$restype;
2390                         }
2391                 }
2392                 $isth->finish;
2393         #get branch information.....
2394                 my $bsth=$dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
2395                 $bsth->execute($data->{'holdingbranch'});
2396                 if (my $bdata=$bsth->fetchrow_hashref){
2397                         $data->{'branchname'} = $bdata->{'branchname'};
2398                 }
2399                 my $date=format_date($data->{'datelastseen'});
2400                 $data->{'datelastseen'}=$date;
2401                 $data->{'datedue'}=$datedue;
2402         # get notforloan complete status if applicable
2403                 my $sthnflstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.notforloan"');
2404                 $sthnflstatus->execute;
2405                 my ($authorised_valuecode) = $sthnflstatus->fetchrow;
2406                 if ($authorised_valuecode) {
2407                         $sthnflstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?");
2408                         $sthnflstatus->execute($authorised_valuecode,$data->{itemnotforloan});
2409                         my ($lib) = $sthnflstatus->fetchrow;
2410                         $data->{notforloan} = $lib;
2411                 }
2412                 $results[$i]=$data;
2413                 $i++;
2414         }
2415         $sth->finish;
2416         return(@results);
2417 }
2418
2419 =head2 bibitems
2420
2421   ($count, @results) = &bibitems($biblionumber);
2422
2423 Given the biblionumber for a book, C<&bibitems> looks up that book's
2424 biblioitems (different publications of the same book, the audio book
2425 and film versions, etc.).
2426
2427 C<$count> is the number of elements in C<@results>.
2428
2429 C<@results> is an array of references-to-hash; the keys are the fields
2430 of the C<biblioitems> and C<itemtypes> tables of the Koha database. In
2431 addition, C<itemlost> indicates the availability of the item: if it is
2432 "2", then all copies of the item are long overdue; if it is "1", then
2433 all copies are lost; otherwise, there is at least one copy available.
2434
2435 =cut
2436 #'
2437 sub bibitems {
2438     my ($bibnum) = @_;
2439     my $dbh   = C4::Context->dbh;
2440     my $sth   = $dbh->prepare("SELECT biblioitems.*,
2441                         itemtypes.*,
2442                         MIN(items.itemlost)        as itemlost,
2443                         MIN(items.dateaccessioned) as dateaccessioned
2444                           FROM biblioitems, itemtypes, items
2445                          WHERE biblioitems.biblionumber     = ?
2446                            AND biblioitems.itemtype         = itemtypes.itemtype
2447                            AND biblioitems.biblioitemnumber = items.biblioitemnumber
2448                       GROUP BY items.biblioitemnumber");
2449     my $count = 0;
2450     my @results;
2451     $sth->execute($bibnum);
2452     while (my $data = $sth->fetchrow_hashref) {
2453         $results[$count] = $data;
2454         $count++;
2455     } # while
2456     $sth->finish;
2457     return($count, @results);
2458 } # sub bibitems
2459
2460
2461 =head2 bibitemdata
2462
2463   $itemdata = &bibitemdata($biblioitemnumber);
2464
2465 Looks up the biblioitem with the given biblioitemnumber. Returns a
2466 reference-to-hash. The keys are the fields from the C<biblio>,
2467 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
2468 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
2469
2470 =cut
2471 #'
2472 sub bibitemdata {
2473     my ($bibitem) = @_;
2474     my $dbh   = C4::Context->dbh;
2475     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");
2476     my $data;
2477
2478     $sth->execute($bibitem);
2479
2480     $data = $sth->fetchrow_hashref;
2481
2482     $sth->finish;
2483     return($data);
2484 } # sub bibitemdata
2485
2486
2487 =head2 getbibliofromitemnumber
2488
2489   $item = &getbibliofromitemnumber($env, $dbh, $itemnumber);
2490
2491 Looks up the item with the given itemnumber.
2492
2493 C<$env> and C<$dbh> are ignored.
2494
2495 C<&itemnodata> returns a reference-to-hash whose keys are the fields
2496 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
2497 database.
2498
2499 =cut
2500 #'
2501 sub getbibliofromitemnumber {
2502   my ($env,$dbh,$itemnumber) = @_;
2503   $dbh = C4::Context->dbh;
2504   my $sth=$dbh->prepare("Select * from biblio,items,biblioitems
2505     where items.itemnumber = ?
2506     and biblio.biblionumber = items.biblionumber
2507     and biblioitems.biblioitemnumber = items.biblioitemnumber");
2508 #  print $query;
2509   $sth->execute($itemnumber);
2510   my $data=$sth->fetchrow_hashref;
2511   $sth->finish;
2512   return($data);
2513 }
2514
2515 =head2 barcodes
2516
2517   @barcodes = &barcodes($biblioitemnumber);
2518
2519 Given a biblioitemnumber, looks up the corresponding items.
2520
2521 Returns an array of references-to-hash; the keys are C<barcode> and
2522 C<itemlost>.
2523
2524 The returned items include very overdue items, but not lost ones.
2525
2526 =cut
2527 #'
2528 sub barcodes{
2529     #called from request.pl
2530     my ($biblioitemnumber)=@_;
2531     my $dbh = C4::Context->dbh;
2532     my $sth=$dbh->prepare("SELECT barcode, itemlost, holdingbranch FROM items
2533                            WHERE biblioitemnumber = ?
2534                              AND (wthdrawn <> 1 OR wthdrawn IS NULL)");
2535     $sth->execute($biblioitemnumber);
2536     my @barcodes;
2537     my $i=0;
2538     while (my $data=$sth->fetchrow_hashref){
2539         $barcodes[$i]=$data;
2540         $i++;
2541     }
2542     $sth->finish;
2543     return(@barcodes);
2544 }
2545
2546
2547 =head2 itemdata
2548
2549   $item = &itemdata($barcode);
2550
2551 Looks up the item with the given barcode, and returns a
2552 reference-to-hash containing information about that item. The keys of
2553 the hash are the fields from the C<items> and C<biblioitems> tables in
2554 the Koha database.
2555
2556 =cut
2557 #'
2558 sub get_item_from_barcode {
2559   my ($barcode)=@_;
2560   my $dbh = C4::Context->dbh;
2561   my $sth=$dbh->prepare("Select * from items,biblioitems where barcode=?
2562   and items.biblioitemnumber=biblioitems.biblioitemnumber");
2563   $sth->execute($barcode);
2564   my $data=$sth->fetchrow_hashref;
2565   $sth->finish;
2566   return($data);
2567 }
2568
2569
2570 =head2 itemissues
2571
2572   @issues = &itemissues($biblioitemnumber, $biblio);
2573
2574 Looks up information about who has borrowed the bookZ<>(s) with the
2575 given biblioitemnumber.
2576
2577 C<$biblio> is ignored.
2578
2579 C<&itemissues> returns an array of references-to-hash. The keys
2580 include the fields from the C<items> table in the Koha database.
2581 Additional keys include:
2582
2583 =over 4
2584
2585 =item C<date_due>
2586
2587 If the item is currently on loan, this gives the due date.
2588
2589 If the item is not on loan, then this is either "Available" or
2590 "Cancelled", if the item has been withdrawn.
2591
2592 =item C<card>
2593
2594 If the item is currently on loan, this gives the card number of the
2595 patron who currently has the item.
2596
2597 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
2598
2599 These give the timestamp for the last three times the item was
2600 borrowed.
2601
2602 =item C<card0>, C<card1>, C<card2>
2603
2604 The card number of the last three patrons who borrowed this item.
2605
2606 =item C<borrower0>, C<borrower1>, C<borrower2>
2607
2608 The borrower number of the last three patrons who borrowed this item.
2609
2610 =back
2611
2612 =cut
2613 #'
2614 sub itemissues {
2615     my ($bibitem, $biblio)=@_;
2616     my $dbh   = C4::Context->dbh;
2617     # FIXME - If this function die()s, the script will abort, and the
2618     # user won't get anything; depending on how far the script has
2619     # gotten, the user might get a blank page. It would be much better
2620     # to at least print an error message. The easiest way to do this
2621     # is to set $SIG{__DIE__}.
2622     my $sth   = $dbh->prepare("Select * from items where
2623 items.biblioitemnumber = ?")
2624       || die $dbh->errstr;
2625     my $i     = 0;
2626     my @results;
2627
2628     $sth->execute($bibitem)
2629       || die $sth->errstr;
2630
2631     while (my $data = $sth->fetchrow_hashref) {
2632         # Find out who currently has this item.
2633         # FIXME - Wouldn't it be better to do this as a left join of
2634         # some sort? Currently, this code assumes that if
2635         # fetchrow_hashref() fails, then the book is on the shelf.
2636         # fetchrow_hashref() can fail for any number of reasons (e.g.,
2637         # database server crash), not just because no items match the
2638         # search criteria.
2639         my $sth2   = $dbh->prepare("select * from issues,borrowers
2640 where itemnumber = ?
2641 and returndate is NULL
2642 and issues.borrowernumber = borrowers.borrowernumber");
2643
2644         $sth2->execute($data->{'itemnumber'});
2645         if (my $data2 = $sth2->fetchrow_hashref) {
2646             $data->{'date_due'} = $data2->{'date_due'};
2647             $data->{'card'}     = $data2->{'cardnumber'};
2648             $data->{'borrower'}     = $data2->{'borrowernumber'};
2649         } else {
2650             if ($data->{'wthdrawn'} eq '1') {
2651                 $data->{'date_due'} = 'Cancelled';
2652             } else {
2653                 $data->{'date_due'} = 'Available';
2654             } # else
2655         } # else
2656
2657         $sth2->finish;
2658
2659         # Find the last 3 people who borrowed this item.
2660         $sth2 = $dbh->prepare("select * from issues, borrowers
2661                                                 where itemnumber = ?
2662                                                                         and issues.borrowernumber = borrowers.borrowernumber
2663                                                                         and returndate is not NULL
2664                                                                         order by returndate desc,timestamp desc") || die $dbh->errstr;
2665         $sth2->execute($data->{'itemnumber'}) || die $sth2->errstr;
2666         for (my $i2 = 0; $i2 < 2; $i2++) { # FIXME : error if there is less than 3 pple borrowing this item
2667             if (my $data2 = $sth2->fetchrow_hashref) {
2668                 $data->{"timestamp$i2"} = $data2->{'timestamp'};
2669                 $data->{"card$i2"}      = $data2->{'cardnumber'};
2670                 $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
2671             } # if
2672         } # for
2673
2674         $sth2->finish;
2675         $results[$i] = $data;
2676         $i++;
2677     }
2678
2679     $sth->finish;
2680     return(@results);
2681 }
2682
2683 =head2 getsubject
2684
2685   ($count, $subjects) = &getsubject($biblionumber);
2686
2687 Looks up the subjects of the book with the given biblionumber. Returns
2688 a two-element list. C<$subjects> is a reference-to-array, where each
2689 element is a subject of the book, and C<$count> is the number of
2690 elements in C<$subjects>.
2691
2692 =cut
2693 #'
2694 sub getsubject {
2695   my ($bibnum)=@_;
2696   my $dbh = C4::Context->dbh;
2697   my $sth=$dbh->prepare("Select * from bibliosubject where biblionumber=?");
2698   $sth->execute($bibnum);
2699   my @results;
2700   my $i=0;
2701   while (my $data=$sth->fetchrow_hashref){
2702     $results[$i]=$data;
2703     $i++;
2704   }
2705   $sth->finish;
2706   return($i,\@results);
2707 }
2708
2709 =head2 getaddauthor
2710
2711   ($count, $authors) = &getaddauthor($biblionumber);
2712
2713 Looks up the additional authors for the book with the given
2714 biblionumber.
2715
2716 Returns a two-element list. C<$authors> is a reference-to-array, where
2717 each element is an additional author, and C<$count> is the number of
2718 elements in C<$authors>.
2719
2720 =cut
2721 #'
2722 sub getaddauthor {
2723   my ($bibnum)=@_;
2724   my $dbh = C4::Context->dbh;
2725   my $sth=$dbh->prepare("Select * from additionalauthors where biblionumber=?");
2726   $sth->execute($bibnum);
2727   my @results;
2728   my $i=0;
2729   while (my $data=$sth->fetchrow_hashref){
2730     $results[$i]=$data;
2731     $i++;
2732   }
2733   $sth->finish;
2734   return($i,\@results);
2735 }
2736
2737
2738 =head2 getsubtitle
2739
2740   ($count, $subtitles) = &getsubtitle($biblionumber);
2741
2742 Looks up the subtitles for the book with the given biblionumber.
2743
2744 Returns a two-element list. C<$subtitles> is a reference-to-array,
2745 where each element is a subtitle, and C<$count> is the number of
2746 elements in C<$subtitles>.
2747
2748 =cut
2749 #'
2750 sub getsubtitle {
2751   my ($bibnum)=@_;
2752   my $dbh = C4::Context->dbh;
2753   my $sth=$dbh->prepare("Select * from bibliosubtitle where biblionumber=?");
2754   $sth->execute($bibnum);
2755   my @results;
2756   my $i=0;
2757   while (my $data=$sth->fetchrow_hashref){
2758     $results[$i]=$data;
2759     $i++;
2760   }
2761   $sth->finish;
2762   return($i,\@results);
2763 }
2764
2765
2766 =head2 getwebsites
2767
2768   ($count, @websites) = &getwebsites($biblionumber);
2769
2770 Looks up the web sites pertaining to the book with the given
2771 biblionumber.
2772
2773 C<$count> is the number of elements in C<@websites>.
2774
2775 C<@websites> is an array of references-to-hash; the keys are the
2776 fields from the C<websites> table in the Koha database.
2777
2778 =cut
2779 #FIXME : could maybe be deleted. Otherwise, would be better in a Websites.pm package
2780 #(with add / modify / delete subs)
2781
2782 sub getwebsites {
2783     my ($biblionumber) = @_;
2784     my $dbh   = C4::Context->dbh;
2785     my $sth   = $dbh->prepare("Select * from websites where biblionumber = ?");
2786     my $count = 0;
2787     my @results;
2788
2789     $sth->execute($biblionumber);
2790     while (my $data = $sth->fetchrow_hashref) {
2791         # FIXME - The URL scheme shouldn't be stripped off, at least
2792         # not here, since it's part of the URL, and will be useful in
2793         # constructing a link to the site. If you don't want the user
2794         # to see the "http://" part, strip that off when building the
2795         # HTML code.
2796         $data->{'url'} =~ s/^http:\/\///;       # FIXME - Leaning toothpick
2797                                                 # syndrome
2798         $results[$count] = $data;
2799         $count++;
2800     } # while
2801
2802     $sth->finish;
2803     return($count, @results);
2804 } # sub getwebsites
2805
2806 =head2 getwebbiblioitems
2807
2808   ($count, @results) = &getwebbiblioitems($biblionumber);
2809
2810 Given a book's biblionumber, looks up the web versions of the book
2811 (biblioitems with itemtype C<WEB>).
2812
2813 C<$count> is the number of items in C<@results>. C<@results> is an
2814 array of references-to-hash; the keys are the items from the
2815 C<biblioitems> table of the Koha database.
2816
2817 =cut
2818 #'
2819 sub getwebbiblioitems {
2820     my ($biblionumber) = @_;
2821     my $dbh   = C4::Context->dbh;
2822     my $sth   = $dbh->prepare("Select * from biblioitems where biblionumber = ?
2823 and itemtype = 'WEB'");
2824     my $count = 0;
2825     my @results;
2826
2827     $sth->execute($biblionumber);
2828     while (my $data = $sth->fetchrow_hashref) {
2829         $data->{'url'} =~ s/^http:\/\///;
2830         $results[$count] = $data;
2831         $count++;
2832     } # while
2833
2834     $sth->finish;
2835     return($count, @results);
2836 } # sub getwebbiblioitems
2837
2838 sub nsb_clean {
2839     my $NSB = '\x88';    # NSB : begin Non Sorting Block
2840     my $NSE = '\x89';    # NSE : Non Sorting Block end
2841                          # handles non sorting blocks
2842     my ($string) = @_;
2843     $_ = $string;
2844     s/$NSB/(/gm;
2845     s/[ ]{0,1}$NSE/) /gm;
2846     $string = $_;
2847     return ($string);
2848 }
2849
2850 sub FindDuplicate {
2851         my ($record)=@_;
2852         my $dbh = C4::Context->dbh;
2853         my $result = MARCmarc2koha($dbh,$record,'');
2854         my $sth;
2855         my ($biblionumber,$bibid,$title);
2856         # search duplicate on ISBN, easy and fast...
2857         if ($result->{isbn}) {
2858                 $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=?");
2859                 $sth->execute($result->{'isbn'});
2860                 ($biblionumber,$bibid,$title) = $sth->fetchrow;
2861                 return $biblionumber,$bibid,$title if ($biblionumber);
2862         }
2863         # a more complex search : build a request for SearchMarc::catalogsearch()
2864         my (@tags, @and_or, @excluding, @operator, @value, $offset,$length);
2865         # search on biblio.title
2866         my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.title","");
2867         if ($record->field($tag)) {
2868                 if ($record->field($tag)->subfields($subfield)) {
2869                         push @tags, "'".$tag.$subfield."'";
2870                         push @and_or, "and";
2871                         push @excluding, "";
2872                         push @operator, "contains";
2873                         push @value, $record->field($tag)->subfield($subfield);
2874 #                       warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2875                 }
2876         }
2877         # ... and on biblio.author
2878         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.author","");
2879         if ($record->field($tag)) {
2880                 if ($record->field($tag)->subfields($subfield)) {
2881                         push @tags, "'".$tag.$subfield."'";
2882                         push @and_or, "and";
2883                         push @excluding, "";
2884                         push @operator, "contains";
2885                         push @value, $record->field($tag)->subfield($subfield);
2886 #                       warn "for author, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2887                 }
2888         }
2889         # ... and on publicationyear.
2890         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publicationyear","");
2891         if ($record->field($tag)) {
2892                 if ($record->field($tag)->subfields($subfield)) {
2893                         push @tags, "'".$tag.$subfield."'";
2894                         push @and_or, "and";
2895                         push @excluding, "";
2896                         push @operator, "=";
2897                         push @value, $record->field($tag)->subfield($subfield);
2898 #                       warn "for publicationyear, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2899                 }
2900         }
2901         # ... and on size.
2902         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.size","");
2903         if ($record->field($tag)) {
2904                 if ($record->field($tag)->subfields($subfield)) {
2905                         push @tags, "'".$tag.$subfield."'";
2906                         push @and_or, "and";
2907                         push @excluding, "";
2908                         push @operator, "=";
2909                         push @value, $record->field($tag)->subfield($subfield);
2910 #                       warn "for size, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2911                 }
2912         }
2913         # ... and on publisher.
2914         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publishercode","");
2915         if ($record->field($tag)) {
2916                 if ($record->field($tag)->subfields($subfield)) {
2917                         push @tags, "'".$tag.$subfield."'";
2918                         push @and_or, "and";
2919                         push @excluding, "";
2920                         push @operator, "=";
2921                         push @value, $record->field($tag)->subfield($subfield);
2922 #                       warn "for publishercode, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2923                 }
2924         }
2925         # ... and on volume.
2926         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.volume","");
2927         if ($record->field($tag)) {
2928                 if ($record->field($tag)->subfields($subfield)) {
2929                         push @tags, "'".$tag.$subfield."'";
2930                         push @and_or, "and";
2931                         push @excluding, "";
2932                         push @operator, "=";
2933                         push @value, $record->field($tag)->subfield($subfield);
2934 #                       warn "for volume, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2935                 }
2936         }
2937
2938         my ($finalresult,$nbresult) = C4::SearchMarc::catalogsearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10);
2939         # there is at least 1 result => return the 1st one
2940         if ($nbresult) {
2941 #               warn "$nbresult => ".@$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2942                 return @$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2943         }
2944         # no result, returns nothing
2945         return;
2946 }
2947
2948 sub DisplayISBN {
2949         my ($isbn)=@_;
2950         my $seg1;
2951         if(substr($isbn, 0, 1) <=7) {
2952                 $seg1 = substr($isbn, 0, 1);
2953         } elsif(substr($isbn, 0, 2) <= 94) {
2954                 $seg1 = substr($isbn, 0, 2);
2955         } elsif(substr($isbn, 0, 3) <= 995) {
2956                 $seg1 = substr($isbn, 0, 3);
2957         } elsif(substr($isbn, 0, 4) <= 9989) {
2958                 $seg1 = substr($isbn, 0, 4);
2959         } else {
2960                 $seg1 = substr($isbn, 0, 5);
2961         }
2962         my $x = substr($isbn, length($seg1));
2963         my $seg2;
2964         if(substr($x, 0, 2) <= 19) {
2965 #               if(sTmp2 < 10) sTmp2 = "0" sTmp2;
2966                 $seg2 = substr($x, 0, 2);
2967         } elsif(substr($x, 0, 3) <= 699) {
2968                 $seg2 = substr($x, 0, 3);
2969         } elsif(substr($x, 0, 4) <= 8399) {
2970                 $seg2 = substr($x, 0, 4);
2971         } elsif(substr($x, 0, 5) <= 89999) {
2972                 $seg2 = substr($x, 0, 5);
2973         } elsif(substr($x, 0, 6) <= 9499999) {
2974                 $seg2 = substr($x, 0, 6);
2975         } else {
2976                 $seg2 = substr($x, 0, 7);
2977         }
2978         my $seg3=substr($x,length($seg2));
2979         $seg3=substr($seg3,0,length($seg3)-1) ;
2980         my $seg4 = substr($x, -1, 1);
2981         return "$seg1-$seg2-$seg3-$seg4";
2982 }
2983
2984
2985 END { }    # module clean-up code here (global destructor)
2986
2987 =back
2988
2989 =head1 AUTHOR
2990
2991 Koha Developement team <info@koha.org>
2992
2993 Paul POULAIN paul.poulain@free.fr
2994
2995 =cut
2996
2997 # $Id$
2998 # $Log$
2999 # Revision 1.162  2006/03/13 23:12:44  rangi
3000 # Adding commits, so that changes stick
3001 #
3002 # Revision 1.161  2006/03/10 02:40:38  kados
3003 # syncing MARChtml2xml wtih rel_2_2, removing unused MARChtml2marc
3004 #
3005 # Revision 1.160  2006/03/07 22:00:18  kados
3006 # adding support for 'delete' function
3007 #
3008 # Revision 1.159  2006/03/07 21:54:47  rangi
3009 # Starting work on deletes
3010 #
3011 # Revision 1.158  2006/03/06 02:45:41  kados
3012 # Adding fixes to MARC editor to HEAD
3013 #
3014 # Revision 1.157  2006/03/01 03:07:54  kados
3015 # rollback ... by accident I committed a rel_2_2 Biblio.pm
3016 #
3017 # Revision 1.155  2006/02/27 01:08:31  kados
3018 # Removing 'our Zconn' from top...
3019 #
3020 # Revision 1.154  2006/02/26 00:08:20  kados
3021 # moving all $Zconn s to z3950_extended_services (currently, nothing
3022 # works).
3023 #
3024 # Revision 1.153  2006/02/25 22:39:10  kados
3025 # Another purely documentation commit. Just changing formatting to ease
3026 # readability.
3027 #
3028 # Revision 1.152  2006/02/25 21:17:20  kados
3029 # Purely documentation change: converted all =head2 entries to use function
3030 # name as title rather than usage as title
3031 #
3032 # Revision 1.151  2006/02/25 21:02:20  kados
3033 #
3034 # Further cleanup, convering new routines to 4-chars
3035 #
3036 # Revision 1.150  2006/02/25 20:49:15  kados
3037 # Better documentation, added warning if serviceType is 'drop' since it's
3038 # not supported in Zebra.
3039 #
3040 # Revision 1.149  2006/02/25 20:30:32  kados
3041 # IMPORTANT: Paul, I've removed the decode_char routine because it's no
3042 # longer necessary. If we need to convert from MARC-8 for display, we should:
3043 #
3044 # 1. use utf-8
3045 # 2. do it with MARC::Charset
3046 #
3047 # If you still need it, let me know and I'll put it back in.
3048 #
3049 # Revision 1.148  2006/02/25 19:23:01  kados
3050 # cleaning up POD docs, deleting zebra_create as it's no longer used (
3051 # replaced by z3950_extended_services).
3052 #
3053 # Revision 1.147  2006/02/25 19:09:59  kados
3054 # readding some lost subs
3055 #
3056 # Revision 1.145  2006/02/22 01:02:39  kados
3057 # Replacing all calls to zebra_update with calls to
3058 # z3950_extended_services. More work coming, but it's
3059 # working now.
3060 #
3061 # Revision 1.144  2006/02/20 14:22:38  kados
3062 # typo
3063 #
3064 # Revision 1.143  2006/02/20 13:26:11  kados
3065 # A new subroutine to handle Z39.50 extended services. You pass it a
3066 # connection object, service type, service options, and a record, and
3067 # it performs the service and handles any exception found.
3068 #
3069 # Revision 1.142  2006/02/16 20:49:56  kados
3070 # destroy a connection after we're done -- we really should just have one
3071 # connection object and not destroy it until the whole transaction is
3072 # finished -- but this will do for now
3073 #
3074 # Revision 1.141  2006/02/16 19:47:22  rangi
3075 # Trying to error trap a little more.
3076 #
3077 # Revision 1.140  2006/02/14 21:36:03  kados
3078 # adding a 'use ZOOM' to biblio.pm, needed for non-mod_perl install.
3079 # also adding diagnostic error if not able to connect to Zebra
3080 #
3081 # Revision 1.139  2006/02/14 19:53:25  rangi
3082 # Just a little missing my
3083 #
3084 # Seems to be working great Paul, and I like what you did with zebradb
3085 #
3086 # Revision 1.138  2006/02/14 11:25:22  tipaul
3087 # road to 3.0 : updating a biblio in zebra seems to work. Still working on it, there are probably some bugs !
3088 #
3089 # Revision 1.137  2006/02/13 16:34:26  tipaul
3090 # fixing some warnings (perl -w should be quiet)
3091 #
3092 # Revision 1.136  2006/01/10 17:01:29  tipaul
3093 # adding a XMLgetbiblio in Biblio.pm (1st draft, to use with zebra)
3094 #
3095 # Revision 1.135  2006/01/06 16:39:37  tipaul
3096 # synch'ing head and rel_2_2 (from 2.2.5, including npl templates)
3097 # Seems not to break too many things, but i'm probably wrong here.
3098 # at least, new features/bugfixes from 2.2.5 are here (tested on some features on my head local copy)
3099 #
3100 # - removing useless directories (koha-html and koha-plucene)
3101 #
3102 # Revision 1.134  2006/01/04 15:54:55  tipaul
3103 # utf8 is a : go for beta test in HEAD.
3104 # some explanations :
3105 # - 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.
3106 # - *-top.inc will show the pages in utf8
3107 # - 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.
3108 # - using marcxml field and no more the iso2709 raw marc biblioitems.marc field.
3109 #
3110 # Revision 1.133  2005/12/12 14:25:51  thd
3111 #
3112 #
3113 # Reverse array filled with elements from repeated subfields
3114 # to avoid last to first concatenation of elements in Koha DB.-
3115 #
3116 # Revision 1.132  2005-10-26 09:12:33  tipaul
3117 # big commit, still breaking things...
3118 #
3119 # * synch with rel_2_2. Probably the last non manual synch, as rel_2_2 should not be modified deeply.
3120 # * code cleaning (cleaning warnings from perl -w) continued
3121 #
3122 # Revision 1.131  2005/09/22 10:01:45  tipaul
3123 # see mail on koha-devel : code cleaning on Search.pm + normalizing API + use of biblionumber everywhere (instead of bn, biblio, ...)
3124 #
3125 # Revision 1.130  2005/09/02 14:34:14  tipaul
3126 # continuing the work to move to zebra. Begin of work for MARC=OFF support.
3127 # IMPORTANT NOTE : the MARCkoha2marc sub API has been modified. Instead of biblionumber & biblioitemnumber, it now gets a hash.
3128 # The sub is used only in Biblio.pm, so the API change should be harmless (except for me, but i'm aware ;-) )
3129 #
3130 # Revision 1.129  2005/08/12 13:50:31  tipaul
3131 # removing useless sub declarations
3132 #
3133 # Revision 1.128  2005/08/11 16:12:47  tipaul
3134 # Playing with the zebra...
3135 #
3136 # * go to koha cvs home directory
3137 # * in misc/zebra there is a unimarc directory. I suggest that marc21 libraries create a marc21 directory
3138 # * put your zebra.cfg files here & create your database.
3139 # * from koha cvs home directory, ln -s misc/zebra/marc21 zebra (I mean create a symbolic link to YOUR zebra directory)
3140 # * now, everytime you add/modify a biblio/item your zebra DB is updated correctly.
3141 #
3142 # NOTE :
3143 # * this uses a system call in perl. CPU consumming, but we are waiting for indexdata Perl/zoom
3144 # * deletion still not work
3145 # * UNIMARC zebra config files are provided in misc/zebra/unimarc directory. The most important line being :
3146 # in zebra.cfg :
3147 # recordId: (bib1,Local-number)
3148 # storeKeys:1
3149 #
3150 # in .abs file :
3151 # elm 090            Local-number            -
3152 # elm 090/?          Local-number            -
3153 # elm 090/?/9        Local-number            !:w
3154 #
3155 # (090$9 being the field mapped to biblio.biblionumber in Koha)
3156 #
3157 # Revision 1.127  2005/08/11 14:37:32  tipaul
3158 # * POD documenting
3159 # * removing useless subs
3160 # * removing some subs that are also elsewhere
3161 # * 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)
3162 #
3163 # Revision 1.126  2005/08/11 09:13:28  tipaul
3164 # just removing useless subs (a lot !!!) for code cleaning
3165 #
3166 # Revision 1.125  2005/08/11 09:00:07  tipaul
3167 # Ok guys, this time, it seems that item add and modif begin working as expected...
3168 # Still a lot of bugs to fix, of course
3169 #
3170 # Revision 1.124  2005/08/10 10:21:15  tipaul
3171 # continuing the road to zebra :
3172 # - the biblio add begins to work.
3173 # - the biblio modif begins to work.
3174 #
3175 # (still without doing anything on zebra)
3176 # (no new change in updatedatabase)
3177 #
3178 # Revision 1.123  2005/08/09 14:10:28  tipaul
3179 # 1st commit to go to zebra.
3180 # don't update your cvs if you want to have a working head...
3181 #
3182 # this commit contains :
3183 # * 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...
3184 # * 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.
3185 # * other files : get rid of bibid and use biblionumber instead.
3186 #
3187 # What is broken :
3188 # * does not do anything on zebra yet.
3189 # * if you rename marc_subfield_table, you can't search anymore.
3190 # * you can view a biblio & bibliodetails, go to MARC editor, but NOT save any modif.
3191 # * 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 ;-) )
3192 #
3193 # 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
3194 # 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.
3195
3196 # tipaul cutted previous commit notes