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