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