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

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