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