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