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