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
  22 require Exporter;
  23 # use utf8;
  24 use C4::Context;
  25 use MARC::Record;
  26 use MARC::File::USMARC;
  27 use MARC::File::XML;
  28 use ZOOM;
  29 use C4::Koha;
  30 use C4::Dates qw/format_date/;
  31 use C4::Log; # logaction
  32 use C4::ClassSource;
  33
  34 use vars qw($VERSION @ISA @EXPORT);
  35
  36 # TODO: fix version
  37 # $VERSION = ?;
  38
  39 @ISA = qw( Exporter );
  40
  41 # EXPORTED FUNCTIONS.
  42
  43 # to add biblios or items
  44 push @EXPORT, qw( &AddBiblio &AddItem );
  45
  46 # to get something
  47 push @EXPORT, qw(
  48   &GetBiblio
  49   &GetBiblioData
  50   &GetBiblioItemData
  51   &GetBiblioItemInfosOf
  52   &GetBiblioItemByBiblioNumber
  53   &GetBiblioFromItemNumber
  54
  55   &GetMarcItem
  56   &GetItem
  57   &GetItemInfosOf
  58   &GetItemStatus
  59   &GetItemLocation
  60   &GetLostItems
  61   &GetItemsForInventory
  62   &GetItemsCount
  63
  64   &GetMarcNotes
  65   &GetMarcSubjects
  66   &GetMarcBiblio
  67   &GetMarcAuthors
  68   &GetMarcSeries
  69   GetMarcUrls
  70   &GetUsedMarcStructure
  71
  72   &GetItemsInfo
  73   &GetItemsByBiblioitemnumber
  74   &GetItemnumberFromBarcode
  75   &get_itemnumbers_of
  76   &GetXmlBiblio
  77
  78   &GetAuthorisedValueDesc
  79   &GetMarcStructure
  80   &GetMarcFromKohaField
  81   &GetFrameworkCode
  82   &GetPublisherNameFromIsbn
  83   &TransformKohaToMarc
  84 );
  85
  86 # To modify something
  87 push @EXPORT, qw(
  88   &ModBiblio
  89   &ModItem
  90   &ModItemTransfer
  91   &ModBiblioframework
  92   &ModZebra
  93   &ModItemInMarc
  94   &ModItemInMarconefield
  95   &ModDateLastSeen
  96 );
  97
  98 # To delete something
  99 push @EXPORT, qw(
 100   &DelBiblio
 101   &DelItem
 102 );
 103
 104 # Internal functions
 105 # those functions are exported but should not be used
 106 # they are usefull is few circumstances, so are exported.
 107 # but don't use them unless you're a core developer ;-)
 108 push @EXPORT, qw(
 109   &ModBiblioMarc
 110   &AddItemInMarc
 111 );
 112
 113 # Others functions
 114 push @EXPORT, qw(
 115   &TransformMarcToKoha
 116   &TransformHtmlToMarc2
 117   &TransformHtmlToMarc
 118   &TransformHtmlToXml
 119   &PrepareItemrecordDisplay
 120   &char_decode
 121   &GetNoZebraIndexes
 122 );
 123
 124 =head1 NAME
 125
 126 C4::Biblio - cataloging management functions
 127
 128 =head1 DESCRIPTION
 129
 130 Biblio.pm contains functions for managing storage and editing of bibliographic data within Koha. Most of the functions in this module are used for cataloging records: adding, editing, or removing biblios, biblioitems, or items. Koha's stores bibliographic information in three places:
 131
 132 =over 4
 133
 134 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
 135
 136 =item 2. as raw MARC in the Zebra index and storage engine
 137
 138 =item 3. as raw MARC the biblioitems.marc and biblioitems.marcxml
 139
 140 =back
 141
 142 In the 3.0 version of Koha, the authoritative record-level information is in biblioitems.marcxml
 143
 144 Because the data isn't completely normalized there's a chance for information to get out of sync. The design choice to go with a un-normalized schema was driven by performance and stability concerns. However, if this occur, it can be considered as a bug : The API is (or should be) complete & the only entry point for all biblio/items managements.
 145
 146 =over 4
 147
 148 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
 149
 150 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
 151
 152 =back
 153
 154 Because of this design choice, the process of managing storage and editing is a bit convoluted. Historically, Biblio.pm's grown to an unmanagable size and as a result we have several types of functions currently:
 155
 156 =over 4
 157
 158 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
 159
 160 =item 2. _koha_* - low-level internal functions for managing the koha tables
 161
 162 =item 3. Marc management function : as the MARC record is stored in biblioitems.marc(xml), some subs dedicated to it's management are in this package. They should be used only internally by Biblio.pm, the only official entry points being AddBiblio, AddItem, ModBiblio, ModItem.
 163
 164 =item 4. Zebra functions used to update the Zebra index
 165
 166 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
 167
 168 =back
 169
 170 The MARC record (in biblioitems.marcxml) contains the complete marc record, including items. It also contains the biblionumber. That is the reason why it is not stored directly by AddBiblio, with all other fields . To save a biblio, we need to :
 171
 172 =over 4
 173
 174 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
 175
 176 =item 2. add the biblionumber and biblioitemnumber into the MARC records
 177
 178 =item 3. save the marc record
 179
 180 =back
 181
 182 When dealing with items, we must :
 183
 184 =over 4
 185
 186 =item 1. save the item in items table, that gives us an itemnumber
 187
 188 =item 2. add the itemnumber to the item MARC field
 189
 190 =item 3. overwrite the MARC record (with the added item) into biblioitems.marc(xml)
 191
 192 When modifying a biblio or an item, the behaviour is quite similar.
 193
 194 =back
 195
 196 =head1 EXPORTED FUNCTIONS
 197
 198 =head2 AddBiblio
 199
 200 =over 4
 201
 202 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
 203 Exported function (core API) for adding a new biblio to koha.
 204
 205 =back
 206
 207 =cut
 208
 209 sub AddBiblio {
 210     my ( $record, $frameworkcode ) = @_;
 211         my ($biblionumber,$biblioitemnumber,$error);
 212     my $dbh = C4::Context->dbh;
 213     # transform the data into koha-table style data
 214     my $olddata = TransformMarcToKoha( $dbh, $record, $frameworkcode );
 215     ($biblionumber,$error) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
 216     $olddata->{'biblionumber'} = $biblionumber;
 217     ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $olddata );
 218
 219     _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
 220
 221     # now add the record
 222     $biblionumber = ModBiblioMarc( $record, $biblionumber, $frameworkcode );
 223
 224     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$biblionumber,"biblio")
 225         if C4::Context->preference("CataloguingLog");
 226
 227     return ( $biblionumber, $biblioitemnumber );
 228 }
 229
 230 =head2 AddItem
 231
 232 =over 2
 233
 234     $biblionumber = AddItem( $record, $biblionumber)
 235     Exported function (core API) for adding a new item to Koha
 236
 237 =back
 238
 239 =cut
 240
 241 sub AddItem {
 242     my ( $record, $biblionumber ) = @_;
 243     my $dbh = C4::Context->dbh;
 244
 245     # add item in old-DB
 246     my $frameworkcode = GetFrameworkCode( $biblionumber );
 247     my $item = &TransformMarcToKoha( $dbh, $record, $frameworkcode );
 248
 249     # needs old biblionumber and biblioitemnumber
 250     $item->{'biblionumber'} = $biblionumber;
 251     my $sth =
 252       $dbh->prepare(
 253         "SELECT biblioitemnumber,itemtype FROM biblioitems WHERE biblionumber=?"
 254       );
 255     $sth->execute( $item->{'biblionumber'} );
 256     my $itemtype;
 257     ( $item->{'biblioitemnumber'}, $itemtype ) = $sth->fetchrow;
 258     $sth =
 259       $dbh->prepare(
 260         "SELECT notforloan FROM itemtypes WHERE itemtype='$itemtype'");
 261     $sth->execute();
 262     my $notforloan = $sth->fetchrow;
 263     ##Change the notforloan field if $notforloan found
 264     if ( $notforloan > 0 ) {
 265         $item->{'notforloan'} = $notforloan;
 266         &MARCitemchange( $record, "items.notforloan", $notforloan );
 267     }
 268     if ( !$item->{'dateaccessioned'} || $item->{'dateaccessioned'} eq '' ) {
 269
 270         # find today's date
 271         my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
 272           localtime(time);
 273         $year += 1900;
 274         $mon  += 1;
 275         my $date =
 276           "$year-" . sprintf( "%0.2d", $mon ) . "-" . sprintf( "%0.2d", $mday );
 277         $item->{'dateaccessioned'} = $date;
 278         &MARCitemchange( $record, "items.dateaccessioned", $date );
 279     }
 280     my ( $itemnumber, $error ) = &_koha_new_items( $dbh, $item, $item->{barcode} );
 281     # add itemnumber to MARC::Record before adding the item.
 282     $sth = $dbh->prepare(
 283 "SELECT tagfield,tagsubfield
 284 FROM marc_subfield_structure
 285 WHERE frameworkcode=?
 286         AND kohafield=?"
 287       );
 288     &TransformKohaToMarcOneField( $sth, $record, "items.itemnumber", $itemnumber,
 289         $frameworkcode );
 290
 291     # add the item
 292     &AddItemInMarc( $record, $item->{'biblionumber'},$frameworkcode );
 293
 294     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$itemnumber,"item")
 295         if C4::Context->preference("CataloguingLog");
 296
 297     return ($item->{biblionumber}, $item->{biblioitemnumber},$itemnumber);
 298 }
 299
 300 =head2 ModBiblio
 301
 302     ModBiblio( $record,$biblionumber,$frameworkcode);
 303     Exported function (core API) to modify a biblio
 304
 305 =cut
 306
 307 sub ModBiblio {
 308     my ( $record, $biblionumber, $frameworkcode ) = @_;
 309     if (C4::Context->preference("CataloguingLog")) {
 310         my $newrecord = GetMarcBiblio($biblionumber);
 311         &logaction(C4::Context->userenv->{'number'},"CATALOGUING","MODIFY",$biblionumber,"BEFORE=>".$newrecord->as_formatted);
 312     }
 313
 314     my $dbh = C4::Context->dbh;
 315
 316     $frameworkcode = "" unless $frameworkcode;
 317
 318     # get the items before and append them to the biblio before updating the record, atm we just have the biblio
 319     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField("items.itemnumber",$frameworkcode);
 320     my $oldRecord = GetMarcBiblio( $biblionumber );
 321
 322     # parse each item, and, for an unknown reason, re-encode each subfield
 323     # if you don't do that, the record will have encoding mixed
 324     # and the biblio will be re-encoded.
 325     # strange, I (Paul P.) searched more than 1 day to understand what happends
 326     # but could only solve the problem this way...
 327    my @fields = $oldRecord->field( $itemtag );
 328     foreach my $fielditem ( @fields ){
 329         my $field;
 330         foreach ($fielditem->subfields()) {
 331             if ($field) {
 332                 $field->add_subfields(Encode::encode('utf-8',$_->[0]) => Encode::encode('utf-8',$_->[1]));
 333             } else {
 334                 $field = MARC::Field->new("$itemtag",'','',Encode::encode('utf-8',$_->[0]) => Encode::encode('utf-8',$_->[1]));
 335             }
 336           }
 337         $record->append_fields($field);
 338     }
 339
 340     # update biblionumber and biblioitemnumber in MARC
 341     # FIXME - this is assuming a 1 to 1 relationship between
 342     # biblios and biblioitems
 343     my $sth =  $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
 344     $sth->execute($biblionumber);
 345     my ($biblioitemnumber) = $sth->fetchrow;
 346     $sth->finish();
 347     _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
 348
 349     # update the MARC record (that now contains biblio and items) with the new record data
 350     &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
 351
 352     # load the koha-table data object
 353     my $oldbiblio = TransformMarcToKoha( $dbh, $record, $frameworkcode );
 354
 355     # modify the other koha tables
 356     _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
 357     _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
 358     return 1;
 359 }
 360
 361 =head2 ModItem
 362
 363 =over 2
 364
 365 Exported function (core API) for modifying an item in Koha.
 366
 367 =back
 368
 369 =cut
 370
 371 sub ModItem {
 372     my ( $record, $biblionumber, $itemnumber, $delete, $new_item_hashref )
 373       = @_;
 374
 375     #logging
 376     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","MODIFY",$itemnumber,$record->as_formatted)
 377         if C4::Context->preference("CataloguingLog");
 378
 379     my $dbh = C4::Context->dbh;
 380
 381     # if we have a MARC record, we're coming from cataloging and so
 382     # we do the whole routine: update the MARC and zebra, then update the koha
 383     # tables
 384     if ($record) {
 385         my $frameworkcode = GetFrameworkCode( $biblionumber );
 386         ModItemInMarc( $record, $biblionumber, $itemnumber, $frameworkcode );
 387         my $olditem       = TransformMarcToKoha( $dbh, $record, $frameworkcode,'items');
 388         $olditem->{'biblionumber'} = $biblionumber;
 389         my $sth =  $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
 390         $sth->execute($biblionumber);
 391         my ($biblioitemnumber) = $sth->fetchrow;
 392         $sth->finish();
 393         $olditem->{'biblioitemnumber'} = $biblioitemnumber;
 394         _koha_modify_item( $dbh, $olditem );
 395         return $biblionumber;
 396     }
 397
 398     # otherwise, we're just looking to modify something quickly
 399     # (like a status) so we just update the koha tables
 400     elsif ($new_item_hashref) {
 401         _koha_modify_item( $dbh, $new_item_hashref );
 402     }
 403 }
 404
 405 sub ModItemTransfer {
 406     my ( $itemnumber, $frombranch, $tobranch ) = @_;
 407
 408     my $dbh = C4::Context->dbh;
 409
 410     #new entry in branchtransfers....
 411     my $sth = $dbh->prepare(
 412         "INSERT INTO branchtransfers (itemnumber, frombranch, datesent, tobranch)
 413         VALUES (?, ?, NOW(), ?)");
 414     $sth->execute($itemnumber, $frombranch, $tobranch);
 415     #update holdingbranch in items .....
 416      $sth= $dbh->prepare(
 417           "UPDATE items SET holdingbranch = ? WHERE items.itemnumber = ?");
 418     $sth->execute($tobranch,$itemnumber);
 419     &ModDateLastSeen($itemnumber);
 420     $sth = $dbh->prepare(
 421         "SELECT biblionumber FROM items WHERE itemnumber=?"
 422       );
 423     $sth->execute($itemnumber);
 424     while ( my ( $biblionumber ) = $sth->fetchrow ) {
 425         &ModItemInMarconefield( $biblionumber, $itemnumber,
 426             'items.holdingbranch', $tobranch );
 427     }
 428     return;
 429 }
 430
 431 =head2 ModBiblioframework
 432
 433     ModBiblioframework($biblionumber,$frameworkcode);
 434     Exported function to modify a biblio framework
 435
 436 =cut
 437
 438 sub ModBiblioframework {
 439     my ( $biblionumber, $frameworkcode ) = @_;
 440     my $dbh = C4::Context->dbh;
 441     my $sth = $dbh->prepare(
 442         "UPDATE biblio SET frameworkcode=? WHERE biblionumber=?"
 443     );
 444     $sth->execute($frameworkcode, $biblionumber);
 445     return 1;
 446 }
 447
 448 =head2 ModItemInMarconefield
 449
 450 =over
 451
 452 modify only 1 field in a MARC item (mainly used for holdingbranch, but could also be used for status modif - moving a book to "lost" on a long overdu for example)
 453 &ModItemInMarconefield( $biblionumber, $itemnumber, $itemfield, $newvalue )
 454
 455 =back
 456
 457 =cut
 458
 459 sub ModItemInMarconefield {
 460     my ( $biblionumber, $itemnumber, $itemfield, $newvalue ) = @_;
 461     my $dbh = C4::Context->dbh;
 462     if ( !defined $newvalue ) {
 463         $newvalue = "";
 464     }
 465
 466     my $record = GetMarcItem( $biblionumber, $itemnumber );
 467     my ($tagfield, $tagsubfield) = GetMarcFromKohaField( $itemfield,'');
 468     if ($tagfield && $tagsubfield) {
 469         my $tag = $record->field($tagfield);
 470         if ($tag) {
 471 #             my $tagsubs = $record->field($tagfield)->subfield($tagsubfield);
 472             $tag->update( $tagsubfield => $newvalue );
 473             $record->delete_field($tag);
 474             $record->insert_fields_ordered($tag);
 475             &ModItemInMarc( $record, $biblionumber, $itemnumber, 0 );
 476         }
 477     }
 478 }
 479
 480 =head2 ModItemInMarc
 481
 482 =over
 483
 484 &ModItemInMarc( $record, $biblionumber, $itemnumber )
 485
 486 =back
 487
 488 =cut
 489
 490 sub ModItemInMarc {
 491     my ( $ItemRecord, $biblionumber, $itemnumber, $frameworkcode) = @_;
 492     my $dbh = C4::Context->dbh;
 493
 494     # get complete MARC record & replace the item field by the new one
 495     my $completeRecord = GetMarcBiblio($biblionumber);
 496     my ($itemtag,$itemsubfield) = GetMarcFromKohaField("items.itemnumber",$frameworkcode);
 497     my $itemField = $ItemRecord->field($itemtag);
 498     my @items = $completeRecord->field($itemtag);
 499     foreach (@items) {
 500         if ($_->subfield($itemsubfield) eq $itemnumber) {
 501 #             $completeRecord->delete_field($_);
 502             $_->replace_with($itemField);
 503         }
 504     }
 505     # save the record
 506     my $sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
 507     $sth->execute( $completeRecord->as_usmarc(), $completeRecord->as_xml_record(),$biblionumber );
 508     $sth->finish;
 509     ModZebra($biblionumber,"specialUpdate","biblioserver",$completeRecord);
 510 }
 511
 512 =head2 ModDateLastSeen
 513
 514 &ModDateLastSeen($itemnum)
 515 Mark item as seen. Is called when an item is issued, returned or manually marked during inventory/stocktaking
 516 C<$itemnum> is the item number
 517
 518 =cut
 519
 520 sub ModDateLastSeen {
 521     my ($itemnum) = @_;
 522     my $dbh       = C4::Context->dbh;
 523     my $sth       =
 524       $dbh->prepare(
 525           "UPDATE items SET itemlost=0,datelastseen  = NOW() WHERE items.itemnumber = ?"
 526       );
 527     $sth->execute($itemnum);
 528     return;
 529 }
 530 =head2 DelBiblio
 531
 532 =over
 533
 534 my $error = &DelBiblio($dbh,$biblionumber);
 535 Exported function (core API) for deleting a biblio in koha.
 536 Deletes biblio record from Zebra and Koha tables (biblio,biblioitems,items)
 537 Also backs it up to deleted* tables
 538 Checks to make sure there are not issues on any of the items
 539 return:
 540 C<$error> : undef unless an error occurs
 541
 542 =back
 543
 544 =cut
 545
 546 sub DelBiblio {
 547     my ( $biblionumber ) = @_;
 548     my $dbh = C4::Context->dbh;
 549     my $error;    # for error handling
 550
 551         # First make sure this biblio has no items attached
 552         my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
 553         $sth->execute($biblionumber);
 554         if (my $itemnumber = $sth->fetchrow){
 555                 # Fix this to use a status the template can understand
 556                 $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
 557         }
 558
 559     return $error if $error;
 560
 561     # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
 562     # for at least 2 reasons :
 563     # - we need to read the biblio if NoZebra is set (to remove it from the indexes
 564     # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
 565     #   and we would have no way to remove it (except manually in zebra, but I bet it would be very hard to handle the problem)
 566     ModZebra($biblionumber, "delete_record", "biblioserver", undef);
 567
 568     # delete biblio from Koha tables and save in deletedbiblio
 569     $error = &_koha_delete_biblio( $dbh, $biblionumber );
 570
 571     # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
 572     $sth =
 573       $dbh->prepare(
 574         "SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
 575     $sth->execute($biblionumber);
 576     while ( my $biblioitemnumber = $sth->fetchrow ) {
 577
 578         # delete this biblioitem
 579         $error = &_koha_delete_biblioitems( $dbh, $biblioitemnumber );
 580         return $error if $error;
 581     }
 582     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","DELETE",$biblionumber,"")
 583         if C4::Context->preference("CataloguingLog");
 584     return;
 585 }
 586
 587 =head2 DelItem
 588
 589 =over
 590
 591 DelItem( $biblionumber, $itemnumber );
 592 Exported function (core API) for deleting an item record in Koha.
 593
 594 =back
 595
 596 =cut
 597
 598 sub DelItem {
 599     my ( $dbh, $biblionumber, $itemnumber ) = @_;
 600
 601         # check the item has no current issues
 602
 603
 604     &_koha_delete_item( $dbh, $itemnumber );
 605
 606     # get the MARC record
 607     my $record = GetMarcBiblio($biblionumber);
 608     my $frameworkcode = GetFrameworkCode($biblionumber);
 609
 610     # backup the record
 611     my $copy2deleted = $dbh->prepare("UPDATE deleteditems SET marc=? WHERE itemnumber=?");
 612     $copy2deleted->execute( $record->as_usmarc(), $itemnumber );
 613
 614     #search item field code
 615     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField("items.itemnumber",$frameworkcode);
 616     my @fields = $record->field($itemtag);
 617
 618     # delete the item specified
 619     foreach my $field (@fields) {
 620         if ( $field->subfield($itemsubfield) eq $itemnumber ) {
 621             $record->delete_field($field);
 622         }
 623     }
 624     &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
 625     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","DELETE",$itemnumber,"item")
 626         if C4::Context->preference("CataloguingLog");
 627 }
 628
 629 =head2 GetBiblioData
 630
 631 =over 4
 632
 633 $data = &GetBiblioData($biblionumber);
 634 Returns information about the book with the given biblionumber.
 635 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
 636 the C<biblio> and C<biblioitems> tables in the
 637 Koha database.
 638 In addition, C<$data-E<gt>{subject}> is the list of the book's
 639 subjects, separated by C<" , "> (space, comma, space).
 640 If there are multiple biblioitems with the given biblionumber, only
 641 the first one is considered.
 642
 643 =back
 644
 645 =cut
 646
 647 sub GetBiblioData {
 648     my ( $bibnum ) = @_;
 649     my $dbh = C4::Context->dbh;
 650
 651     my $query = "
 652         SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
 653         FROM biblio
 654             LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
 655             LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
 656         WHERE biblio.biblionumber = ?
 657             AND biblioitems.biblionumber = biblio.biblionumber
 658     ";
 659     my $sth = $dbh->prepare($query);
 660     $sth->execute($bibnum);
 661     my $data;
 662     $data = $sth->fetchrow_hashref;
 663     $sth->finish;
 664
 665     return ($data);
 666 }    # sub GetBiblioData
 667
 668
 669 =head2 GetItemsInfo
 670
 671 =over 4
 672
 673   @results = &GetItemsInfo($biblionumber, $type);
 674
 675 Returns information about books with the given biblionumber.
 676
 677 C<$type> may be either C<intra> or anything else. If it is not set to
 678 C<intra>, then the search will exclude lost, very overdue, and
 679 withdrawn items.
 680
 681 C<&GetItemsInfo> returns a list of references-to-hash. Each element
 682 contains a number of keys. Most of them are table items from the
 683 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
 684 Koha database. Other keys include:
 685
 686 =over 4
 687
 688 =item C<$data-E<gt>{branchname}>
 689
 690 The name (not the code) of the branch to which the book belongs.
 691
 692 =item C<$data-E<gt>{datelastseen}>
 693
 694 This is simply C<items.datelastseen>, except that while the date is
 695 stored in YYYY-MM-DD format in the database, here it is converted to
 696 DD/MM/YYYY format. A NULL date is returned as C<//>.
 697
 698 =item C<$data-E<gt>{datedue}>
 699
 700 =item C<$data-E<gt>{class}>
 701
 702 This is the concatenation of C<biblioitems.classification>, the book's
 703 Dewey code, and C<biblioitems.subclass>.
 704
 705 =item C<$data-E<gt>{ocount}>
 706
 707 I think this is the number of copies of the book available.
 708
 709 =item C<$data-E<gt>{order}>
 710
 711 If this is set, it is set to C<One Order>.
 712
 713 =back
 714
 715 =back
 716
 717 =cut
 718
 719 sub GetItemsInfo {
 720     my ( $biblionumber, $type ) = @_;
 721     my $dbh   = C4::Context->dbh;
 722     my $query = "SELECT *,items.notforloan as itemnotforloan
 723                  FROM items
 724                  LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
 725                  LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
 726                  LEFT JOIN itemtypes on biblioitems.itemtype = itemtypes.itemtype
 727                 WHERE items.biblionumber = ?
 728                 ORDER BY items.dateaccessioned desc
 729                  ";
 730     my $sth = $dbh->prepare($query);
 731     $sth->execute($biblionumber);
 732     my $i = 0;
 733     my @results;
 734     my ( $date_due, $count_reserves );
 735
 736     while ( my $data = $sth->fetchrow_hashref ) {
 737         my $datedue = '';
 738         my $isth    = $dbh->prepare(
 739             "SELECT issues.*,borrowers.cardnumber,borrowers.surname,borrowers.firstname
 740             FROM   issues LEFT JOIN borrowers ON issues.borrowernumber=borrowers.borrowernumber
 741             WHERE  itemnumber = ?
 742                 AND returndate IS NULL"
 743         );
 744         $isth->execute( $data->{'itemnumber'} );
 745         if ( my $idata = $isth->fetchrow_hashref ) {
 746             $data->{borrowernumber} = $idata->{borrowernumber};
 747             $data->{cardnumber}     = $idata->{cardnumber};
 748             $data->{surname}     = $idata->{surname};
 749             $data->{firstname}     = $idata->{firstname};
 750             $datedue                = format_date( $idata->{'date_due'} );
 751         }
 752         if ( $datedue eq '' ) {
 753             #$datedue="Available";
 754             my ( $restype, $reserves ) =
 755               C4::Reserves::CheckReserves( $data->{'itemnumber'} );
 756             if ($restype) {
 757
 758                 #$datedue=$restype;
 759                 $count_reserves = $restype;
 760             }
 761         }
 762         $isth->finish;
 763
 764         #get branch information.....
 765         my $bsth = $dbh->prepare(
 766             "SELECT * FROM branches WHERE branchcode = ?
 767         "
 768         );
 769         $bsth->execute( $data->{'holdingbranch'} );
 770         if ( my $bdata = $bsth->fetchrow_hashref ) {
 771             $data->{'branchname'} = $bdata->{'branchname'};
 772         }
 773         my $date = format_date( $data->{'datelastseen'} );
 774         $data->{'datelastseen'}   = $date;
 775         $data->{'datedue'}        = $datedue;
 776         $data->{'count_reserves'} = $count_reserves;
 777
 778         # get notforloan complete status if applicable
 779         my $sthnflstatus = $dbh->prepare(
 780             'SELECT authorised_value
 781             FROM   marc_subfield_structure
 782             WHERE  kohafield="items.notforloan"
 783         '
 784         );
 785
 786         $sthnflstatus->execute;
 787         my ($authorised_valuecode) = $sthnflstatus->fetchrow;
 788         if ($authorised_valuecode) {
 789             $sthnflstatus = $dbh->prepare(
 790                 "SELECT lib FROM authorised_values
 791                  WHERE  category=?
 792                  AND authorised_value=?"
 793             );
 794             $sthnflstatus->execute( $authorised_valuecode,
 795                 $data->{itemnotforloan} );
 796             my ($lib) = $sthnflstatus->fetchrow;
 797             $data->{notforloan} = $lib;
 798         }
 799
 800         # my stack procedures
 801         my $stackstatus = $dbh->prepare(
 802             'SELECT authorised_value
 803              FROM   marc_subfield_structure
 804              WHERE  kohafield="items.stack"
 805         '
 806         );
 807         $stackstatus->execute;
 808
 809         ($authorised_valuecode) = $stackstatus->fetchrow;
 810         if ($authorised_valuecode) {
 811             $stackstatus = $dbh->prepare(
 812                 "SELECT lib
 813                  FROM   authorised_values
 814                  WHERE  category=?
 815                  AND    authorised_value=?
 816             "
 817             );
 818             $stackstatus->execute( $authorised_valuecode, $data->{stack} );
 819             my ($lib) = $stackstatus->fetchrow;
 820             $data->{stack} = $lib;
 821         }
 822         $results[$i] = $data;
 823         $i++;
 824     }
 825     $sth->finish;
 826
 827     return (@results);
 828 }
 829
 830 =head2 getitemstatus
 831
 832 =over 4
 833
 834 $itemstatushash = &getitemstatus($fwkcode);
 835 returns information about status.
 836 Can be MARC dependant.
 837 fwkcode is optional.
 838 But basically could be can be loan or not
 839 Create a status selector with the following code
 840
 841 =head3 in PERL SCRIPT
 842
 843 my $itemstatushash = getitemstatus;
 844 my @itemstatusloop;
 845 foreach my $thisstatus (keys %$itemstatushash) {
 846     my %row =(value => $thisstatus,
 847                 statusname => $itemstatushash->{$thisstatus}->{'statusname'},
 848             );
 849     push @itemstatusloop, \%row;
 850 }
 851 $template->param(statusloop=>\@itemstatusloop);
 852
 853
 854 =head3 in TEMPLATE
 855
 856             <select name="statusloop">
 857                 <option value="">Default</option>
 858             <!-- TMPL_LOOP name="statusloop" -->
 859                 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="statusname" --></option>
 860             <!-- /TMPL_LOOP -->
 861             </select>
 862
 863 =cut
 864
 865 sub GetItemStatus {
 866
 867     # returns a reference to a hash of references to status...
 868     my ($fwk) = @_;
 869     my %itemstatus;
 870     my $dbh = C4::Context->dbh;
 871     my $sth;
 872     $fwk = '' unless ($fwk);
 873     my ( $tag, $subfield ) =
 874       GetMarcFromKohaField( "items.notforloan", $fwk );
 875     if ( $tag and $subfield ) {
 876         my $sth =
 877           $dbh->prepare(
 878                         "SELECT authorised_value
 879                         FROM marc_subfield_structure
 880                         WHERE tagfield=?
 881                                 AND tagsubfield=?
 882                                 AND frameworkcode=?
 883                         "
 884           );
 885         $sth->execute( $tag, $subfield, $fwk );
 886         if ( my ($authorisedvaluecat) = $sth->fetchrow ) {
 887             my $authvalsth =
 888               $dbh->prepare(
 889                                 "SELECT authorised_value,lib
 890                                 FROM authorised_values
 891                                 WHERE category=?
 892                                 ORDER BY lib
 893                                 "
 894               );
 895             $authvalsth->execute($authorisedvaluecat);
 896             while ( my ( $authorisedvalue, $lib ) = $authvalsth->fetchrow ) {
 897                 $itemstatus{$authorisedvalue} = $lib;
 898             }
 899             $authvalsth->finish;
 900             return \%itemstatus;
 901             exit 1;
 902         }
 903         else {
 904
 905             #No authvalue list
 906             # build default
 907         }
 908         $sth->finish;
 909     }
 910
 911     #No authvalue list
 912     #build default
 913     $itemstatus{"1"} = "Not For Loan";
 914     return \%itemstatus;
 915 }
 916
 917 =head2 getitemlocation
 918
 919 =over 4
 920
 921 $itemlochash = &getitemlocation($fwk);
 922 returns informations about location.
 923 where fwk stands for an optional framework code.
 924 Create a location selector with the following code
 925
 926 =head3 in PERL SCRIPT
 927
 928 my $itemlochash = getitemlocation;
 929 my @itemlocloop;
 930 foreach my $thisloc (keys %$itemlochash) {
 931     my $selected = 1 if $thisbranch eq $branch;
 932     my %row =(locval => $thisloc,
 933                 selected => $selected,
 934                 locname => $itemlochash->{$thisloc},
 935             );
 936     push @itemlocloop, \%row;
 937 }
 938 $template->param(itemlocationloop => \@itemlocloop);
 939
 940 =head3 in TEMPLATE
 941
 942 <select name="location">
 943     <option value="">Default</option>
 944 <!-- TMPL_LOOP name="itemlocationloop" -->
 945     <option value="<!-- TMPL_VAR name="locval" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="locname" --></option>
 946 <!-- /TMPL_LOOP -->
 947 </select>
 948
 949 =back
 950
 951 =cut
 952
 953 sub GetItemLocation {
 954
 955     # returns a reference to a hash of references to location...
 956     my ($fwk) = @_;
 957     my %itemlocation;
 958     my $dbh = C4::Context->dbh;
 959     my $sth;
 960     $fwk = '' unless ($fwk);
 961     my ( $tag, $subfield ) =
 962       GetMarcFromKohaField( "items.location", $fwk );
 963     if ( $tag and $subfield ) {
 964         my $sth =
 965           $dbh->prepare(
 966                         "SELECT authorised_value
 967                         FROM marc_subfield_structure
 968                         WHERE tagfield=?
 969                                 AND tagsubfield=?
 970                                 AND frameworkcode=?"
 971           );
 972         $sth->execute( $tag, $subfield, $fwk );
 973         if ( my ($authorisedvaluecat) = $sth->fetchrow ) {
 974             my $authvalsth =
 975               $dbh->prepare(
 976                                 "SELECT authorised_value,lib
 977                                 FROM authorised_values
 978                                 WHERE category=?
 979                                 ORDER BY lib"
 980               );
 981             $authvalsth->execute($authorisedvaluecat);
 982             while ( my ( $authorisedvalue, $lib ) = $authvalsth->fetchrow ) {
 983                 $itemlocation{$authorisedvalue} = $lib;
 984             }
 985             $authvalsth->finish;
 986             return \%itemlocation;
 987             exit 1;
 988         }
 989         else {
 990
 991             #No authvalue list
 992             # build default
 993         }
 994         $sth->finish;
 995     }
 996
 997     #No authvalue list
 998     #build default
 999     $itemlocation{"1"} = "Not For Loan";
1000     return \%itemlocation;
1001 }
1002
1003 =head2 GetLostItems
1004
1005 $items = GetLostItems($where,$orderby);
1006
1007 This function get the items lost into C<$items>.
1008
1009 =over 2
1010
1011 =item input:
1012 C<$where> is a hashref. it containts a field of the items table as key
1013 and the value to match as value.
1014 C<$orderby> is a field of the items table.
1015
1016 =item return:
1017 C<$items> is a reference to an array full of hasref which keys are items' table column.
1018
1019 =item usage in the perl script:
1020
1021 my %where;
1022 $where{barcode} = 0001548;
1023 my $items = GetLostItems( \%where, "homebranch" );
1024 $template->param(itemsloop => $items);
1025
1026 =back
1027
1028 =cut
1029
1030 sub GetLostItems {
1031     # Getting input args.
1032     my $where   = shift;
1033     my $orderby = shift;
1034     my $dbh     = C4::Context->dbh;
1035
1036     my $query   = "
1037         SELECT *
1038         FROM   items
1039         WHERE  itemlost IS NOT NULL
1040           AND  itemlost <> 0
1041     ";
1042     foreach my $key (keys %$where) {
1043         $query .= " AND " . $key . " LIKE '%" . $where->{$key} . "%'";
1044     }
1045     $query .= " ORDER BY ".$orderby if defined $orderby;
1046
1047     my $sth = $dbh->prepare($query);
1048     $sth->execute;
1049     my @items;
1050     while ( my $row = $sth->fetchrow_hashref ){
1051         push @items, $row;
1052     }
1053     return \@items;
1054 }
1055
1056 =head2 GetItemsForInventory
1057
1058 $itemlist = GetItemsForInventory($minlocation,$maxlocation,$datelastseen,$offset,$size)
1059
1060 Retrieve a list of title/authors/barcode/callnumber, for biblio inventory.
1061
1062 The sub returns a list of hashes, containing itemnumber, author, title, barcode & item callnumber.
1063 It is ordered by callnumber,title.
1064
1065 The minlocation & maxlocation parameters are used to specify a range of item callnumbers
1066 the datelastseen can be used to specify that you want to see items not seen since a past date only.
1067 offset & size can be used to retrieve only a part of the whole listing (defaut behaviour)
1068
1069 =cut
1070
1071 sub GetItemsForInventory {
1072     my ( $minlocation, $maxlocation,$location, $datelastseen, $branch, $offset, $size ) = @_;
1073     my $dbh = C4::Context->dbh;
1074     my $sth;
1075     if ($datelastseen) {
1076         $datelastseen=format_date_in_iso($datelastseen);
1077         my $query =
1078                 "SELECT itemnumber,barcode,itemcallnumber,title,author,biblio.biblionumber,datelastseen
1079                  FROM items
1080                    LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1081                  WHERE itemcallnumber>= ?
1082                    AND itemcallnumber <=?
1083                    AND (datelastseen< ? OR datelastseen IS NULL)";
1084         $query.= " AND items.location=".$dbh->quote($location) if $location;
1085         $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch;
1086         $query .= " ORDER BY itemcallnumber,title";
1087         $sth = $dbh->prepare($query);
1088         $sth->execute( $minlocation, $maxlocation, $datelastseen );
1089     }
1090     else {
1091         my $query ="
1092                 SELECT itemnumber,barcode,itemcallnumber,biblio.biblionumber,title,author,datelastseen
1093                 FROM items
1094                   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1095                 WHERE itemcallnumber>= ?
1096                   AND itemcallnumber <=?";
1097         $query.= " AND items.location=".$dbh->quote($location) if $location;
1098         $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch;
1099         $query .= " ORDER BY itemcallnumber,title";
1100         $sth = $dbh->prepare($query);
1101         $sth->execute( $minlocation, $maxlocation );
1102     }
1103     my @results;
1104     while ( my $row = $sth->fetchrow_hashref ) {
1105         $offset-- if ($offset);
1106         $row->{datelastseen}=format_date($row->{datelastseen});
1107         if ( ( !$offset ) && $size ) {
1108             push @results, $row;
1109             $size--;
1110         }
1111     }
1112     return \@results;
1113 }
1114
1115 =head2 &GetBiblioItemData
1116
1117 =over 4
1118
1119 $itemdata = &GetBiblioItemData($biblioitemnumber);
1120
1121 Looks up the biblioitem with the given biblioitemnumber. Returns a
1122 reference-to-hash. The keys are the fields from the C<biblio>,
1123 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
1124 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
1125
1126 =back
1127
1128 =cut
1129
1130 #'
1131 sub GetBiblioItemData {
1132     my ($biblioitemnumber) = @_;
1133     my $dbh       = C4::Context->dbh;
1134     my $sth       =
1135       $dbh->prepare(
1136         "SELECT *,biblioitems.notes AS bnotes
1137                 FROM biblioitems,biblio,itemtypes
1138         WHERE biblio.biblionumber = biblioitems.biblionumber
1139                 AND biblioitemnumber = ? "
1140       );
1141     my $data;
1142     $sth->execute($biblioitemnumber);
1143     $data = $sth->fetchrow_hashref;
1144     $sth->finish;
1145     return ($data);
1146 }    # sub &GetBiblioItemData
1147
1148 =head2 GetItemnumberFromBarcode
1149
1150 =over 4
1151
1152 $result = GetItemnumberFromBarcode($barcode);
1153
1154 =back
1155
1156 =cut
1157
1158 sub GetItemnumberFromBarcode {
1159     my ($barcode) = @_;
1160     my $dbh = C4::Context->dbh;
1161
1162     my $rq =
1163       $dbh->prepare("SELECT itemnumber FROM items WHERE items.barcode=?");
1164     $rq->execute($barcode);
1165     my ($result) = $rq->fetchrow;
1166     return ($result);
1167 }
1168
1169 =head2 GetBiblioItemByBiblioNumber
1170
1171 =over 4
1172
1173 NOTE : This function has been copy/paste from C4/Biblio.pm from head before zebra integration.
1174
1175 =back
1176
1177 =cut
1178
1179 sub GetBiblioItemByBiblioNumber {
1180     my ($biblionumber) = @_;
1181     my $dbh = C4::Context->dbh;
1182     my $sth = $dbh->prepare("Select * FROM biblioitems WHERE biblionumber = ?");
1183     my $count = 0;
1184     my @results;
1185
1186     $sth->execute($biblionumber);
1187
1188     while ( my $data = $sth->fetchrow_hashref ) {
1189         push @results, $data;
1190     }
1191
1192     $sth->finish;
1193     return @results;
1194 }
1195
1196 =head2 GetBiblioFromItemNumber
1197
1198 =over 4
1199
1200 $item = &GetBiblioFromItemNumber($itemnumber);
1201
1202 Looks up the item with the given itemnumber.
1203
1204 C<&itemnodata> returns a reference-to-hash whose keys are the fields
1205 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
1206 database.
1207
1208 =back
1209
1210 =cut
1211
1212 #'
1213 sub GetBiblioFromItemNumber {
1214     my ( $itemnumber ) = @_;
1215     my $dbh = C4::Context->dbh;
1216     my $sth = $dbh->prepare(
1217         "SELECT * FROM items
1218         LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1219         LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
1220          WHERE items.itemnumber = ?"
1221     );
1222
1223     $sth->execute($itemnumber);
1224     my $data = $sth->fetchrow_hashref;
1225     $sth->finish;
1226     return ($data);
1227 }
1228
1229 =head2 GetBiblio
1230
1231 =over 4
1232
1233 ( $count, @results ) = &GetBiblio($biblionumber);
1234
1235 =back
1236
1237 =cut
1238
1239 sub GetBiblio {
1240     my ($biblionumber) = @_;
1241     my $dbh = C4::Context->dbh;
1242     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber = ?");
1243     my $count = 0;
1244     my @results;
1245     $sth->execute($biblionumber);
1246     while ( my $data = $sth->fetchrow_hashref ) {
1247         $results[$count] = $data;
1248         $count++;
1249     }    # while
1250     $sth->finish;
1251     return ( $count, @results );
1252 }    # sub GetBiblio
1253
1254 =head2 GetItem
1255
1256 =over 4
1257
1258 $data = &GetItem($itemnumber,$barcode);
1259
1260 return Item information, for a given itemnumber or barcode
1261
1262 =back
1263
1264 =cut
1265
1266 sub GetItem {
1267     my ($itemnumber,$barcode) = @_;
1268     my $dbh = C4::Context->dbh;
1269     if ($itemnumber) {
1270         my $sth = $dbh->prepare("
1271             SELECT * FROM items
1272             WHERE itemnumber = ?");
1273         $sth->execute($itemnumber);
1274         my $data = $sth->fetchrow_hashref;
1275         return $data;
1276     } else {
1277         my $sth = $dbh->prepare("
1278             SELECT * FROM items
1279             WHERE barcode = ?"
1280             );
1281         $sth->execute($barcode);
1282         my $data = $sth->fetchrow_hashref;
1283         return $data;
1284     }
1285 }    # sub GetItem
1286
1287 =head2 get_itemnumbers_of
1288
1289 =over 4
1290
1291 my @itemnumbers_of = get_itemnumbers_of(@biblionumbers);
1292
1293 Given a list of biblionumbers, return the list of corresponding itemnumbers
1294 for each biblionumber.
1295
1296 Return a reference on a hash where keys are biblionumbers and values are
1297 references on array of itemnumbers.
1298
1299 =back
1300
1301 =cut
1302
1303 sub get_itemnumbers_of {
1304     my @biblionumbers = @_;
1305
1306     my $dbh = C4::Context->dbh;
1307
1308     my $query = '
1309         SELECT itemnumber,
1310             biblionumber
1311         FROM items
1312         WHERE biblionumber IN (?' . ( ',?' x scalar @biblionumbers - 1 ) . ')
1313     ';
1314     my $sth = $dbh->prepare($query);
1315     $sth->execute(@biblionumbers);
1316
1317     my %itemnumbers_of;
1318
1319     while ( my ( $itemnumber, $biblionumber ) = $sth->fetchrow_array ) {
1320         push @{ $itemnumbers_of{$biblionumber} }, $itemnumber;
1321     }
1322
1323     return \%itemnumbers_of;
1324 }
1325
1326 =head2 GetItemInfosOf
1327
1328 =over 4
1329
1330 GetItemInfosOf(@itemnumbers);
1331
1332 =back
1333
1334 =cut
1335
1336 sub GetItemInfosOf {
1337     my @itemnumbers = @_;
1338
1339     my $query = '
1340         SELECT *
1341         FROM items
1342         WHERE itemnumber IN (' . join( ',', @itemnumbers ) . ')
1343     ';
1344     return get_infos_of( $query, 'itemnumber' );
1345 }
1346
1347 =head2 GetItemsByBiblioitemnumber
1348
1349 =over 4
1350
1351 GetItemsByBiblioitemnumber($biblioitemnumber);
1352
1353 Returns an arrayref of hashrefs suitable for use in a TMPL_LOOP
1354 Called by moredetail.pl
1355
1356 =back
1357
1358 =cut
1359
1360 sub GetItemsByBiblioitemnumber {
1361         my ( $bibitem ) = @_;
1362         my $dbh = C4::Context->dbh;
1363         my $sth = $dbh->prepare("SELECT * FROM items WHERE items.biblioitemnumber = ?") || die $dbh->errstr;
1364         # Get all items attached to a biblioitem
1365     my $i = 0;
1366     my @results;
1367     $sth->execute($bibitem) || die $sth->errstr;
1368     while ( my $data = $sth->fetchrow_hashref ) {
1369                 # Foreach item, get circulation information
1370                 my $sth2 = $dbh->prepare( "SELECT * FROM issues,borrowers
1371                                    WHERE itemnumber = ?
1372                                    AND returndate is NULL
1373                                    AND issues.borrowernumber = borrowers.borrowernumber"
1374         );
1375         $sth2->execute( $data->{'itemnumber'} );
1376         if ( my $data2 = $sth2->fetchrow_hashref ) {
1377                         # if item is out, set the due date and who it is out too
1378                         $data->{'date_due'}   = $data2->{'date_due'};
1379                         $data->{'cardnumber'} = $data2->{'cardnumber'};
1380                         $data->{'borrowernumber'}   = $data2->{'borrowernumber'};
1381                 }
1382         else {
1383                         # set date_due to blank, so in the template we check itemlost, and wthdrawn
1384                         $data->{'date_due'} = '';
1385                 }    # else
1386         $sth2->finish;
1387         # Find the last 3 people who borrowed this item.
1388         my $query2 = "SELECT * FROM issues, borrowers WHERE itemnumber = ?
1389                       AND issues.borrowernumber = borrowers.borrowernumber
1390                       AND returndate is not NULL
1391                       ORDER BY returndate desc,timestamp desc LIMIT 3";
1392         $sth2 = $dbh->prepare($query2) || die $dbh->errstr;
1393         $sth2->execute( $data->{'itemnumber'} ) || die $sth2->errstr;
1394         my $i2 = 0;
1395         while ( my $data2 = $sth2->fetchrow_hashref ) {
1396                         $data->{"timestamp$i2"} = $data2->{'timestamp'};
1397                         $data->{"card$i2"}      = $data2->{'cardnumber'};
1398                         $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
1399                         $i2++;
1400                 }
1401         $sth2->finish;
1402         push(@results,$data);
1403     }
1404     $sth->finish;
1405     return (\@results);
1406 }
1407
1408
1409 =head2 GetBiblioItemInfosOf
1410
1411 =over 4
1412
1413 GetBiblioItemInfosOf(@biblioitemnumbers);
1414
1415 =back
1416
1417 =cut
1418
1419 sub GetBiblioItemInfosOf {
1420     my @biblioitemnumbers = @_;
1421
1422     my $query = '
1423         SELECT biblioitemnumber,
1424             publicationyear,
1425             itemtype
1426         FROM biblioitems
1427         WHERE biblioitemnumber IN (' . join( ',', @biblioitemnumbers ) . ')
1428     ';
1429     return get_infos_of( $query, 'biblioitemnumber' );
1430 }
1431
1432 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
1433
1434 =head2 GetMarcStructure
1435
1436 =over 4
1437
1438 $res = GetMarcStructure($forlibrarian,$frameworkcode);
1439
1440 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
1441 $forlibrarian  :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
1442 $frameworkcode : the framework code to read
1443
1444 =back
1445
1446 =cut
1447
1448 sub GetMarcStructure {
1449     my ( $forlibrarian, $frameworkcode ) = @_;
1450     my $dbh=C4::Context->dbh;
1451     $frameworkcode = "" unless $frameworkcode;
1452     my $sth;
1453     my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
1454
1455     # check that framework exists
1456     $sth =
1457       $dbh->prepare(
1458         "SELECT COUNT(*) FROM marc_tag_structure WHERE frameworkcode=?");
1459     $sth->execute($frameworkcode);
1460     my ($total) = $sth->fetchrow;
1461     $frameworkcode = "" unless ( $total > 0 );
1462     $sth =
1463       $dbh->prepare(
1464                 "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable
1465                 FROM marc_tag_structure
1466                 WHERE frameworkcode=?
1467                 ORDER BY tagfield"
1468       );
1469     $sth->execute($frameworkcode);
1470     my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
1471
1472     while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) =
1473         $sth->fetchrow )
1474     {
1475         $res->{$tag}->{lib} =
1476           ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1477         $res->{$tab}->{tab}        = "";
1478         $res->{$tag}->{mandatory}  = $mandatory;
1479         $res->{$tag}->{repeatable} = $repeatable;
1480     }
1481
1482     $sth =
1483       $dbh->prepare(
1484                         "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue
1485                                 FROM marc_subfield_structure
1486                         WHERE frameworkcode=?
1487                                 ORDER BY tagfield,tagsubfield
1488                         "
1489     );
1490
1491     $sth->execute($frameworkcode);
1492
1493     my $subfield;
1494     my $authorised_value;
1495     my $authtypecode;
1496     my $value_builder;
1497     my $kohafield;
1498     my $seealso;
1499     my $hidden;
1500     my $isurl;
1501     my $link;
1502     my $defaultvalue;
1503
1504     while (
1505         (
1506             $tag,          $subfield,      $liblibrarian,
1507             ,              $libopac,       $tab,
1508             $mandatory,    $repeatable,    $authorised_value,
1509             $authtypecode, $value_builder, $kohafield,
1510             $seealso,      $hidden,        $isurl,
1511             $link,$defaultvalue
1512         )
1513         = $sth->fetchrow
1514       )
1515     {
1516         $res->{$tag}->{$subfield}->{lib} =
1517           ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1518         $res->{$tag}->{$subfield}->{tab}              = $tab;
1519         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
1520         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
1521         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
1522         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
1523         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
1524         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
1525         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
1526         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
1527         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
1528         $res->{$tag}->{$subfield}->{'link'}           = $link;
1529         $res->{$tag}->{$subfield}->{defaultvalue}     = $defaultvalue;
1530     }
1531     return $res;
1532 }
1533
1534 =head2 GetUsedMarcStructure
1535
1536     the same function as GetMarcStructure expcet it just take field
1537     in tab 0-9. (used field)
1538
1539     my $results = GetUsedMarcStructure($frameworkcode);
1540
1541     L<$results> is a ref to an array which each case containts a ref
1542     to a hash which each keys is the columns from marc_subfield_structure
1543
1544     L<$frameworkcode> is the framework code.
1545
1546 =cut
1547
1548 sub GetUsedMarcStructure($){
1549     my $frameworkcode = shift || '';
1550     my $dbh           = C4::Context->dbh;
1551     my $query         = qq/
1552         SELECT *
1553         FROM   marc_subfield_structure
1554         WHERE   tab > -1
1555             AND frameworkcode = ?
1556     /;
1557     my @results;
1558     my $sth = $dbh->prepare($query);
1559     $sth->execute($frameworkcode);
1560     while (my $row = $sth->fetchrow_hashref){
1561         push @results,$row;
1562     }
1563     return \@results;
1564 }
1565
1566 =head2 GetMarcFromKohaField
1567
1568 =over 4
1569
1570 ($MARCfield,$MARCsubfield)=GetMarcFromKohaField($kohafield,$frameworkcode);
1571 Returns the MARC fields & subfields mapped to the koha field
1572 for the given frameworkcode
1573
1574 =back
1575
1576 =cut
1577
1578 sub GetMarcFromKohaField {
1579     my ( $kohafield, $frameworkcode ) = @_;
1580     return 0, 0 unless $kohafield;
1581     my $relations = C4::Context->marcfromkohafield;
1582     return (
1583         $relations->{$frameworkcode}->{$kohafield}->[0],
1584         $relations->{$frameworkcode}->{$kohafield}->[1]
1585     );
1586 }
1587
1588 =head2 GetMarcBiblio
1589
1590 =over 4
1591
1592 Returns MARC::Record of the biblionumber passed in parameter.
1593 the marc record contains both biblio & item datas
1594
1595 =back
1596
1597 =cut
1598
1599 sub GetMarcBiblio {
1600     my $biblionumber = shift;
1601     my $dbh          = C4::Context->dbh;
1602     my $sth          =
1603       $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1604     $sth->execute($biblionumber);
1605      my ($marcxml) = $sth->fetchrow;
1606      MARC::File::XML->default_record_format(C4::Context->preference('marcflavour'));
1607      $marcxml =~ s/\x1e//g;
1608      $marcxml =~ s/\x1f//g;
1609      $marcxml =~ s/\x1d//g;
1610      $marcxml =~ s/\x0f//g;
1611      $marcxml =~ s/\x0c//g;
1612 #   warn $marcxml;
1613     my $record = MARC::Record->new();
1614
1615       $record = eval {MARC::Record::new_from_xml( $marcxml, "utf8",C4::Context->preference('marcflavour'))} if ($marcxml);
1616      if ($@) {warn $@;}
1617 #      $record = MARC::Record::new_from_usmarc( $marc) if $marc;
1618     return $record;
1619 }
1620
1621 =head2 GetXmlBiblio
1622
1623 =over 4
1624
1625 my $marcxml = GetXmlBiblio($biblionumber);
1626
1627 Returns biblioitems.marcxml of the biblionumber passed in parameter.
1628 The XML contains both biblio & item datas
1629
1630 =back
1631
1632 =cut
1633
1634 sub GetXmlBiblio {
1635     my ( $biblionumber ) = @_;
1636     my $dbh = C4::Context->dbh;
1637     my $sth =
1638       $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1639     $sth->execute($biblionumber);
1640     my ($marcxml) = $sth->fetchrow;
1641     return $marcxml;
1642 }
1643
1644 =head2 GetAuthorisedValueDesc
1645
1646 =over 4
1647
1648 my $subfieldvalue =get_authorised_value_desc(
1649     $tag, $subf[$i][0],$subf[$i][1], '', $taglib);
1650 Retrieve the complete description for a given authorised value.
1651
1652 =back
1653
1654 =cut
1655
1656 sub GetAuthorisedValueDesc {
1657     my ( $tag, $subfield, $value, $framework, $tagslib ) = @_;
1658     my $dbh = C4::Context->dbh;
1659
1660     #---- branch
1661     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1662         return C4::Branch::GetBranchName($value);
1663     }
1664
1665     #---- itemtypes
1666     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1667         return getitemtypeinfo($value)->{description};
1668     }
1669
1670     #---- "true" authorized value
1671     my $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1672     if ( $category ne "" ) {
1673         my $sth =
1674           $dbh->prepare(
1675             "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
1676           );
1677         $sth->execute( $category, $value );
1678         my $data = $sth->fetchrow_hashref;
1679         return $data->{'lib'};
1680     }
1681     else {
1682         return $value;    # if nothing is found return the original value
1683     }
1684 }
1685
1686 =head2 GetMarcItem
1687
1688 =over 4
1689
1690 Returns MARC::Record of the item passed in parameter.
1691
1692 =back
1693
1694 =cut
1695
1696 sub GetMarcItem {
1697     my ( $biblionumber, $itemnumber ) = @_;
1698     my $dbh = C4::Context->dbh;
1699     my $newrecord = MARC::Record->new();
1700     my $marcflavour = C4::Context->preference('marcflavour');
1701
1702     my $marcxml = GetXmlBiblio($biblionumber);
1703     my $record = MARC::Record->new();
1704     $record = MARC::Record::new_from_xml( $marcxml, "utf8", $marcflavour );
1705     # now, find where the itemnumber is stored & extract only the item
1706     my ( $itemnumberfield, $itemnumbersubfield ) =
1707       GetMarcFromKohaField( 'items.itemnumber', '' );
1708     my @fields = $record->field($itemnumberfield);
1709     foreach my $field (@fields) {
1710         if ( $field->subfield($itemnumbersubfield) eq $itemnumber ) {
1711             $newrecord->insert_fields_ordered($field);
1712         }
1713     }
1714     return $newrecord;
1715 }
1716
1717
1718
1719 =head2 GetMarcNotes
1720
1721 =over 4
1722
1723 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1724 Get all notes from the MARC record and returns them in an array.
1725 The note are stored in differents places depending on MARC flavour
1726
1727 =back
1728
1729 =cut
1730
1731 sub GetMarcNotes {
1732     my ( $record, $marcflavour ) = @_;
1733     my $scope;
1734     if ( $marcflavour eq "MARC21" ) {
1735         $scope = '5..';
1736     }
1737     else {    # assume unimarc if not marc21
1738         $scope = '3..';
1739     }
1740     my @marcnotes;
1741     my $note = "";
1742     my $tag  = "";
1743     my $marcnote;
1744     foreach my $field ( $record->field($scope) ) {
1745         my $value = $field->as_string();
1746         if ( $note ne "" ) {
1747             $marcnote = { marcnote => $note, };
1748             push @marcnotes, $marcnote;
1749             $note = $value;
1750         }
1751         if ( $note ne $value ) {
1752             $note = $note . " " . $value;
1753         }
1754     }
1755
1756     if ( $note ) {
1757         $marcnote = { marcnote => $note };
1758         push @marcnotes, $marcnote;    #load last tag into array
1759     }
1760     return \@marcnotes;
1761 }    # end GetMarcNotes
1762
1763 =head2 GetMarcSubjects
1764
1765 =over 4
1766
1767 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1768 Get all subjects from the MARC record and returns them in an array.
1769 The subjects are stored in differents places depending on MARC flavour
1770
1771 =back
1772
1773 =cut
1774
1775 sub GetMarcSubjects {
1776     my ( $record, $marcflavour ) = @_;
1777     my ( $mintag, $maxtag );
1778     if ( $marcflavour eq "MARC21" ) {
1779         $mintag = "600";
1780         $maxtag = "699";
1781     }
1782     else {    # assume unimarc if not marc21
1783         $mintag = "600";
1784         $maxtag = "611";
1785     }
1786
1787     my @marcsubjcts;
1788
1789     foreach my $field ( $record->fields ) {
1790         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1791         my @subfields = $field->subfields();
1792         my $link = "su:";
1793         my $label;
1794         my $flag = 0;
1795         my $authoritysep=C4::Context->preference("authoritysep");
1796         for my $subject_subfield ( @subfields ) {
1797             if (
1798                 $marcflavour ne 'MARC21'
1799                 and (
1800                     ($subject_subfield->[0] eq '3') or
1801                     ($subject_subfield->[0] eq '4') or
1802                     ($subject_subfield->[0] eq '5')
1803                 )
1804             )
1805             {
1806                 next;
1807             }
1808             my $code = $subject_subfield->[0];
1809             $label .= $subject_subfield->[1].$authoritysep unless ( $code == 9 );
1810             $link  .= " and su-to:".$subject_subfield->[1]  unless ( $code == 9 );
1811             if ( $code == 9 ) {
1812                 $link = "an:".$subject_subfield->[1];
1813                 $flag = 1;
1814             }
1815             elsif ( ! $flag ) {
1816                 $link =~ s/ and\ssu-to:$//;
1817             }
1818         }
1819          $label =~ s/$authoritysep$//;
1820         push @marcsubjcts,
1821           {
1822             label => $label,
1823             link  => $link
1824           }
1825     }
1826     return \@marcsubjcts;
1827 }    #end GetMarcSubjects
1828
1829 =head2 GetMarcAuthors
1830
1831 =over 4
1832
1833 authors = GetMarcAuthors($record,$marcflavour);
1834 Get all authors from the MARC record and returns them in an array.
1835 The authors are stored in differents places depending on MARC flavour
1836
1837 =back
1838
1839 =cut
1840
1841 sub GetMarcAuthors {
1842     my ( $record, $marcflavour ) = @_;
1843     my ( $mintag, $maxtag );
1844     # tagslib useful for UNIMARC author reponsabilities
1845     my $tagslib = &GetMarcStructure( 1, '' ); # FIXME : we don't have the framework available, we take the default framework. May be bugguy on some setups, will be usually correct.
1846     if ( $marcflavour eq "MARC21" ) {
1847         $mintag = "700";
1848         $maxtag = "720";
1849     }
1850     elsif ( $marcflavour eq "UNIMARC" ) {    # assume unimarc if not marc21
1851         $mintag = "701";
1852         $maxtag = "712";
1853     }
1854         else {
1855                 return;
1856         }
1857     my @marcauthors;
1858
1859     foreach my $field ( $record->fields ) {
1860         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1861         my %hash;
1862         my @subfields = $field->subfields();
1863         my $count_auth = 0;
1864         for my $authors_subfield (@subfields) {
1865                         #unimarc-specific line
1866             next if ($marcflavour eq 'UNIMARC' and (($authors_subfield->[0] eq '3') or ($authors_subfield->[0] eq '5')));
1867             my $subfieldcode = $authors_subfield->[0];
1868             my $value;
1869             # deal with UNIMARC author responsibility
1870                         if ( $marcflavour eq 'UNIMARC' and ($authors_subfield->[0] eq '4')) {
1871                 $value = "(".GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib ).")";
1872             } else {
1873                 $value        = $authors_subfield->[1];
1874             }
1875             $hash{tag}       = $field->tag;
1876             $hash{value}    .= $value . " " if ($subfieldcode != 9) ;
1877             $hash{link}     .= $value if ($subfieldcode eq 9);
1878         }
1879         push @marcauthors, \%hash;
1880     }
1881     return \@marcauthors;
1882 }
1883
1884 =head2 GetMarcUrls
1885
1886 =over 4
1887
1888 $marcurls = GetMarcUrls($record,$marcflavour);
1889 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1890 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1891
1892 =back
1893
1894 =cut
1895
1896 sub GetMarcUrls {
1897     my ($record, $marcflavour) = @_;
1898     my @marcurls;
1899     my $marcurl;
1900     for my $field ($record->field('856')) {
1901         my $url = $field->subfield('u');
1902         my @notes;
1903         for my $note ( $field->subfield('z')) {
1904             push @notes , {note => $note};
1905         }
1906         $marcurl = {  MARCURL => $url,
1907                       notes => \@notes,
1908                                         };
1909                 if($marcflavour eq 'MARC21') {
1910                 my $s3 = $field->subfield('3');
1911                         my $link = $field->subfield('y');
1912             $marcurl->{'linktext'} = $link || $s3 || $url ;;
1913             $marcurl->{'part'} = $s3 if($link);
1914             $marcurl->{'toc'} = 1 if($s3 =~ /^[Tt]able/) ;
1915                 } else {
1916                         $marcurl->{'linktext'} = $url;
1917                 }
1918         push @marcurls, $marcurl;
1919         }
1920     return \@marcurls;
1921 }  #end GetMarcUrls
1922
1923 =head2 GetMarcSeries
1924
1925 =over 4
1926
1927 $marcseriesarray = GetMarcSeries($record,$marcflavour);
1928 Get all series from the MARC record and returns them in an array.
1929 The series are stored in differents places depending on MARC flavour
1930
1931 =back
1932
1933 =cut
1934
1935 sub GetMarcSeries {
1936     my ($record, $marcflavour) = @_;
1937     my ($mintag, $maxtag);
1938     if ($marcflavour eq "MARC21") {
1939         $mintag = "440";
1940         $maxtag = "490";
1941     } else {           # assume unimarc if not marc21
1942         $mintag = "600";
1943         $maxtag = "619";
1944     }
1945
1946     my @marcseries;
1947     my $subjct = "";
1948     my $subfield = "";
1949     my $marcsubjct;
1950
1951     foreach my $field ($record->field('440'), $record->field('490')) {
1952         my @subfields_loop;
1953         #my $value = $field->subfield('a');
1954         #$marcsubjct = {MARCSUBJCT => $value,};
1955         my @subfields = $field->subfields();
1956         #warn "subfields:".join " ", @$subfields;
1957         my $counter = 0;
1958         my @link_loop;
1959         for my $series_subfield (@subfields) {
1960                         my $volume_number;
1961                         undef $volume_number;
1962                         # see if this is an instance of a volume
1963                         if ($series_subfield->[0] eq 'v') {
1964                                 $volume_number=1;
1965                         }
1966
1967             my $code = $series_subfield->[0];
1968             my $value = $series_subfield->[1];
1969             my $linkvalue = $value;
1970             $linkvalue =~ s/(\(|\))//g;
1971             my $operator = " and " unless $counter==0;
1972             push @link_loop, {link => $linkvalue, operator => $operator };
1973             my $separator = C4::Context->preference("authoritysep") unless $counter==0;
1974                         if ($volume_number) {
1975                         push @subfields_loop, {volumenum => $value};
1976                         }
1977                         else {
1978             push @subfields_loop, {code => $code, value => $value, link_loop => \@link_loop, separator => $separator, volumenum => $volume_number};
1979                         }
1980             $counter++;
1981         }
1982         push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1983         #$marcsubjct = {MARCSUBJCT => $field->as_string(),};
1984         #push @marcsubjcts, $marcsubjct;
1985         #$subjct = $value;
1986
1987     }
1988     my $marcseriessarray=\@marcseries;
1989     return $marcseriessarray;
1990 }  #end getMARCseriess
1991
1992 =head2 GetFrameworkCode
1993
1994 =over 4
1995
1996     $frameworkcode = GetFrameworkCode( $biblionumber )
1997
1998 =back
1999
2000 =cut
2001
2002 sub GetFrameworkCode {
2003     my ( $biblionumber ) = @_;
2004     my $dbh = C4::Context->dbh;
2005     my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
2006     $sth->execute($biblionumber);
2007     my ($frameworkcode) = $sth->fetchrow;
2008     return $frameworkcode;
2009 }
2010
2011 =head2 GetPublisherNameFromIsbn
2012
2013     $name = GetPublishercodeFromIsbn($isbn);
2014     if(defined $name){
2015         ...
2016     }
2017
2018 =cut
2019
2020 sub GetPublisherNameFromIsbn($){
2021     my $isbn = shift;
2022     $isbn =~ s/[- _]//g;
2023     $isbn =~ s/^0*//;
2024     my @codes = (split '-', DisplayISBN($isbn));
2025     my $code = $codes[0].$codes[1].$codes[2];
2026     my $dbh  = C4::Context->dbh;
2027     my $query = qq{
2028         SELECT distinct publishercode
2029         FROM   biblioitems
2030         WHERE  isbn LIKE ?
2031         AND    publishercode IS NOT NULL
2032         LIMIT 1
2033     };
2034     my $sth = $dbh->prepare($query);
2035     $sth->execute("$code%");
2036     my $name = $sth->fetchrow;
2037     return $name if length $name;
2038     return undef;
2039 }
2040
2041 =head2 TransformKohaToMarc
2042
2043 =over 4
2044
2045     $record = TransformKohaToMarc( $hash )
2046     This function builds partial MARC::Record from a hash
2047     Hash entries can be from biblio or biblioitems.
2048     This function is called in acquisition module, to create a basic catalogue entry from user entry
2049
2050 =back
2051
2052 =cut
2053
2054 sub TransformKohaToMarc {
2055
2056     my ( $hash ) = @_;
2057     my $dbh = C4::Context->dbh;
2058     my $sth =
2059     $dbh->prepare(
2060         "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?"
2061     );
2062     my $record = MARC::Record->new();
2063     foreach (keys %{$hash}) {
2064         &TransformKohaToMarcOneField( $sth, $record, $_,
2065             $hash->{$_}, '' );
2066         }
2067     return $record;
2068 }
2069
2070 =head2 TransformKohaToMarcOneField
2071
2072 =over 4
2073
2074     $record = TransformKohaToMarcOneField( $sth, $record, $kohafieldname, $value, $frameworkcode );
2075
2076 =back
2077
2078 =cut
2079
2080 sub TransformKohaToMarcOneField {
2081     my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_;
2082     $frameworkcode='' unless $frameworkcode;
2083     my $tagfield;
2084     my $tagsubfield;
2085
2086     if ( !defined $sth ) {
2087         my $dbh = C4::Context->dbh;
2088         $sth = $dbh->prepare(
2089             "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?"
2090         );
2091     }
2092     $sth->execute( $frameworkcode, $kohafieldname );
2093     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
2094         my $tag = $record->field($tagfield);
2095         if ($tag) {
2096             $tag->update( $tagsubfield => $value );
2097             $record->delete_field($tag);
2098             $record->insert_fields_ordered($tag);
2099         }
2100         else {
2101             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
2102         }
2103     }
2104     return $record;
2105 }
2106
2107 =head2 TransformHtmlToXml
2108
2109 =over 4
2110
2111 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type )
2112
2113 $auth_type contains :
2114 - nothing : rebuild a biblio, un UNIMARC the encoding is in 100$a pos 26/27
2115 - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2116 - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2117
2118 =back
2119
2120 =cut
2121
2122 sub TransformHtmlToXml {
2123     my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2124     my $xml = MARC::File::XML::header('UTF-8');
2125     $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2126     MARC::File::XML->default_record_format($auth_type);
2127     # in UNIMARC, field 100 contains the encoding
2128     # check that there is one, otherwise the
2129     # MARC::Record->new_from_xml will fail (and Koha will die)
2130     my $unimarc_and_100_exist=0;
2131     $unimarc_and_100_exist=1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
2132     my $prevvalue;
2133     my $prevtag = -1;
2134     my $first   = 1;
2135     my $j       = -1;
2136     for ( my $i = 0 ; $i <= @$tags ; $i++ ) {
2137         if (C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a") {
2138             # if we have a 100 field and it's values are not correct, skip them.
2139             # if we don't have any valid 100 field, we will create a default one at the end
2140             my $enc = substr( @$values[$i], 26, 2 );
2141             if ($enc eq '01' or $enc eq '50' or $enc eq '03') {
2142                 $unimarc_and_100_exist=1;
2143             } else {
2144                 next;
2145             }
2146         }
2147         @$values[$i] =~ s/&/&amp;/g;
2148         @$values[$i] =~ s/</&lt;/g;
2149         @$values[$i] =~ s/>/&gt;/g;
2150         @$values[$i] =~ s/"/&quot;/g;
2151         @$values[$i] =~ s/'/&apos;/g;
2152 #         if ( !utf8::is_utf8( @$values[$i] ) ) {
2153 #             utf8::decode( @$values[$i] );
2154 #         }
2155         if ( ( @$tags[$i] ne $prevtag ) ) {
2156             $j++ unless ( @$tags[$i] eq "" );
2157             if ( !$first ) {
2158                 $xml .= "</datafield>\n";
2159                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
2160                     && ( @$values[$i] ne "" ) )
2161                 {
2162                     my $ind1 = substr( @$indicator[$j], 0, 1 );
2163                     my $ind2;
2164                     if ( @$indicator[$j] ) {
2165                         $ind2 = substr( @$indicator[$j], 1, 1 );
2166                     }
2167                     else {
2168                         warn "Indicator in @$tags[$i] is empty";
2169                         $ind2 = " ";
2170                     }
2171                     $xml .=
2172 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2173                     $xml .=
2174 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2175                     $first = 0;
2176                 }
2177                 else {
2178                     $first = 1;
2179                 }
2180             }
2181             else {
2182                 if ( @$values[$i] ne "" ) {
2183
2184                     # leader
2185                     if ( @$tags[$i] eq "000" ) {
2186                         $xml .= "<leader>@$values[$i]</leader>\n";
2187                         $first = 1;
2188
2189                         # rest of the fixed fields
2190                     }
2191                     elsif ( @$tags[$i] < 10 ) {
2192                         $xml .=
2193 "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2194                         $first = 1;
2195                     }
2196                     else {
2197                         my $ind1 = substr( @$indicator[$j], 0, 1 );
2198                         my $ind2 = substr( @$indicator[$j], 1, 1 );
2199                         $xml .=
2200 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2201                         $xml .=
2202 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2203                         $first = 0;
2204                     }
2205                 }
2206             }
2207         }
2208         else {    # @$tags[$i] eq $prevtag
2209             if ( @$values[$i] eq "" ) {
2210             }
2211             else {
2212                 if ($first) {
2213                     my $ind1 = substr( @$indicator[$j], 0, 1 );
2214                     my $ind2 = substr( @$indicator[$j], 1, 1 );
2215                     $xml .=
2216 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2217                     $first = 0;
2218                 }
2219                 $xml .=
2220 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2221             }
2222         }
2223         $prevtag = @$tags[$i];
2224     }
2225     if (C4::Context->preference('marcflavour') and !$unimarc_and_100_exist) {
2226 #     warn "SETTING 100 for $auth_type";
2227         use POSIX qw(strftime);
2228         my $string = strftime( "%Y%m%d", localtime(time) );
2229         # set 50 to position 26 is biblios, 13 if authorities
2230         my $pos=26;
2231         $pos=13 if $auth_type eq 'UNIMARCAUTH';
2232         $string = sprintf( "%-*s", 35, $string );
2233         substr( $string, $pos , 6, "50" );
2234         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2235         $xml .= "<subfield code=\"a\">$string</subfield>\n";
2236         $xml .= "</datafield>\n";
2237     }
2238     $xml .= MARC::File::XML::footer();
2239     return $xml;
2240 }
2241
2242 =head2 TransformHtmlToMarc
2243
2244     L<$record> = TransformHtmlToMarc(L<$params>,L<$cgi>)
2245     L<$params> is a ref to an array as below:
2246     {
2247         'tag_010_indicator_531951' ,
2248         'tag_010_code_a_531951_145735' ,
2249         'tag_010_subfield_a_531951_145735' ,
2250         'tag_200_indicator_873510' ,
2251         'tag_200_code_a_873510_673465' ,
2252         'tag_200_subfield_a_873510_673465' ,
2253         'tag_200_code_b_873510_704318' ,
2254         'tag_200_subfield_b_873510_704318' ,
2255         'tag_200_code_e_873510_280822' ,
2256         'tag_200_subfield_e_873510_280822' ,
2257         'tag_200_code_f_873510_110730' ,
2258         'tag_200_subfield_f_873510_110730' ,
2259     }
2260     L<$cgi> is the CGI object which containts the value.
2261     L<$record> is the MARC::Record object.
2262
2263 =cut
2264
2265 sub TransformHtmlToMarc {
2266     my $params = shift;
2267     my $cgi    = shift;
2268
2269     # creating a new record
2270     my $record  = MARC::Record->new();
2271     my $i=0;
2272     my @fields;
2273     while ($params->[$i]){ # browse all CGI params
2274         my $param = $params->[$i];
2275         my $newfield=0;
2276         # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2277         if ($param eq 'biblionumber') {
2278             my ( $biblionumbertagfield, $biblionumbertagsubfield ) =
2279                 &GetMarcFromKohaField( "biblio.biblionumber", '' );
2280             if ($biblionumbertagfield < 10) {
2281                 $newfield = MARC::Field->new(
2282                     $biblionumbertagfield,
2283                     $cgi->param($param),
2284                 );
2285             } else {
2286                 $newfield = MARC::Field->new(
2287                     $biblionumbertagfield,
2288                     '',
2289                     '',
2290                     "$biblionumbertagsubfield" => $cgi->param($param),
2291                 );
2292             }
2293             push @fields,$newfield if($newfield);
2294         }
2295         elsif ($param =~ /^tag_(\d*)_indicator_/){ # new field start when having 'input name="..._indicator_..."
2296             my $tag  = $1;
2297
2298             my $ind1 = substr($cgi->param($param),0,1);
2299             my $ind2 = substr($cgi->param($param),1,1);
2300             $newfield=0;
2301             my $j=$i+1;
2302
2303             if($tag < 10){ # no code for theses fields
2304     # in MARC editor, 000 contains the leader.
2305                 if ($tag eq '000' ) {
2306                     $record->leader($cgi->param($params->[$j+1])) if length($cgi->param($params->[$j+1]))==24;
2307     # between 001 and 009 (included)
2308                 } else {
2309                     $newfield = MARC::Field->new(
2310                         $tag,
2311                         $cgi->param($params->[$j+1]),
2312                     );
2313                 }
2314     # > 009, deal with subfields
2315             } else {
2316                 while($params->[$j] =~ /_code_/){ # browse all it's subfield
2317                     my $inner_param = $params->[$j];
2318                     if ($newfield){
2319                         if($cgi->param($params->[$j+1])){  # only if there is a value (code => value)
2320                             $newfield->add_subfields(
2321                                 $cgi->param($inner_param) => $cgi->param($params->[$j+1])
2322                             );
2323                         }
2324                     } else {
2325                         if ( $cgi->param($params->[$j+1]) ) { # creating only if there is a value (code => value)
2326                             $newfield = MARC::Field->new(
2327                                 $tag,
2328                                 ''.$ind1,
2329                                 ''.$ind2,
2330                                 $cgi->param($inner_param) => $cgi->param($params->[$j+1]),
2331                             );
2332                         }
2333                     }
2334                     $j+=2;
2335                 }
2336             }
2337             push @fields,$newfield if($newfield);
2338         }
2339         $i++;
2340     }
2341
2342     $record->append_fields(@fields);
2343     return $record;
2344 }
2345
2346 =head2 TransformMarcToKoha
2347
2348 =over 4
2349
2350         $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
2351
2352 =back
2353
2354 =cut
2355
2356 sub TransformMarcToKoha {
2357     my ( $dbh, $record, $frameworkcode, $table ) = @_;
2358
2359     my $result;
2360
2361     # sometimes we only want to return the items data
2362     if ($table eq 'items') {
2363         my $sth = $dbh->prepare("SHOW COLUMNS FROM items");
2364         $sth->execute();
2365         while ( (my $field) = $sth->fetchrow ) {
2366             my $value = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2367             my $key = _disambiguate($table, $field);
2368             if ($result->{$key}) {
2369                 $result->{$key} .= " | " . $value;
2370             } else {
2371                 $result->{$key} = $value;
2372             }
2373         }
2374         return $result;
2375     } else {
2376         my @tables = ('biblio','biblioitems','items');
2377         foreach my $table (@tables){
2378             my $sth2 = $dbh->prepare("SHOW COLUMNS from $table");
2379             $sth2->execute;
2380             while (my ($field) = $sth2->fetchrow){
2381                 # FIXME use of _disambiguate is a temporary hack
2382                 # $result->{_disambiguate($table, $field)} = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2383                 my $value = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2384                 my $key = _disambiguate($table, $field);
2385                 if ($result->{$key}) {
2386                     # FIXME - hack to not bring in duplicates of the same value
2387                     unless (($key eq "biblionumber" or $key eq "biblioitemnumber") and ($value eq "")) {
2388                         $result->{$key} .= " | " . $value;
2389                     }
2390                 } else {
2391                     $result->{$key} = $value;
2392                 }
2393             }
2394             $sth2->finish();
2395         }
2396         # modify copyrightdate to keep only the 1st year found
2397         my $temp = $result->{'copyrightdate'};
2398         $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2399         if ( $1 > 0 ) {
2400             $result->{'copyrightdate'} = $1;
2401         }
2402         else {                      # if no cYYYY, get the 1st date.
2403             $temp =~ m/(\d\d\d\d)/;
2404             $result->{'copyrightdate'} = $1;
2405         }
2406
2407         # modify publicationyear to keep only the 1st year found
2408         $temp = $result->{'publicationyear'};
2409         $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2410         if ( $1 > 0 ) {
2411             $result->{'publicationyear'} = $1;
2412         }
2413         else {                      # if no cYYYY, get the 1st date.
2414             $temp =~ m/(\d\d\d\d)/;
2415             $result->{'publicationyear'} = $1;
2416         }
2417         return $result;
2418     }
2419 }
2420
2421
2422 =head2 _disambiguate
2423
2424 =over 4
2425
2426 $newkey = _disambiguate($table, $field);
2427
2428 This is a temporary hack to distinguish between the
2429 following sets of columns when using TransformMarcToKoha.
2430
2431 items.cn_source & biblioitems.cn_source
2432 items.cn_sort & biblioitems.cn_sort
2433
2434 Columns that are currently NOT distinguished (FIXME
2435 due to lack of time to fully test) are:
2436
2437 biblio.notes and biblioitems.notes
2438 biblionumber
2439 timestamp
2440 biblioitemnumber
2441
2442 FIXME - this is necessary because prefixing each column
2443 name with the table name would require changing lots
2444 of code and templates, and exposing more of the DB
2445 structure than is good to the UI templates, particularly
2446 since biblio and bibloitems may well merge in a future
2447 version.  In the future, it would also be good to
2448 separate DB access and UI presentation field names
2449 more.
2450
2451 =back
2452
2453 =cut
2454
2455 sub _disambiguate {
2456     my ($table, $column) = @_;
2457     if ($column eq "cn_sort" or $column eq "cn_source") {
2458         return $table . '.' . $column;
2459     } else {
2460         return $column;
2461     }
2462
2463 }
2464
2465 =head2 get_koha_field_from_marc
2466
2467 =over 4
2468
2469 $result->{_disambiguate($table, $field)} = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2470
2471 Internal function to map data from the MARC record to a specific non-MARC field.
2472 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2473
2474 =back
2475
2476 =cut
2477
2478 sub get_koha_field_from_marc {
2479     my ($koha_table,$koha_column,$record,$frameworkcode) = @_;
2480     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table.'.'.$koha_column, $frameworkcode );
2481     my $kohafield;
2482     foreach my $field ( $record->field($tagfield) ) {
2483         if ( $field->tag() < 10 ) {
2484             if ( $kohafield ) {
2485                 $kohafield .= " | " . $field->data();
2486             }
2487             else {
2488                 $kohafield = $field->data();
2489             }
2490         }
2491         else {
2492             if ( $field->subfields ) {
2493                 my @subfields = $field->subfields();
2494                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2495                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2496                         if ( $kohafield ) {
2497                             $kohafield .=
2498                               " | " . $subfields[$subfieldcount][1];
2499                         }
2500                         else {
2501                             $kohafield =
2502                               $subfields[$subfieldcount][1];
2503                         }
2504                     }
2505                 }
2506             }
2507         }
2508     }
2509     return $kohafield;
2510 }
2511
2512
2513 =head2 TransformMarcToKohaOneField
2514
2515 =over 4
2516
2517 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2518
2519 =back
2520
2521 =cut
2522
2523 sub TransformMarcToKohaOneField {
2524
2525     # FIXME ? if a field has a repeatable subfield that is used in old-db,
2526     # only the 1st will be retrieved...
2527     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2528     my $res = "";
2529     my ( $tagfield, $subfield ) =
2530       GetMarcFromKohaField( $kohatable . "." . $kohafield,
2531         $frameworkcode );
2532     foreach my $field ( $record->field($tagfield) ) {
2533         if ( $field->tag() < 10 ) {
2534             if ( $result->{$kohafield} ) {
2535                 $result->{$kohafield} .= " | " . $field->data();
2536             }
2537             else {
2538                 $result->{$kohafield} = $field->data();
2539             }
2540         }
2541         else {
2542             if ( $field->subfields ) {
2543                 my @subfields = $field->subfields();
2544                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2545                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2546                         if ( $result->{$kohafield} ) {
2547                             $result->{$kohafield} .=
2548                               " | " . $subfields[$subfieldcount][1];
2549                         }
2550                         else {
2551                             $result->{$kohafield} =
2552                               $subfields[$subfieldcount][1];
2553                         }
2554                     }
2555                 }
2556             }
2557         }
2558     }
2559     return $result;
2560 }
2561
2562 =head1  OTHER FUNCTIONS
2563
2564 =head2 char_decode
2565
2566 =over 4
2567
2568 my $string = char_decode( $string, $encoding );
2569
2570 converts ISO 5426 coded string to UTF-8
2571 sloppy code : should be improved in next issue
2572
2573 =back
2574
2575 =cut
2576
2577 sub char_decode {
2578     my ( $string, $encoding ) = @_;
2579     $_ = $string;
2580
2581     $encoding = C4::Context->preference("marcflavour") unless $encoding;
2582     if ( $encoding eq "UNIMARC" ) {
2583
2584         #         s/\xe1/Æ/gm;
2585         s/\xe2/Ğ/gm;
2586         s/\xe9/Ø/gm;
2587         s/\xec/ş/gm;
2588         s/\xf1/æ/gm;
2589         s/\xf3/ğ/gm;
2590         s/\xf9/ø/gm;
2591         s/\xfb/ß/gm;
2592         s/\xc1\x61/à/gm;
2593         s/\xc1\x65/è/gm;
2594         s/\xc1\x69/ì/gm;
2595         s/\xc1\x6f/ò/gm;
2596         s/\xc1\x75/ù/gm;
2597         s/\xc1\x41/À/gm;
2598         s/\xc1\x45/È/gm;
2599         s/\xc1\x49/Ì/gm;
2600         s/\xc1\x4f/Ò/gm;
2601         s/\xc1\x55/Ù/gm;
2602         s/\xc2\x41/Á/gm;
2603         s/\xc2\x45/É/gm;
2604         s/\xc2\x49/Í/gm;
2605         s/\xc2\x4f/Ó/gm;
2606         s/\xc2\x55/Ú/gm;
2607         s/\xc2\x59/İ/gm;
2608         s/\xc2\x61/á/gm;
2609         s/\xc2\x65/é/gm;
2610         s/\xc2\x69/í/gm;
2611         s/\xc2\x6f/ó/gm;
2612         s/\xc2\x75/ú/gm;
2613         s/\xc2\x79/ı/gm;
2614         s/\xc3\x41/Â/gm;
2615         s/\xc3\x45/Ê/gm;
2616         s/\xc3\x49/Î/gm;
2617         s/\xc3\x4f/Ô/gm;
2618         s/\xc3\x55/Û/gm;
2619         s/\xc3\x61/â/gm;
2620         s/\xc3\x65/ê/gm;
2621         s/\xc3\x69/î/gm;
2622         s/\xc3\x6f/ô/gm;
2623         s/\xc3\x75/û/gm;
2624         s/\xc4\x41/Ã/gm;
2625         s/\xc4\x4e/Ñ/gm;
2626         s/\xc4\x4f/Õ/gm;
2627         s/\xc4\x61/ã/gm;
2628         s/\xc4\x6e/ñ/gm;
2629         s/\xc4\x6f/õ/gm;
2630         s/\xc8\x41/Ä/gm;
2631         s/\xc8\x45/Ë/gm;
2632         s/\xc8\x49/Ï/gm;
2633         s/\xc8\x61/ä/gm;
2634         s/\xc8\x65/ë/gm;
2635         s/\xc8\x69/ï/gm;
2636         s/\xc8\x6F/ö/gm;
2637         s/\xc8\x75/ü/gm;
2638         s/\xc8\x76/ÿ/gm;
2639         s/\xc9\x41/Ä/gm;
2640         s/\xc9\x45/Ë/gm;
2641         s/\xc9\x49/Ï/gm;
2642         s/\xc9\x4f/Ö/gm;
2643         s/\xc9\x55/Ü/gm;
2644         s/\xc9\x61/ä/gm;
2645         s/\xc9\x6f/ö/gm;
2646         s/\xc9\x75/ü/gm;
2647         s/\xca\x41/Å/gm;
2648         s/\xca\x61/å/gm;
2649         s/\xd0\x43/Ç/gm;
2650         s/\xd0\x63/ç/gm;
2651
2652         # this handles non-sorting blocks (if implementation requires this)
2653         $string = nsb_clean($_);
2654     }
2655     elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2656         ##MARC-8 to UTF-8
2657
2658         s/\xe1\x61/à/gm;
2659         s/\xe1\x65/è/gm;
2660         s/\xe1\x69/ì/gm;
2661         s/\xe1\x6f/ò/gm;
2662         s/\xe1\x75/ù/gm;
2663         s/\xe1\x41/À/gm;
2664         s/\xe1\x45/È/gm;
2665         s/\xe1\x49/Ì/gm;
2666         s/\xe1\x4f/Ò/gm;
2667         s/\xe1\x55/Ù/gm;
2668         s/\xe2\x41/Á/gm;
2669         s/\xe2\x45/É/gm;
2670         s/\xe2\x49/Í/gm;
2671         s/\xe2\x4f/Ó/gm;
2672         s/\xe2\x55/Ú/gm;
2673         s/\xe2\x59/İ/gm;
2674         s/\xe2\x61/á/gm;
2675         s/\xe2\x65/é/gm;
2676         s/\xe2\x69/í/gm;
2677         s/\xe2\x6f/ó/gm;
2678         s/\xe2\x75/ú/gm;
2679         s/\xe2\x79/ı/gm;
2680         s/\xe3\x41/Â/gm;
2681         s/\xe3\x45/Ê/gm;
2682         s/\xe3\x49/Î/gm;
2683         s/\xe3\x4f/Ô/gm;
2684         s/\xe3\x55/Û/gm;
2685         s/\xe3\x61/â/gm;
2686         s/\xe3\x65/ê/gm;
2687         s/\xe3\x69/î/gm;
2688         s/\xe3\x6f/ô/gm;
2689         s/\xe3\x75/û/gm;
2690         s/\xe4\x41/Ã/gm;
2691         s/\xe4\x4e/Ñ/gm;
2692         s/\xe4\x4f/Õ/gm;
2693         s/\xe4\x61/ã/gm;
2694         s/\xe4\x6e/ñ/gm;
2695         s/\xe4\x6f/õ/gm;
2696         s/\xe6\x41/Ă/gm;
2697         s/\xe6\x45/Ĕ/gm;
2698         s/\xe6\x65/ĕ/gm;
2699         s/\xe6\x61/ă/gm;
2700         s/\xe8\x45/Ë/gm;
2701         s/\xe8\x49/Ï/gm;
2702         s/\xe8\x65/ë/gm;
2703         s/\xe8\x69/ï/gm;
2704         s/\xe8\x76/ÿ/gm;
2705         s/\xe9\x41/A/gm;
2706         s/\xe9\x4f/O/gm;
2707         s/\xe9\x55/U/gm;
2708         s/\xe9\x61/a/gm;
2709         s/\xe9\x6f/o/gm;
2710         s/\xe9\x75/u/gm;
2711         s/\xea\x41/A/gm;
2712         s/\xea\x61/a/gm;
2713
2714         #Additional Turkish characters
2715         s/\x1b//gm;
2716         s/\x1e//gm;
2717         s/(\xf0)s/\xc5\x9f/gm;
2718         s/(\xf0)S/\xc5\x9e/gm;
2719         s/(\xf0)c/ç/gm;
2720         s/(\xf0)C/Ç/gm;
2721         s/\xe7\x49/\\xc4\xb0/gm;
2722         s/(\xe6)G/\xc4\x9e/gm;
2723         s/(\xe6)g/ğ\xc4\x9f/gm;
2724         s/\xB8/ı/gm;
2725         s/\xB9/£/gm;
2726         s/(\xe8|\xc8)o/ö/gm;
2727         s/(\xe8|\xc8)O/Ö/gm;
2728         s/(\xe8|\xc8)u/ü/gm;
2729         s/(\xe8|\xc8)U/Ü/gm;
2730         s/\xc2\xb8/\xc4\xb1/gm;
2731         s/¸/\xc4\xb1/gm;
2732
2733         # this handles non-sorting blocks (if implementation requires this)
2734         $string = nsb_clean($_);
2735     }
2736     return ($string);
2737 }
2738
2739 =head2 nsb_clean
2740
2741 =over 4
2742
2743 my $string = nsb_clean( $string, $encoding );
2744
2745 =back
2746
2747 =cut
2748
2749 sub nsb_clean {
2750     my $NSB      = '\x88';    # NSB : begin Non Sorting Block
2751     my $NSE      = '\x89';    # NSE : Non Sorting Block end
2752                               # handles non sorting blocks
2753     my ($string) = @_;
2754     $_ = $string;
2755     s/$NSB/(/gm;
2756     s/[ ]{0,1}$NSE/) /gm;
2757     $string = $_;
2758     return ($string);
2759 }
2760
2761 =head2 PrepareItemrecordDisplay
2762
2763 =over 4
2764
2765 PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber);
2766
2767 Returns a hash with all the fields for Display a given item data in a template
2768
2769 =back
2770
2771 =cut
2772
2773 sub PrepareItemrecordDisplay {
2774
2775     my ( $bibnum, $itemnum ) = @_;
2776
2777     my $dbh = C4::Context->dbh;
2778     my $frameworkcode = &GetFrameworkCode( $bibnum );
2779     my ( $itemtagfield, $itemtagsubfield ) =
2780       &GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2781     my $tagslib = &GetMarcStructure( 1, $frameworkcode );
2782     my $itemrecord = GetMarcItem( $bibnum, $itemnum) if ($itemnum);
2783     my @loop_data;
2784     my $authorised_values_sth =
2785       $dbh->prepare(
2786 "SELECT authorised_value,lib FROM authorised_values WHERE category=? ORDER BY lib"
2787       );
2788     foreach my $tag ( sort keys %{$tagslib} ) {
2789         my $previous_tag = '';
2790         if ( $tag ne '' ) {
2791             # loop through each subfield
2792             my $cntsubf;
2793             foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
2794                 next if ( subfield_is_koha_internal_p($subfield) );
2795                 next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
2796                 my %subfield_data;
2797                 $subfield_data{tag}           = $tag;
2798                 $subfield_data{subfield}      = $subfield;
2799                 $subfield_data{countsubfield} = $cntsubf++;
2800                 $subfield_data{kohafield}     =
2801                   $tagslib->{$tag}->{$subfield}->{'kohafield'};
2802
2803          #        $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
2804                 $subfield_data{marc_lib} =
2805                     "<span id=\"error\" title=\""
2806                   . $tagslib->{$tag}->{$subfield}->{lib} . "\">"
2807                   . substr( $tagslib->{$tag}->{$subfield}->{lib}, 0, 12 )
2808                   . "</span>";
2809                 $subfield_data{mandatory} =
2810                   $tagslib->{$tag}->{$subfield}->{mandatory};
2811                 $subfield_data{repeatable} =
2812                   $tagslib->{$tag}->{$subfield}->{repeatable};
2813                 $subfield_data{hidden} = "display:none"
2814                   if $tagslib->{$tag}->{$subfield}->{hidden};
2815                 my ( $x, $value );
2816                 ( $x, $value ) = _find_value( $tag, $subfield, $itemrecord )
2817                   if ($itemrecord);
2818                 $value =~ s/"/&quot;/g;
2819
2820                 # search for itemcallnumber if applicable
2821                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
2822                     'items.itemcallnumber'
2823                     && C4::Context->preference('itemcallnumber') )
2824                 {
2825                     my $CNtag =
2826                       substr( C4::Context->preference('itemcallnumber'), 0, 3 );
2827                     my $CNsubfield =
2828                       substr( C4::Context->preference('itemcallnumber'), 3, 1 );
2829                     my $temp = $itemrecord->field($CNtag) if ($itemrecord);
2830                     if ($temp) {
2831                         $value = $temp->subfield($CNsubfield);
2832                     }
2833                 }
2834                 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
2835                     my @authorised_values;
2836                     my %authorised_lib;
2837
2838                     # builds list, depending on authorised value...
2839                     #---- branch
2840                     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq
2841                         "branches" )
2842                     {
2843                         if ( ( C4::Context->preference("IndependantBranches") )
2844                             && ( C4::Context->userenv->{flags} != 1 ) )
2845                         {
2846                             my $sth =
2847                               $dbh->prepare(
2848                                                                 "SELECT branchcode,branchname FROM branches WHERE branchcode = ? ORDER BY branchname"
2849                               );
2850                             $sth->execute( C4::Context->userenv->{branch} );
2851                             push @authorised_values, ""
2852                               unless (
2853                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
2854                             while ( my ( $branchcode, $branchname ) =
2855                                 $sth->fetchrow_array )
2856                             {
2857                                 push @authorised_values, $branchcode;
2858                                 $authorised_lib{$branchcode} = $branchname;
2859                             }
2860                         }
2861                         else {
2862                             my $sth =
2863                               $dbh->prepare(
2864                                                                 "SELECT branchcode,branchname FROM branches ORDER BY branchname"
2865                               );
2866                             $sth->execute;
2867                             push @authorised_values, ""
2868                               unless (
2869                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
2870                             while ( my ( $branchcode, $branchname ) =
2871                                 $sth->fetchrow_array )
2872                             {
2873                                 push @authorised_values, $branchcode;
2874                                 $authorised_lib{$branchcode} = $branchname;
2875                             }
2876                         }
2877
2878                         #----- itemtypes
2879                     }
2880                     elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq
2881                         "itemtypes" )
2882                     {
2883                         my $sth =
2884                           $dbh->prepare(
2885                                                         "SELECT itemtype,description FROM itemtypes ORDER BY description"
2886                           );
2887                         $sth->execute;
2888                         push @authorised_values, ""
2889                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2890                         while ( my ( $itemtype, $description ) =
2891                             $sth->fetchrow_array )
2892                         {
2893                             push @authorised_values, $itemtype;
2894                             $authorised_lib{$itemtype} = $description;
2895                         }
2896
2897                         #---- "true" authorised value
2898                     }
2899                     else {
2900                         $authorised_values_sth->execute(
2901                             $tagslib->{$tag}->{$subfield}->{authorised_value} );
2902                         push @authorised_values, ""
2903                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2904                         while ( my ( $value, $lib ) =
2905                             $authorised_values_sth->fetchrow_array )
2906                         {
2907                             push @authorised_values, $value;
2908                             $authorised_lib{$value} = $lib;
2909                         }
2910                     }
2911                     $subfield_data{marc_value} = CGI::scrolling_list(
2912                         -name     => 'field_value',
2913                         -values   => \@authorised_values,
2914                         -default  => "$value",
2915                         -labels   => \%authorised_lib,
2916                         -size     => 1,
2917                         -tabindex => '',
2918                         -multiple => 0,
2919                     );
2920                 }
2921                 elsif ( $tagslib->{$tag}->{$subfield}->{thesaurus_category} ) {
2922                     $subfield_data{marc_value} =
2923 "<input type=\"text\" name=\"field_value\"  size=47 maxlength=255> <a href=\"javascript:Dopop('cataloguing/thesaurus_popup.pl?category=$tagslib->{$tag}->{$subfield}->{thesaurus_category}&index=',)\">...</a>";
2924
2925 #"
2926 # COMMENTED OUT because No $i is provided with this API.
2927 # And thus, no value_builder can be activated.
2928 # BUT could be thought over.
2929 #         } elsif ($tagslib->{$tag}->{$subfield}->{'value_builder'}) {
2930 #             my $plugin="value_builder/".$tagslib->{$tag}->{$subfield}->{'value_builder'};
2931 #             require $plugin;
2932 #             my $extended_param = plugin_parameters($dbh,$itemrecord,$tagslib,$i,0);
2933 #             my ($function_name,$javascript) = plugin_javascript($dbh,$record,$tagslib,$i,0);
2934 #             $subfield_data{marc_value}="<input type=\"text\" value=\"$value\" name=\"field_value\"  size=47 maxlength=255 DISABLE READONLY OnFocus=\"javascript:Focus$function_name()\" OnBlur=\"javascript:Blur$function_name()\"> <a href=\"javascript:Clic$function_name()\">...</a> $javascript";
2935                 }
2936                 else {
2937                     $subfield_data{marc_value} =
2938 "<input type=\"text\" name=\"field_value\" value=\"$value\" size=50 maxlength=255>";
2939                 }
2940                 push( @loop_data, \%subfield_data );
2941             }
2942         }
2943     }
2944     my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
2945       if ( $itemrecord && $itemrecord->field($itemtagfield) );
2946     return {
2947         'itemtagfield'    => $itemtagfield,
2948         'itemtagsubfield' => $itemtagsubfield,
2949         'itemnumber'      => $itemnumber,
2950         'iteminformation' => \@loop_data
2951     };
2952 }
2953 #"
2954
2955 #
2956 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2957 # at the same time
2958 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2959 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2960 # =head2 ModZebrafiles
2961 #
2962 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2963 #
2964 # =cut
2965 #
2966 # sub ModZebrafiles {
2967 #
2968 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2969 #
2970 #     my $op;
2971 #     my $zebradir =
2972 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2973 #     unless ( opendir( DIR, "$zebradir" ) ) {
2974 #         warn "$zebradir not found";
2975 #         return;
2976 #     }
2977 #     closedir DIR;
2978 #     my $filename = $zebradir . $biblionumber;
2979 #
2980 #     if ($record) {
2981 #         open( OUTPUT, ">", $filename . ".xml" );
2982 #         print OUTPUT $record;
2983 #         close OUTPUT;
2984 #     }
2985 # }
2986
2987 =head2 ModZebra
2988
2989 =over 4
2990
2991 ModZebra( $biblionumber, $op, $server, $newRecord );
2992
2993     $biblionumber is the biblionumber we want to index
2994     $op is specialUpdate or delete, and is used to know what we want to do
2995     $server is the server that we want to update
2996     $newRecord is the MARC::Record containing the new record. It is usefull only when NoZebra=1, and is used to know what to add to the nozebra database. (the record in mySQL being, if it exist, the previous record, the one just before the modif. We need both : the previous and the new one.
2997
2998 =back
2999
3000 =cut
3001
3002 sub ModZebra {
3003 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
3004     my ( $biblionumber, $op, $server, $newRecord ) = @_;
3005     my $dbh=C4::Context->dbh;
3006
3007     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
3008     # at the same time
3009     # replaced by a zebraqueue table, that is filled with ModZebra to run.
3010     # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
3011
3012     if (C4::Context->preference("NoZebra")) {
3013         # lock the nozebra table : we will read index lines, update them in Perl process
3014         # and write everything in 1 transaction.
3015         # lock the table to avoid someone else overwriting what we are doing
3016         $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE');
3017         my %result; # the result hash that will be builded by deletion / add, and written on mySQL at the end, to improve speed
3018         my $record;
3019         if ($server eq 'biblioserver') {
3020             $record= GetMarcBiblio($biblionumber);
3021         } else {
3022             $record= C4::AuthoritiesMarc::GetAuthority($biblionumber);
3023         }
3024         if ($op eq 'specialUpdate') {
3025             # OK, we have to add or update the record
3026             # 1st delete (virtually, in indexes) ...
3027             %result = _DelBiblioNoZebra($biblionumber,$record,$server);
3028             # ... add the record
3029             %result=_AddBiblioNoZebra($biblionumber,$newRecord, $server, %result);
3030         } else {
3031             # it's a deletion, delete the record...
3032             # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
3033             %result=_DelBiblioNoZebra($biblionumber,$record,$server);
3034         }
3035         # ok, now update the database...
3036         my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
3037         foreach my $key (keys %result) {
3038             foreach my $index (keys %{$result{$key}}) {
3039                 $sth->execute($result{$key}->{$index}, $server, $key, $index);
3040             }
3041         }
3042         $dbh->do('UNLOCK TABLES');
3043
3044     } else {
3045         #
3046         # we use zebra, just fill zebraqueue table
3047         #
3048         my $sth=$dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
3049         $sth->execute($biblionumber,$server,$op);
3050         $sth->finish;
3051     }
3052 }
3053
3054 =head2 GetNoZebraIndexes
3055
3056     %indexes = GetNoZebraIndexes;
3057
3058     return the data from NoZebraIndexes syspref.
3059
3060 =cut
3061
3062 sub GetNoZebraIndexes {
3063     my $index = C4::Context->preference('NoZebraIndexes');
3064     my %indexes;
3065     foreach my $line (split /('|"),/,$index) {
3066         $line =~ /(.*)=>(.*)/;
3067         my $index = substr($1,1); # get the index, don't forget to remove initial ' or "
3068         my $fields = $2;
3069         $index =~ s/'|"| //g;
3070         $fields =~ s/'|"| //g;
3071         $indexes{$index}=$fields;
3072     }
3073     return %indexes;
3074 }
3075
3076 =head1 INTERNAL FUNCTIONS
3077
3078 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
3079
3080     function to delete a biblio in NoZebra indexes
3081     This function does NOT delete anything in database : it reads all the indexes entries
3082     that have to be deleted & delete them in the hash
3083     The SQL part is done either :
3084     - after the Add if we are modifying a biblio (delete + add again)
3085     - immediatly after this sub if we are doing a true deletion.
3086     $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
3087
3088 =cut
3089
3090
3091 sub _DelBiblioNoZebra {
3092     my ($biblionumber, $record, $server)=@_;
3093
3094     # Get the indexes
3095     my $dbh = C4::Context->dbh;
3096     # Get the indexes
3097     my %index;
3098     my $title;
3099     if ($server eq 'biblioserver') {
3100         %index=GetNoZebraIndexes;
3101         # get title of the record (to store the 10 first letters with the index)
3102         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
3103         $title = lc($record->subfield($titletag,$titlesubfield));
3104     } else {
3105         # for authorities, the "title" is the $a mainentry
3106         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
3107         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
3108         $title = $record->subfield($authref->{auth_tag_to_report},'a');
3109         $index{'mainmainentry'}= $authref->{'auth_tag_to_report'}.'a';
3110         $index{'mainentry'}    = $authref->{'auth_tag_to_report'}.'*';
3111         $index{'auth_type'}    = '152b';
3112     }
3113
3114     my %result;
3115     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3116     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
3117     # limit to 10 char, should be enough, and limit the DB size
3118     $title = substr($title,0,10);
3119     #parse each field
3120     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3121     foreach my $field ($record->fields()) {
3122         #parse each subfield
3123         next if $field->tag <10;
3124         foreach my $subfield ($field->subfields()) {
3125             my $tag = $field->tag();
3126             my $subfieldcode = $subfield->[0];
3127             my $indexed=0;
3128             # check each index to see if the subfield is stored somewhere
3129             # otherwise, store it in __RAW__ index
3130             foreach my $key (keys %index) {
3131 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3132                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
3133                     $indexed=1;
3134                     my $line= lc $subfield->[1];
3135                     # remove meaningless value in the field...
3136                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3137                     # ... and split in words
3138                     foreach (split / /,$line) {
3139                         next unless $_; # skip  empty values (multiple spaces)
3140                         # if the entry is already here, do nothing, the biblionumber has already be removed
3141                         unless ($result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) {
3142                             # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
3143                             $sth2->execute($server,$key,$_);
3144                             my $existing_biblionumbers = $sth2->fetchrow;
3145                             # it exists
3146                             if ($existing_biblionumbers) {
3147 #                                 warn " existing for $key $_: $existing_biblionumbers";
3148                                 $result{$key}->{$_} =$existing_biblionumbers;
3149                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3150                             }
3151                         }
3152                     }
3153                 }
3154             }
3155             # the subfield is not indexed, store it in __RAW__ index anyway
3156             unless ($indexed) {
3157                 my $line= lc $subfield->[1];
3158                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3159                 # ... and split in words
3160                 foreach (split / /,$line) {
3161                     next unless $_; # skip  empty values (multiple spaces)
3162                     # if the entry is already here, do nothing, the biblionumber has already be removed
3163                     unless ($result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/) {
3164                         # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
3165                         $sth2->execute($server,'__RAW__',$_);
3166                         my $existing_biblionumbers = $sth2->fetchrow;
3167                         # it exists
3168                         if ($existing_biblionumbers) {
3169                             $result{'__RAW__'}->{$_} =$existing_biblionumbers;
3170                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3171                         }
3172                     }
3173                 }
3174             }
3175         }
3176     }
3177     return %result;
3178 }
3179
3180 =head2 _AddBiblioNoZebra($biblionumber, $record, $server, %result);
3181
3182     function to add a biblio in NoZebra indexes
3183
3184 =cut
3185
3186 sub _AddBiblioNoZebra {
3187     my ($biblionumber, $record, $server, %result)=@_;
3188     my $dbh = C4::Context->dbh;
3189     # Get the indexes
3190     my %index;
3191     my $title;
3192     if ($server eq 'biblioserver') {
3193         %index=GetNoZebraIndexes;
3194         # get title of the record (to store the 10 first letters with the index)
3195         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
3196         $title = lc($record->subfield($titletag,$titlesubfield));
3197     } else {
3198         # warn "server : $server";
3199         # for authorities, the "title" is the $a mainentry
3200         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
3201         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
3202         $title = $record->subfield($authref->{auth_tag_to_report},'a');
3203         $index{'mainmainentry'} = $authref->{auth_tag_to_report}.'a';
3204         $index{'mainentry'}     = $authref->{auth_tag_to_report}.'*';
3205         $index{'auth_type'}     = '152b';
3206     }
3207
3208     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3209     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
3210     # limit to 10 char, should be enough, and limit the DB size
3211     $title = substr($title,0,10);
3212     #parse each field
3213     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3214     foreach my $field ($record->fields()) {
3215         #parse each subfield
3216         next if $field->tag <10;
3217         foreach my $subfield ($field->subfields()) {
3218             my $tag = $field->tag();
3219             my $subfieldcode = $subfield->[0];
3220             my $indexed=0;
3221             # check each index to see if the subfield is stored somewhere
3222             # otherwise, store it in __RAW__ index
3223             foreach my $key (keys %index) {
3224 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3225                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
3226                     $indexed=1;
3227                     my $line= lc $subfield->[1];
3228                     # remove meaningless value in the field...
3229                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3230                     # ... and split in words
3231                     foreach (split / /,$line) {
3232                         next unless $_; # skip  empty values (multiple spaces)
3233                         # if the entry is already here, improve weight
3234 #                         warn "managing $_";
3235                         if ($result{$key}->{"$_"} =~ /$biblionumber,$title\-(\d);/) {
3236                             my $weight=$1+1;
3237                             $result{$key}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3238                             $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3239                         } else {
3240                             # get the value if it exist in the nozebra table, otherwise, create it
3241                             $sth2->execute($server,$key,$_);
3242                             my $existing_biblionumbers = $sth2->fetchrow;
3243                             # it exists
3244                             if ($existing_biblionumbers) {
3245                                 $result{$key}->{"$_"} =$existing_biblionumbers;
3246                                 my $weight=$1+1;
3247                                 $result{$key}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3248                                 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3249                             # create a new ligne for this entry
3250                             } else {
3251 #                             warn "INSERT : $server / $key / $_";
3252                                 $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).', indexname='.$dbh->quote($key).',value='.$dbh->quote($_));
3253                                 $result{$key}->{"$_"}.="$biblionumber,$title-1;";
3254                             }
3255                         }
3256                     }
3257                 }
3258             }
3259             # the subfield is not indexed, store it in __RAW__ index anyway
3260             unless ($indexed) {
3261                 my $line= lc $subfield->[1];
3262                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3263                 # ... and split in words
3264                 foreach (split / /,$line) {
3265                     next unless $_; # skip  empty values (multiple spaces)
3266                     # if the entry is already here, improve weight
3267                     if ($result{'__RAW__'}->{"$_"} =~ /$biblionumber,$title\-(\d);/) {
3268                         my $weight=$1+1;
3269                         $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3270                         $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3271                     } else {
3272                         # get the value if it exist in the nozebra table, otherwise, create it
3273                         $sth2->execute($server,'__RAW__',$_);
3274                         my $existing_biblionumbers = $sth2->fetchrow;
3275                         # it exists
3276                         if ($existing_biblionumbers) {
3277                             $result{'__RAW__'}->{"$_"} =$existing_biblionumbers;
3278                             my $weight=$1+1;
3279                             $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3280                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3281                         # create a new ligne for this entry
3282                         } else {
3283                             $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).',  indexname="__RAW__",value='.$dbh->quote($_));
3284                             $result{'__RAW__'}->{"$_"}.="$biblionumber,$title-1;";
3285                         }
3286                     }
3287                 }
3288             }
3289         }
3290     }
3291     return %result;
3292 }
3293
3294
3295 =head2 MARCitemchange
3296
3297 =over 4
3298
3299 &MARCitemchange( $record, $itemfield, $newvalue )
3300
3301 Function to update a single value in an item field.
3302 Used twice, could probably be replaced by something else, but works well...
3303
3304 =back
3305
3306 =back
3307
3308 =cut
3309
3310 sub MARCitemchange {
3311     my ( $record, $itemfield, $newvalue ) = @_;
3312     my $dbh = C4::Context->dbh;
3313
3314     my ( $tagfield, $tagsubfield ) =
3315       GetMarcFromKohaField( $itemfield, "" );
3316     if ( ($tagfield) && ($tagsubfield) ) {
3317         my $tag = $record->field($tagfield);
3318         if ($tag) {
3319             $tag->update( $tagsubfield => $newvalue );
3320             $record->delete_field($tag);
3321             $record->insert_fields_ordered($tag);
3322         }
3323     }
3324 }
3325 =head2 _find_value
3326
3327 =over 4
3328
3329 ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
3330
3331 Find the given $subfield in the given $tag in the given
3332 MARC::Record $record.  If the subfield is found, returns
3333 the (indicators, value) pair; otherwise, (undef, undef) is
3334 returned.
3335
3336 PROPOSITION :
3337 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
3338 I suggest we export it from this module.
3339
3340 =back
3341
3342 =cut
3343
3344 sub _find_value {
3345     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
3346     my @result;
3347     my $indicator;
3348     if ( $tagfield < 10 ) {
3349         if ( $record->field($tagfield) ) {
3350             push @result, $record->field($tagfield)->data();
3351         }
3352         else {
3353             push @result, "";
3354         }
3355     }
3356     else {
3357         foreach my $field ( $record->field($tagfield) ) {
3358             my @subfields = $field->subfields();
3359             foreach my $subfield (@subfields) {
3360                 if ( @$subfield[0] eq $insubfield ) {
3361                     push @result, @$subfield[1];
3362                     $indicator = $field->indicator(1) . $field->indicator(2);
3363                 }
3364             }
3365         }
3366     }
3367     return ( $indicator, @result );
3368 }
3369
3370 =head2 _koha_marc_update_bib_ids
3371
3372 =over 4
3373
3374 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
3375
3376 Internal function to add or update biblionumber and biblioitemnumber to
3377 the MARC XML.
3378
3379 =back
3380
3381 =cut
3382
3383 sub _koha_marc_update_bib_ids {
3384     my ($record, $frameworkcode, $biblionumber, $biblioitemnumber) = @_;
3385
3386     # we must add bibnum and bibitemnum in MARC::Record...
3387     # we build the new field with biblionumber and biblioitemnumber
3388     # we drop the original field
3389     # we add the new builded field.
3390     my ($biblio_tag, $biblio_subfield ) = GetMarcFromKohaField("biblio.biblionumber",$frameworkcode);
3391     my ($biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.biblioitemnumber",$frameworkcode);
3392
3393     if ($biblio_tag != $biblioitem_tag) {
3394         # biblionumber & biblioitemnumber are in different fields
3395
3396         # deal with biblionumber
3397         my ($new_field, $old_field);
3398         if ($biblio_tag < 10) {
3399             $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
3400         } else {
3401             $new_field =
3402               MARC::Field->new( $biblio_tag, '', '',
3403                 "$biblio_subfield" => $biblionumber );
3404         }
3405
3406         # drop old field and create new one...
3407         $old_field = $record->field($biblio_tag);
3408         $record->delete_field($old_field);
3409         $record->append_fields($new_field);
3410
3411         # deal with biblioitemnumber
3412         if ($biblioitem_tag < 10) {
3413             $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
3414         } else {
3415             $new_field =
3416               MARC::Field->new( $biblioitem_tag, '', '',
3417                 "$biblioitem_subfield" => $biblioitemnumber, );
3418         }
3419         # drop old field and create new one...
3420         $old_field = $record->field($biblioitem_tag);
3421         $record->delete_field($old_field);
3422         $record->insert_fields_ordered($new_field);
3423
3424     } else {
3425         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
3426         my $new_field = MARC::Field->new(
3427             $biblio_tag, '', '',
3428             "$biblio_subfield" => $biblionumber,
3429             "$biblioitem_subfield" => $biblioitemnumber
3430         );
3431
3432         # drop old field and create new one...
3433         my $old_field = $record->field($biblio_tag);
3434         $record->delete_field($old_field);
3435         $record->insert_fields_ordered($new_field);
3436     }
3437 }
3438
3439 =head2 _koha_add_biblio
3440
3441 =over 4
3442
3443 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3444
3445 Internal function to add a biblio ($biblio is a hash with the values)
3446
3447 =back
3448
3449 =cut
3450
3451 sub _koha_add_biblio {
3452     my ( $dbh, $biblio, $frameworkcode ) = @_;
3453
3454         my $error;
3455
3456         # get the next biblionumber
3457     my $sth = $dbh->prepare("SELECT MAX(biblionumber) FROM biblio");
3458     $sth->execute();
3459     my $data = $sth->fetchrow_arrayref();
3460     my $biblionumber = $$data[0] + 1;
3461         # set the series flag
3462     my $serial = 0;
3463     if ( $biblio->{'seriestitle'} ) { $serial = 1 };
3464
3465     $sth->finish();
3466         my $query =
3467         "INSERT INTO biblio
3468                 SET biblionumber  = ?,
3469                         frameworkcode = ?,
3470                         author = ?,
3471                         title = ?,
3472                         unititle =?,
3473                         notes = ?,
3474                         serial = ?,
3475                         seriestitle = ?,
3476                         copyrightdate = ?,
3477                         datecreated=NOW(),
3478                         abstract = ?
3479                 ";
3480     $sth = $dbh->prepare($query);
3481     $sth->execute(
3482         $biblionumber,
3483                 $frameworkcode,
3484         $biblio->{'author'},
3485         $biblio->{'title'},
3486                 $biblio->{'unititle'},
3487         $biblio->{'notes'},
3488                 $serial,
3489         $biblio->{'seriestitle'},
3490                 $biblio->{'copyrightdate'},
3491         $biblio->{'abstract'}
3492     );
3493
3494         if ( $dbh->errstr ) {
3495                 $error.="ERROR in _koha_add_biblio $query".$dbh->errstr;
3496         warn $error;
3497     }
3498
3499     $sth->finish();
3500         #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3501     return ($biblionumber,$error);
3502 }
3503
3504 =head2 _koha_modify_biblio
3505
3506 =over 4
3507
3508 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3509
3510 Internal function for updating the biblio table
3511
3512 =back
3513
3514 =cut
3515
3516 sub _koha_modify_biblio {
3517     my ( $dbh, $biblio, $frameworkcode ) = @_;
3518         my $error;
3519
3520     my $query = "
3521         UPDATE biblio
3522         SET    frameworkcode = ?,
3523                            author = ?,
3524                            title = ?,
3525                            unititle = ?,
3526                            notes = ?,
3527                            serial = ?,
3528                            seriestitle = ?,
3529                            copyrightdate = ?,
3530                abstract = ?
3531         WHERE  biblionumber = ?
3532                 "
3533         ;
3534     my $sth = $dbh->prepare($query);
3535
3536     $sth->execute(
3537                 $frameworkcode,
3538         $biblio->{'author'},
3539         $biblio->{'title'},
3540         $biblio->{'unititle'},
3541         $biblio->{'notes'},
3542         $biblio->{'serial'},
3543         $biblio->{'seriestitle'},
3544         $biblio->{'copyrightdate'},
3545                 $biblio->{'abstract'},
3546         $biblio->{'biblionumber'}
3547     ) if $biblio->{'biblionumber'};
3548
3549     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3550                 $error.="ERROR in _koha_modify_biblio $query".$dbh->errstr;
3551         warn $error;
3552     }
3553     return ( $biblio->{'biblionumber'},$error );
3554 }
3555
3556 =head2 _koha_modify_biblioitem_nonmarc
3557
3558 =over 4
3559
3560 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3561
3562 Updates biblioitems row except for marc and marcxml, which should be changed
3563 via ModBiblioMarc
3564
3565 =back
3566
3567 =cut
3568
3569 sub _koha_modify_biblioitem_nonmarc {
3570     my ( $dbh, $biblioitem ) = @_;
3571         my $error;
3572
3573         # re-calculate the cn_sort, it may have changed
3574         my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3575
3576         my $query =
3577         "UPDATE biblioitems
3578         SET biblionumber        = ?,
3579                 volume                  = ?,
3580                 number                  = ?,
3581         itemtype        = ?,
3582         isbn            = ?,
3583         issn            = ?,
3584                 publicationyear = ?,
3585         publishercode   = ?,
3586                 volumedate      = ?,
3587                 volumedesc      = ?,
3588                 collectiontitle = ?,
3589                 collectionissn  = ?,
3590                 collectionvolume= ?,
3591                 editionstatement= ?,
3592                 editionresponsibility = ?,
3593                 illus                   = ?,
3594                 pages                   = ?,
3595                 notes                   = ?,
3596                 size                    = ?,
3597                 place                   = ?,
3598                 lccn                    = ?,
3599                 url                     = ?,
3600         cn_source               = ?,
3601         cn_class        = ?,
3602         cn_item         = ?,
3603                 cn_suffix       = ?,
3604                 cn_sort         = ?,
3605                 totalissues     = ?
3606         where biblioitemnumber = ?
3607                 ";
3608         my $sth = $dbh->prepare($query);
3609         $sth->execute(
3610                 $biblioitem->{'biblionumber'},
3611                 $biblioitem->{'volume'},
3612                 $biblioitem->{'number'},
3613                 $biblioitem->{'itemtype'},
3614                 $biblioitem->{'isbn'},
3615                 $biblioitem->{'issn'},
3616                 $biblioitem->{'publicationyear'},
3617                 $biblioitem->{'publishercode'},
3618                 $biblioitem->{'volumedate'},
3619                 $biblioitem->{'volumedesc'},
3620                 $biblioitem->{'collectiontitle'},
3621                 $biblioitem->{'collectionissn'},
3622                 $biblioitem->{'collectionvolume'},
3623                 $biblioitem->{'editionstatement'},
3624                 $biblioitem->{'editionresponsibility'},
3625                 $biblioitem->{'illus'},
3626                 $biblioitem->{'pages'},
3627                 $biblioitem->{'bnotes'},
3628                 $biblioitem->{'size'},
3629                 $biblioitem->{'place'},
3630                 $biblioitem->{'lccn'},
3631                 $biblioitem->{'url'},
3632                 $biblioitem->{'biblioitems.cn_source'},
3633                 $biblioitem->{'cn_class'},
3634                 $biblioitem->{'cn_item'},
3635                 $biblioitem->{'cn_suffix'},
3636                 $cn_sort,
3637                 $biblioitem->{'totalissues'},
3638                 $biblioitem->{'biblioitemnumber'}
3639         );
3640     if ( $dbh->errstr ) {
3641                 $error.="ERROR in _koha_modify_biblioitem_nonmarc $query".$dbh->errstr;
3642         warn $error;
3643     }
3644         return ($biblioitem->{'biblioitemnumber'},$error);
3645 }
3646
3647 =head2 _koha_add_biblioitem
3648
3649 =over 4
3650
3651 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3652
3653 Internal function to add a biblioitem
3654
3655 =back
3656
3657 =cut
3658
3659 sub _koha_add_biblioitem {
3660     my ( $dbh, $biblioitem ) = @_;
3661         my $error;
3662     my $sth = $dbh->prepare("SELECT MAX(biblioitemnumber) FROM biblioitems");
3663     $sth->execute();
3664     my $data       = $sth->fetchrow_arrayref;
3665     my $bibitemnum = $$data[0] + 1;
3666     $sth->finish();
3667
3668         my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3669     my $query =
3670     "INSERT INTO biblioitems SET
3671                 biblioitemnumber = ?,
3672         biblionumber    = ?,
3673         volume          = ?,
3674         number          = ?,
3675         itemtype        = ?,
3676         isbn            = ?,
3677         issn            = ?,
3678         publicationyear = ?,
3679         publishercode   = ?,
3680         volumedate      = ?,
3681         volumedesc      = ?,
3682         collectiontitle = ?,
3683         collectionissn  = ?,
3684         collectionvolume= ?,
3685         editionstatement= ?,
3686         editionresponsibility = ?,
3687         illus           = ?,
3688         pages           = ?,
3689         notes           = ?,
3690         size            = ?,
3691         place           = ?,
3692         lccn            = ?,
3693         marc            = ?,
3694         url             = ?,
3695         cn_source       = ?,
3696         cn_class        = ?,
3697         cn_item         = ?,
3698         cn_suffix       = ?,
3699         cn_sort         = ?,
3700         totalissues     = ?
3701         ";
3702         $sth = $dbh->prepare($query);
3703     $sth->execute(
3704                 $bibitemnum,
3705         $biblioitem->{'biblionumber'},
3706         $biblioitem->{'volume'},
3707         $biblioitem->{'number'},
3708         $biblioitem->{'itemtype'},
3709         $biblioitem->{'isbn'},
3710         $biblioitem->{'issn'},
3711         $biblioitem->{'publicationyear'},
3712         $biblioitem->{'publishercode'},
3713         $biblioitem->{'volumedate'},
3714         $biblioitem->{'volumedesc'},
3715         $biblioitem->{'collectiontitle'},
3716         $biblioitem->{'collectionissn'},
3717         $biblioitem->{'collectionvolume'},
3718         $biblioitem->{'editionstatement'},
3719         $biblioitem->{'editionresponsibility'},
3720         $biblioitem->{'illus'},
3721         $biblioitem->{'pages'},
3722         $biblioitem->{'bnotes'},
3723         $biblioitem->{'size'},
3724         $biblioitem->{'place'},
3725         $biblioitem->{'lccn'},
3726         $biblioitem->{'marc'},
3727         $biblioitem->{'url'},
3728         $biblioitem->{'biblioitems.cn_source'},
3729         $biblioitem->{'cn_class'},
3730         $biblioitem->{'cn_item'},
3731         $biblioitem->{'cn_suffix'},
3732         $cn_sort,
3733         $biblioitem->{'totalissues'}
3734     );
3735     if ( $dbh->errstr ) {
3736                 $error.="ERROR in _koha_add_biblioitem $query".$dbh->errstr;
3737                 warn $error;
3738     }
3739     $sth->finish();
3740     return ($bibitemnum,$error);
3741 }
3742
3743 =head2 _koha_new_items
3744
3745 =over 4
3746
3747 my ($itemnumber,$error) = _koha_new_items( $dbh, $item, $barcode );
3748
3749 =back
3750
3751 =cut
3752
3753 sub _koha_new_items {
3754     my ( $dbh, $item, $barcode ) = @_;
3755         my $error;
3756
3757     my $sth = $dbh->prepare("SELECT MAX(itemnumber) FROM items");
3758     $sth->execute();
3759     my $data       = $sth->fetchrow_hashref;
3760     my $itemnumber = $data->{'MAX(itemnumber)'} + 1;
3761     $sth->finish;
3762
3763     my ($items_cn_sort) = GetClassSort($item->{'items.cn_source'}, $item->{'itemcallnumber'}, "");
3764
3765     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
3766     if ( $item->{'dateaccessioned'} eq '' || !$item->{'dateaccessioned'} ) {
3767                 my $today = C4::Dates->new();
3768                 $item->{'dateaccessioned'} =  $today->output("iso"); #TODO: check time issues
3769         }
3770         my $query =
3771            "INSERT INTO items SET
3772             itemnumber          = ?,
3773                         biblionumber            = ?,
3774             biblioitemnumber    = ?,
3775                         barcode                 = ?,
3776                         dateaccessioned         = ?,
3777                         booksellerid        = ?,
3778             homebranch          = ?,
3779             price               = ?,
3780                         replacementprice        = ?,
3781             replacementpricedate = NOW(),
3782                         datelastborrowed        = ?,
3783                         datelastseen            = NOW(),
3784                         stack                   = ?,
3785                         notforloan                      = ?,
3786                         damaged                         = ?,
3787             itemlost            = ?,
3788                         wthdrawn                = ?,
3789                         itemcallnumber          = ?,
3790                         restricted                      = ?,
3791                         itemnotes                       = ?,
3792                         holdingbranch           = ?,
3793             paidfor             = ?,
3794                         location                        = ?,
3795                         onloan                          = ?,
3796                         cn_source                       = ?,
3797                         cn_sort                         = ?,
3798                         ccode                           = ?,
3799                         materials                       = ?,
3800                         uri                             = ?
3801           ";
3802     $sth = $dbh->prepare($query);
3803         $sth->execute(
3804             $itemnumber,
3805                         $item->{'biblionumber'},
3806                         $item->{'biblioitemnumber'},
3807             $barcode,
3808                         $item->{'dateaccessioned'},
3809                         $item->{'booksellerid'},
3810             $item->{'homebranch'},
3811             $item->{'price'},
3812                         $item->{'replacementprice'},
3813                         $item->{datelastborrowed},
3814                         $item->{stack},
3815                         $item->{'notforloan'},
3816                         $item->{'damaged'},
3817             $item->{'itemlost'},
3818                         $item->{'wthdrawn'},
3819                         $item->{'itemcallnumber'},
3820             $item->{'restricted'},
3821                         $item->{'itemnotes'},
3822                         $item->{'holdingbranch'},
3823                         $item->{'paidfor'},
3824                         $item->{'location'},
3825                         $item->{'onloan'},
3826                         $item->{'items.cn_source'},
3827                         $items_cn_sort,
3828                         $item->{'ccode'},
3829                         $item->{'materials'},
3830                         $item->{'uri'},
3831     );
3832     if ( defined $sth->errstr ) {
3833         $error.="ERROR in _koha_new_items $query".$sth->errstr;
3834     }
3835         $sth->finish();
3836     return ( $itemnumber, $error );
3837 }
3838
3839 =head2 _koha_modify_item
3840
3841 =over 4
3842
3843 my ($itemnumber,$error) =_koha_modify_item( $dbh, $item, $op );
3844
3845 =back
3846
3847 =cut
3848
3849 sub _koha_modify_item {
3850     my ( $dbh, $item ) = @_;
3851         my $error;
3852
3853         # calculate items.cn_sort
3854     $item->{'cn_sort'} = GetClassSort($item->{'items.cn_source'}, $item->{'itemcallnumber'}, "");
3855
3856     my $query = "UPDATE items SET ";
3857         my @bind;
3858         for my $key ( keys %$item ) {
3859                 $query.="$key=?,";
3860                 push @bind, $item->{$key};
3861     }
3862         $query =~ s/,$//;
3863     $query .= " WHERE itemnumber=?";
3864     push @bind, $item->{'itemnumber'};
3865     my $sth = $dbh->prepare($query);
3866     $sth->execute(@bind);
3867     if ( $dbh->errstr ) {
3868         $error.="ERROR in _koha_modify_item $query".$dbh->errstr;
3869         warn $error;
3870     }
3871     $sth->finish();
3872         return ($item->{'itemnumber'},$error);
3873 }
3874
3875 =head2 _koha_delete_biblio
3876
3877 =over 4
3878
3879 $error = _koha_delete_biblio($dbh,$biblionumber);
3880
3881 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3882
3883 C<$dbh> - the database handle
3884 C<$biblionumber> - the biblionumber of the biblio to be deleted
3885
3886 =back
3887
3888 =cut
3889
3890 # FIXME: add error handling
3891
3892 sub _koha_delete_biblio {
3893     my ( $dbh, $biblionumber ) = @_;
3894
3895     # get all the data for this biblio
3896     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3897     $sth->execute($biblionumber);
3898
3899     if ( my $data = $sth->fetchrow_hashref ) {
3900
3901         # save the record in deletedbiblio
3902         # find the fields to save
3903         my $query = "INSERT INTO deletedbiblio SET ";
3904         my @bind  = ();
3905         foreach my $temp ( keys %$data ) {
3906             $query .= "$temp = ?,";
3907             push( @bind, $data->{$temp} );
3908         }
3909
3910         # replace the last , by ",?)"
3911         $query =~ s/\,$//;
3912         my $bkup_sth = $dbh->prepare($query);
3913         $bkup_sth->execute(@bind);
3914         $bkup_sth->finish;
3915
3916         # delete the biblio
3917         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3918         $del_sth->execute($biblionumber);
3919         $del_sth->finish;
3920     }
3921     $sth->finish;
3922     return undef;
3923 }
3924
3925 =head2 _koha_delete_biblioitems
3926
3927 =over 4
3928
3929 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3930
3931 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3932
3933 C<$dbh> - the database handle
3934 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3935
3936 =back
3937
3938 =cut
3939
3940 # FIXME: add error handling
3941
3942 sub _koha_delete_biblioitems {
3943     my ( $dbh, $biblioitemnumber ) = @_;
3944
3945     # get all the data for this biblioitem
3946     my $sth =
3947       $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3948     $sth->execute($biblioitemnumber);
3949
3950     if ( my $data = $sth->fetchrow_hashref ) {
3951
3952         # save the record in deletedbiblioitems
3953         # find the fields to save
3954         my $query = "INSERT INTO deletedbiblioitems SET ";
3955         my @bind  = ();
3956         foreach my $temp ( keys %$data ) {
3957             $query .= "$temp = ?,";
3958             push( @bind, $data->{$temp} );
3959         }
3960
3961         # replace the last , by ",?)"
3962         $query =~ s/\,$//;
3963         my $bkup_sth = $dbh->prepare($query);
3964         $bkup_sth->execute(@bind);
3965         $bkup_sth->finish;
3966
3967         # delete the biblioitem
3968         my $del_sth =
3969           $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3970         $del_sth->execute($biblioitemnumber);
3971         $del_sth->finish;
3972     }
3973     $sth->finish;
3974     return undef;
3975 }
3976
3977 =head2 _koha_delete_item
3978
3979 =over 4
3980
3981 _koha_delete_item( $dbh, $itemnum );
3982
3983 Internal function to delete an item record from the koha tables
3984
3985 =back
3986
3987 =cut
3988
3989 sub _koha_delete_item {
3990     my ( $dbh, $itemnum ) = @_;
3991
3992         # save the deleted item to deleteditems table
3993     my $sth = $dbh->prepare("SELECT * FROM items WHERE itemnumber=?");
3994     $sth->execute($itemnum);
3995     my $data = $sth->fetchrow_hashref();
3996     $sth->finish();
3997     my $query = "INSERT INTO deleteditems SET ";
3998     my @bind  = ();
3999     foreach my $key ( keys %$data ) {
4000         $query .= "$key = ?,";
4001         push( @bind, $data->{$key} );
4002     }
4003     $query =~ s/\,$//;
4004     $sth = $dbh->prepare($query);
4005     $sth->execute(@bind);
4006     $sth->finish();
4007
4008         # delete from items table
4009     $sth = $dbh->prepare("DELETE FROM items WHERE itemnumber=?");
4010     $sth->execute($itemnum);
4011     $sth->finish();
4012         return undef;
4013 }
4014
4015 =head1 UNEXPORTED FUNCTIONS
4016
4017 =head2 ModBiblioMarc
4018
4019     &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
4020
4021     Add MARC data for a biblio to koha
4022
4023     Function exported, but should NOT be used, unless you really know what you're doing
4024
4025 =cut
4026
4027 sub ModBiblioMarc {
4028
4029 # pass the MARC::Record to this function, and it will create the records in the marc field
4030     my ( $record, $biblionumber, $frameworkcode ) = @_;
4031     my $dbh = C4::Context->dbh;
4032     my @fields = $record->fields();
4033     if ( !$frameworkcode ) {
4034         $frameworkcode = "";
4035     }
4036     my $sth =
4037       $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
4038     $sth->execute( $frameworkcode, $biblionumber );
4039     $sth->finish;
4040     my $encoding = C4::Context->preference("marcflavour");
4041
4042     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
4043     if ( $encoding eq "UNIMARC" ) {
4044         my $string;
4045         if ( length($record->subfield( 100, "a" )) == 35 ) {
4046             $string = $record->subfield( 100, "a" );
4047             my $f100 = $record->field(100);
4048             $record->delete_field($f100);
4049         }
4050         else {
4051             $string = POSIX::strftime( "%Y%m%d", localtime );
4052             $string =~ s/\-//g;
4053             $string = sprintf( "%-*s", 35, $string );
4054         }
4055         substr( $string, 22, 6, "frey50" );
4056         unless ( $record->subfield( 100, "a" ) ) {
4057             $record->insert_grouped_field(
4058                 MARC::Field->new( 100, "", "", "a" => $string ) );
4059         }
4060     }
4061     ModZebra($biblionumber,"specialUpdate","biblioserver",$record);
4062     $sth =
4063       $dbh->prepare(
4064         "UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
4065     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding),
4066         $biblionumber );
4067     $sth->finish;
4068     return $biblionumber;
4069 }
4070
4071 =head2 AddItemInMarc
4072
4073 =over 4
4074
4075 $newbiblionumber = AddItemInMarc( $record, $biblionumber, $frameworkcode );
4076
4077 Add an item in a MARC record and save the MARC record
4078
4079 Function exported, but should NOT be used, unless you really know what you're doing
4080
4081 =back
4082
4083 =cut
4084
4085 sub AddItemInMarc {
4086
4087     # pass the MARC::Record to this function, and it will create the records in the marc tables
4088     my ( $record, $biblionumber, $frameworkcode ) = @_;
4089     my $newrec = &GetMarcBiblio($biblionumber);
4090
4091     # create it
4092     my @fields = $record->fields();
4093     foreach my $field (@fields) {
4094         $newrec->append_fields($field);
4095     }
4096
4097     # FIXME: should we be making sure the biblionumbers are the same?
4098     my $newbiblionumber =
4099       &ModBiblioMarc( $newrec, $biblionumber, $frameworkcode );
4100     return $newbiblionumber;
4101 }
4102
4103 =head2 z3950_extended_services
4104
4105 z3950_extended_services($serviceType,$serviceOptions,$record);
4106
4107     z3950_extended_services is used to handle all interactions with Zebra's extended serices package, which is employed to perform all management of the MARC data stored in Zebra.
4108
4109 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
4110
4111 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
4112
4113     action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
4114
4115 and maybe
4116
4117     recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
4118     syntax => the record syntax (transfer syntax)
4119     databaseName = Database from connection object
4120
4121     To set serviceOptions, call set_service_options($serviceType)
4122
4123 C<$record> the record, if one is needed for the service type
4124
4125     A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
4126
4127 =cut
4128
4129 sub z3950_extended_services {
4130     my ( $server, $serviceType, $action, $serviceOptions ) = @_;
4131
4132     # get our connection object
4133     my $Zconn = C4::Context->Zconn( $server, 0, 1 );
4134
4135     # create a new package object
4136     my $Zpackage = $Zconn->package();
4137
4138     # set our options
4139     $Zpackage->option( action => $action );
4140
4141     if ( $serviceOptions->{'databaseName'} ) {
4142         $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
4143     }
4144     if ( $serviceOptions->{'recordIdNumber'} ) {
4145         $Zpackage->option(
4146             recordIdNumber => $serviceOptions->{'recordIdNumber'} );
4147     }
4148     if ( $serviceOptions->{'recordIdOpaque'} ) {
4149         $Zpackage->option(
4150             recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
4151     }
4152
4153  # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
4154  #if ($serviceType eq 'itemorder') {
4155  #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
4156  #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
4157  #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
4158  #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
4159  #}
4160
4161     if ( $serviceOptions->{record} ) {
4162         $Zpackage->option( record => $serviceOptions->{record} );
4163
4164         # can be xml or marc
4165         if ( $serviceOptions->{'syntax'} ) {
4166             $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
4167         }
4168     }
4169
4170     # send the request, handle any exception encountered
4171     eval { $Zpackage->send($serviceType) };
4172     if ( $@ && $@->isa("ZOOM::Exception") ) {
4173         return "error:  " . $@->code() . " " . $@->message() . "\n";
4174     }
4175
4176     # free up package resources
4177     $Zpackage->destroy();
4178 }
4179
4180 =head2 set_service_options
4181
4182 my $serviceOptions = set_service_options($serviceType);
4183
4184 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
4185
4186 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
4187
4188 =cut
4189
4190 sub set_service_options {
4191     my ($serviceType) = @_;
4192     my $serviceOptions;
4193
4194 # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
4195 #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
4196
4197     if ( $serviceType eq 'commit' ) {
4198
4199         # nothing to do
4200     }
4201     if ( $serviceType eq 'create' ) {
4202
4203         # nothing to do
4204     }
4205     if ( $serviceType eq 'drop' ) {
4206         die "ERROR: 'drop' not currently supported (by Zebra)";
4207     }
4208     return $serviceOptions;
4209 }
4210
4211 =head2 GetItemsCount
4212
4213 $count = &GetItemsCount( $biblionumber);
4214 this function return count of item with $biblionumber
4215 =cut
4216
4217 sub GetItemsCount {
4218     my ( $biblionumber ) = @_;
4219     my $dbh = C4::Context->dbh;
4220     my $query = "SELECT count(*)
4221                   FROM  items
4222                   WHERE biblionumber=?";
4223     my $sth = $dbh->prepare($query);
4224     $sth->execute($biblionumber);
4225     my $count = $sth->fetchrow;
4226     $sth->finish;
4227     return ($count);
4228 }
4229
4230 END { }    # module clean-up code here (global destructor)
4231
4232 1;
4233
4234 __END__
4235
4236 =head1 AUTHOR
4237
4238 Koha Developement team <info@koha.org>
4239
4240 Paul POULAIN paul.poulain@free.fr
4241
4242 Joshua Ferraro jmf@liblime.com
4243
4244 =cut