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           use utf8;
1459           utf8::decode($res->{$tag}->{lib});
1460 #           warn "$liblibrarian";
1461         $res->{$tab}->{tab}        = "";            # XXX
1462         $res->{$tag}->{mandatory}  = $mandatory;
1463         $res->{$tag}->{repeatable} = $repeatable;
1464     }
1465
1466     $sth =
1467       $dbh->prepare(
1468 "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"
1469       );
1470     $sth->execute($frameworkcode);
1471
1472     my $subfield;
1473     my $authorised_value;
1474     my $authtypecode;
1475     my $value_builder;
1476     my $kohafield;
1477     my $seealso;
1478     my $hidden;
1479     my $isurl;
1480     my $link;
1481     my $defaultvalue;
1482
1483     while (
1484         (
1485             $tag,          $subfield,      $liblibrarian,
1486             ,              $libopac,       $tab,
1487             $mandatory,    $repeatable,    $authorised_value,
1488             $authtypecode, $value_builder, $kohafield,
1489             $seealso,      $hidden,        $isurl,
1490             $link,$defaultvalue
1491         )
1492         = $sth->fetchrow
1493       )
1494     {
1495         $res->{$tag}->{$subfield}->{lib} =
1496           ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1497         $res->{$tag}->{$subfield}->{tab}              = $tab;
1498         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
1499         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
1500         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
1501         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
1502         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
1503         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
1504         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
1505         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
1506         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
1507         $res->{$tag}->{$subfield}->{link}             = $link;
1508         $res->{$tag}->{$subfield}->{defaultvalue}     = $defaultvalue;
1509     }
1510     return $res;
1511 }
1512
1513 =head2 GetMarcFromKohaField
1514
1515 =over 4
1516
1517 ($MARCfield,$MARCsubfield)=GetMarcFromKohaField($kohafield,$frameworkcode);
1518 Returns the MARC fields & subfields mapped to the koha field
1519 for the given frameworkcode
1520
1521 =back
1522
1523 =cut
1524
1525 sub GetMarcFromKohaField {
1526     my ( $kohafield, $frameworkcode ) = @_;
1527     return 0, 0 unless $kohafield;
1528     my $relations = C4::Context->marcfromkohafield;
1529     return (
1530         $relations->{$frameworkcode}->{$kohafield}->[0],
1531         $relations->{$frameworkcode}->{$kohafield}->[1]
1532     );
1533 }
1534
1535 =head2 GetMarcBiblio
1536
1537 =over 4
1538
1539 Returns MARC::Record of the biblionumber passed in parameter.
1540 the marc record contains both biblio & item datas
1541
1542 =back
1543
1544 =cut
1545
1546 sub GetMarcBiblio {
1547     my $biblionumber = shift;
1548     my $dbh          = C4::Context->dbh;
1549     my $sth          =
1550       $dbh->prepare("select marcxml from biblioitems where biblionumber=? ");
1551     $sth->execute($biblionumber);
1552     my ($marcxml) = $sth->fetchrow;
1553     MARC::File::XML->default_record_format(C4::Context->preference('marcflavour'));
1554     $marcxml =~ s/\x1e//g;
1555     $marcxml =~ s/\x1f//g;
1556     $marcxml =~ s/\x1d//g;
1557     $marcxml =~ s/\x0f//g;
1558     $marcxml =~ s/\x0c//g;
1559     my $record = MARC::Record->new();
1560     $record = MARC::Record::new_from_xml( $marcxml, "utf8",C4::Context->preference('marcflavour')) if $marcxml;
1561     return $record;
1562 }
1563
1564 =head2 GetXmlBiblio
1565
1566 =over 4
1567
1568 my $marcxml = GetXmlBiblio($biblionumber);
1569
1570 Returns biblioitems.marcxml of the biblionumber passed in parameter.
1571 The XML contains both biblio & item datas
1572
1573 =back
1574
1575 =cut
1576
1577 sub GetXmlBiblio {
1578     my ( $biblionumber ) = @_;
1579     my $dbh = C4::Context->dbh;
1580     my $sth =
1581       $dbh->prepare("select marcxml from biblioitems where biblionumber=? ");
1582     $sth->execute($biblionumber);
1583     my ($marcxml) = $sth->fetchrow;
1584     return $marcxml;
1585 }
1586
1587 =head2 GetAuthorisedValueDesc
1588
1589 =over 4
1590
1591 my $subfieldvalue =get_authorised_value_desc(
1592     $tag, $subf[$i][0],$subf[$i][1], '', $taglib);
1593 Retrieve the complete description for a given authorised value.
1594
1595 =back
1596
1597 =cut
1598
1599 sub GetAuthorisedValueDesc {
1600     my ( $tag, $subfield, $value, $framework, $tagslib ) = @_;
1601     my $dbh = C4::Context->dbh;
1602
1603     #---- branch
1604     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1605         return C4::Branch::GetBranchName($value);
1606     }
1607
1608     #---- itemtypes
1609     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1610         return getitemtypeinfo($value);
1611     }
1612
1613     #---- "true" authorized value
1614     my $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1615
1616     if ( $category ne "" ) {
1617         my $sth =
1618           $dbh->prepare(
1619             "select lib from authorised_values where category = ? and authorised_value = ?"
1620           );
1621         $sth->execute( $category, $value );
1622         my $data = $sth->fetchrow_hashref;
1623         return $data->{'lib'};
1624     }
1625     else {
1626         return $value;    # if nothing is found return the original value
1627     }
1628 }
1629
1630 =head2 GetMarcItem
1631
1632 =over 4
1633
1634 Returns MARC::Record of the item passed in parameter.
1635
1636 =back
1637
1638 =cut
1639
1640 sub GetMarcItem {
1641     my ( $biblionumber, $itemnumber ) = @_;
1642     my $dbh = C4::Context->dbh;
1643     my $newrecord = MARC::Record->new();
1644     my $marcflavour = C4::Context->preference('marcflavour');
1645
1646     my $marcxml = GetXmlBiblio($biblionumber);
1647     my $record = MARC::Record->new();
1648     $record = MARC::Record::new_from_xml( $marcxml, "utf8", $marcflavour );
1649     # now, find where the itemnumber is stored & extract only the item
1650     my ( $itemnumberfield, $itemnumbersubfield ) =
1651       GetMarcFromKohaField( 'items.itemnumber', '' );
1652     my @fields = $record->field($itemnumberfield);
1653     foreach my $field (@fields) {
1654         if ( $field->subfield($itemnumbersubfield) eq $itemnumber ) {
1655             $newrecord->insert_fields_ordered($field);
1656         }
1657     }
1658     return $newrecord;
1659 }
1660
1661
1662
1663 =head2 GetMarcNotes
1664
1665 =over 4
1666
1667 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1668 Get all notes from the MARC record and returns them in an array.
1669 The note are stored in differents places depending on MARC flavour
1670
1671 =back
1672
1673 =cut
1674
1675 sub GetMarcNotes {
1676     my ( $record, $marcflavour ) = @_;
1677     my $scope;
1678     if ( $marcflavour eq "MARC21" ) {
1679         $scope = '5..';
1680     }
1681     else {    # assume unimarc if not marc21
1682         $scope = '3..';
1683     }
1684     my @marcnotes;
1685     my $note = "";
1686     my $tag  = "";
1687     my $marcnote;
1688     foreach my $field ( $record->field($scope) ) {
1689         my $value = $field->as_string();
1690         if ( $note ne "" ) {
1691             $marcnote = { marcnote => $note, };
1692             push @marcnotes, $marcnote;
1693             $note = $value;
1694         }
1695         if ( $note ne $value ) {
1696             $note = $note . " " . $value;
1697         }
1698     }
1699
1700     if ( $note ) {
1701         $marcnote = { marcnote => $note };
1702         push @marcnotes, $marcnote;    #load last tag into array
1703     }
1704     return \@marcnotes;
1705 }    # end GetMarcNotes
1706
1707 =head2 GetMarcSubjects
1708
1709 =over 4
1710
1711 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1712 Get all subjects from the MARC record and returns them in an array.
1713 The subjects are stored in differents places depending on MARC flavour
1714
1715 =back
1716
1717 =cut
1718
1719 sub GetMarcSubjects {
1720     my ( $record, $marcflavour ) = @_;
1721     my ( $mintag, $maxtag );
1722     if ( $marcflavour eq "MARC21" ) {
1723         $mintag = "600";
1724         $maxtag = "699";
1725     }
1726     else {    # assume unimarc if not marc21
1727         $mintag = "600";
1728         $maxtag = "611";
1729     }
1730
1731     my @marcsubjcts;
1732
1733     foreach my $field ( $record->fields ) {
1734         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1735         my @subfields = $field->subfields();
1736         my $link;
1737         my $label = "su:";
1738         my $flag = 0;
1739         for my $subject_subfield ( @subfields ) {
1740             my $code = $subject_subfield->[0];
1741             $label .= $subject_subfield->[1] . " and su-to:" unless ( $code == 9 );
1742             if ( $code == 9 ) {
1743                 $link = "Koha-Auth-Number:".$subject_subfield->[1];
1744                 $flag = 1;
1745             }
1746             elsif ( ! $flag ) {
1747                 $link = $label;
1748                 $link =~ s/ and\ssu-to:$//;
1749             }
1750         }
1751         $label =~ s/su/ /g;
1752         $label =~ s/://g;
1753         $label =~ s/-to//g;
1754         $label =~ s/ and //g;
1755         push @marcsubjcts,
1756           {
1757             label => $label,
1758             link  => $link
1759           }
1760     }
1761     return \@marcsubjcts;
1762 }    #end GetMarcSubjects
1763
1764 =head2 GetMarcAuthors
1765
1766 =over 4
1767
1768 authors = GetMarcAuthors($record,$marcflavour);
1769 Get all authors from the MARC record and returns them in an array.
1770 The authors are stored in differents places depending on MARC flavour
1771
1772 =back
1773
1774 =cut
1775
1776 sub GetMarcAuthors {
1777     my ( $record, $marcflavour ) = @_;
1778     my ( $mintag, $maxtag );
1779     if ( $marcflavour eq "MARC21" ) {
1780         $mintag = "100";
1781         $maxtag = "111";
1782     }
1783     else {    # assume unimarc if not marc21
1784         $mintag = "701";
1785         $maxtag = "712";
1786     }
1787
1788     my @marcauthors;
1789
1790     foreach my $field ( $record->fields ) {
1791         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1792         my %hash;
1793         my @subfields = $field->subfields();
1794         my $count_auth = 0;
1795         my $and ;
1796         for my $authors_subfield (@subfields) {
1797                 if ($count_auth ne '0'){
1798                 $and = " and au:";
1799                 }
1800             $count_auth++;
1801             my $subfieldcode     = $authors_subfield->[0];
1802             my $value            = $authors_subfield->[1];
1803             $hash{'tag'}         = $field->tag;
1804             $hash{value}        .= $value . " " if ($subfieldcode != 9) ;
1805             $hash{link}        .= $value if ($subfieldcode eq 9);
1806         }
1807         push @marcauthors, \%hash;
1808     }
1809     return \@marcauthors;
1810 }
1811
1812 =head2 GetMarcSeries
1813
1814 =over 4
1815
1816 $marcseriessarray = GetMarcSeries($record,$marcflavour);
1817 Get all series from the MARC record and returns them in an array.
1818 The series are stored in differents places depending on MARC flavour
1819
1820 =back
1821
1822 =cut
1823
1824 sub GetMarcSeries {
1825     my ($record, $marcflavour) = @_;
1826     my ($mintag, $maxtag);
1827     if ($marcflavour eq "MARC21") {
1828         $mintag = "440";
1829         $maxtag = "490";
1830     } else {           # assume unimarc if not marc21
1831         $mintag = "600";
1832         $maxtag = "619";
1833     }
1834
1835     my @marcseries;
1836     my $subjct = "";
1837     my $subfield = "";
1838     my $marcsubjct;
1839
1840     foreach my $field ($record->field('440'), $record->field('490')) {
1841         my @subfields_loop;
1842         #my $value = $field->subfield('a');
1843         #$marcsubjct = {MARCSUBJCT => $value,};
1844         my @subfields = $field->subfields();
1845         #warn "subfields:".join " ", @$subfields;
1846         my $counter = 0;
1847         my @link_loop;
1848         for my $series_subfield (@subfields) {
1849                         my $volume_number;
1850                         undef $volume_number;
1851                         # see if this is an instance of a volume
1852                         if ($series_subfield->[0] eq 'v') {
1853                                 $volume_number=1;
1854                         }
1855
1856             my $code = $series_subfield->[0];
1857             my $value = $series_subfield->[1];
1858             my $linkvalue = $value;
1859             $linkvalue =~ s/(\(|\))//g;
1860             my $operator = " and " unless $counter==0;
1861             push @link_loop, {link => $linkvalue, operator => $operator };
1862             my $separator = C4::Context->preference("authoritysep") unless $counter==0;
1863                         if ($volume_number) {
1864                         push @subfields_loop, {volumenum => $value};
1865                         }
1866                         else {
1867             push @subfields_loop, {code => $code, value => $value, link_loop => \@link_loop, separator => $separator, volumenum => $volume_number};
1868                         }
1869             $counter++;
1870         }
1871         push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1872         #$marcsubjct = {MARCSUBJCT => $field->as_string(),};
1873         #push @marcsubjcts, $marcsubjct;
1874         #$subjct = $value;
1875
1876     }
1877     my $marcseriessarray=\@marcseries;
1878     return $marcseriessarray;
1879 }  #end getMARCseriess
1880
1881 =head2 GetFrameworkCode
1882
1883 =over 4
1884
1885 $frameworkcode = GetFrameworkCode( $biblionumber )
1886
1887 =back
1888
1889 =cut
1890
1891 sub GetFrameworkCode {
1892     my ( $biblionumber ) = @_;
1893     my $dbh = C4::Context->dbh;
1894     my $sth =
1895       $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
1896     $sth->execute($biblionumber);
1897     my ($frameworkcode) = $sth->fetchrow;
1898     return $frameworkcode;
1899 }
1900
1901 =head2 TransformKohaToMarc
1902
1903 =over 4
1904
1905 $record = TransformKohaToMarc( $hash )
1906 This function builds partial MARC::Record from a hash
1907 Hash entries can be from biblio or biblioitems.
1908 This function is called in acquisition module, to create a basic catalogue entry from user entry
1909
1910 =back
1911
1912 =cut
1913
1914 sub TransformKohaToMarc {
1915
1916     my ( $hash ) = @_;
1917     my $dbh = C4::Context->dbh;
1918     my $sth =
1919     $dbh->prepare(
1920         "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
1921     );
1922     my $record = MARC::Record->new();
1923     foreach (keys %{$hash}) {
1924         &TransformKohaToMarcOneField( $sth, $record, $_,
1925             $hash->{$_}, '' );
1926         }
1927     return $record;
1928 }
1929
1930 =head2 TransformKohaToMarcOneField
1931
1932 =over 4
1933
1934 $record = TransformKohaToMarcOneField( $sth, $record, $kohafieldname, $value, $frameworkcode );
1935
1936 =back
1937
1938 =cut
1939
1940 sub TransformKohaToMarcOneField {
1941     my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_;
1942     $frameworkcode='' unless $frameworkcode;
1943     my $tagfield;
1944     my $tagsubfield;
1945
1946     if ( !defined $sth ) {
1947         my $dbh = C4::Context->dbh;
1948         $sth =
1949           $dbh->prepare(
1950 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
1951           );
1952     }
1953     $sth->execute( $frameworkcode, $kohafieldname );
1954     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
1955         my $tag = $record->field($tagfield);
1956         if ($tag) {
1957             $tag->update( $tagsubfield => $value );
1958             $record->delete_field($tag);
1959             $record->insert_fields_ordered($tag);
1960         }
1961         else {
1962             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
1963         }
1964     }
1965     return $record;
1966 }
1967
1968 =head2 TransformHtmlToXml
1969
1970 =over 4
1971
1972 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator, $ind_tag )
1973
1974 =back
1975
1976 =cut
1977
1978 sub TransformHtmlToXml {
1979     my ( $tags, $subfields, $values, $indicator, $ind_tag ) = @_;
1980     my $xml = MARC::File::XML::header('UTF-8');
1981     if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1982         MARC::File::XML->default_record_format('UNIMARC');
1983         use POSIX qw(strftime);
1984         my $string = strftime( "%Y%m%d", localtime(time) );
1985         $string = sprintf( "%-*s", 35, $string );
1986         substr( $string, 22, 6, "frey50" );
1987         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
1988         $xml .= "<subfield code=\"a\">$string</subfield>\n";
1989         $xml .= "</datafield>\n";
1990     }
1991     my $prevvalue;
1992     my $prevtag = -1;
1993     my $first   = 1;
1994     my $j       = -1;
1995     for ( my $i = 0 ; $i <= @$tags ; $i++ ) {
1996         @$values[$i] =~ s/&/&amp;/g;
1997         @$values[$i] =~ s/</&lt;/g;
1998         @$values[$i] =~ s/>/&gt;/g;
1999         @$values[$i] =~ s/"/&quot;/g;
2000         @$values[$i] =~ s/'/&apos;/g;
2001         if ( !utf8::is_utf8( @$values[$i] ) ) {
2002             utf8::decode( @$values[$i] );
2003         }
2004         if ( ( @$tags[$i] ne $prevtag ) ) {
2005             $j++ unless ( @$tags[$i] eq "" );
2006             if ( !$first ) {
2007                 $xml .= "</datafield>\n";
2008                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
2009                     && ( @$values[$i] ne "" ) )
2010                 {
2011                     my $ind1 = substr( @$indicator[$j], 0, 1 );
2012                     my $ind2;
2013                     if ( @$indicator[$j] ) {
2014                         $ind2 = substr( @$indicator[$j], 1, 1 );
2015                     }
2016                     else {
2017                         warn "Indicator in @$tags[$i] is empty";
2018                         $ind2 = " ";
2019                     }
2020                     $xml .=
2021 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2022                     $xml .=
2023 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2024                     $first = 0;
2025                 }
2026                 else {
2027                     $first = 1;
2028                 }
2029             }
2030             else {
2031                 if ( @$values[$i] ne "" ) {
2032
2033                     # leader
2034                     if ( @$tags[$i] eq "000" ) {
2035                         $xml .= "<leader>@$values[$i]</leader>\n";
2036                         $first = 1;
2037
2038                         # rest of the fixed fields
2039                     }
2040                     elsif ( @$tags[$i] < 10 ) {
2041                         $xml .=
2042 "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2043                         $first = 1;
2044                     }
2045                     else {
2046                         my $ind1 = substr( @$indicator[$j], 0, 1 );
2047                         my $ind2 = substr( @$indicator[$j], 1, 1 );
2048                         $xml .=
2049 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2050                         $xml .=
2051 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2052                         $first = 0;
2053                     }
2054                 }
2055             }
2056         }
2057         else {    # @$tags[$i] eq $prevtag
2058             if ( @$values[$i] eq "" ) {
2059             }
2060             else {
2061                 if ($first) {
2062                     my $ind1 = substr( @$indicator[$j], 0, 1 );
2063                     my $ind2 = substr( @$indicator[$j], 1, 1 );
2064                     $xml .=
2065 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2066                     $first = 0;
2067                 }
2068                 $xml .=
2069 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2070             }
2071         }
2072         $prevtag = @$tags[$i];
2073     }
2074     $xml .= MARC::File::XML::footer();
2075
2076     return $xml;
2077 }
2078
2079 =head2 TransformHtmlToMarc
2080
2081 =over 4
2082
2083 $record = TransformHtmlToMarc( $dbh, $rtags, $rsubfields, $rvalues, %indicators )
2084
2085 =back
2086
2087 =cut
2088
2089 sub TransformHtmlToMarc {
2090     my ( $dbh, $rtags, $rsubfields, $rvalues, %indicators ) = @_;
2091     my $prevtag = -1;
2092     my $record  = MARC::Record->new();
2093
2094     #     my %subfieldlist=();
2095     my $prevvalue;    # if tag <10
2096     my $field;        # if tag >=10
2097     for ( my $i = 0 ; $i < @$rtags ; $i++ ) {
2098         next unless @$rvalues[$i];
2099
2100  # rebuild MARC::Record
2101  #             warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
2102         if ( @$rtags[$i] ne $prevtag ) {
2103             if ( $prevtag < 10 ) {
2104                 if ($prevvalue) {
2105
2106                     if ( $prevtag ne '000' ) {
2107                         $record->insert_fields_ordered(
2108                             ( sprintf "%03s", $prevtag ), $prevvalue );
2109                     }
2110                     else {
2111
2112                         $record->leader($prevvalue);
2113
2114                     }
2115                 }
2116             }
2117             else {
2118                 if ($field) {
2119                     $record->insert_fields_ordered($field);
2120                 }
2121             }
2122             $indicators{ @$rtags[$i] } .= '  ';
2123             if ( @$rtags[$i] < 10 ) {
2124                 $prevvalue = @$rvalues[$i];
2125                 undef $field;
2126             }
2127             else {
2128                 undef $prevvalue;
2129                 $field = MARC::Field->new(
2130                     ( sprintf "%03s", @$rtags[$i] ),
2131                     substr( $indicators{ @$rtags[$i] }, 0, 1 ),
2132                     substr( $indicators{ @$rtags[$i] }, 1, 1 ),
2133                     @$rsubfields[$i] => @$rvalues[$i]
2134                 );
2135             }
2136             $prevtag = @$rtags[$i];
2137         }
2138         else {
2139             if ( @$rtags[$i] < 10 ) {
2140                 $prevvalue = @$rvalues[$i];
2141             }
2142             else {
2143                 if ( length( @$rvalues[$i] ) > 0 ) {
2144                     $field->add_subfields( @$rsubfields[$i] => @$rvalues[$i] );
2145                 }
2146             }
2147             $prevtag = @$rtags[$i];
2148         }
2149     }
2150
2151     # the last has not been included inside the loop... do it now !
2152     $record->insert_fields_ordered($field) if $field;
2153
2154     $record->encoding('UTF-8');
2155
2156     #    $record->MARC::File::USMARC::update_leader();
2157     return $record;
2158 }
2159
2160 =head2 TransformMarcToKoha
2161
2162 =over 4
2163
2164 $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
2165
2166 =back
2167
2168 =cut
2169
2170 sub TransformMarcToKoha {
2171     my ( $dbh, $record, $frameworkcode ) = @_;
2172     my $sth =
2173       $dbh->prepare(
2174 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
2175       );
2176     my $result;
2177     my $sth2 = $dbh->prepare("SHOW COLUMNS from biblio");
2178     $sth2->execute;
2179     my $field;
2180     while ( ($field) = $sth2->fetchrow ) {
2181         $result =
2182           &TransformMarcToKohaOneField( "biblio", $field, $record, $result,
2183             $frameworkcode );
2184     }
2185     $sth2 = $dbh->prepare("SHOW COLUMNS from biblioitems");
2186     $sth2->execute;
2187     while ( ($field) = $sth2->fetchrow ) {
2188         if ( $field eq 'notes' ) { $field = 'bnotes'; }
2189         $result =
2190           &TransformMarcToKohaOneField( "biblioitems", $field, $record, $result,
2191             $frameworkcode );
2192     }
2193     $sth2 = $dbh->prepare("SHOW COLUMNS from items");
2194     $sth2->execute;
2195     while ( ($field) = $sth2->fetchrow ) {
2196         $result =
2197           &TransformMarcToKohaOneField( "items", $field, $record, $result,
2198             $frameworkcode );
2199     }
2200
2201     #
2202     # modify copyrightdate to keep only the 1st year found
2203     my $temp = $result->{'copyrightdate'};
2204     $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2205     if ( $1 > 0 ) {
2206         $result->{'copyrightdate'} = $1;
2207     }
2208     else {                      # if no cYYYY, get the 1st date.
2209         $temp =~ m/(\d\d\d\d)/;
2210         $result->{'copyrightdate'} = $1;
2211     }
2212
2213     # modify publicationyear to keep only the 1st year found
2214     $temp = $result->{'publicationyear'};
2215     $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2216     if ( $1 > 0 ) {
2217         $result->{'publicationyear'} = $1;
2218     }
2219     else {                      # if no cYYYY, get the 1st date.
2220         $temp =~ m/(\d\d\d\d)/;
2221         $result->{'publicationyear'} = $1;
2222     }
2223     return $result;
2224 }
2225
2226 =head2 TransformMarcToKohaOneField
2227
2228 =over 4
2229
2230 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2231
2232 =back
2233
2234 =cut
2235
2236 sub TransformMarcToKohaOneField {
2237
2238 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
2239     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2240
2241     my $res = "";
2242     my ( $tagfield, $subfield ) =
2243       GetMarcFromKohaField( $kohatable . "." . $kohafield,
2244         $frameworkcode );
2245     foreach my $field ( $record->field($tagfield) ) {
2246         if ( $field->tag() < 10 ) {
2247             if ( $result->{$kohafield} ) {
2248                 $result->{$kohafield} .= " | " . $field->data();
2249             }
2250             else {
2251                 $result->{$kohafield} = $field->data();
2252             }
2253         }
2254         else {
2255             if ( $field->subfields ) {
2256                 my @subfields = $field->subfields();
2257                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2258                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2259                         if ( $result->{$kohafield} ) {
2260                             $result->{$kohafield} .=
2261                               " | " . $subfields[$subfieldcount][1];
2262                         }
2263                         else {
2264                             $result->{$kohafield} =
2265                               $subfields[$subfieldcount][1];
2266                         }
2267                     }
2268                 }
2269             }
2270         }
2271     }
2272     return $result;
2273 }
2274 =head1  OTHER FUNCTIONS
2275
2276 =head2 char_decode
2277
2278 =over 4
2279
2280 my $string = char_decode( $string, $encoding );
2281
2282 converts ISO 5426 coded string to UTF-8
2283 sloppy code : should be improved in next issue
2284
2285 =back
2286
2287 =cut
2288
2289 sub char_decode {
2290     my ( $string, $encoding ) = @_;
2291     $_ = $string;
2292
2293     $encoding = C4::Context->preference("marcflavour") unless $encoding;
2294     if ( $encoding eq "UNIMARC" ) {
2295
2296         #         s/\xe1/Æ/gm;
2297         s/\xe2/Ğ/gm;
2298         s/\xe9/Ø/gm;
2299         s/\xec/ş/gm;
2300         s/\xf1/æ/gm;
2301         s/\xf3/ğ/gm;
2302         s/\xf9/ø/gm;
2303         s/\xfb/ß/gm;
2304         s/\xc1\x61/à/gm;
2305         s/\xc1\x65/è/gm;
2306         s/\xc1\x69/ì/gm;
2307         s/\xc1\x6f/ò/gm;
2308         s/\xc1\x75/ù/gm;
2309         s/\xc1\x41/À/gm;
2310         s/\xc1\x45/È/gm;
2311         s/\xc1\x49/Ì/gm;
2312         s/\xc1\x4f/Ò/gm;
2313         s/\xc1\x55/Ù/gm;
2314         s/\xc2\x41/Á/gm;
2315         s/\xc2\x45/É/gm;
2316         s/\xc2\x49/Í/gm;
2317         s/\xc2\x4f/Ó/gm;
2318         s/\xc2\x55/Ú/gm;
2319         s/\xc2\x59/İ/gm;
2320         s/\xc2\x61/á/gm;
2321         s/\xc2\x65/é/gm;
2322         s/\xc2\x69/í/gm;
2323         s/\xc2\x6f/ó/gm;
2324         s/\xc2\x75/ú/gm;
2325         s/\xc2\x79/ı/gm;
2326         s/\xc3\x41/Â/gm;
2327         s/\xc3\x45/Ê/gm;
2328         s/\xc3\x49/Î/gm;
2329         s/\xc3\x4f/Ô/gm;
2330         s/\xc3\x55/Û/gm;
2331         s/\xc3\x61/â/gm;
2332         s/\xc3\x65/ê/gm;
2333         s/\xc3\x69/î/gm;
2334         s/\xc3\x6f/ô/gm;
2335         s/\xc3\x75/û/gm;
2336         s/\xc4\x41/Ã/gm;
2337         s/\xc4\x4e/Ñ/gm;
2338         s/\xc4\x4f/Õ/gm;
2339         s/\xc4\x61/ã/gm;
2340         s/\xc4\x6e/ñ/gm;
2341         s/\xc4\x6f/õ/gm;
2342         s/\xc8\x41/Ä/gm;
2343         s/\xc8\x45/Ë/gm;
2344         s/\xc8\x49/Ï/gm;
2345         s/\xc8\x61/ä/gm;
2346         s/\xc8\x65/ë/gm;
2347         s/\xc8\x69/ï/gm;
2348         s/\xc8\x6F/ö/gm;
2349         s/\xc8\x75/ü/gm;
2350         s/\xc8\x76/ÿ/gm;
2351         s/\xc9\x41/Ä/gm;
2352         s/\xc9\x45/Ë/gm;
2353         s/\xc9\x49/Ï/gm;
2354         s/\xc9\x4f/Ö/gm;
2355         s/\xc9\x55/Ü/gm;
2356         s/\xc9\x61/ä/gm;
2357         s/\xc9\x6f/ö/gm;
2358         s/\xc9\x75/ü/gm;
2359         s/\xca\x41/Å/gm;
2360         s/\xca\x61/å/gm;
2361         s/\xd0\x43/Ç/gm;
2362         s/\xd0\x63/ç/gm;
2363
2364         # this handles non-sorting blocks (if implementation requires this)
2365         $string = nsb_clean($_);
2366     }
2367     elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2368         ##MARC-8 to UTF-8
2369
2370         s/\xe1\x61/à/gm;
2371         s/\xe1\x65/è/gm;
2372         s/\xe1\x69/ì/gm;
2373         s/\xe1\x6f/ò/gm;
2374         s/\xe1\x75/ù/gm;
2375         s/\xe1\x41/À/gm;
2376         s/\xe1\x45/È/gm;
2377         s/\xe1\x49/Ì/gm;
2378         s/\xe1\x4f/Ò/gm;
2379         s/\xe1\x55/Ù/gm;
2380         s/\xe2\x41/Á/gm;
2381         s/\xe2\x45/É/gm;
2382         s/\xe2\x49/Í/gm;
2383         s/\xe2\x4f/Ó/gm;
2384         s/\xe2\x55/Ú/gm;
2385         s/\xe2\x59/İ/gm;
2386         s/\xe2\x61/á/gm;
2387         s/\xe2\x65/é/gm;
2388         s/\xe2\x69/í/gm;
2389         s/\xe2\x6f/ó/gm;
2390         s/\xe2\x75/ú/gm;
2391         s/\xe2\x79/ı/gm;
2392         s/\xe3\x41/Â/gm;
2393         s/\xe3\x45/Ê/gm;
2394         s/\xe3\x49/Î/gm;
2395         s/\xe3\x4f/Ô/gm;
2396         s/\xe3\x55/Û/gm;
2397         s/\xe3\x61/â/gm;
2398         s/\xe3\x65/ê/gm;
2399         s/\xe3\x69/î/gm;
2400         s/\xe3\x6f/ô/gm;
2401         s/\xe3\x75/û/gm;
2402         s/\xe4\x41/Ã/gm;
2403         s/\xe4\x4e/Ñ/gm;
2404         s/\xe4\x4f/Õ/gm;
2405         s/\xe4\x61/ã/gm;
2406         s/\xe4\x6e/ñ/gm;
2407         s/\xe4\x6f/õ/gm;
2408         s/\xe6\x41/Ă/gm;
2409         s/\xe6\x45/Ĕ/gm;
2410         s/\xe6\x65/ĕ/gm;
2411         s/\xe6\x61/ă/gm;
2412         s/\xe8\x45/Ë/gm;
2413         s/\xe8\x49/Ï/gm;
2414         s/\xe8\x65/ë/gm;
2415         s/\xe8\x69/ï/gm;
2416         s/\xe8\x76/ÿ/gm;
2417         s/\xe9\x41/A/gm;
2418         s/\xe9\x4f/O/gm;
2419         s/\xe9\x55/U/gm;
2420         s/\xe9\x61/a/gm;
2421         s/\xe9\x6f/o/gm;
2422         s/\xe9\x75/u/gm;
2423         s/\xea\x41/A/gm;
2424         s/\xea\x61/a/gm;
2425
2426         #Additional Turkish characters
2427         s/\x1b//gm;
2428         s/\x1e//gm;
2429         s/(\xf0)s/\xc5\x9f/gm;
2430         s/(\xf0)S/\xc5\x9e/gm;
2431         s/(\xf0)c/ç/gm;
2432         s/(\xf0)C/Ç/gm;
2433         s/\xe7\x49/\\xc4\xb0/gm;
2434         s/(\xe6)G/\xc4\x9e/gm;
2435         s/(\xe6)g/ğ\xc4\x9f/gm;
2436         s/\xB8/ı/gm;
2437         s/\xB9/£/gm;
2438         s/(\xe8|\xc8)o/ö/gm;
2439         s/(\xe8|\xc8)O/Ö/gm;
2440         s/(\xe8|\xc8)u/ü/gm;
2441         s/(\xe8|\xc8)U/Ü/gm;
2442         s/\xc2\xb8/\xc4\xb1/gm;
2443         s/¸/\xc4\xb1/gm;
2444
2445         # this handles non-sorting blocks (if implementation requires this)
2446         $string = nsb_clean($_);
2447     }
2448     return ($string);
2449 }
2450
2451 =head2 nsb_clean
2452
2453 =over 4
2454
2455 my $string = nsb_clean( $string, $encoding );
2456
2457 =back
2458
2459 =cut
2460
2461 sub nsb_clean {
2462     my $NSB      = '\x88';    # NSB : begin Non Sorting Block
2463     my $NSE      = '\x89';    # NSE : Non Sorting Block end
2464                               # handles non sorting blocks
2465     my ($string) = @_;
2466     $_ = $string;
2467     s/$NSB/(/gm;
2468     s/[ ]{0,1}$NSE/) /gm;
2469     $string = $_;
2470     return ($string);
2471 }
2472
2473 =head2 PrepareItemrecordDisplay
2474
2475 =over 4
2476
2477 PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber);
2478
2479 Returns a hash with all the fields for Display a given item data in a template
2480
2481 =back
2482
2483 =cut
2484
2485 sub PrepareItemrecordDisplay {
2486
2487     my ( $bibnum, $itemnum ) = @_;
2488
2489     my $dbh = C4::Context->dbh;
2490     my $frameworkcode = &GetFrameworkCode( $bibnum );
2491     my ( $itemtagfield, $itemtagsubfield ) =
2492       &GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2493     my $tagslib = &GetMarcStructure( 1, $frameworkcode );
2494     my $itemrecord = GetMarcItem( $bibnum, $itemnum) if ($itemnum);
2495     my @loop_data;
2496     my $authorised_values_sth =
2497       $dbh->prepare(
2498 "select authorised_value,lib from authorised_values where category=? order by lib"
2499       );
2500     foreach my $tag ( sort keys %{$tagslib} ) {
2501         my $previous_tag = '';
2502         if ( $tag ne '' ) {
2503             # loop through each subfield
2504             my $cntsubf;
2505             foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
2506                 next if ( subfield_is_koha_internal_p($subfield) );
2507                 next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
2508                 my %subfield_data;
2509                 $subfield_data{tag}           = $tag;
2510                 $subfield_data{subfield}      = $subfield;
2511                 $subfield_data{countsubfield} = $cntsubf++;
2512                 $subfield_data{kohafield}     =
2513                   $tagslib->{$tag}->{$subfield}->{'kohafield'};
2514
2515          #        $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
2516                 $subfield_data{marc_lib} =
2517                     "<span id=\"error\" title=\""
2518                   . $tagslib->{$tag}->{$subfield}->{lib} . "\">"
2519                   . substr( $tagslib->{$tag}->{$subfield}->{lib}, 0, 12 )
2520                   . "</span>";
2521                 $subfield_data{mandatory} =
2522                   $tagslib->{$tag}->{$subfield}->{mandatory};
2523                 $subfield_data{repeatable} =
2524                   $tagslib->{$tag}->{$subfield}->{repeatable};
2525                 $subfield_data{hidden} = "display:none"
2526                   if $tagslib->{$tag}->{$subfield}->{hidden};
2527                 my ( $x, $value );
2528                 ( $x, $value ) = _find_value( $tag, $subfield, $itemrecord )
2529                   if ($itemrecord);
2530                 $value =~ s/"/&quot;/g;
2531
2532                 # search for itemcallnumber if applicable
2533                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
2534                     'items.itemcallnumber'
2535                     && C4::Context->preference('itemcallnumber') )
2536                 {
2537                     my $CNtag =
2538                       substr( C4::Context->preference('itemcallnumber'), 0, 3 );
2539                     my $CNsubfield =
2540                       substr( C4::Context->preference('itemcallnumber'), 3, 1 );
2541                     my $temp = $itemrecord->field($CNtag) if ($itemrecord);
2542                     if ($temp) {
2543                         $value = $temp->subfield($CNsubfield);
2544                     }
2545                 }
2546                 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
2547                     my @authorised_values;
2548                     my %authorised_lib;
2549
2550                     # builds list, depending on authorised value...
2551                     #---- branch
2552                     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq
2553                         "branches" )
2554                     {
2555                         if ( ( C4::Context->preference("IndependantBranches") )
2556                             && ( C4::Context->userenv->{flags} != 1 ) )
2557                         {
2558                             my $sth =
2559                               $dbh->prepare(
2560 "select branchcode,branchname from branches where branchcode = ? order by branchname"
2561                               );
2562                             $sth->execute( C4::Context->userenv->{branch} );
2563                             push @authorised_values, ""
2564                               unless (
2565                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
2566                             while ( my ( $branchcode, $branchname ) =
2567                                 $sth->fetchrow_array )
2568                             {
2569                                 push @authorised_values, $branchcode;
2570                                 $authorised_lib{$branchcode} = $branchname;
2571                             }
2572                         }
2573                         else {
2574                             my $sth =
2575                               $dbh->prepare(
2576 "select branchcode,branchname from branches order by branchname"
2577                               );
2578                             $sth->execute;
2579                             push @authorised_values, ""
2580                               unless (
2581                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
2582                             while ( my ( $branchcode, $branchname ) =
2583                                 $sth->fetchrow_array )
2584                             {
2585                                 push @authorised_values, $branchcode;
2586                                 $authorised_lib{$branchcode} = $branchname;
2587                             }
2588                         }
2589
2590                         #----- itemtypes
2591                     }
2592                     elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq
2593                         "itemtypes" )
2594                     {
2595                         my $sth =
2596                           $dbh->prepare(
2597 "select itemtype,description from itemtypes order by description"
2598                           );
2599                         $sth->execute;
2600                         push @authorised_values, ""
2601                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2602                         while ( my ( $itemtype, $description ) =
2603                             $sth->fetchrow_array )
2604                         {
2605                             push @authorised_values, $itemtype;
2606                             $authorised_lib{$itemtype} = $description;
2607                         }
2608
2609                         #---- "true" authorised value
2610                     }
2611                     else {
2612                         $authorised_values_sth->execute(
2613                             $tagslib->{$tag}->{$subfield}->{authorised_value} );
2614                         push @authorised_values, ""
2615                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2616                         while ( my ( $value, $lib ) =
2617                             $authorised_values_sth->fetchrow_array )
2618                         {
2619                             push @authorised_values, $value;
2620                             $authorised_lib{$value} = $lib;
2621                         }
2622                     }
2623                     $subfield_data{marc_value} = CGI::scrolling_list(
2624                         -name     => 'field_value',
2625                         -values   => \@authorised_values,
2626                         -default  => "$value",
2627                         -labels   => \%authorised_lib,
2628                         -size     => 1,
2629                         -tabindex => '',
2630                         -multiple => 0,
2631                     );
2632                 }
2633                 elsif ( $tagslib->{$tag}->{$subfield}->{thesaurus_category} ) {
2634                     $subfield_data{marc_value} =
2635 "<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>";
2636
2637 #"
2638 # COMMENTED OUT because No $i is provided with this API.
2639 # And thus, no value_builder can be activated.
2640 # BUT could be thought over.
2641 #         } elsif ($tagslib->{$tag}->{$subfield}->{'value_builder'}) {
2642 #             my $plugin="value_builder/".$tagslib->{$tag}->{$subfield}->{'value_builder'};
2643 #             require $plugin;
2644 #             my $extended_param = plugin_parameters($dbh,$itemrecord,$tagslib,$i,0);
2645 #             my ($function_name,$javascript) = plugin_javascript($dbh,$record,$tagslib,$i,0);
2646 #             $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";
2647                 }
2648                 else {
2649                     $subfield_data{marc_value} =
2650 "<input type=\"text\" name=\"field_value\" value=\"$value\" size=50 maxlength=255>";
2651                 }
2652                 push( @loop_data, \%subfield_data );
2653             }
2654         }
2655     }
2656     my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
2657       if ( $itemrecord && $itemrecord->field($itemtagfield) );
2658     return {
2659         'itemtagfield'    => $itemtagfield,
2660         'itemtagsubfield' => $itemtagsubfield,
2661         'itemnumber'      => $itemnumber,
2662         'iteminformation' => \@loop_data
2663     };
2664 }
2665 #"
2666
2667 #
2668 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2669 # at the same time
2670 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2671 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2672 # =head2 ModZebrafiles
2673 #
2674 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2675 #
2676 # =cut
2677 #
2678 # sub ModZebrafiles {
2679 #
2680 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2681 #
2682 #     my $op;
2683 #     my $zebradir =
2684 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2685 #     unless ( opendir( DIR, "$zebradir" ) ) {
2686 #         warn "$zebradir not found";
2687 #         return;
2688 #     }
2689 #     closedir DIR;
2690 #     my $filename = $zebradir . $biblionumber;
2691 #
2692 #     if ($record) {
2693 #         open( OUTPUT, ">", $filename . ".xml" );
2694 #         print OUTPUT $record;
2695 #         close OUTPUT;
2696 #     }
2697 # }
2698
2699 =head2 ModZebra
2700
2701 =over 4
2702
2703 ModZebra( $biblionumber, $op, $server, $newRecord );
2704
2705     $biblionumber is the biblionumber we want to index
2706     $op is specialUpdate or delete, and is used to know what we want to do
2707     $server is the server that we want to update
2708     $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.
2709 =back
2710
2711 =cut
2712
2713 sub ModZebra {
2714 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2715     my ( $biblionumber, $op, $server, $newRecord ) = @_;
2716 #     warn "ModZebra with : ( $biblionumber, $op, $server, $newRecord )";
2717     my $dbh=C4::Context->dbh;
2718     #warn "SERVER:".$server;
2719 #
2720 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2721 # at the same time
2722 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2723 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2724
2725     if (C4::Context->preference("NoZebra")) {
2726         # lock the nozebra table : we will read index lines, update them in Perl process
2727         # and write everything in 1 transaction.
2728         # lock the table to avoid someone else overwriting what we are doing
2729         $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE');
2730         my %result; # the result hash that will be builded by deletion / add, and written on mySQL at the end, to improve speed
2731         my $record;
2732         if ($server eq 'biblioserver') {
2733             $record= GetMarcBiblio($biblionumber);
2734         } else {
2735             $record= C4::AuthoritiesMarc::GetAuthority($biblionumber);
2736         }
2737         if ($op eq 'specialUpdate') {
2738             # OK, we have to add or update the record
2739             # 1st delete (virtually, in indexes) ...
2740             %result = _DelBiblioNoZebra($biblionumber,$record,$server);
2741             # ... add the record
2742             %result=_AddBiblioNoZebra($biblionumber,$newRecord, $server, %result);
2743         } else {
2744             # it's a deletion, delete the record...
2745 #             warn "DELETE the record $biblionumber on $server".$record->as_formatted;
2746             %result=_DelBiblioNoZebra($biblionumber,$record,$server);
2747         }
2748         # ok, now update the database...
2749         my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
2750         foreach my $key (keys %result) {
2751             foreach my $index (keys %{$result{$key}}) {
2752 #                 warn "UPDATING : $server $key , $index with :".$result{$key}->{$index};
2753                 $sth->execute($result{$key}->{$index}, $server, $key, $index);
2754             }
2755         }
2756     $dbh->do('UNLOCK TABLES');
2757
2758     } else {
2759         #
2760         # we use zebra, just fill zebraqueue table
2761         #
2762         my $sth=$dbh->prepare("insert into zebraqueue  (biblio_auth_number ,server,operation) values(?,?,?)");
2763         $sth->execute($biblionumber,$server,$op);
2764         $sth->finish;
2765     }
2766 }
2767
2768 =head2 GetNoZebraIndexes
2769
2770 =cut
2771
2772 sub GetNoZebraIndexes {
2773     my $index = C4::Context->preference('NoZebraIndexes');
2774     my %indexes;
2775     foreach my $line (split /('|"),/,$index) {
2776         $line =~ /(.*)=>(.*)/;
2777         my $index = substr($1,1); # get the index, don't forget to remove initial ' or "
2778         my $fields = $2;
2779         $index =~ s/'|"| //g;
2780         $fields =~ s/'|"| //g;
2781         $indexes{$index}=$fields;
2782     }
2783     return %indexes;
2784 }
2785
2786 =head1 INTERNAL FUNCTIONS
2787
2788 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
2789
2790     function to delete a biblio in NoZebra indexes
2791     This function does NOT delete anything in database : it reads all the indexes entries
2792     that have to be deleted & delete them in the hash
2793     The SQL part is done either :
2794     - after the Add if we are modifying a biblio (delete + add again)
2795     - immediatly after this sub if we are doing a true deletion.
2796     $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
2797
2798 =cut
2799
2800
2801 sub _DelBiblioNoZebra {
2802     my ($biblionumber, $record, $server)=@_;
2803
2804     # Get the indexes
2805     my $dbh = C4::Context->dbh;
2806     # Get the indexes
2807     my %index;
2808     my $title;
2809     if ($server eq 'biblioserver') {
2810         %index=GetNoZebraIndexes;
2811         # get title of the record (to store the 10 first letters with the index)
2812         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
2813         $title = lc($record->subfield($titletag,$titlesubfield));
2814     } else {
2815         # for authorities, the "title" is the $a mainentry
2816         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
2817         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
2818         $title = $record->subfield($authref->{auth_tag_to_report},'a');
2819         $index{'mainmainentry'}= $authref->{'auth_tag_to_report'}.'a';
2820         $index{'mainentry'}    = $authref->{'auth_tag_to_report'}.'*';
2821         $index{'auth_type'}    = '152b';
2822     }
2823
2824     my %result;
2825     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2826     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2827     # limit to 10 char, should be enough, and limit the DB size
2828     $title = substr($title,0,10);
2829     #parse each field
2830     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2831     foreach my $field ($record->fields()) {
2832         #parse each subfield
2833         next if $field->tag <10;
2834         foreach my $subfield ($field->subfields()) {
2835             my $tag = $field->tag();
2836             my $subfieldcode = $subfield->[0];
2837             my $indexed=0;
2838             # check each index to see if the subfield is stored somewhere
2839             # otherwise, store it in __RAW__ index
2840             foreach my $key (keys %index) {
2841 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2842                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
2843                     $indexed=1;
2844                     my $line= lc $subfield->[1];
2845                     # remove meaningless value in the field...
2846                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2847                     # ... and split in words
2848                     foreach (split / /,$line) {
2849                         next unless $_; # skip  empty values (multiple spaces)
2850                         # if the entry is already here, do nothing, the biblionumber has already be removed
2851                         unless ($result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) {
2852                             # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2853                             $sth2->execute($server,$key,$_);
2854                             my $existing_biblionumbers = $sth2->fetchrow;
2855                             # it exists
2856                             if ($existing_biblionumbers) {
2857 #                                 warn " existing for $key $_: $existing_biblionumbers";
2858                                 $result{$key}->{$_} =$existing_biblionumbers;
2859                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2860                             }
2861                         }
2862                     }
2863                 }
2864             }
2865             # the subfield is not indexed, store it in __RAW__ index anyway
2866             unless ($indexed) {
2867                 my $line= lc $subfield->[1];
2868                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2869                 # ... and split in words
2870                 foreach (split / /,$line) {
2871                     next unless $_; # skip  empty values (multiple spaces)
2872                     # if the entry is already here, do nothing, the biblionumber has already be removed
2873                     unless ($result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/) {
2874                         # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2875                         $sth2->execute($server,'__RAW__',$_);
2876                         my $existing_biblionumbers = $sth2->fetchrow;
2877                         # it exists
2878                         if ($existing_biblionumbers) {
2879                             $result{'__RAW__'}->{$_} =$existing_biblionumbers;
2880                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2881                         }
2882                     }
2883                 }
2884             }
2885         }
2886     }
2887     return %result;
2888 }
2889
2890 =head2 _DelBiblioNoZebra($biblionumber,$record);
2891
2892     function to delete a biblio in NoZebra indexes
2893
2894 =cut
2895
2896
2897 sub _AddBiblioNoZebra {
2898     my ($biblionumber, $record, $server, %result)=@_;
2899     my $dbh = C4::Context->dbh;
2900     # Get the indexes
2901     my %index;
2902     my $title;
2903     if ($server eq 'biblioserver') {
2904         %index=GetNoZebraIndexes;
2905         # get title of the record (to store the 10 first letters with the index)
2906         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
2907         $title = lc($record->subfield($titletag,$titlesubfield));
2908     } else {
2909 #     warn "server : $server";
2910         # for authorities, the "title" is the $a mainentry
2911         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
2912         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
2913         $title = $record->subfield($authref->{auth_tag_to_report},'a');
2914         $index{'mainmainentry'}=$authref->{auth_tag_to_report}.'a';
2915         $index{'mainentry'}    = $authref->{auth_tag_to_report}.'*';
2916         $index{'auth_type'}    = '152b';
2917     }
2918
2919     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2920     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2921     # limit to 10 char, should be enough, and limit the DB size
2922     $title = substr($title,0,10);
2923     #parse each field
2924     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2925     foreach my $field ($record->fields()) {
2926         #parse each subfield
2927         next if $field->tag <10;
2928         foreach my $subfield ($field->subfields()) {
2929             my $tag = $field->tag();
2930             my $subfieldcode = $subfield->[0];
2931             my $indexed=0;
2932             # check each index to see if the subfield is stored somewhere
2933             # otherwise, store it in __RAW__ index
2934             foreach my $key (keys %index) {
2935 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2936                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
2937                     $indexed=1;
2938                     my $line= lc $subfield->[1];
2939                     # remove meaningless value in the field...
2940                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2941                     # ... and split in words
2942                     foreach (split / /,$line) {
2943                         next unless $_; # skip  empty values (multiple spaces)
2944                         # if the entry is already here, improve weight
2945 #                         warn "managing $_";
2946                         if ($result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) {
2947                             my $weight=$1+1;
2948                             $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2949                             $result{$key}->{$_} .= "$biblionumber,$title-$weight;";
2950                         } else {
2951                             # get the value if it exist in the nozebra table, otherwise, create it
2952                             $sth2->execute($server,$key,$_);
2953                             my $existing_biblionumbers = $sth2->fetchrow;
2954                             # it exists
2955                             if ($existing_biblionumbers) {
2956                                 $result{$key}->{$_} =$existing_biblionumbers;
2957                                 my $weight=$1+1;
2958                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2959                                 $result{$key}->{$_} .= "$biblionumber,$title-$weight;";
2960                             # create a new ligne for this entry
2961                             } else {
2962 #                             warn "INSERT : $server / $key / $_";
2963                                 $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).', indexname='.$dbh->quote($key).',value='.$dbh->quote($_));
2964                                 $result{$key}->{$_}.="$biblionumber,$title-1;";
2965                             }
2966                         }
2967                     }
2968                 }
2969             }
2970             # the subfield is not indexed, store it in __RAW__ index anyway
2971             unless ($indexed) {
2972                 my $line= lc $subfield->[1];
2973                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2974                 # ... and split in words
2975                 foreach (split / /,$line) {
2976                     next unless $_; # skip  empty values (multiple spaces)
2977                     # if the entry is already here, improve weight
2978                     if ($result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/) {
2979                         my $weight=$1+1;
2980                         $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2981                         $result{'__RAW__'}->{$_} .= "$biblionumber,$title-$weight;";
2982                     } else {
2983                         # get the value if it exist in the nozebra table, otherwise, create it
2984                         $sth2->execute($server,'__RAW__',$_);
2985                         my $existing_biblionumbers = $sth2->fetchrow;
2986                         # it exists
2987                         if ($existing_biblionumbers) {
2988                             $result{'__RAW__'}->{$_} =$existing_biblionumbers;
2989                             my $weight=$1+1;
2990                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2991                             $result{'__RAW__'}->{$_} .= "$biblionumber,$title-$weight;";
2992                         # create a new ligne for this entry
2993                         } else {
2994                             $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).',  indexname="__RAW__",value='.$dbh->quote($_));
2995                             $result{'__RAW__'}->{$_}.="$biblionumber,$title-1;";
2996                         }
2997                     }
2998                 }
2999             }
3000         }
3001     }
3002     return %result;
3003 }
3004
3005
3006 =head2 MARCitemchange
3007
3008 =over 4
3009
3010 &MARCitemchange( $record, $itemfield, $newvalue )
3011
3012 Function to update a single value in an item field.
3013 Used twice, could probably be replaced by something else, but works well...
3014
3015 =back
3016
3017 =back
3018
3019 =cut
3020
3021 sub MARCitemchange {
3022     my ( $record, $itemfield, $newvalue ) = @_;
3023     my $dbh = C4::Context->dbh;
3024
3025     my ( $tagfield, $tagsubfield ) =
3026       GetMarcFromKohaField( $itemfield, "" );
3027     if ( ($tagfield) && ($tagsubfield) ) {
3028         my $tag = $record->field($tagfield);
3029         if ($tag) {
3030             $tag->update( $tagsubfield => $newvalue );
3031             $record->delete_field($tag);
3032             $record->insert_fields_ordered($tag);
3033         }
3034     }
3035 }
3036
3037 =head2 _koha_add_biblio
3038
3039 =over 4
3040
3041 _koha_add_biblio($dbh,$biblioitem);
3042
3043 Internal function to add a biblio ($biblio is a hash with the values)
3044
3045 =back
3046
3047 =cut
3048
3049 sub _koha_add_biblio {
3050     my ( $dbh, $biblio, $frameworkcode ) = @_;
3051     my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
3052     $sth->execute;
3053     my $data         = $sth->fetchrow_arrayref;
3054     my $biblionumber = $$data[0] + 1;
3055     my $series       = 0;
3056
3057     if ( $biblio->{'seriestitle'} ) { $series = 1 }
3058     $sth->finish;
3059     $sth = $dbh->prepare(
3060         "INSERT INTO biblio
3061     SET biblionumber  = ?, title = ?, author = ?, copyrightdate = ?, serial = ?, seriestitle = ?, notes = ?, abstract = ?, unititle = ?, frameworkcode = ? "
3062     );
3063     $sth->execute(
3064         $biblionumber,         $biblio->{'title'},
3065         $biblio->{'author'},   $biblio->{'copyrightdate'},
3066         $biblio->{'serial'},   $biblio->{'seriestitle'},
3067         $biblio->{'notes'},    $biblio->{'abstract'},
3068         $biblio->{'unititle'}, $frameworkcode
3069     );
3070
3071     $sth->finish;
3072     return ($biblionumber);
3073 }
3074
3075 =head2 _find_value
3076
3077 =over 4
3078
3079 ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
3080
3081 Find the given $subfield in the given $tag in the given
3082 MARC::Record $record.  If the subfield is found, returns
3083 the (indicators, value) pair; otherwise, (undef, undef) is
3084 returned.
3085
3086 PROPOSITION :
3087 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
3088 I suggest we export it from this module.
3089
3090 =back
3091
3092 =cut
3093
3094 sub _find_value {
3095     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
3096     my @result;
3097     my $indicator;
3098     if ( $tagfield < 10 ) {
3099         if ( $record->field($tagfield) ) {
3100             push @result, $record->field($tagfield)->data();
3101         }
3102         else {
3103             push @result, "";
3104         }
3105     }
3106     else {
3107         foreach my $field ( $record->field($tagfield) ) {
3108             my @subfields = $field->subfields();
3109             foreach my $subfield (@subfields) {
3110                 if ( @$subfield[0] eq $insubfield ) {
3111                     push @result, @$subfield[1];
3112                     $indicator = $field->indicator(1) . $field->indicator(2);
3113                 }
3114             }
3115         }
3116     }
3117     return ( $indicator, @result );
3118 }
3119
3120 =head2 _koha_modify_biblio
3121
3122 =over 4
3123
3124 Internal function for updating the biblio table
3125
3126 =back
3127
3128 =cut
3129
3130 sub _koha_modify_biblio {
3131     my ( $dbh, $biblio ) = @_;
3132
3133 # FIXME: this code could be made more portable by not hard-coding the values that are supposed to be in biblio table
3134     my $sth =
3135       $dbh->prepare(
3136 "Update biblio set title = ?, author = ?, abstract = ?, copyrightdate = ?, seriestitle = ?, serial = ?, unititle = ?, notes = ? where biblionumber = ?"
3137       );
3138     $sth->execute(
3139         $biblio->{'title'},       $biblio->{'author'},
3140         $biblio->{'abstract'},    $biblio->{'copyrightdate'},
3141         $biblio->{'seriestitle'}, $biblio->{'serial'},
3142         $biblio->{'unititle'},    $biblio->{'notes'},
3143         $biblio->{'biblionumber'}
3144     );
3145     $sth->finish;
3146     return ( $biblio->{'biblionumber'} );
3147 }
3148
3149 =head2 _koha_modify_biblioitem
3150
3151 =over 4
3152
3153 _koha_modify_biblioitem( $dbh, $biblioitem );
3154
3155 =back
3156
3157 =cut
3158
3159 sub _koha_modify_biblioitem {
3160     my ( $dbh, $biblioitem ) = @_;
3161     my $query;
3162 ##Recalculate LC in case it changed --TG
3163
3164     $biblioitem->{'itemtype'}      = $dbh->quote( $biblioitem->{'itemtype'} );
3165     $biblioitem->{'url'}           = $dbh->quote( $biblioitem->{'url'} );
3166     $biblioitem->{'isbn'}          = $dbh->quote( $biblioitem->{'isbn'} );
3167     $biblioitem->{'issn'}          = $dbh->quote( $biblioitem->{'issn'} );
3168     $biblioitem->{'publishercode'} =
3169       $dbh->quote( $biblioitem->{'publishercode'} );
3170     $biblioitem->{'publicationyear'} =
3171       $dbh->quote( $biblioitem->{'publicationyear'} );
3172     $biblioitem->{'classification'} =
3173       $dbh->quote( $biblioitem->{'classification'} );
3174     $biblioitem->{'dewey'}        = $dbh->quote( $biblioitem->{'dewey'} );
3175     $biblioitem->{'subclass'}     = $dbh->quote( $biblioitem->{'subclass'} );
3176     $biblioitem->{'illus'}        = $dbh->quote( $biblioitem->{'illus'} );
3177     $biblioitem->{'pages'}        = $dbh->quote( $biblioitem->{'pages'} );
3178     $biblioitem->{'volumeddesc'}  = $dbh->quote( $biblioitem->{'volumeddesc'} );
3179     $biblioitem->{'bnotes'}       = $dbh->quote( $biblioitem->{'bnotes'} );
3180     $biblioitem->{'size'}         = $dbh->quote( $biblioitem->{'size'} );
3181     $biblioitem->{'place'}        = $dbh->quote( $biblioitem->{'place'} );
3182     $biblioitem->{'ccode'}        = $dbh->quote( $biblioitem->{'ccode'} );
3183     $biblioitem->{'biblionumber'} =
3184       $dbh->quote( $biblioitem->{'biblionumber'} );
3185
3186     $query = "Update biblioitems set
3187         itemtype        = $biblioitem->{'itemtype'},
3188         url             = $biblioitem->{'url'},
3189         isbn            = $biblioitem->{'isbn'},
3190         issn            = $biblioitem->{'issn'},
3191         publishercode   = $biblioitem->{'publishercode'},
3192         publicationyear = $biblioitem->{'publicationyear'},
3193         classification  = $biblioitem->{'classification'},
3194         dewey           = $biblioitem->{'dewey'},
3195         subclass        = $biblioitem->{'subclass'},
3196         illus           = $biblioitem->{'illus'},
3197         pages           = $biblioitem->{'pages'},
3198         volumeddesc     = $biblioitem->{'volumeddesc'},
3199         notes           = $biblioitem->{'bnotes'},
3200         size            = $biblioitem->{'size'},
3201         place           = $biblioitem->{'place'},
3202         ccode           = $biblioitem->{'ccode'}
3203         where biblionumber = $biblioitem->{'biblionumber'}";
3204
3205     $dbh->do($query);
3206     if ( $dbh->errstr ) {
3207         warn "ERROR in _koha_modify_biblioitem $query";
3208     }
3209 }
3210
3211 =head2 _koha_add_biblioitem
3212
3213 =over 4
3214
3215 _koha_add_biblioitem( $dbh, $biblioitem );
3216
3217 Internal function to add a biblioitem
3218
3219 =back
3220
3221 =cut
3222
3223 sub _koha_add_biblioitem {
3224     my ( $dbh, $biblioitem ) = @_;
3225
3226     #  my $dbh   = C4Connect;
3227     my $sth = $dbh->prepare("SELECT max(biblioitemnumber) FROM biblioitems");
3228     my $data;
3229     my $bibitemnum;
3230
3231     $sth->execute;
3232     $data       = $sth->fetchrow_arrayref;
3233     $bibitemnum = $$data[0] + 1;
3234
3235     $sth->finish;
3236
3237     $sth = $dbh->prepare(
3238         "INSERT INTO biblioitems SET
3239             biblioitemnumber = ?, biblionumber    = ?,
3240             volume           = ?, number          = ?,
3241             classification   = ?, itemtype        = ?,
3242             url              = ?, isbn            = ?,
3243             issn             = ?, dewey           = ?,
3244             subclass         = ?, publicationyear = ?,
3245             publishercode    = ?, volumedate      = ?,
3246             volumeddesc      = ?, illus           = ?,
3247             pages            = ?, notes           = ?,
3248             size             = ?, lccn            = ?,
3249             marc             = ?, lcsort          =?,
3250             place            = ?, ccode           = ?
3251           "
3252     );
3253     my ($lcsort) =
3254       calculatelc( $biblioitem->{'classification'} )
3255       . $biblioitem->{'subclass'};
3256     $sth->execute(
3257         $bibitemnum,                     $biblioitem->{'biblionumber'},
3258         $biblioitem->{'volume'},         $biblioitem->{'number'},
3259         $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
3260         $biblioitem->{'url'},            $biblioitem->{'isbn'},
3261         $biblioitem->{'issn'},           $biblioitem->{'dewey'},
3262         $biblioitem->{'subclass'},       $biblioitem->{'publicationyear'},
3263         $biblioitem->{'publishercode'},  $biblioitem->{'volumedate'},
3264         $biblioitem->{'volumeddesc'},    $biblioitem->{'illus'},
3265         $biblioitem->{'pages'},          $biblioitem->{'bnotes'},
3266         $biblioitem->{'size'},           $biblioitem->{'lccn'},
3267         $biblioitem->{'marc'},           $biblioitem->{'place'},
3268         $lcsort,                         $biblioitem->{'ccode'}
3269     );
3270     $sth->finish;
3271     return ($bibitemnum);
3272 }
3273
3274 =head2 _koha_new_items
3275
3276 =over 4
3277
3278 _koha_new_items( $dbh, $item, $barcode );
3279
3280 =back
3281
3282 =cut
3283
3284 sub _koha_new_items {
3285     my ( $dbh, $item, $barcode ) = @_;
3286
3287     #  my $dbh   = C4Connect;
3288     my $sth = $dbh->prepare("Select max(itemnumber) from items");
3289     my $data;
3290     my $itemnumber;
3291     my $error = "";
3292
3293     $sth->execute;
3294     $data       = $sth->fetchrow_hashref;
3295     $itemnumber = $data->{'max(itemnumber)'} + 1;
3296     $sth->finish;
3297 ## Now calculate lccalnumber
3298     my ($cutterextra) = itemcalculator(
3299         $dbh,
3300         $item->{'biblioitemnumber'},
3301         $item->{'itemcallnumber'}
3302     );
3303
3304 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
3305     if ( $item->{'loan'} ) {
3306         $item->{'notforloan'} = $item->{'loan'};
3307     }
3308
3309     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
3310     if ( $item->{'dateaccessioned'} eq '' || !$item->{'dateaccessioned'} ) {
3311
3312         $sth = $dbh->prepare(
3313             "Insert into items set
3314             itemnumber           = ?,     biblionumber     = ?,
3315             multivolumepart      = ?,
3316             biblioitemnumber     = ?,     barcode          = ?,
3317             booksellerid         = ?,     dateaccessioned  = NOW(),
3318             homebranch           = ?,     holdingbranch    = ?,
3319             price                = ?,     replacementprice = ?,
3320             replacementpricedate = NOW(), datelastseen     = NOW(),
3321             multivolume          = ?,     stack            = ?,
3322             itemlost             = ?,     wthdrawn         = ?,
3323             paidfor              = ?,     itemnotes        = ?,
3324             itemcallnumber       =?,      notforloan       = ?,
3325             location             = ?,     Cutterextra      = ?
3326           "
3327         );
3328         $sth->execute(
3329             $itemnumber,                $item->{'biblionumber'},
3330             $item->{'multivolumepart'}, $item->{'biblioitemnumber'},
3331             $barcode,                   $item->{'booksellerid'},
3332             $item->{'homebranch'},      $item->{'holdingbranch'},
3333             $item->{'price'},           $item->{'replacementprice'},
3334             $item->{multivolume},       $item->{stack},
3335             $item->{itemlost},          $item->{wthdrawn},
3336             $item->{paidfor},           $item->{'itemnotes'},
3337             $item->{'itemcallnumber'},  $item->{'notforloan'},
3338             $item->{'location'},        $cutterextra
3339         );
3340     }
3341     else {
3342         $sth = $dbh->prepare(
3343             "INSERT INTO items SET
3344             itemnumber           = ?,     biblionumber     = ?,
3345             multivolumepart      = ?,
3346             biblioitemnumber     = ?,     barcode          = ?,
3347             booksellerid         = ?,     dateaccessioned  = ?,
3348             homebranch           = ?,     holdingbranch    = ?,
3349             price                = ?,     replacementprice = ?,
3350             replacementpricedate = NOW(), datelastseen     = NOW(),
3351             multivolume          = ?,     stack            = ?,
3352             itemlost             = ?,     wthdrawn         = ?,
3353             paidfor              = ?,     itemnotes        = ?,
3354             itemcallnumber       = ?,     notforloan       = ?,
3355             location             = ?,
3356             Cutterextra          = ?
3357                             "
3358         );
3359         $sth->execute(
3360             $itemnumber,                 $item->{'biblionumber'},
3361             $item->{'multivolumepart'},  $item->{'biblioitemnumber'},
3362             $barcode,                    $item->{'booksellerid'},
3363             $item->{'dateaccessioned'},  $item->{'homebranch'},
3364             $item->{'holdingbranch'},    $item->{'price'},
3365             $item->{'replacementprice'}, $item->{multivolume},
3366             $item->{stack},              $item->{itemlost},
3367             $item->{wthdrawn},           $item->{paidfor},
3368             $item->{'itemnotes'},        $item->{'itemcallnumber'},
3369             $item->{'notforloan'},       $item->{'location'},
3370             $cutterextra
3371         );
3372     }
3373     if ( defined $sth->errstr ) {
3374         $error .= $sth->errstr;
3375     }
3376     return ( $itemnumber, $error );
3377 }
3378
3379 =head2 _koha_modify_item
3380
3381 =over 4
3382
3383 _koha_modify_item( $dbh, $item, $op );
3384
3385 =back
3386
3387 =cut
3388
3389 sub _koha_modify_item {
3390     my ( $dbh, $item, $op ) = @_;
3391     $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
3392
3393     # if all we're doing is setting statuses, just update those and get out
3394     if ( $op eq "setstatus" ) {
3395         my $query =
3396           "UPDATE items SET itemlost=?,wthdrawn=?,binding=? WHERE itemnumber=?";
3397         my @bind = (
3398             $item->{'itemlost'}, $item->{'wthdrawn'},
3399             $item->{'binding'},  $item->{'itemnumber'}
3400         );
3401         my $sth = $dbh->prepare($query);
3402         $sth->execute(@bind);
3403         $sth->finish;
3404         return undef;
3405     }
3406 ## Now calculate lccalnumber
3407     my ($cutterextra) =
3408       itemcalculator( $dbh, $item->{'bibitemnum'}, $item->{'itemcallnumber'} );
3409
3410     my $query = "UPDATE items SET
3411 barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,homebranch=?,cutterextra=?, onloan=?, binding=?";
3412
3413     my @bind = (
3414         $item->{'barcode'},        $item->{'notes'},
3415         $item->{'itemcallnumber'}, $item->{'notforloan'},
3416         $item->{'location'},       $item->{multivolumepart},
3417         $item->{multivolume},      $item->{stack},
3418         $item->{wthdrawn},         $item->{holdingbranch},
3419         $item->{homebranch},       $cutterextra,
3420         $item->{onloan},           $item->{binding}
3421     );
3422     if ( $item->{'lost'} ne '' ) {
3423         $query =
3424 "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
3425                             itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
3426                              location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,cutterextra=?,onloan=?, binding=?";
3427         @bind = (
3428             $item->{'bibitemnum'},     $item->{'barcode'},
3429             $item->{'notes'},          $item->{'homebranch'},
3430             $item->{'lost'},           $item->{'wthdrawn'},
3431             $item->{'itemcallnumber'}, $item->{'notforloan'},
3432             $item->{'location'},       $item->{multivolumepart},
3433             $item->{multivolume},      $item->{stack},
3434             $item->{wthdrawn},         $item->{holdingbranch},
3435             $cutterextra,              $item->{onloan},
3436             $item->{binding}
3437         );
3438         if ( $item->{homebranch} ) {
3439             $query .= ",homebranch=?";
3440             push @bind, $item->{homebranch};
3441         }
3442         if ( $item->{holdingbranch} ) {
3443             $query .= ",holdingbranch=?";
3444             push @bind, $item->{holdingbranch};
3445         }
3446     }
3447     $query .= " where itemnumber=?";
3448     push @bind, $item->{'itemnum'};
3449     if ( $item->{'replacement'} ne '' ) {
3450         $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
3451     }
3452     my $sth = $dbh->prepare($query);
3453     $sth->execute(@bind);
3454     $sth->finish;
3455 }
3456
3457 =head2 _koha_delete_biblio
3458
3459 =over 4
3460
3461 $error = _koha_delete_biblio($dbh,$biblionumber);
3462
3463 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3464
3465 C<$dbh> - the database handle
3466 C<$biblionumber> - the biblionumber of the biblio to be deleted
3467
3468 =back
3469
3470 =cut
3471
3472 # FIXME: add error handling
3473
3474 sub _koha_delete_biblio {
3475     my ( $dbh, $biblionumber ) = @_;
3476
3477     # get all the data for this biblio
3478     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3479     $sth->execute($biblionumber);
3480
3481     if ( my $data = $sth->fetchrow_hashref ) {
3482
3483         # save the record in deletedbiblio
3484         # find the fields to save
3485         my $query = "INSERT INTO deletedbiblio SET ";
3486         my @bind  = ();
3487         foreach my $temp ( keys %$data ) {
3488             $query .= "$temp = ?,";
3489             push( @bind, $data->{$temp} );
3490         }
3491
3492         # replace the last , by ",?)"
3493         $query =~ s/\,$//;
3494         my $bkup_sth = $dbh->prepare($query);
3495         $bkup_sth->execute(@bind);
3496         $bkup_sth->finish;
3497
3498         # delete the biblio
3499         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3500         $del_sth->execute($biblionumber);
3501         $del_sth->finish;
3502     }
3503     $sth->finish;
3504     return undef;
3505 }
3506
3507 =head2 _koha_delete_biblioitems
3508
3509 =over 4
3510
3511 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3512
3513 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3514
3515 C<$dbh> - the database handle
3516 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3517
3518 =back
3519
3520 =cut
3521
3522 # FIXME: add error handling
3523
3524 sub _koha_delete_biblioitems {
3525     my ( $dbh, $biblioitemnumber ) = @_;
3526
3527     # get all the data for this biblioitem
3528     my $sth =
3529       $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3530     $sth->execute($biblioitemnumber);
3531
3532     if ( my $data = $sth->fetchrow_hashref ) {
3533
3534         # save the record in deletedbiblioitems
3535         # find the fields to save
3536         my $query = "INSERT INTO deletedbiblioitems SET ";
3537         my @bind  = ();
3538         foreach my $temp ( keys %$data ) {
3539             $query .= "$temp = ?,";
3540             push( @bind, $data->{$temp} );
3541         }
3542
3543         # replace the last , by ",?)"
3544         $query =~ s/\,$//;
3545         my $bkup_sth = $dbh->prepare($query);
3546         $bkup_sth->execute(@bind);
3547         $bkup_sth->finish;
3548
3549         # delete the biblioitem
3550         my $del_sth =
3551           $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3552         $del_sth->execute($biblioitemnumber);
3553         $del_sth->finish;
3554     }
3555     $sth->finish;
3556     return undef;
3557 }
3558
3559 =head2 _koha_delete_item
3560
3561 =over 4
3562
3563 _koha_delete_item( $dbh, $itemnum );
3564
3565 Internal function to delete an item record from the koha tables
3566
3567 =back
3568
3569 =cut
3570
3571 sub _koha_delete_item {
3572     my ( $dbh, $itemnum ) = @_;
3573
3574     my $sth = $dbh->prepare("select * from items where itemnumber=?");
3575     $sth->execute($itemnum);
3576     my $data = $sth->fetchrow_hashref;
3577     $sth->finish;
3578     my $query = "Insert into deleteditems set ";
3579     my @bind  = ();
3580     foreach my $temp ( keys %$data ) {
3581         $query .= "$temp = ?,";
3582         push( @bind, $data->{$temp} );
3583     }
3584     $query =~ s/\,$//;
3585
3586     #  print $query;
3587     $sth = $dbh->prepare($query);
3588     $sth->execute(@bind);
3589     $sth->finish;
3590     $sth = $dbh->prepare("Delete from items where itemnumber=?");
3591     $sth->execute($itemnum);
3592     $sth->finish;
3593 }
3594
3595 =head1 UNEXPORTED FUNCTIONS
3596
3597 =over 4
3598
3599 =head2 calculatelc
3600
3601 $lc = calculatelc($classification);
3602
3603 =back
3604
3605 =cut
3606
3607 sub calculatelc {
3608     my ($classification) = @_;
3609     $classification =~ s/^\s+|\s+$//g;
3610     my $i = 0;
3611     my $lc2;
3612     my $lc1;
3613
3614     for ( $i = 0 ; $i < length($classification) ; $i++ ) {
3615         my $c = ( substr( $classification, $i, 1 ) );
3616         if ( $c ge '0' && $c le '9' ) {
3617
3618             $lc2 = substr( $classification, $i );
3619             last;
3620         }
3621         else {
3622             $lc1 .= substr( $classification, $i, 1 );
3623
3624         }
3625     }    #while
3626
3627     my $other = length($lc1);
3628     if ( !$lc1 ) {
3629         $other = 0;
3630     }
3631
3632     my $extras;
3633     if ( $other < 4 ) {
3634         for ( 1 .. ( 4 - $other ) ) {
3635             $extras .= "0";
3636         }
3637     }
3638     $lc1 .= $extras;
3639     $lc2 =~ s/^ //g;
3640
3641     $lc2 =~ s/ //g;
3642     $extras = "";
3643     ##Find the decimal part of $lc2
3644     my $pos = index( $lc2, "." );
3645     if ( $pos < 0 ) { $pos = length($lc2); }
3646     if ( $pos >= 0 && $pos < 5 ) {
3647         ##Pad lc2 with zeros to create a 5digit decimal needed in marc record to sort as numeric
3648
3649         for ( 1 .. ( 5 - $pos ) ) {
3650             $extras .= "0";
3651         }
3652     }
3653     $lc2 = $extras . $lc2;
3654     return ( $lc1 . $lc2 );
3655 }
3656
3657 =head2 itemcalculator
3658
3659 =over 4
3660
3661 $cutterextra = itemcalculator( $dbh, $biblioitem, $callnumber );
3662
3663 =back
3664
3665 =cut
3666
3667 sub itemcalculator {
3668     my ( $dbh, $biblioitem, $callnumber ) = @_;
3669     my $sth =
3670       $dbh->prepare(
3671 "select classification, subclass from biblioitems where biblioitemnumber=?"
3672       );
3673
3674     $sth->execute($biblioitem);
3675     my ( $classification, $subclass ) = $sth->fetchrow;
3676     my $all         = $classification . " " . $subclass;
3677     my $total       = length($all);
3678     my $cutterextra = substr( $callnumber, $total - 1 );
3679
3680     return $cutterextra;
3681 }
3682
3683 =head2 ModBiblioMarc
3684
3685 =over 4
3686
3687 &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3688
3689 Add MARC data for a biblio to koha
3690
3691 Function exported, but should NOT be used, unless you really know what you're doing
3692
3693 =back
3694
3695 =cut
3696
3697 sub ModBiblioMarc {
3698
3699 # pass the MARC::Record to this function, and it will create the records in the marc field
3700     my ( $record, $biblionumber, $frameworkcode ) = @_;
3701     my $dbh = C4::Context->dbh;
3702     my @fields = $record->fields();
3703     if ( !$frameworkcode ) {
3704         $frameworkcode = "";
3705     }
3706     my $sth =
3707       $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3708     $sth->execute( $frameworkcode, $biblionumber );
3709     $sth->finish;
3710     my $encoding = C4::Context->preference("marcflavour");
3711
3712 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3713     if ( $encoding eq "UNIMARC" ) {
3714         my $string;
3715         if ( length($record->subfield( 100, "a" )) == 35 ) {
3716             $string = $record->subfield( 100, "a" );
3717             my $f100 = $record->field(100);
3718             $record->delete_field($f100);
3719         }
3720         else {
3721             $string = POSIX::strftime( "%Y%m%d", localtime );
3722             $string =~ s/\-//g;
3723             $string = sprintf( "%-*s", 35, $string );
3724         }
3725         substr( $string, 22, 6, "frey50" );
3726         unless ( $record->subfield( 100, "a" ) ) {
3727             $record->insert_grouped_field(
3728                 MARC::Field->new( 100, "", "", "a" => $string ) );
3729         }
3730     }
3731 #     warn "biblionumber : ".$biblionumber;
3732     ModZebra($biblionumber,"specialUpdate","biblioserver",$record);
3733     $sth =
3734       $dbh->prepare(
3735         "update biblioitems set marc=?,marcxml=?  where biblionumber=?");
3736     $sth->execute( $record->as_usmarc(), $record->as_xml_record(),
3737         $biblionumber );
3738 #     warn $record->as_xml_record();
3739     $sth->finish;
3740     return $biblionumber;
3741 }
3742
3743 =head2 AddItemInMarc
3744
3745 =over 4
3746
3747 $newbiblionumber = AddItemInMarc( $record, $biblionumber, $frameworkcode );
3748
3749 Add an item in a MARC record and save the MARC record
3750
3751 Function exported, but should NOT be used, unless you really know what you're doing
3752
3753 =back
3754
3755 =cut
3756
3757 sub AddItemInMarc {
3758
3759 # pass the MARC::Record to this function, and it will create the records in the marc tables
3760     my ( $record, $biblionumber, $frameworkcode ) = @_;
3761     my $newrec = &GetMarcBiblio($biblionumber);
3762
3763     # create it
3764     my @fields = $record->fields();
3765     foreach my $field (@fields) {
3766         $newrec->append_fields($field);
3767     }
3768
3769     # FIXME: should we be making sure the biblionumbers are the same?
3770     my $newbiblionumber =
3771       &ModBiblioMarc( $newrec, $biblionumber, $frameworkcode );
3772     return $newbiblionumber;
3773 }
3774
3775 =head2 z3950_extended_services
3776
3777 z3950_extended_services($serviceType,$serviceOptions,$record);
3778
3779     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.
3780
3781 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
3782
3783 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
3784
3785     action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
3786
3787 and maybe
3788
3789     recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
3790     syntax => the record syntax (transfer syntax)
3791     databaseName = Database from connection object
3792
3793     To set serviceOptions, call set_service_options($serviceType)
3794
3795 C<$record> the record, if one is needed for the service type
3796
3797     A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
3798
3799 =cut
3800
3801 sub z3950_extended_services {
3802     my ( $server, $serviceType, $action, $serviceOptions ) = @_;
3803
3804     # get our connection object
3805     my $Zconn = C4::Context->Zconn( $server, 0, 1 );
3806
3807     # create a new package object
3808     my $Zpackage = $Zconn->package();
3809
3810     # set our options
3811     $Zpackage->option( action => $action );
3812
3813     if ( $serviceOptions->{'databaseName'} ) {
3814         $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
3815     }
3816     if ( $serviceOptions->{'recordIdNumber'} ) {
3817         $Zpackage->option(
3818             recordIdNumber => $serviceOptions->{'recordIdNumber'} );
3819     }
3820     if ( $serviceOptions->{'recordIdOpaque'} ) {
3821         $Zpackage->option(
3822             recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
3823     }
3824
3825  # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
3826  #if ($serviceType eq 'itemorder') {
3827  #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
3828  #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
3829  #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
3830  #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
3831  #}
3832
3833     if ( $serviceOptions->{record} ) {
3834         $Zpackage->option( record => $serviceOptions->{record} );
3835
3836         # can be xml or marc
3837         if ( $serviceOptions->{'syntax'} ) {
3838             $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
3839         }
3840     }
3841
3842     # send the request, handle any exception encountered
3843     eval { $Zpackage->send($serviceType) };
3844     if ( $@ && $@->isa("ZOOM::Exception") ) {
3845         return "error:  " . $@->code() . " " . $@->message() . "\n";
3846     }
3847
3848     # free up package resources
3849     $Zpackage->destroy();
3850 }
3851
3852 =head2 set_service_options
3853
3854 my $serviceOptions = set_service_options($serviceType);
3855
3856 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
3857
3858 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
3859
3860 =cut
3861
3862 sub set_service_options {
3863     my ($serviceType) = @_;
3864     my $serviceOptions;
3865
3866 # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
3867 #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
3868
3869     if ( $serviceType eq 'commit' ) {
3870
3871         # nothing to do
3872     }
3873     if ( $serviceType eq 'create' ) {
3874
3875         # nothing to do
3876     }
3877     if ( $serviceType eq 'drop' ) {
3878         die "ERROR: 'drop' not currently supported (by Zebra)";
3879     }
3880     return $serviceOptions;
3881 }
3882
3883 =head2 GetItemsCount
3884
3885 $count = &GetItemsCount( $biblionumber);
3886 this function return count of item with $biblionumber
3887 =cut
3888
3889 sub GetItemsCount {
3890     my ( $biblionumber ) = @_;
3891     my $dbh = C4::Context->dbh;
3892     my $query = qq|SELECT count(*)
3893                   FROM  items
3894                   WHERE biblionumber=?|;
3895     my $sth = $dbh->prepare($query);
3896     $sth->execute($biblionumber);
3897     my $count = $sth->fetchrow;
3898     $sth->finish;
3899     return ($count);
3900 }
3901
3902
3903
3904
3905 END { }    # module clean-up code here (global destructor)
3906
3907 1;
3908
3909 __END__
3910
3911 =head1 AUTHOR
3912
3913 Koha Developement team <info@koha.org>
3914
3915 Paul POULAIN paul.poulain@free.fr
3916
3917 Joshua Ferraro jmf@liblime.com
3918
3919 =cut
3920
3921 # $Id$
3922 # $Log$
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.