koha-dev.rot13.org Git - koha_gimpoz/blob - C4/Biblio.pm

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