C4/Biblio.pm

   1 package C4::Biblio;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20 use strict;
  21
  22 require Exporter;
  23 use utf8;
  24 use C4::Context;
  25 use MARC::Record;
  26 use MARC::File::USMARC;
  27 use MARC::File::XML;
  28 use ZOOM;
  29 use C4::Koha;
  30 use C4::Date;
  31 use C4::Log; # logaction
  32
  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,$location, $datelastseen, $branch, $offset, $size ) = @_;
1118     my $dbh = C4::Context->dbh;
1119     my $sth;
1120     if ($datelastseen) {
1121         $datelastseen=format_date_in_iso($datelastseen);
1122         my $query =
1123                 "SELECT itemnumber,barcode,itemcallnumber,title,author,biblio.biblionumber,datelastseen
1124                  FROM items
1125                    LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1126                  WHERE itemcallnumber>= ?
1127                    AND itemcallnumber <=?
1128                    AND (datelastseen< ? OR datelastseen IS NULL)";
1129         $query.= " AND items.location=".$dbh->quote($location) if $location;
1130         $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch;
1131         $query .= " ORDER BY itemcallnumber,title";
1132         $sth = $dbh->prepare($query);
1133         $sth->execute( $minlocation, $maxlocation, $datelastseen );
1134     }
1135     else {
1136         my $query ="
1137                 SELECT itemnumber,barcode,itemcallnumber,biblio.biblionumber,title,author,datelastseen
1138                 FROM items
1139                   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1140                 WHERE itemcallnumber>= ?
1141                   AND itemcallnumber <=?";
1142         $query.= " AND items.location=".$dbh->quote($location) if $location;
1143         $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch;
1144         $query .= " ORDER BY itemcallnumber,title";
1145         $sth = $dbh->prepare($query);
1146         $sth->execute( $minlocation, $maxlocation );
1147     }
1148     my @results;
1149     while ( my $row = $sth->fetchrow_hashref ) {
1150         $offset-- if ($offset);
1151         $row->{datelastseen}=format_date($row->{datelastseen});
1152         if ( ( !$offset ) && $size ) {
1153             push @results, $row;
1154             $size--;
1155         }
1156     }
1157     return \@results;
1158 }
1159
1160 =head2 &GetBiblioItemData
1161
1162 =over 4
1163
1164 $itemdata = &GetBiblioItemData($biblioitemnumber);
1165
1166 Looks up the biblioitem with the given biblioitemnumber. Returns a
1167 reference-to-hash. The keys are the fields from the C<biblio>,
1168 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
1169 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
1170
1171 =back
1172
1173 =cut
1174
1175 #'
1176 sub GetBiblioItemData {
1177     my ($bibitem) = @_;
1178     my $dbh       = C4::Context->dbh;
1179     my $sth       =
1180       $dbh->prepare(
1181 "Select *,biblioitems.notes as bnotes from biblioitems, biblio,itemtypes where biblio.biblionumber = biblioitems.biblionumber and biblioitemnumber = ? and biblioitems.itemtype = itemtypes.itemtype"
1182       );
1183     my $data;
1184
1185     $sth->execute($bibitem);
1186
1187     $data = $sth->fetchrow_hashref;
1188
1189     $sth->finish;
1190     return ($data);
1191 }    # sub &GetBiblioItemData
1192
1193 =head2 GetItemnumberFromBarcode
1194
1195 =over 4
1196
1197 $result = GetItemnumberFromBarcode($barcode);
1198
1199 =back
1200
1201 =cut
1202
1203 sub GetItemnumberFromBarcode {
1204     my ($barcode) = @_;
1205     my $dbh = C4::Context->dbh;
1206
1207     my $rq =
1208       $dbh->prepare("SELECT itemnumber from items where items.barcode=?");
1209     $rq->execute($barcode);
1210     my ($result) = $rq->fetchrow;
1211     return ($result);
1212 }
1213
1214 =head2 GetBiblioItemByBiblioNumber
1215
1216 =over 4
1217
1218 NOTE : This function has been copy/paste from C4/Biblio.pm from head before zebra integration.
1219
1220 =back
1221
1222 =cut
1223
1224 sub GetBiblioItemByBiblioNumber {
1225     my ($biblionumber) = @_;
1226     my $dbh = C4::Context->dbh;
1227     my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
1228     my $count = 0;
1229     my @results;
1230
1231     $sth->execute($biblionumber);
1232
1233     while ( my $data = $sth->fetchrow_hashref ) {
1234         push @results, $data;
1235     }
1236
1237     $sth->finish;
1238     return @results;
1239 }
1240
1241 =head2 GetBiblioFromItemNumber
1242
1243 =over 4
1244
1245 $item = &GetBiblioFromItemNumber($itemnumber);
1246
1247 Looks up the item with the given itemnumber.
1248
1249 C<&itemnodata> returns a reference-to-hash whose keys are the fields
1250 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
1251 database.
1252
1253 =back
1254
1255 =cut
1256
1257 #'
1258 sub GetBiblioFromItemNumber {
1259     my ( $itemnumber ) = @_;
1260     my $dbh = C4::Context->dbh;
1261     my $sth = $dbh->prepare(
1262         "SELECT * FROM biblio,items,biblioitems
1263          WHERE items.itemnumber = ?
1264            AND biblio.biblionumber = items.biblionumber
1265            AND biblioitems.biblioitemnumber = items.biblioitemnumber"
1266     );
1267
1268     $sth->execute($itemnumber);
1269     my $data = $sth->fetchrow_hashref;
1270     $sth->finish;
1271     return ($data);
1272 }
1273
1274 =head2 GetBiblio
1275
1276 =over 4
1277
1278 ( $count, @results ) = &GetBiblio($biblionumber);
1279
1280 =back
1281
1282 =cut
1283
1284 sub GetBiblio {
1285     my ($biblionumber) = @_;
1286     my $dbh = C4::Context->dbh;
1287     my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
1288     my $count = 0;
1289     my @results;
1290     $sth->execute($biblionumber);
1291     while ( my $data = $sth->fetchrow_hashref ) {
1292         $results[$count] = $data;
1293         $count++;
1294     }    # while
1295     $sth->finish;
1296     return ( $count, @results );
1297 }    # sub GetBiblio
1298
1299 =head2 GetItem
1300
1301 =over 4
1302
1303 $data = &GetItem($itemnumber,$barcode);
1304
1305 return Item information, for a given itemnumber or barcode
1306
1307 =back
1308
1309 =cut
1310
1311 sub GetItem {
1312     my ($itemnumber,$barcode) = @_;
1313     my $dbh = C4::Context->dbh;
1314     if ($itemnumber) {
1315         my $sth = $dbh->prepare("
1316             SELECT * FROM items
1317             WHERE itemnumber = ?");
1318         $sth->execute($itemnumber);
1319         my $data = $sth->fetchrow_hashref;
1320         return $data;
1321     } else {
1322         my $sth = $dbh->prepare("
1323             SELECT * FROM items
1324             WHERE barcode = ?"
1325             );
1326         $sth->execute($barcode);
1327         my $data = $sth->fetchrow_hashref;
1328         return $data;
1329     }
1330 }    # sub GetItem
1331
1332 =head2 get_itemnumbers_of
1333
1334 =over 4
1335
1336 my @itemnumbers_of = get_itemnumbers_of(@biblionumbers);
1337
1338 Given a list of biblionumbers, return the list of corresponding itemnumbers
1339 for each biblionumber.
1340
1341 Return a reference on a hash where keys are biblionumbers and values are
1342 references on array of itemnumbers.
1343
1344 =back
1345
1346 =cut
1347
1348 sub get_itemnumbers_of {
1349     my @biblionumbers = @_;
1350
1351     my $dbh = C4::Context->dbh;
1352
1353     my $query = '
1354         SELECT itemnumber,
1355             biblionumber
1356         FROM items
1357         WHERE biblionumber IN (?' . ( ',?' x scalar @biblionumbers - 1 ) . ')
1358     ';
1359     my $sth = $dbh->prepare($query);
1360     $sth->execute(@biblionumbers);
1361
1362     my %itemnumbers_of;
1363
1364     while ( my ( $itemnumber, $biblionumber ) = $sth->fetchrow_array ) {
1365         push @{ $itemnumbers_of{$biblionumber} }, $itemnumber;
1366     }
1367
1368     return \%itemnumbers_of;
1369 }
1370
1371 =head2 GetItemInfosOf
1372
1373 =over 4
1374
1375 GetItemInfosOf(@itemnumbers);
1376
1377 =back
1378
1379 =cut
1380
1381 sub GetItemInfosOf {
1382     my @itemnumbers = @_;
1383
1384     my $query = '
1385         SELECT *
1386         FROM items
1387         WHERE itemnumber IN (' . join( ',', @itemnumbers ) . ')
1388     ';
1389     return get_infos_of( $query, 'itemnumber' );
1390 }
1391
1392 =head2 GetBiblioItemInfosOf
1393
1394 =over 4
1395
1396 GetBiblioItemInfosOf(@biblioitemnumbers);
1397
1398 =back
1399
1400 =cut
1401
1402 sub GetBiblioItemInfosOf {
1403     my @biblioitemnumbers = @_;
1404
1405     my $query = '
1406         SELECT biblioitemnumber,
1407             publicationyear,
1408             itemtype
1409         FROM biblioitems
1410         WHERE biblioitemnumber IN (' . join( ',', @biblioitemnumbers ) . ')
1411     ';
1412     return get_infos_of( $query, 'biblioitemnumber' );
1413 }
1414
1415 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
1416
1417 =head2 GetMarcStructure
1418
1419 =over 4
1420
1421 $res = GetMarcStructure($forlibrarian,$frameworkcode);
1422
1423 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
1424 $forlibrarian  :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
1425 $frameworkcode : the framework code to read
1426
1427 =back
1428
1429 =cut
1430
1431 sub GetMarcStructure {
1432     my ( $forlibrarian, $frameworkcode ) = @_;
1433     my $dbh=C4::Context->dbh;
1434     $frameworkcode = "" unless $frameworkcode;
1435     my $sth;
1436     my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
1437
1438     # check that framework exists
1439     $sth =
1440       $dbh->prepare(
1441         "select count(*) from marc_tag_structure where frameworkcode=?");
1442     $sth->execute($frameworkcode);
1443     my ($total) = $sth->fetchrow;
1444     $frameworkcode = "" unless ( $total > 0 );
1445     $sth =
1446       $dbh->prepare(
1447 "select tagfield,liblibrarian,libopac,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield"
1448       );
1449     $sth->execute($frameworkcode);
1450     my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
1451
1452     while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) =
1453         $sth->fetchrow )
1454     {
1455         $res->{$tag}->{lib} =
1456           ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1457           # why the hell do we need to explicitly decode utf8 ?
1458           # that's a good question, but we must do it...
1459         $res->{$tab}->{tab}        = "";            # XXX
1460         $res->{$tag}->{mandatory}  = $mandatory;
1461         $res->{$tag}->{repeatable} = $repeatable;
1462     }
1463
1464     $sth =
1465       $dbh->prepare(
1466 "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"
1467       );
1468     $sth->execute($frameworkcode);
1469
1470     my $subfield;
1471     my $authorised_value;
1472     my $authtypecode;
1473     my $value_builder;
1474     my $kohafield;
1475     my $seealso;
1476     my $hidden;
1477     my $isurl;
1478     my $link;
1479     my $defaultvalue;
1480
1481     while (
1482         (
1483             $tag,          $subfield,      $liblibrarian,
1484             ,              $libopac,       $tab,
1485             $mandatory,    $repeatable,    $authorised_value,
1486             $authtypecode, $value_builder, $kohafield,
1487             $seealso,      $hidden,        $isurl,
1488             $link,$defaultvalue
1489         )
1490         = $sth->fetchrow
1491       )
1492     {
1493         $res->{$tag}->{$subfield}->{lib} =
1494           ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1495         $res->{$tag}->{$subfield}->{tab}              = $tab;
1496         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
1497         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
1498         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
1499         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
1500         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
1501         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
1502         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
1503         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
1504         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
1505         $res->{$tag}->{$subfield}->{'link'}           = $link;
1506         $res->{$tag}->{$subfield}->{defaultvalue}     = $defaultvalue;
1507     }
1508     return $res;
1509 }
1510
1511 =head2 GetMarcFromKohaField
1512
1513 =over 4
1514
1515 ($MARCfield,$MARCsubfield)=GetMarcFromKohaField($kohafield,$frameworkcode);
1516 Returns the MARC fields & subfields mapped to the koha field
1517 for the given frameworkcode
1518
1519 =back
1520
1521 =cut
1522
1523 sub GetMarcFromKohaField {
1524     my ( $kohafield, $frameworkcode ) = @_;
1525     return 0, 0 unless $kohafield;
1526     my $relations = C4::Context->marcfromkohafield;
1527     return (
1528         $relations->{$frameworkcode}->{$kohafield}->[0],
1529         $relations->{$frameworkcode}->{$kohafield}->[1]
1530     );
1531 }
1532
1533 =head2 GetMarcBiblio
1534
1535 =over 4
1536
1537 Returns MARC::Record of the biblionumber passed in parameter.
1538 the marc record contains both biblio & item datas
1539
1540 =back
1541
1542 =cut
1543
1544 sub GetMarcBiblio {
1545     my $biblionumber = shift;
1546     my $dbh          = C4::Context->dbh;
1547     my $sth          =
1548       $dbh->prepare("select marcxml from biblioitems where biblionumber=? ");
1549     $sth->execute($biblionumber);
1550      my ($marcxml) = $sth->fetchrow;
1551      MARC::File::XML->default_record_format(C4::Context->preference('marcflavour'));
1552      $marcxml =~ s/\x1e//g;
1553      $marcxml =~ s/\x1f//g;
1554      $marcxml =~ s/\x1d//g;
1555      $marcxml =~ s/\x0f//g;
1556      $marcxml =~ s/\x0c//g;
1557 #   warn $marcxml;
1558     my $record = MARC::Record->new();
1559      $record = MARC::Record::new_from_xml( $marcxml, "utf8",C4::Context->preference('marcflavour')) if $marcxml;
1560 #      $record = MARC::Record::new_from_usmarc( $marc) if $marc;
1561     return $record;
1562 }
1563
1564 =head2 GetXmlBiblio
1565
1566 =over 4
1567
1568 my $marcxml = GetXmlBiblio($biblionumber);
1569
1570 Returns biblioitems.marcxml of the biblionumber passed in parameter.
1571 The XML contains both biblio & item datas
1572
1573 =back
1574
1575 =cut
1576
1577 sub GetXmlBiblio {
1578     my ( $biblionumber ) = @_;
1579     my $dbh = C4::Context->dbh;
1580     my $sth =
1581       $dbh->prepare("select marcxml from biblioitems where biblionumber=? ");
1582     $sth->execute($biblionumber);
1583     my ($marcxml) = $sth->fetchrow;
1584     return $marcxml;
1585 }
1586
1587 =head2 GetAuthorisedValueDesc
1588
1589 =over 4
1590
1591 my $subfieldvalue =get_authorised_value_desc(
1592     $tag, $subf[$i][0],$subf[$i][1], '', $taglib);
1593 Retrieve the complete description for a given authorised value.
1594
1595 =back
1596
1597 =cut
1598
1599 sub GetAuthorisedValueDesc {
1600     my ( $tag, $subfield, $value, $framework, $tagslib ) = @_;
1601     my $dbh = C4::Context->dbh;
1602
1603     #---- branch
1604     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1605         return C4::Branch::GetBranchName($value);
1606     }
1607
1608     #---- itemtypes
1609     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1610         return getitemtypeinfo($value)->{description};
1611     }
1612
1613     #---- "true" authorized value
1614     my $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1615     if ( $category ne "" ) {
1616         my $sth =
1617           $dbh->prepare(
1618             "select lib from authorised_values where category = ? and authorised_value = ?"
1619           );
1620         $sth->execute( $category, $value );
1621         my $data = $sth->fetchrow_hashref;
1622         return $data->{'lib'};
1623     }
1624     else {
1625         return $value;    # if nothing is found return the original value
1626     }
1627 }
1628
1629 =head2 GetMarcItem
1630
1631 =over 4
1632
1633 Returns MARC::Record of the item passed in parameter.
1634
1635 =back
1636
1637 =cut
1638
1639 sub GetMarcItem {
1640     my ( $biblionumber, $itemnumber ) = @_;
1641     my $dbh = C4::Context->dbh;
1642     my $newrecord = MARC::Record->new();
1643     my $marcflavour = C4::Context->preference('marcflavour');
1644
1645     my $marcxml = GetXmlBiblio($biblionumber);
1646     my $record = MARC::Record->new();
1647     $record = MARC::Record::new_from_xml( $marcxml, "utf8", $marcflavour );
1648     # now, find where the itemnumber is stored & extract only the item
1649     my ( $itemnumberfield, $itemnumbersubfield ) =
1650       GetMarcFromKohaField( 'items.itemnumber', '' );
1651     my @fields = $record->field($itemnumberfield);
1652     foreach my $field (@fields) {
1653         if ( $field->subfield($itemnumbersubfield) eq $itemnumber ) {
1654             $newrecord->insert_fields_ordered($field);
1655         }
1656     }
1657     return $newrecord;
1658 }
1659
1660
1661
1662 =head2 GetMarcNotes
1663
1664 =over 4
1665
1666 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1667 Get all notes from the MARC record and returns them in an array.
1668 The note are stored in differents places depending on MARC flavour
1669
1670 =back
1671
1672 =cut
1673
1674 sub GetMarcNotes {
1675     my ( $record, $marcflavour ) = @_;
1676     my $scope;
1677     if ( $marcflavour eq "MARC21" ) {
1678         $scope = '5..';
1679     }
1680     else {    # assume unimarc if not marc21
1681         $scope = '3..';
1682     }
1683     my @marcnotes;
1684     my $note = "";
1685     my $tag  = "";
1686     my $marcnote;
1687     foreach my $field ( $record->field($scope) ) {
1688         my $value = $field->as_string();
1689         if ( $note ne "" ) {
1690             $marcnote = { marcnote => $note, };
1691             push @marcnotes, $marcnote;
1692             $note = $value;
1693         }
1694         if ( $note ne $value ) {
1695             $note = $note . " " . $value;
1696         }
1697     }
1698
1699     if ( $note ) {
1700         $marcnote = { marcnote => $note };
1701         push @marcnotes, $marcnote;    #load last tag into array
1702     }
1703     return \@marcnotes;
1704 }    # end GetMarcNotes
1705
1706 =head2 GetMarcSubjects
1707
1708 =over 4
1709
1710 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1711 Get all subjects from the MARC record and returns them in an array.
1712 The subjects are stored in differents places depending on MARC flavour
1713
1714 =back
1715
1716 =cut
1717
1718 sub GetMarcSubjects {
1719     my ( $record, $marcflavour ) = @_;
1720     my ( $mintag, $maxtag );
1721     if ( $marcflavour eq "MARC21" ) {
1722         $mintag = "600";
1723         $maxtag = "699";
1724     }
1725     else {    # assume unimarc if not marc21
1726         $mintag = "600";
1727         $maxtag = "611";
1728     }
1729
1730     my @marcsubjcts;
1731
1732     foreach my $field ( $record->fields ) {
1733         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1734         my @subfields = $field->subfields();
1735         my $link = "su:";
1736         my $label;
1737         my $flag = 0;
1738         my $authoritysep=C4::Context->preference("authoritysep");
1739         for my $subject_subfield ( @subfields ) {
1740             if (
1741                 $marcflavour ne 'MARC21'
1742                 and (
1743                     ($subject_subfield->[0] eq '3') or
1744                     ($subject_subfield->[0] eq '4') or
1745                     ($subject_subfield->[0] eq '5')
1746                 )
1747             )
1748             {
1749                 next;
1750             }
1751             my $code = $subject_subfield->[0];
1752             $label .= $subject_subfield->[1].$authoritysep unless ( $code == 9 );
1753             $link  .= " and su-to:".$subject_subfield->[1]  unless ( $code == 9 );
1754             if ( $code == 9 ) {
1755                 $link = "an:".$subject_subfield->[1];
1756                 $flag = 1;
1757             }
1758             elsif ( ! $flag ) {
1759                 $link =~ s/ and\ssu-to:$//;
1760             }
1761         }
1762          $label =~ s/$authoritysep$//;
1763         push @marcsubjcts,
1764           {
1765             label => $label,
1766             link  => $link
1767           }
1768     }
1769     return \@marcsubjcts;
1770 }    #end GetMarcSubjects
1771
1772 =head2 GetMarcAuthors
1773
1774 =over 4
1775
1776 authors = GetMarcAuthors($record,$marcflavour);
1777 Get all authors from the MARC record and returns them in an array.
1778 The authors are stored in differents places depending on MARC flavour
1779
1780 =back
1781
1782 =cut
1783
1784 sub GetMarcAuthors {
1785     my ( $record, $marcflavour ) = @_;
1786     my ( $mintag, $maxtag );
1787     if ( $marcflavour eq "MARC21" ) {
1788         $mintag = "100";
1789         $maxtag = "111";
1790     }
1791     else {    # assume unimarc if not marc21
1792         $mintag = "701";
1793         $maxtag = "712";
1794     }
1795
1796     my @marcauthors;
1797
1798     foreach my $field ( $record->fields ) {
1799         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1800         my %hash;
1801         my @subfields = $field->subfields();
1802         my $count_auth = 0;
1803         my $and ;
1804         for my $authors_subfield (@subfields) {
1805             if (
1806                 $marcflavour ne 'MARC21'
1807                 and (
1808                     ($authors_subfield->[0] eq '3') or
1809                     ($authors_subfield->[0] eq '4') or
1810                     ($authors_subfield->[0] eq '5')
1811                 )
1812             )
1813             {
1814                 next;
1815             }
1816             if ($count_auth ne '0'){
1817                 $and = " and au:";
1818             }
1819             $count_auth++;
1820             my $subfieldcode = $authors_subfield->[0];
1821             my $value        = $authors_subfield->[1];
1822             $hash{tag}       = $field->tag;
1823             $hash{value}    .= $value . " " if ($subfieldcode != 9) ;
1824             $hash{link}     .= $value if ($subfieldcode eq 9);
1825         }
1826         push @marcauthors, \%hash;
1827     }
1828     return \@marcauthors;
1829 }
1830
1831 =head2 GetMarcSeries
1832
1833 =over 4
1834
1835 $marcseriessarray = GetMarcSeries($record,$marcflavour);
1836 Get all series from the MARC record and returns them in an array.
1837 The series are stored in differents places depending on MARC flavour
1838
1839 =back
1840
1841 =cut
1842
1843 sub GetMarcSeries {
1844     my ($record, $marcflavour) = @_;
1845     my ($mintag, $maxtag);
1846     if ($marcflavour eq "MARC21") {
1847         $mintag = "440";
1848         $maxtag = "490";
1849     } else {           # assume unimarc if not marc21
1850         $mintag = "600";
1851         $maxtag = "619";
1852     }
1853
1854     my @marcseries;
1855     my $subjct = "";
1856     my $subfield = "";
1857     my $marcsubjct;
1858
1859     foreach my $field ($record->field('440'), $record->field('490')) {
1860         my @subfields_loop;
1861         #my $value = $field->subfield('a');
1862         #$marcsubjct = {MARCSUBJCT => $value,};
1863         my @subfields = $field->subfields();
1864         #warn "subfields:".join " ", @$subfields;
1865         my $counter = 0;
1866         my @link_loop;
1867         for my $series_subfield (@subfields) {
1868                         my $volume_number;
1869                         undef $volume_number;
1870                         # see if this is an instance of a volume
1871                         if ($series_subfield->[0] eq 'v') {
1872                                 $volume_number=1;
1873                         }
1874
1875             my $code = $series_subfield->[0];
1876             my $value = $series_subfield->[1];
1877             my $linkvalue = $value;
1878             $linkvalue =~ s/(\(|\))//g;
1879             my $operator = " and " unless $counter==0;
1880             push @link_loop, {link => $linkvalue, operator => $operator };
1881             my $separator = C4::Context->preference("authoritysep") unless $counter==0;
1882                         if ($volume_number) {
1883                         push @subfields_loop, {volumenum => $value};
1884                         }
1885                         else {
1886             push @subfields_loop, {code => $code, value => $value, link_loop => \@link_loop, separator => $separator, volumenum => $volume_number};
1887                         }
1888             $counter++;
1889         }
1890         push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1891         #$marcsubjct = {MARCSUBJCT => $field->as_string(),};
1892         #push @marcsubjcts, $marcsubjct;
1893         #$subjct = $value;
1894
1895     }
1896     my $marcseriessarray=\@marcseries;
1897     return $marcseriessarray;
1898 }  #end getMARCseriess
1899
1900 =head2 GetFrameworkCode
1901
1902 =over 4
1903
1904 $frameworkcode = GetFrameworkCode( $biblionumber )
1905
1906 =back
1907
1908 =cut
1909
1910 sub GetFrameworkCode {
1911     my ( $biblionumber ) = @_;
1912     my $dbh = C4::Context->dbh;
1913     my $sth =
1914       $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
1915     $sth->execute($biblionumber);
1916     my ($frameworkcode) = $sth->fetchrow;
1917     return $frameworkcode;
1918 }
1919
1920 =head2 TransformKohaToMarc
1921
1922 =over 4
1923
1924 $record = TransformKohaToMarc( $hash )
1925 This function builds partial MARC::Record from a hash
1926 Hash entries can be from biblio or biblioitems.
1927 This function is called in acquisition module, to create a basic catalogue entry from user entry
1928
1929 =back
1930
1931 =cut
1932
1933 sub TransformKohaToMarc {
1934
1935     my ( $hash ) = @_;
1936     my $dbh = C4::Context->dbh;
1937     my $sth =
1938     $dbh->prepare(
1939         "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
1940     );
1941     my $record = MARC::Record->new();
1942     foreach (keys %{$hash}) {
1943         &TransformKohaToMarcOneField( $sth, $record, $_,
1944             $hash->{$_}, '' );
1945         }
1946     return $record;
1947 }
1948
1949 =head2 TransformKohaToMarcOneField
1950
1951 =over 4
1952
1953 $record = TransformKohaToMarcOneField( $sth, $record, $kohafieldname, $value, $frameworkcode );
1954
1955 =back
1956
1957 =cut
1958
1959 sub TransformKohaToMarcOneField {
1960     my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_;
1961     $frameworkcode='' unless $frameworkcode;
1962     my $tagfield;
1963     my $tagsubfield;
1964
1965     if ( !defined $sth ) {
1966         my $dbh = C4::Context->dbh;
1967         $sth =
1968           $dbh->prepare(
1969 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
1970           );
1971     }
1972     $sth->execute( $frameworkcode, $kohafieldname );
1973     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
1974         my $tag = $record->field($tagfield);
1975         if ($tag) {
1976             $tag->update( $tagsubfield => $value );
1977             $record->delete_field($tag);
1978             $record->insert_fields_ordered($tag);
1979         }
1980         else {
1981             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
1982         }
1983     }
1984     return $record;
1985 }
1986
1987 =head2 TransformHtmlToXml
1988
1989 =over 4
1990
1991 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type )
1992
1993 $auth_type contains :
1994 - nothing : rebuild a biblio, un UNIMARC the encoding is in 100$a pos 26/27
1995 - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
1996 - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
1997 =back
1998
1999 =cut
2000
2001 sub TransformHtmlToXml {
2002     my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2003     my $xml = MARC::File::XML::header('UTF-8');
2004     $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2005     MARC::File::XML->default_record_format($auth_type);
2006     # in UNIMARC, field 100 contains the encoding
2007     # check that there is one, otherwise the
2008     # MARC::Record->new_from_xml will fail (and Koha will die)
2009     my $unimarc_and_100_exist=0;
2010     $unimarc_and_100_exist=1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
2011     my $prevvalue;
2012     my $prevtag = -1;
2013     my $first   = 1;
2014     my $j       = -1;
2015     for ( my $i = 0 ; $i <= @$tags ; $i++ ) {
2016         if (C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a") {
2017             # if we have a 100 field and it's values are not correct, skip them.
2018             # if we don't have any valid 100 field, we will create a default one at the end
2019             my $enc = substr( @$values[$i], 26, 2 );
2020             if ($enc eq '01' or $enc eq '50' or $enc eq '03') {
2021                 $unimarc_and_100_exist=1;
2022             } else {
2023                 next;
2024             }
2025         }
2026         @$values[$i] =~ s/&/&amp;/g;
2027         @$values[$i] =~ s/</&lt;/g;
2028         @$values[$i] =~ s/>/&gt;/g;
2029         @$values[$i] =~ s/"/&quot;/g;
2030         @$values[$i] =~ s/'/&apos;/g;
2031 #         if ( !utf8::is_utf8( @$values[$i] ) ) {
2032 #             utf8::decode( @$values[$i] );
2033 #         }
2034         if ( ( @$tags[$i] ne $prevtag ) ) {
2035             $j++ unless ( @$tags[$i] eq "" );
2036             if ( !$first ) {
2037                 $xml .= "</datafield>\n";
2038                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
2039                     && ( @$values[$i] ne "" ) )
2040                 {
2041                     my $ind1 = substr( @$indicator[$j], 0, 1 );
2042                     my $ind2;
2043                     if ( @$indicator[$j] ) {
2044                         $ind2 = substr( @$indicator[$j], 1, 1 );
2045                     }
2046                     else {
2047                         warn "Indicator in @$tags[$i] is empty";
2048                         $ind2 = " ";
2049                     }
2050                     $xml .=
2051 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2052                     $xml .=
2053 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2054                     $first = 0;
2055                 }
2056                 else {
2057                     $first = 1;
2058                 }
2059             }
2060             else {
2061                 if ( @$values[$i] ne "" ) {
2062
2063                     # leader
2064                     if ( @$tags[$i] eq "000" ) {
2065                         $xml .= "<leader>@$values[$i]</leader>\n";
2066                         $first = 1;
2067
2068                         # rest of the fixed fields
2069                     }
2070                     elsif ( @$tags[$i] < 10 ) {
2071                         $xml .=
2072 "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2073                         $first = 1;
2074                     }
2075                     else {
2076                         my $ind1 = substr( @$indicator[$j], 0, 1 );
2077                         my $ind2 = substr( @$indicator[$j], 1, 1 );
2078                         $xml .=
2079 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2080                         $xml .=
2081 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2082                         $first = 0;
2083                     }
2084                 }
2085             }
2086         }
2087         else {    # @$tags[$i] eq $prevtag
2088             if ( @$values[$i] eq "" ) {
2089             }
2090             else {
2091                 if ($first) {
2092                     my $ind1 = substr( @$indicator[$j], 0, 1 );
2093                     my $ind2 = substr( @$indicator[$j], 1, 1 );
2094                     $xml .=
2095 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2096                     $first = 0;
2097                 }
2098                 $xml .=
2099 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2100             }
2101         }
2102         $prevtag = @$tags[$i];
2103     }
2104     if (C4::Context->preference('marcflavour') and !$unimarc_and_100_exist) {
2105 #     warn "SETTING 100 for $auth_type";
2106         use POSIX qw(strftime);
2107         my $string = strftime( "%Y%m%d", localtime(time) );
2108         # set 50 to position 26 is biblios, 13 if authorities
2109         my $pos=26;
2110         $pos=13 if $auth_type eq 'UNIMARCAUTH';
2111         $string = sprintf( "%-*s", 35, $string );
2112         substr( $string, $pos , 6, "50" );
2113         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2114         $xml .= "<subfield code=\"a\">$string</subfield>\n";
2115         $xml .= "</datafield>\n";
2116     }
2117     $xml .= MARC::File::XML::footer();
2118     return $xml;
2119 }
2120
2121 =head2 TransformHtmlToMarc
2122
2123 =over 4
2124
2125 $record = TransformHtmlToMarc( $dbh, $rtags, $rsubfields, $rvalues, %indicators )
2126
2127 =back
2128
2129 =cut
2130
2131 sub TransformHtmlToMarc {
2132     my ( $dbh, $rtags, $rsubfields, $rvalues, %indicators ) = @_;
2133     my $prevtag = -1;
2134     my $record  = MARC::Record->new();
2135
2136     #     my %subfieldlist=();
2137     my $prevvalue;    # if tag <10
2138     my $field;        # if tag >=10
2139     for ( my $i = 0 ; $i < @$rtags ; $i++ ) {
2140         next unless @$rvalues[$i];
2141
2142  # rebuild MARC::Record
2143  #             warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
2144         if ( @$rtags[$i] ne $prevtag ) {
2145             if ( $prevtag < 10 ) {
2146                 if ($prevvalue) {
2147
2148                     if ( $prevtag ne '000' ) {
2149                         $record->insert_fields_ordered(
2150                             ( sprintf "%03s", $prevtag ), $prevvalue );
2151                     }
2152                     else {
2153
2154                         $record->leader($prevvalue);
2155
2156                     }
2157                 }
2158             }
2159             else {
2160                 if ($field) {
2161                     $record->insert_fields_ordered($field);
2162                 }
2163             }
2164             $indicators{ @$rtags[$i] } .= '  ';
2165             if ( @$rtags[$i] < 10 ) {
2166                 $prevvalue = @$rvalues[$i];
2167                 undef $field;
2168             }
2169             else {
2170                 undef $prevvalue;
2171                 $field = MARC::Field->new(
2172                     ( sprintf "%03s", @$rtags[$i] ),
2173                     substr( $indicators{ @$rtags[$i] }, 0, 1 ),
2174                     substr( $indicators{ @$rtags[$i] }, 1, 1 ),
2175                     @$rsubfields[$i] => @$rvalues[$i]
2176                 );
2177             }
2178             $prevtag = @$rtags[$i];
2179         }
2180         else {
2181             if ( @$rtags[$i] < 10 ) {
2182                 $prevvalue = @$rvalues[$i];
2183             }
2184             else {
2185                 if ( length( @$rvalues[$i] ) > 0 ) {
2186                     $field->add_subfields( @$rsubfields[$i] => @$rvalues[$i] );
2187                 }
2188             }
2189             $prevtag = @$rtags[$i];
2190         }
2191     }
2192
2193     # the last has not been included inside the loop... do it now !
2194     $record->insert_fields_ordered($field) if $field;
2195
2196     $record->encoding('UTF-8');
2197
2198     #    $record->MARC::File::USMARC::update_leader();
2199     return $record;
2200 }
2201
2202 =head2 TransformMarcToKoha
2203
2204 =over 4
2205
2206 $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
2207
2208 =back
2209
2210 =cut
2211
2212 sub TransformMarcToKoha {
2213     my ( $dbh, $record, $frameworkcode ) = @_;
2214     my $sth =
2215       $dbh->prepare(
2216 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
2217       );
2218     my $result;
2219     my $sth2 = $dbh->prepare("SHOW COLUMNS from biblio");
2220     $sth2->execute;
2221     my $field;
2222     while ( ($field) = $sth2->fetchrow ) {
2223         $result =
2224           &TransformMarcToKohaOneField( "biblio", $field, $record, $result,
2225             $frameworkcode );
2226     }
2227     $sth2 = $dbh->prepare("SHOW COLUMNS from biblioitems");
2228     $sth2->execute;
2229     while ( ($field) = $sth2->fetchrow ) {
2230         if ( $field eq 'notes' ) { $field = 'bnotes'; }
2231         $result =
2232           &TransformMarcToKohaOneField( "biblioitems", $field, $record, $result,
2233             $frameworkcode );
2234     }
2235     $sth2 = $dbh->prepare("SHOW COLUMNS from items");
2236     $sth2->execute;
2237     while ( ($field) = $sth2->fetchrow ) {
2238         $result =
2239           &TransformMarcToKohaOneField( "items", $field, $record, $result,
2240             $frameworkcode );
2241     }
2242
2243     #
2244     # modify copyrightdate to keep only the 1st year found
2245     my $temp = $result->{'copyrightdate'};
2246     $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2247     if ( $1 > 0 ) {
2248         $result->{'copyrightdate'} = $1;
2249     }
2250     else {                      # if no cYYYY, get the 1st date.
2251         $temp =~ m/(\d\d\d\d)/;
2252         $result->{'copyrightdate'} = $1;
2253     }
2254
2255     # modify publicationyear to keep only the 1st year found
2256     $temp = $result->{'publicationyear'};
2257     $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2258     if ( $1 > 0 ) {
2259         $result->{'publicationyear'} = $1;
2260     }
2261     else {                      # if no cYYYY, get the 1st date.
2262         $temp =~ m/(\d\d\d\d)/;
2263         $result->{'publicationyear'} = $1;
2264     }
2265     return $result;
2266 }
2267
2268 =head2 TransformMarcToKohaOneField
2269
2270 =over 4
2271
2272 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2273
2274 =back
2275
2276 =cut
2277
2278 sub TransformMarcToKohaOneField {
2279
2280 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
2281     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2282
2283     my $res = "";
2284     my ( $tagfield, $subfield ) =
2285       GetMarcFromKohaField( $kohatable . "." . $kohafield,
2286         $frameworkcode );
2287     foreach my $field ( $record->field($tagfield) ) {
2288         if ( $field->tag() < 10 ) {
2289             if ( $result->{$kohafield} ) {
2290                 $result->{$kohafield} .= " | " . $field->data();
2291             }
2292             else {
2293                 $result->{$kohafield} = $field->data();
2294             }
2295         }
2296         else {
2297             if ( $field->subfields ) {
2298                 my @subfields = $field->subfields();
2299                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2300                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2301                         if ( $result->{$kohafield} ) {
2302                             $result->{$kohafield} .=
2303                               " | " . $subfields[$subfieldcount][1];
2304                         }
2305                         else {
2306                             $result->{$kohafield} =
2307                               $subfields[$subfieldcount][1];
2308                         }
2309                     }
2310                 }
2311             }
2312         }
2313     }
2314     return $result;
2315 }
2316 =head1  OTHER FUNCTIONS
2317
2318 =head2 char_decode
2319
2320 =over 4
2321
2322 my $string = char_decode( $string, $encoding );
2323
2324 converts ISO 5426 coded string to UTF-8
2325 sloppy code : should be improved in next issue
2326
2327 =back
2328
2329 =cut
2330
2331 sub char_decode {
2332     my ( $string, $encoding ) = @_;
2333     $_ = $string;
2334
2335     $encoding = C4::Context->preference("marcflavour") unless $encoding;
2336     if ( $encoding eq "UNIMARC" ) {
2337
2338         #         s/\xe1/Æ/gm;
2339         s/\xe2/Ğ/gm;
2340         s/\xe9/Ø/gm;
2341         s/\xec/ş/gm;
2342         s/\xf1/æ/gm;
2343         s/\xf3/ğ/gm;
2344         s/\xf9/ø/gm;
2345         s/\xfb/ß/gm;
2346         s/\xc1\x61/à/gm;
2347         s/\xc1\x65/è/gm;
2348         s/\xc1\x69/ì/gm;
2349         s/\xc1\x6f/ò/gm;
2350         s/\xc1\x75/ù/gm;
2351         s/\xc1\x41/À/gm;
2352         s/\xc1\x45/È/gm;
2353         s/\xc1\x49/Ì/gm;
2354         s/\xc1\x4f/Ò/gm;
2355         s/\xc1\x55/Ù/gm;
2356         s/\xc2\x41/Á/gm;
2357         s/\xc2\x45/É/gm;
2358         s/\xc2\x49/Í/gm;
2359         s/\xc2\x4f/Ó/gm;
2360         s/\xc2\x55/Ú/gm;
2361         s/\xc2\x59/İ/gm;
2362         s/\xc2\x61/á/gm;
2363         s/\xc2\x65/é/gm;
2364         s/\xc2\x69/í/gm;
2365         s/\xc2\x6f/ó/gm;
2366         s/\xc2\x75/ú/gm;
2367         s/\xc2\x79/ı/gm;
2368         s/\xc3\x41/Â/gm;
2369         s/\xc3\x45/Ê/gm;
2370         s/\xc3\x49/Î/gm;
2371         s/\xc3\x4f/Ô/gm;
2372         s/\xc3\x55/Û/gm;
2373         s/\xc3\x61/â/gm;
2374         s/\xc3\x65/ê/gm;
2375         s/\xc3\x69/î/gm;
2376         s/\xc3\x6f/ô/gm;
2377         s/\xc3\x75/û/gm;
2378         s/\xc4\x41/Ã/gm;
2379         s/\xc4\x4e/Ñ/gm;
2380         s/\xc4\x4f/Õ/gm;
2381         s/\xc4\x61/ã/gm;
2382         s/\xc4\x6e/ñ/gm;
2383         s/\xc4\x6f/õ/gm;
2384         s/\xc8\x41/Ä/gm;
2385         s/\xc8\x45/Ë/gm;
2386         s/\xc8\x49/Ï/gm;
2387         s/\xc8\x61/ä/gm;
2388         s/\xc8\x65/ë/gm;
2389         s/\xc8\x69/ï/gm;
2390         s/\xc8\x6F/ö/gm;
2391         s/\xc8\x75/ü/gm;
2392         s/\xc8\x76/ÿ/gm;
2393         s/\xc9\x41/Ä/gm;
2394         s/\xc9\x45/Ë/gm;
2395         s/\xc9\x49/Ï/gm;
2396         s/\xc9\x4f/Ö/gm;
2397         s/\xc9\x55/Ü/gm;
2398         s/\xc9\x61/ä/gm;
2399         s/\xc9\x6f/ö/gm;
2400         s/\xc9\x75/ü/gm;
2401         s/\xca\x41/Å/gm;
2402         s/\xca\x61/å/gm;
2403         s/\xd0\x43/Ç/gm;
2404         s/\xd0\x63/ç/gm;
2405
2406         # this handles non-sorting blocks (if implementation requires this)
2407         $string = nsb_clean($_);
2408     }
2409     elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2410         ##MARC-8 to UTF-8
2411
2412         s/\xe1\x61/à/gm;
2413         s/\xe1\x65/è/gm;
2414         s/\xe1\x69/ì/gm;
2415         s/\xe1\x6f/ò/gm;
2416         s/\xe1\x75/ù/gm;
2417         s/\xe1\x41/À/gm;
2418         s/\xe1\x45/È/gm;
2419         s/\xe1\x49/Ì/gm;
2420         s/\xe1\x4f/Ò/gm;
2421         s/\xe1\x55/Ù/gm;
2422         s/\xe2\x41/Á/gm;
2423         s/\xe2\x45/É/gm;
2424         s/\xe2\x49/Í/gm;
2425         s/\xe2\x4f/Ó/gm;
2426         s/\xe2\x55/Ú/gm;
2427         s/\xe2\x59/İ/gm;
2428         s/\xe2\x61/á/gm;
2429         s/\xe2\x65/é/gm;
2430         s/\xe2\x69/í/gm;
2431         s/\xe2\x6f/ó/gm;
2432         s/\xe2\x75/ú/gm;
2433         s/\xe2\x79/ı/gm;
2434         s/\xe3\x41/Â/gm;
2435         s/\xe3\x45/Ê/gm;
2436         s/\xe3\x49/Î/gm;
2437         s/\xe3\x4f/Ô/gm;
2438         s/\xe3\x55/Û/gm;
2439         s/\xe3\x61/â/gm;
2440         s/\xe3\x65/ê/gm;
2441         s/\xe3\x69/î/gm;
2442         s/\xe3\x6f/ô/gm;
2443         s/\xe3\x75/û/gm;
2444         s/\xe4\x41/Ã/gm;
2445         s/\xe4\x4e/Ñ/gm;
2446         s/\xe4\x4f/Õ/gm;
2447         s/\xe4\x61/ã/gm;
2448         s/\xe4\x6e/ñ/gm;
2449         s/\xe4\x6f/õ/gm;
2450         s/\xe6\x41/Ă/gm;
2451         s/\xe6\x45/Ĕ/gm;
2452         s/\xe6\x65/ĕ/gm;
2453         s/\xe6\x61/ă/gm;
2454         s/\xe8\x45/Ë/gm;
2455         s/\xe8\x49/Ï/gm;
2456         s/\xe8\x65/ë/gm;
2457         s/\xe8\x69/ï/gm;
2458         s/\xe8\x76/ÿ/gm;
2459         s/\xe9\x41/A/gm;
2460         s/\xe9\x4f/O/gm;
2461         s/\xe9\x55/U/gm;
2462         s/\xe9\x61/a/gm;
2463         s/\xe9\x6f/o/gm;
2464         s/\xe9\x75/u/gm;
2465         s/\xea\x41/A/gm;
2466         s/\xea\x61/a/gm;
2467
2468         #Additional Turkish characters
2469         s/\x1b//gm;
2470         s/\x1e//gm;
2471         s/(\xf0)s/\xc5\x9f/gm;
2472         s/(\xf0)S/\xc5\x9e/gm;
2473         s/(\xf0)c/ç/gm;
2474         s/(\xf0)C/Ç/gm;
2475         s/\xe7\x49/\\xc4\xb0/gm;
2476         s/(\xe6)G/\xc4\x9e/gm;
2477         s/(\xe6)g/ğ\xc4\x9f/gm;
2478         s/\xB8/ı/gm;
2479         s/\xB9/£/gm;
2480         s/(\xe8|\xc8)o/ö/gm;
2481         s/(\xe8|\xc8)O/Ö/gm;
2482         s/(\xe8|\xc8)u/ü/gm;
2483         s/(\xe8|\xc8)U/Ü/gm;
2484         s/\xc2\xb8/\xc4\xb1/gm;
2485         s/¸/\xc4\xb1/gm;
2486
2487         # this handles non-sorting blocks (if implementation requires this)
2488         $string = nsb_clean($_);
2489     }
2490     return ($string);
2491 }
2492
2493 =head2 nsb_clean
2494
2495 =over 4
2496
2497 my $string = nsb_clean( $string, $encoding );
2498
2499 =back
2500
2501 =cut
2502
2503 sub nsb_clean {
2504     my $NSB      = '\x88';    # NSB : begin Non Sorting Block
2505     my $NSE      = '\x89';    # NSE : Non Sorting Block end
2506                               # handles non sorting blocks
2507     my ($string) = @_;
2508     $_ = $string;
2509     s/$NSB/(/gm;
2510     s/[ ]{0,1}$NSE/) /gm;
2511     $string = $_;
2512     return ($string);
2513 }
2514
2515 =head2 PrepareItemrecordDisplay
2516
2517 =over 4
2518
2519 PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber);
2520
2521 Returns a hash with all the fields for Display a given item data in a template
2522
2523 =back
2524
2525 =cut
2526
2527 sub PrepareItemrecordDisplay {
2528
2529     my ( $bibnum, $itemnum ) = @_;
2530
2531     my $dbh = C4::Context->dbh;
2532     my $frameworkcode = &GetFrameworkCode( $bibnum );
2533     my ( $itemtagfield, $itemtagsubfield ) =
2534       &GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2535     my $tagslib = &GetMarcStructure( 1, $frameworkcode );
2536     my $itemrecord = GetMarcItem( $bibnum, $itemnum) if ($itemnum);
2537     my @loop_data;
2538     my $authorised_values_sth =
2539       $dbh->prepare(
2540 "select authorised_value,lib from authorised_values where category=? order by lib"
2541       );
2542     foreach my $tag ( sort keys %{$tagslib} ) {
2543         my $previous_tag = '';
2544         if ( $tag ne '' ) {
2545             # loop through each subfield
2546             my $cntsubf;
2547             foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
2548                 next if ( subfield_is_koha_internal_p($subfield) );
2549                 next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
2550                 my %subfield_data;
2551                 $subfield_data{tag}           = $tag;
2552                 $subfield_data{subfield}      = $subfield;
2553                 $subfield_data{countsubfield} = $cntsubf++;
2554                 $subfield_data{kohafield}     =
2555                   $tagslib->{$tag}->{$subfield}->{'kohafield'};
2556
2557          #        $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
2558                 $subfield_data{marc_lib} =
2559                     "<span id=\"error\" title=\""
2560                   . $tagslib->{$tag}->{$subfield}->{lib} . "\">"
2561                   . substr( $tagslib->{$tag}->{$subfield}->{lib}, 0, 12 )
2562                   . "</span>";
2563                 $subfield_data{mandatory} =
2564                   $tagslib->{$tag}->{$subfield}->{mandatory};
2565                 $subfield_data{repeatable} =
2566                   $tagslib->{$tag}->{$subfield}->{repeatable};
2567                 $subfield_data{hidden} = "display:none"
2568                   if $tagslib->{$tag}->{$subfield}->{hidden};
2569                 my ( $x, $value );
2570                 ( $x, $value ) = _find_value( $tag, $subfield, $itemrecord )
2571                   if ($itemrecord);
2572                 $value =~ s/"/&quot;/g;
2573
2574                 # search for itemcallnumber if applicable
2575                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
2576                     'items.itemcallnumber'
2577                     && C4::Context->preference('itemcallnumber') )
2578                 {
2579                     my $CNtag =
2580                       substr( C4::Context->preference('itemcallnumber'), 0, 3 );
2581                     my $CNsubfield =
2582                       substr( C4::Context->preference('itemcallnumber'), 3, 1 );
2583                     my $temp = $itemrecord->field($CNtag) if ($itemrecord);
2584                     if ($temp) {
2585                         $value = $temp->subfield($CNsubfield);
2586                     }
2587                 }
2588                 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
2589                     my @authorised_values;
2590                     my %authorised_lib;
2591
2592                     # builds list, depending on authorised value...
2593                     #---- branch
2594                     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq
2595                         "branches" )
2596                     {
2597                         if ( ( C4::Context->preference("IndependantBranches") )
2598                             && ( C4::Context->userenv->{flags} != 1 ) )
2599                         {
2600                             my $sth =
2601                               $dbh->prepare(
2602 "select branchcode,branchname from branches where branchcode = ? order by branchname"
2603                               );
2604                             $sth->execute( C4::Context->userenv->{branch} );
2605                             push @authorised_values, ""
2606                               unless (
2607                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
2608                             while ( my ( $branchcode, $branchname ) =
2609                                 $sth->fetchrow_array )
2610                             {
2611                                 push @authorised_values, $branchcode;
2612                                 $authorised_lib{$branchcode} = $branchname;
2613                             }
2614                         }
2615                         else {
2616                             my $sth =
2617                               $dbh->prepare(
2618 "select branchcode,branchname from branches order by branchname"
2619                               );
2620                             $sth->execute;
2621                             push @authorised_values, ""
2622                               unless (
2623                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
2624                             while ( my ( $branchcode, $branchname ) =
2625                                 $sth->fetchrow_array )
2626                             {
2627                                 push @authorised_values, $branchcode;
2628                                 $authorised_lib{$branchcode} = $branchname;
2629                             }
2630                         }
2631
2632                         #----- itemtypes
2633                     }
2634                     elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq
2635                         "itemtypes" )
2636                     {
2637                         my $sth =
2638                           $dbh->prepare(
2639 "select itemtype,description from itemtypes order by description"
2640                           );
2641                         $sth->execute;
2642                         push @authorised_values, ""
2643                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2644                         while ( my ( $itemtype, $description ) =
2645                             $sth->fetchrow_array )
2646                         {
2647                             push @authorised_values, $itemtype;
2648                             $authorised_lib{$itemtype} = $description;
2649                         }
2650
2651                         #---- "true" authorised value
2652                     }
2653                     else {
2654                         $authorised_values_sth->execute(
2655                             $tagslib->{$tag}->{$subfield}->{authorised_value} );
2656                         push @authorised_values, ""
2657                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2658                         while ( my ( $value, $lib ) =
2659                             $authorised_values_sth->fetchrow_array )
2660                         {
2661                             push @authorised_values, $value;
2662                             $authorised_lib{$value} = $lib;
2663                         }
2664                     }
2665                     $subfield_data{marc_value} = CGI::scrolling_list(
2666                         -name     => 'field_value',
2667                         -values   => \@authorised_values,
2668                         -default  => "$value",
2669                         -labels   => \%authorised_lib,
2670                         -size     => 1,
2671                         -tabindex => '',
2672                         -multiple => 0,
2673                     );
2674                 }
2675                 elsif ( $tagslib->{$tag}->{$subfield}->{thesaurus_category} ) {
2676                     $subfield_data{marc_value} =
2677 "<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>";
2678
2679 #"
2680 # COMMENTED OUT because No $i is provided with this API.
2681 # And thus, no value_builder can be activated.
2682 # BUT could be thought over.
2683 #         } elsif ($tagslib->{$tag}->{$subfield}->{'value_builder'}) {
2684 #             my $plugin="value_builder/".$tagslib->{$tag}->{$subfield}->{'value_builder'};
2685 #             require $plugin;
2686 #             my $extended_param = plugin_parameters($dbh,$itemrecord,$tagslib,$i,0);
2687 #             my ($function_name,$javascript) = plugin_javascript($dbh,$record,$tagslib,$i,0);
2688 #             $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";
2689                 }
2690                 else {
2691                     $subfield_data{marc_value} =
2692 "<input type=\"text\" name=\"field_value\" value=\"$value\" size=50 maxlength=255>";
2693                 }
2694                 push( @loop_data, \%subfield_data );
2695             }
2696         }
2697     }
2698     my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
2699       if ( $itemrecord && $itemrecord->field($itemtagfield) );
2700     return {
2701         'itemtagfield'    => $itemtagfield,
2702         'itemtagsubfield' => $itemtagsubfield,
2703         'itemnumber'      => $itemnumber,
2704         'iteminformation' => \@loop_data
2705     };
2706 }
2707 #"
2708
2709 #
2710 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2711 # at the same time
2712 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2713 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2714 # =head2 ModZebrafiles
2715 #
2716 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2717 #
2718 # =cut
2719 #
2720 # sub ModZebrafiles {
2721 #
2722 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2723 #
2724 #     my $op;
2725 #     my $zebradir =
2726 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2727 #     unless ( opendir( DIR, "$zebradir" ) ) {
2728 #         warn "$zebradir not found";
2729 #         return;
2730 #     }
2731 #     closedir DIR;
2732 #     my $filename = $zebradir . $biblionumber;
2733 #
2734 #     if ($record) {
2735 #         open( OUTPUT, ">", $filename . ".xml" );
2736 #         print OUTPUT $record;
2737 #         close OUTPUT;
2738 #     }
2739 # }
2740
2741 =head2 ModZebra
2742
2743 =over 4
2744
2745 ModZebra( $biblionumber, $op, $server, $newRecord );
2746
2747     $biblionumber is the biblionumber we want to index
2748     $op is specialUpdate or delete, and is used to know what we want to do
2749     $server is the server that we want to update
2750     $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.
2751 =back
2752
2753 =cut
2754
2755 sub ModZebra {
2756 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2757     my ( $biblionumber, $op, $server, $newRecord ) = @_;
2758 #     warn "ModZebra with : ( $biblionumber, $op, $server, $newRecord )";
2759     my $dbh=C4::Context->dbh;
2760     #warn "SERVER:".$server;
2761 #
2762 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2763 # at the same time
2764 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2765 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2766
2767     if (C4::Context->preference("NoZebra")) {
2768         # lock the nozebra table : we will read index lines, update them in Perl process
2769         # and write everything in 1 transaction.
2770         # lock the table to avoid someone else overwriting what we are doing
2771         $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE');
2772         my %result; # the result hash that will be builded by deletion / add, and written on mySQL at the end, to improve speed
2773         my $record;
2774         if ($server eq 'biblioserver') {
2775             $record= GetMarcBiblio($biblionumber);
2776         } else {
2777             $record= C4::AuthoritiesMarc::GetAuthority($biblionumber);
2778         }
2779         if ($op eq 'specialUpdate') {
2780             # OK, we have to add or update the record
2781             # 1st delete (virtually, in indexes) ...
2782             %result = _DelBiblioNoZebra($biblionumber,$record,$server);
2783             # ... add the record
2784             %result=_AddBiblioNoZebra($biblionumber,$newRecord, $server, %result);
2785         } else {
2786             # it's a deletion, delete the record...
2787 #             warn "DELETE the record $biblionumber on $server".$record->as_formatted;
2788             %result=_DelBiblioNoZebra($biblionumber,$record,$server);
2789         }
2790         # ok, now update the database...
2791         my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
2792         foreach my $key (keys %result) {
2793             foreach my $index (keys %{$result{$key}}) {
2794 #                 warn "UPDATING : $server $key , $index with :".$result{$key}->{$index};
2795                 $sth->execute($result{$key}->{$index}, $server, $key, $index);
2796             }
2797         }
2798     $dbh->do('UNLOCK TABLES');
2799
2800     } else {
2801         #
2802         # we use zebra, just fill zebraqueue table
2803         #
2804         my $sth=$dbh->prepare("insert into zebraqueue  (biblio_auth_number ,server,operation) values(?,?,?)");
2805         $sth->execute($biblionumber,$server,$op);
2806         $sth->finish;
2807     }
2808 }
2809
2810 =head2 GetNoZebraIndexes
2811
2812 =cut
2813
2814 sub GetNoZebraIndexes {
2815     my $index = C4::Context->preference('NoZebraIndexes');
2816     my %indexes;
2817     foreach my $line (split /('|"),/,$index) {
2818         $line =~ /(.*)=>(.*)/;
2819         my $index = substr($1,1); # get the index, don't forget to remove initial ' or "
2820         my $fields = $2;
2821         $index =~ s/'|"| //g;
2822         $fields =~ s/'|"| //g;
2823         $indexes{$index}=$fields;
2824     }
2825     return %indexes;
2826 }
2827
2828 =head1 INTERNAL FUNCTIONS
2829
2830 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
2831
2832     function to delete a biblio in NoZebra indexes
2833     This function does NOT delete anything in database : it reads all the indexes entries
2834     that have to be deleted & delete them in the hash
2835     The SQL part is done either :
2836     - after the Add if we are modifying a biblio (delete + add again)
2837     - immediatly after this sub if we are doing a true deletion.
2838     $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
2839
2840 =cut
2841
2842
2843 sub _DelBiblioNoZebra {
2844     my ($biblionumber, $record, $server)=@_;
2845
2846     # Get the indexes
2847     my $dbh = C4::Context->dbh;
2848     # Get the indexes
2849     my %index;
2850     my $title;
2851     if ($server eq 'biblioserver') {
2852         %index=GetNoZebraIndexes;
2853         # get title of the record (to store the 10 first letters with the index)
2854         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
2855         $title = lc($record->subfield($titletag,$titlesubfield));
2856     } else {
2857         # for authorities, the "title" is the $a mainentry
2858         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
2859         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
2860         $title = $record->subfield($authref->{auth_tag_to_report},'a');
2861         $index{'mainmainentry'}= $authref->{'auth_tag_to_report'}.'a';
2862         $index{'mainentry'}    = $authref->{'auth_tag_to_report'}.'*';
2863         $index{'auth_type'}    = '152b';
2864     }
2865
2866     my %result;
2867     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2868     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2869     # limit to 10 char, should be enough, and limit the DB size
2870     $title = substr($title,0,10);
2871     #parse each field
2872     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2873     foreach my $field ($record->fields()) {
2874         #parse each subfield
2875         next if $field->tag <10;
2876         foreach my $subfield ($field->subfields()) {
2877             my $tag = $field->tag();
2878             my $subfieldcode = $subfield->[0];
2879             my $indexed=0;
2880             # check each index to see if the subfield is stored somewhere
2881             # otherwise, store it in __RAW__ index
2882             foreach my $key (keys %index) {
2883 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2884                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
2885                     $indexed=1;
2886                     my $line= lc $subfield->[1];
2887                     # remove meaningless value in the field...
2888                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2889                     # ... and split in words
2890                     foreach (split / /,$line) {
2891                         next unless $_; # skip  empty values (multiple spaces)
2892                         # if the entry is already here, do nothing, the biblionumber has already be removed
2893                         unless ($result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) {
2894                             # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2895                             $sth2->execute($server,$key,$_);
2896                             my $existing_biblionumbers = $sth2->fetchrow;
2897                             # it exists
2898                             if ($existing_biblionumbers) {
2899 #                                 warn " existing for $key $_: $existing_biblionumbers";
2900                                 $result{$key}->{$_} =$existing_biblionumbers;
2901                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2902                             }
2903                         }
2904                     }
2905                 }
2906             }
2907             # the subfield is not indexed, store it in __RAW__ index anyway
2908             unless ($indexed) {
2909                 my $line= lc $subfield->[1];
2910                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2911                 # ... and split in words
2912                 foreach (split / /,$line) {
2913                     next unless $_; # skip  empty values (multiple spaces)
2914                     # if the entry is already here, do nothing, the biblionumber has already be removed
2915                     unless ($result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/) {
2916                         # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2917                         $sth2->execute($server,'__RAW__',$_);
2918                         my $existing_biblionumbers = $sth2->fetchrow;
2919                         # it exists
2920                         if ($existing_biblionumbers) {
2921                             $result{'__RAW__'}->{$_} =$existing_biblionumbers;
2922                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2923                         }
2924                     }
2925                 }
2926             }
2927         }
2928     }
2929     return %result;
2930 }
2931
2932 =head2 _DelBiblioNoZebra($biblionumber,$record);
2933
2934     function to delete a biblio in NoZebra indexes
2935
2936 =cut
2937
2938
2939 sub _AddBiblioNoZebra {
2940     my ($biblionumber, $record, $server, %result)=@_;
2941     my $dbh = C4::Context->dbh;
2942     # Get the indexes
2943     my %index;
2944     my $title;
2945     if ($server eq 'biblioserver') {
2946         %index=GetNoZebraIndexes;
2947         # get title of the record (to store the 10 first letters with the index)
2948         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
2949         $title = lc($record->subfield($titletag,$titlesubfield));
2950     } else {
2951 #     warn "server : $server";
2952         # for authorities, the "title" is the $a mainentry
2953         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
2954         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
2955         $title = $record->subfield($authref->{auth_tag_to_report},'a');
2956         $index{'mainmainentry'}=$authref->{auth_tag_to_report}.'a';
2957         $index{'mainentry'}    = $authref->{auth_tag_to_report}.'*';
2958         $index{'auth_type'}    = '152b';
2959     }
2960
2961     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2962     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2963     # limit to 10 char, should be enough, and limit the DB size
2964     $title = substr($title,0,10);
2965     #parse each field
2966     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2967     foreach my $field ($record->fields()) {
2968         #parse each subfield
2969         next if $field->tag <10;
2970         foreach my $subfield ($field->subfields()) {
2971             my $tag = $field->tag();
2972             my $subfieldcode = $subfield->[0];
2973             my $indexed=0;
2974             # check each index to see if the subfield is stored somewhere
2975             # otherwise, store it in __RAW__ index
2976             foreach my $key (keys %index) {
2977 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2978                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
2979                     $indexed=1;
2980                     my $line= lc $subfield->[1];
2981                     # remove meaningless value in the field...
2982                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2983                     # ... and split in words
2984                     foreach (split / /,$line) {
2985                         next unless $_; # skip  empty values (multiple spaces)
2986                         # if the entry is already here, improve weight
2987 #                         warn "managing $_";
2988                         if ($result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) {
2989                             my $weight=$1+1;
2990                             $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2991                             $result{$key}->{$_} .= "$biblionumber,$title-$weight;";
2992                         } else {
2993                             # get the value if it exist in the nozebra table, otherwise, create it
2994                             $sth2->execute($server,$key,$_);
2995                             my $existing_biblionumbers = $sth2->fetchrow;
2996                             # it exists
2997                             if ($existing_biblionumbers) {
2998                                 $result{$key}->{$_} =$existing_biblionumbers;
2999                                 my $weight=$1+1;
3000                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3001                                 $result{$key}->{$_} .= "$biblionumber,$title-$weight;";
3002                             # create a new ligne for this entry
3003                             } else {
3004 #                             warn "INSERT : $server / $key / $_";
3005                                 $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).', indexname='.$dbh->quote($key).',value='.$dbh->quote($_));
3006                                 $result{$key}->{$_}.="$biblionumber,$title-1;";
3007                             }
3008                         }
3009                     }
3010                 }
3011             }
3012             # the subfield is not indexed, store it in __RAW__ index anyway
3013             unless ($indexed) {
3014                 my $line= lc $subfield->[1];
3015                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3016                 # ... and split in words
3017                 foreach (split / /,$line) {
3018                     next unless $_; # skip  empty values (multiple spaces)
3019                     # if the entry is already here, improve weight
3020                     if ($result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/) {
3021                         my $weight=$1+1;
3022                         $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3023                         $result{'__RAW__'}->{$_} .= "$biblionumber,$title-$weight;";
3024                     } else {
3025                         # get the value if it exist in the nozebra table, otherwise, create it
3026                         $sth2->execute($server,'__RAW__',$_);
3027                         my $existing_biblionumbers = $sth2->fetchrow;
3028                         # it exists
3029                         if ($existing_biblionumbers) {
3030                             $result{'__RAW__'}->{$_} =$existing_biblionumbers;
3031                             my $weight=$1+1;
3032                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3033                             $result{'__RAW__'}->{$_} .= "$biblionumber,$title-$weight;";
3034                         # create a new ligne for this entry
3035                         } else {
3036                             $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).',  indexname="__RAW__",value='.$dbh->quote($_));
3037                             $result{'__RAW__'}->{$_}.="$biblionumber,$title-1;";
3038                         }
3039                     }
3040                 }
3041             }
3042         }
3043     }
3044     return %result;
3045 }
3046
3047
3048 =head2 MARCitemchange
3049
3050 =over 4
3051
3052 &MARCitemchange( $record, $itemfield, $newvalue )
3053
3054 Function to update a single value in an item field.
3055 Used twice, could probably be replaced by something else, but works well...
3056
3057 =back
3058
3059 =back
3060
3061 =cut
3062
3063 sub MARCitemchange {
3064     my ( $record, $itemfield, $newvalue ) = @_;
3065     my $dbh = C4::Context->dbh;
3066
3067     my ( $tagfield, $tagsubfield ) =
3068       GetMarcFromKohaField( $itemfield, "" );
3069     if ( ($tagfield) && ($tagsubfield) ) {
3070         my $tag = $record->field($tagfield);
3071         if ($tag) {
3072             $tag->update( $tagsubfield => $newvalue );
3073             $record->delete_field($tag);
3074             $record->insert_fields_ordered($tag);
3075         }
3076     }
3077 }
3078
3079 =head2 _koha_add_biblio
3080
3081 =over 4
3082
3083 _koha_add_biblio($dbh,$biblioitem);
3084
3085 Internal function to add a biblio ($biblio is a hash with the values)
3086
3087 =back
3088
3089 =cut
3090
3091 sub _koha_add_biblio {
3092     my ( $dbh, $biblio, $frameworkcode ) = @_;
3093     my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
3094     $sth->execute;
3095     my $data         = $sth->fetchrow_arrayref;
3096     my $biblionumber = $$data[0] + 1;
3097     my $series       = 0;
3098
3099     if ( $biblio->{'seriestitle'} ) { $series = 1 }
3100     $sth->finish;
3101     $sth = $dbh->prepare(
3102         "INSERT INTO biblio
3103     SET biblionumber  = ?, title = ?, author = ?, copyrightdate = ?, serial = ?, seriestitle = ?, notes = ?, abstract = ?, unititle = ?, frameworkcode = ? "
3104     );
3105     $sth->execute(
3106         $biblionumber,         $biblio->{'title'},
3107         $biblio->{'author'},   $biblio->{'copyrightdate'},
3108         $biblio->{'serial'},   $biblio->{'seriestitle'},
3109         $biblio->{'notes'},    $biblio->{'abstract'},
3110         $biblio->{'unititle'}, $frameworkcode
3111     );
3112
3113     $sth->finish;
3114     return ($biblionumber);
3115 }
3116
3117 =head2 _find_value
3118
3119 =over 4
3120
3121 ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
3122
3123 Find the given $subfield in the given $tag in the given
3124 MARC::Record $record.  If the subfield is found, returns
3125 the (indicators, value) pair; otherwise, (undef, undef) is
3126 returned.
3127
3128 PROPOSITION :
3129 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
3130 I suggest we export it from this module.
3131
3132 =back
3133
3134 =cut
3135
3136 sub _find_value {
3137     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
3138     my @result;
3139     my $indicator;
3140     if ( $tagfield < 10 ) {
3141         if ( $record->field($tagfield) ) {
3142             push @result, $record->field($tagfield)->data();
3143         }
3144         else {
3145             push @result, "";
3146         }
3147     }
3148     else {
3149         foreach my $field ( $record->field($tagfield) ) {
3150             my @subfields = $field->subfields();
3151             foreach my $subfield (@subfields) {
3152                 if ( @$subfield[0] eq $insubfield ) {
3153                     push @result, @$subfield[1];
3154                     $indicator = $field->indicator(1) . $field->indicator(2);
3155                 }
3156             }
3157         }
3158     }
3159     return ( $indicator, @result );
3160 }
3161
3162 =head2 _koha_modify_biblio
3163
3164 =over 4
3165
3166 Internal function for updating the biblio table
3167
3168 =back
3169
3170 =cut
3171
3172 sub _koha_modify_biblio {
3173     my ( $dbh, $biblio ) = @_;
3174
3175 # FIXME: this code could be made more portable by not hard-coding the values that are supposed to be in biblio table
3176     my $sth =
3177       $dbh->prepare(
3178 "Update biblio set title = ?, author = ?, abstract = ?, copyrightdate = ?, seriestitle = ?, serial = ?, unititle = ?, notes = ? where biblionumber = ?"
3179       );
3180     $sth->execute(
3181         $biblio->{'title'},       $biblio->{'author'},
3182         $biblio->{'abstract'},    $biblio->{'copyrightdate'},
3183         $biblio->{'seriestitle'}, $biblio->{'serial'},
3184         $biblio->{'unititle'},    $biblio->{'notes'},
3185         $biblio->{'biblionumber'}
3186     );
3187     $sth->finish;
3188     return ( $biblio->{'biblionumber'} );
3189 }
3190
3191 =head2 _koha_modify_biblioitem
3192
3193 =over 4
3194
3195 _koha_modify_biblioitem( $dbh, $biblioitem );
3196
3197 =back
3198
3199 =cut
3200
3201 sub _koha_modify_biblioitem {
3202     my ( $dbh, $biblioitem ) = @_;
3203     my $query;
3204 ##Recalculate LC in case it changed --TG
3205
3206     $biblioitem->{'itemtype'}      = $dbh->quote( $biblioitem->{'itemtype'} );
3207     $biblioitem->{'url'}           = $dbh->quote( $biblioitem->{'url'} );
3208     $biblioitem->{'isbn'}          = $dbh->quote( $biblioitem->{'isbn'} );
3209     $biblioitem->{'issn'}          = $dbh->quote( $biblioitem->{'issn'} );
3210     $biblioitem->{'publishercode'} =
3211       $dbh->quote( $biblioitem->{'publishercode'} );
3212     $biblioitem->{'publicationyear'} =
3213       $dbh->quote( $biblioitem->{'publicationyear'} );
3214     $biblioitem->{'classification'} =
3215       $dbh->quote( $biblioitem->{'classification'} );
3216     $biblioitem->{'dewey'}        = $dbh->quote( $biblioitem->{'dewey'} );
3217     $biblioitem->{'subclass'}     = $dbh->quote( $biblioitem->{'subclass'} );
3218     $biblioitem->{'illus'}        = $dbh->quote( $biblioitem->{'illus'} );
3219     $biblioitem->{'pages'}        = $dbh->quote( $biblioitem->{'pages'} );
3220     $biblioitem->{'volumeddesc'}  = $dbh->quote( $biblioitem->{'volumeddesc'} );
3221     $biblioitem->{'bnotes'}       = $dbh->quote( $biblioitem->{'bnotes'} );
3222     $biblioitem->{'size'}         = $dbh->quote( $biblioitem->{'size'} );
3223     $biblioitem->{'place'}        = $dbh->quote( $biblioitem->{'place'} );
3224     $biblioitem->{'ccode'}        = $dbh->quote( $biblioitem->{'ccode'} );
3225     $biblioitem->{'biblionumber'} =
3226       $dbh->quote( $biblioitem->{'biblionumber'} );
3227
3228     $query = "Update biblioitems set
3229         itemtype        = $biblioitem->{'itemtype'},
3230         url             = $biblioitem->{'url'},
3231         isbn            = $biblioitem->{'isbn'},
3232         issn            = $biblioitem->{'issn'},
3233         publishercode   = $biblioitem->{'publishercode'},
3234         publicationyear = $biblioitem->{'publicationyear'},
3235         classification  = $biblioitem->{'classification'},
3236         dewey           = $biblioitem->{'dewey'},
3237         subclass        = $biblioitem->{'subclass'},
3238         illus           = $biblioitem->{'illus'},
3239         pages           = $biblioitem->{'pages'},
3240         volumeddesc     = $biblioitem->{'volumeddesc'},
3241         notes           = $biblioitem->{'bnotes'},
3242         size            = $biblioitem->{'size'},
3243         place           = $biblioitem->{'place'},
3244         ccode           = $biblioitem->{'ccode'}
3245         where biblionumber = $biblioitem->{'biblionumber'}";
3246
3247     $dbh->do($query);
3248     if ( $dbh->errstr ) {
3249         warn "ERROR in _koha_modify_biblioitem $query";
3250     }
3251 }
3252
3253 =head2 _koha_add_biblioitem
3254
3255 =over 4
3256
3257 _koha_add_biblioitem( $dbh, $biblioitem );
3258
3259 Internal function to add a biblioitem
3260
3261 =back
3262
3263 =cut
3264
3265 sub _koha_add_biblioitem {
3266     my ( $dbh, $biblioitem ) = @_;
3267
3268     #  my $dbh   = C4Connect;
3269     my $sth = $dbh->prepare("SELECT max(biblioitemnumber) FROM biblioitems");
3270     my $data;
3271     my $bibitemnum;
3272
3273     $sth->execute;
3274     $data       = $sth->fetchrow_arrayref;
3275     $bibitemnum = $$data[0] + 1;
3276
3277     $sth->finish;
3278
3279     $sth = $dbh->prepare(
3280         "INSERT INTO biblioitems SET
3281             biblioitemnumber = ?, biblionumber    = ?,
3282             volume           = ?, number          = ?,
3283             classification   = ?, itemtype        = ?,
3284             url              = ?, isbn            = ?,
3285             issn             = ?, dewey           = ?,
3286             subclass         = ?, publicationyear = ?,
3287             publishercode    = ?, volumedate      = ?,
3288             volumeddesc      = ?, illus           = ?,
3289             pages            = ?, notes           = ?,
3290             size             = ?, lccn            = ?,
3291             marc             = ?, lcsort          =?,
3292             place            = ?, ccode           = ?
3293           "
3294     );
3295     my ($lcsort) =
3296       calculatelc( $biblioitem->{'classification'} )
3297       . $biblioitem->{'subclass'};
3298     $sth->execute(
3299         $bibitemnum,                     $biblioitem->{'biblionumber'},
3300         $biblioitem->{'volume'},         $biblioitem->{'number'},
3301         $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
3302         $biblioitem->{'url'},            $biblioitem->{'isbn'},
3303         $biblioitem->{'issn'},           $biblioitem->{'dewey'},
3304         $biblioitem->{'subclass'},       $biblioitem->{'publicationyear'},
3305         $biblioitem->{'publishercode'},  $biblioitem->{'volumedate'},
3306         $biblioitem->{'volumeddesc'},    $biblioitem->{'illus'},
3307         $biblioitem->{'pages'},          $biblioitem->{'bnotes'},
3308         $biblioitem->{'size'},           $biblioitem->{'lccn'},
3309         $biblioitem->{'marc'},           $biblioitem->{'place'},
3310         $lcsort,                         $biblioitem->{'ccode'}
3311     );
3312     $sth->finish;
3313     return ($bibitemnum);
3314 }
3315
3316 =head2 _koha_new_items
3317
3318 =over 4
3319
3320 _koha_new_items( $dbh, $item, $barcode );
3321
3322 =back
3323
3324 =cut
3325
3326 sub _koha_new_items {
3327     my ( $dbh, $item, $barcode ) = @_;
3328
3329     #  my $dbh   = C4Connect;
3330     my $sth = $dbh->prepare("Select max(itemnumber) from items");
3331     my $data;
3332     my $itemnumber;
3333     my $error = "";
3334
3335     $sth->execute;
3336     $data       = $sth->fetchrow_hashref;
3337     $itemnumber = $data->{'max(itemnumber)'} + 1;
3338     $sth->finish;
3339 ## Now calculate lccalnumber
3340     my ($cutterextra) = itemcalculator(
3341         $dbh,
3342         $item->{'biblioitemnumber'},
3343         $item->{'itemcallnumber'}
3344     );
3345
3346 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
3347     if ( $item->{'loan'} ) {
3348         $item->{'notforloan'} = $item->{'loan'};
3349     }
3350
3351     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
3352     if ( $item->{'dateaccessioned'} eq '' || !$item->{'dateaccessioned'} ) {
3353
3354         $sth = $dbh->prepare(
3355             "Insert into items set
3356             itemnumber           = ?,     biblionumber     = ?,
3357             multivolumepart      = ?,
3358             biblioitemnumber     = ?,     barcode          = ?,
3359             booksellerid         = ?,     dateaccessioned  = NOW(),
3360             homebranch           = ?,     holdingbranch    = ?,
3361             price                = ?,     replacementprice = ?,
3362             replacementpricedate = NOW(), datelastseen     = NOW(),
3363             multivolume          = ?,     stack            = ?,
3364             itemlost             = ?,     wthdrawn         = ?,
3365             paidfor              = ?,     itemnotes        = ?,
3366             itemcallnumber       =?,      notforloan       = ?,
3367             location             = ?,     Cutterextra      = ?
3368           "
3369         );
3370         $sth->execute(
3371             $itemnumber,                $item->{'biblionumber'},
3372             $item->{'multivolumepart'}, $item->{'biblioitemnumber'},
3373             $barcode,                   $item->{'booksellerid'},
3374             $item->{'homebranch'},      $item->{'holdingbranch'},
3375             $item->{'price'},           $item->{'replacementprice'},
3376             $item->{multivolume},       $item->{stack},
3377             $item->{itemlost},          $item->{wthdrawn},
3378             $item->{paidfor},           $item->{'itemnotes'},
3379             $item->{'itemcallnumber'},  $item->{'notforloan'},
3380             $item->{'location'},        $cutterextra
3381         );
3382     }
3383     else {
3384         $sth = $dbh->prepare(
3385             "INSERT INTO items SET
3386             itemnumber           = ?,     biblionumber     = ?,
3387             multivolumepart      = ?,
3388             biblioitemnumber     = ?,     barcode          = ?,
3389             booksellerid         = ?,     dateaccessioned  = ?,
3390             homebranch           = ?,     holdingbranch    = ?,
3391             price                = ?,     replacementprice = ?,
3392             replacementpricedate = NOW(), datelastseen     = NOW(),
3393             multivolume          = ?,     stack            = ?,
3394             itemlost             = ?,     wthdrawn         = ?,
3395             paidfor              = ?,     itemnotes        = ?,
3396             itemcallnumber       = ?,     notforloan       = ?,
3397             location             = ?,
3398             Cutterextra          = ?
3399                             "
3400         );
3401         $sth->execute(
3402             $itemnumber,                 $item->{'biblionumber'},
3403             $item->{'multivolumepart'},  $item->{'biblioitemnumber'},
3404             $barcode,                    $item->{'booksellerid'},
3405             $item->{'dateaccessioned'},  $item->{'homebranch'},
3406             $item->{'holdingbranch'},    $item->{'price'},
3407             $item->{'replacementprice'}, $item->{multivolume},
3408             $item->{stack},              $item->{itemlost},
3409             $item->{wthdrawn},           $item->{paidfor},
3410             $item->{'itemnotes'},        $item->{'itemcallnumber'},
3411             $item->{'notforloan'},       $item->{'location'},
3412             $cutterextra
3413         );
3414     }
3415     if ( defined $sth->errstr ) {
3416         $error .= $sth->errstr;
3417     }
3418     return ( $itemnumber, $error );
3419 }
3420
3421 =head2 _koha_modify_item
3422
3423 =over 4
3424
3425 _koha_modify_item( $dbh, $item, $op );
3426
3427 =back
3428
3429 =cut
3430
3431 sub _koha_modify_item {
3432     my ( $dbh, $item, $op ) = @_;
3433     $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
3434
3435     # if all we're doing is setting statuses, just update those and get out
3436     if ( $op eq "setstatus" ) {
3437         my $query =
3438           "UPDATE items SET itemlost=?,wthdrawn=?,binding=? WHERE itemnumber=?";
3439         my @bind = (
3440             $item->{'itemlost'}, $item->{'wthdrawn'},
3441             $item->{'binding'},  $item->{'itemnumber'}
3442         );
3443         my $sth = $dbh->prepare($query);
3444         $sth->execute(@bind);
3445         $sth->finish;
3446         return undef;
3447     }
3448 ## Now calculate lccalnumber
3449     my ($cutterextra) =
3450       itemcalculator( $dbh, $item->{'bibitemnum'}, $item->{'itemcallnumber'} );
3451
3452     my $query = "UPDATE items SET
3453 barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,homebranch=?,cutterextra=?, onloan=?, binding=?";
3454
3455     my @bind = (
3456         $item->{'barcode'},        $item->{'notes'},
3457         $item->{'itemcallnumber'}, $item->{'notforloan'},
3458         $item->{'location'},       $item->{multivolumepart},
3459         $item->{multivolume},      $item->{stack},
3460         $item->{wthdrawn},         $item->{holdingbranch},
3461         $item->{homebranch},       $cutterextra,
3462         $item->{onloan},           $item->{binding}
3463     );
3464     if ( $item->{'lost'} ne '' ) {
3465         $query =
3466 "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
3467                             itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
3468                              location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,cutterextra=?,onloan=?, binding=?";
3469         @bind = (
3470             $item->{'bibitemnum'},     $item->{'barcode'},
3471             $item->{'notes'},          $item->{'homebranch'},
3472             $item->{'lost'},           $item->{'wthdrawn'},
3473             $item->{'itemcallnumber'}, $item->{'notforloan'},
3474             $item->{'location'},       $item->{multivolumepart},
3475             $item->{multivolume},      $item->{stack},
3476             $item->{wthdrawn},         $item->{holdingbranch},
3477             $cutterextra,              $item->{onloan},
3478             $item->{binding}
3479         );
3480         if ( $item->{homebranch} ) {
3481             $query .= ",homebranch=?";
3482             push @bind, $item->{homebranch};
3483         }
3484         if ( $item->{holdingbranch} ) {
3485             $query .= ",holdingbranch=?";
3486             push @bind, $item->{holdingbranch};
3487         }
3488     }
3489     $query .= " where itemnumber=?";
3490     push @bind, $item->{'itemnum'};
3491     if ( $item->{'replacement'} ne '' ) {
3492         $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
3493     }
3494     my $sth = $dbh->prepare($query);
3495     $sth->execute(@bind);
3496     $sth->finish;
3497 }
3498
3499 =head2 _koha_delete_biblio
3500
3501 =over 4
3502
3503 $error = _koha_delete_biblio($dbh,$biblionumber);
3504
3505 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3506
3507 C<$dbh> - the database handle
3508 C<$biblionumber> - the biblionumber of the biblio to be deleted
3509
3510 =back
3511
3512 =cut
3513
3514 # FIXME: add error handling
3515
3516 sub _koha_delete_biblio {
3517     my ( $dbh, $biblionumber ) = @_;
3518
3519     # get all the data for this biblio
3520     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3521     $sth->execute($biblionumber);
3522
3523     if ( my $data = $sth->fetchrow_hashref ) {
3524
3525         # save the record in deletedbiblio
3526         # find the fields to save
3527         my $query = "INSERT INTO deletedbiblio SET ";
3528         my @bind  = ();
3529         foreach my $temp ( keys %$data ) {
3530             $query .= "$temp = ?,";
3531             push( @bind, $data->{$temp} );
3532         }
3533
3534         # replace the last , by ",?)"
3535         $query =~ s/\,$//;
3536         my $bkup_sth = $dbh->prepare($query);
3537         $bkup_sth->execute(@bind);
3538         $bkup_sth->finish;
3539
3540         # delete the biblio
3541         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3542         $del_sth->execute($biblionumber);
3543         $del_sth->finish;
3544     }
3545     $sth->finish;
3546     return undef;
3547 }
3548
3549 =head2 _koha_delete_biblioitems
3550
3551 =over 4
3552
3553 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3554
3555 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3556
3557 C<$dbh> - the database handle
3558 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3559
3560 =back
3561
3562 =cut
3563
3564 # FIXME: add error handling
3565
3566 sub _koha_delete_biblioitems {
3567     my ( $dbh, $biblioitemnumber ) = @_;
3568
3569     # get all the data for this biblioitem
3570     my $sth =
3571       $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3572     $sth->execute($biblioitemnumber);
3573
3574     if ( my $data = $sth->fetchrow_hashref ) {
3575
3576         # save the record in deletedbiblioitems
3577         # find the fields to save
3578         my $query = "INSERT INTO deletedbiblioitems SET ";
3579         my @bind  = ();
3580         foreach my $temp ( keys %$data ) {
3581             $query .= "$temp = ?,";
3582             push( @bind, $data->{$temp} );
3583         }
3584
3585         # replace the last , by ",?)"
3586         $query =~ s/\,$//;
3587         my $bkup_sth = $dbh->prepare($query);
3588         $bkup_sth->execute(@bind);
3589         $bkup_sth->finish;
3590
3591         # delete the biblioitem
3592         my $del_sth =
3593           $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3594         $del_sth->execute($biblioitemnumber);
3595         $del_sth->finish;
3596     }
3597     $sth->finish;
3598     return undef;
3599 }
3600
3601 =head2 _koha_delete_item
3602
3603 =over 4
3604
3605 _koha_delete_item( $dbh, $itemnum );
3606
3607 Internal function to delete an item record from the koha tables
3608
3609 =back
3610
3611 =cut
3612
3613 sub _koha_delete_item {
3614     my ( $dbh, $itemnum ) = @_;
3615
3616     my $sth = $dbh->prepare("select * from items where itemnumber=?");
3617     $sth->execute($itemnum);
3618     my $data = $sth->fetchrow_hashref;
3619     $sth->finish;
3620     my $query = "Insert into deleteditems set ";
3621     my @bind  = ();
3622     foreach my $temp ( keys %$data ) {
3623         $query .= "$temp = ?,";
3624         push( @bind, $data->{$temp} );
3625     }
3626     $query =~ s/\,$//;
3627
3628     #  print $query;
3629     $sth = $dbh->prepare($query);
3630     $sth->execute(@bind);
3631     $sth->finish;
3632     $sth = $dbh->prepare("Delete from items where itemnumber=?");
3633     $sth->execute($itemnum);
3634     $sth->finish;
3635 }
3636
3637 =head1 UNEXPORTED FUNCTIONS
3638
3639 =over 4
3640
3641 =head2 calculatelc
3642
3643 $lc = calculatelc($classification);
3644
3645 =back
3646
3647 =cut
3648
3649 sub calculatelc {
3650     my ($classification) = @_;
3651     $classification =~ s/^\s+|\s+$//g;
3652     my $i = 0;
3653     my $lc2;
3654     my $lc1;
3655
3656     for ( $i = 0 ; $i < length($classification) ; $i++ ) {
3657         my $c = ( substr( $classification, $i, 1 ) );
3658         if ( $c ge '0' && $c le '9' ) {
3659
3660             $lc2 = substr( $classification, $i );
3661             last;
3662         }
3663         else {
3664             $lc1 .= substr( $classification, $i, 1 );
3665
3666         }
3667     }    #while
3668
3669     my $other = length($lc1);
3670     if ( !$lc1 ) {
3671         $other = 0;
3672     }
3673
3674     my $extras;
3675     if ( $other < 4 ) {
3676         for ( 1 .. ( 4 - $other ) ) {
3677             $extras .= "0";
3678         }
3679     }
3680     $lc1 .= $extras;
3681     $lc2 =~ s/^ //g;
3682
3683     $lc2 =~ s/ //g;
3684     $extras = "";
3685     ##Find the decimal part of $lc2
3686     my $pos = index( $lc2, "." );
3687     if ( $pos < 0 ) { $pos = length($lc2); }
3688     if ( $pos >= 0 && $pos < 5 ) {
3689         ##Pad lc2 with zeros to create a 5digit decimal needed in marc record to sort as numeric
3690
3691         for ( 1 .. ( 5 - $pos ) ) {
3692             $extras .= "0";
3693         }
3694     }
3695     $lc2 = $extras . $lc2;
3696     return ( $lc1 . $lc2 );
3697 }
3698
3699 =head2 itemcalculator
3700
3701 =over 4
3702
3703 $cutterextra = itemcalculator( $dbh, $biblioitem, $callnumber );
3704
3705 =back
3706
3707 =cut
3708
3709 sub itemcalculator {
3710     my ( $dbh, $biblioitem, $callnumber ) = @_;
3711     my $sth =
3712       $dbh->prepare(
3713 "select classification, subclass from biblioitems where biblioitemnumber=?"
3714       );
3715
3716     $sth->execute($biblioitem);
3717     my ( $classification, $subclass ) = $sth->fetchrow;
3718     my $all         = $classification . " " . $subclass;
3719     my $total       = length($all);
3720     my $cutterextra = substr( $callnumber, $total - 1 );
3721
3722     return $cutterextra;
3723 }
3724
3725 =head2 ModBiblioMarc
3726
3727 =over 4
3728
3729 &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3730
3731 Add MARC data for a biblio to koha
3732
3733 Function exported, but should NOT be used, unless you really know what you're doing
3734
3735 =back
3736
3737 =cut
3738
3739 sub ModBiblioMarc {
3740
3741 # pass the MARC::Record to this function, and it will create the records in the marc field
3742     my ( $record, $biblionumber, $frameworkcode ) = @_;
3743     my $dbh = C4::Context->dbh;
3744     my @fields = $record->fields();
3745     if ( !$frameworkcode ) {
3746         $frameworkcode = "";
3747     }
3748     my $sth =
3749       $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3750     $sth->execute( $frameworkcode, $biblionumber );
3751     $sth->finish;
3752     my $encoding = C4::Context->preference("marcflavour");
3753
3754 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3755     if ( $encoding eq "UNIMARC" ) {
3756         my $string;
3757         if ( length($record->subfield( 100, "a" )) == 35 ) {
3758             $string = $record->subfield( 100, "a" );
3759             my $f100 = $record->field(100);
3760             $record->delete_field($f100);
3761         }
3762         else {
3763             $string = POSIX::strftime( "%Y%m%d", localtime );
3764             $string =~ s/\-//g;
3765             $string = sprintf( "%-*s", 35, $string );
3766         }
3767         substr( $string, 22, 6, "frey50" );
3768         unless ( $record->subfield( 100, "a" ) ) {
3769             $record->insert_grouped_field(
3770                 MARC::Field->new( 100, "", "", "a" => $string ) );
3771         }
3772     }
3773 #     warn "biblionumber : ".$biblionumber;
3774     ModZebra($biblionumber,"specialUpdate","biblioserver",$record);
3775     $sth =
3776       $dbh->prepare(
3777         "update biblioitems set marc=?,marcxml=?  where biblionumber=?");
3778     $sth->execute( $record->as_usmarc(), $record->as_xml_record(),
3779         $biblionumber );
3780 #     warn $record->as_xml_record();
3781     $sth->finish;
3782     return $biblionumber;
3783 }
3784
3785 =head2 AddItemInMarc
3786
3787 =over 4
3788
3789 $newbiblionumber = AddItemInMarc( $record, $biblionumber, $frameworkcode );
3790
3791 Add an item in a MARC record and save the MARC record
3792
3793 Function exported, but should NOT be used, unless you really know what you're doing
3794
3795 =back
3796
3797 =cut
3798
3799 sub AddItemInMarc {
3800
3801 # pass the MARC::Record to this function, and it will create the records in the marc tables
3802     my ( $record, $biblionumber, $frameworkcode ) = @_;
3803     my $newrec = &GetMarcBiblio($biblionumber);
3804
3805     # create it
3806     my @fields = $record->fields();
3807     foreach my $field (@fields) {
3808         $newrec->append_fields($field);
3809     }
3810
3811     # FIXME: should we be making sure the biblionumbers are the same?
3812     my $newbiblionumber =
3813       &ModBiblioMarc( $newrec, $biblionumber, $frameworkcode );
3814     return $newbiblionumber;
3815 }
3816
3817 =head2 z3950_extended_services
3818
3819 z3950_extended_services($serviceType,$serviceOptions,$record);
3820
3821     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.
3822
3823 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
3824
3825 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
3826
3827     action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
3828
3829 and maybe
3830
3831     recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
3832     syntax => the record syntax (transfer syntax)
3833     databaseName = Database from connection object
3834
3835     To set serviceOptions, call set_service_options($serviceType)
3836
3837 C<$record> the record, if one is needed for the service type
3838
3839     A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
3840
3841 =cut
3842
3843 sub z3950_extended_services {
3844     my ( $server, $serviceType, $action, $serviceOptions ) = @_;
3845
3846     # get our connection object
3847     my $Zconn = C4::Context->Zconn( $server, 0, 1 );
3848
3849     # create a new package object
3850     my $Zpackage = $Zconn->package();
3851
3852     # set our options
3853     $Zpackage->option( action => $action );
3854
3855     if ( $serviceOptions->{'databaseName'} ) {
3856         $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
3857     }
3858     if ( $serviceOptions->{'recordIdNumber'} ) {
3859         $Zpackage->option(
3860             recordIdNumber => $serviceOptions->{'recordIdNumber'} );
3861     }
3862     if ( $serviceOptions->{'recordIdOpaque'} ) {
3863         $Zpackage->option(
3864             recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
3865     }
3866
3867  # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
3868  #if ($serviceType eq 'itemorder') {
3869  #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
3870  #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
3871  #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
3872  #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
3873  #}
3874
3875     if ( $serviceOptions->{record} ) {
3876         $Zpackage->option( record => $serviceOptions->{record} );
3877
3878         # can be xml or marc
3879         if ( $serviceOptions->{'syntax'} ) {
3880             $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
3881         }
3882     }
3883
3884     # send the request, handle any exception encountered
3885     eval { $Zpackage->send($serviceType) };
3886     if ( $@ && $@->isa("ZOOM::Exception") ) {
3887         return "error:  " . $@->code() . " " . $@->message() . "\n";
3888     }
3889
3890     # free up package resources
3891     $Zpackage->destroy();
3892 }
3893
3894 =head2 set_service_options
3895
3896 my $serviceOptions = set_service_options($serviceType);
3897
3898 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
3899
3900 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
3901
3902 =cut
3903
3904 sub set_service_options {
3905     my ($serviceType) = @_;
3906     my $serviceOptions;
3907
3908 # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
3909 #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
3910
3911     if ( $serviceType eq 'commit' ) {
3912
3913         # nothing to do
3914     }
3915     if ( $serviceType eq 'create' ) {
3916
3917         # nothing to do
3918     }
3919     if ( $serviceType eq 'drop' ) {
3920         die "ERROR: 'drop' not currently supported (by Zebra)";
3921     }
3922     return $serviceOptions;
3923 }
3924
3925 =head2 GetItemsCount
3926
3927 $count = &GetItemsCount( $biblionumber);
3928 this function return count of item with $biblionumber
3929 =cut
3930
3931 sub GetItemsCount {
3932     my ( $biblionumber ) = @_;
3933     my $dbh = C4::Context->dbh;
3934     my $query = qq|SELECT count(*)
3935                   FROM  items
3936                   WHERE biblionumber=?|;
3937     my $sth = $dbh->prepare($query);
3938     $sth->execute($biblionumber);
3939     my $count = $sth->fetchrow;
3940     $sth->finish;
3941     return ($count);
3942 }
3943
3944 END { }    # module clean-up code here (global destructor)
3945
3946 1;
3947
3948 __END__
3949
3950 =head1 AUTHOR
3951
3952 Koha Developement team <info@koha.org>
3953
3954 Paul POULAIN paul.poulain@free.fr
3955
3956 Joshua Ferraro jmf@liblime.com
3957
3958 =cut
3959
3960 # $Id$
3961 # $Log$
3962 # Revision 1.220  2007/07/20 15:43:16  hdl
3963 # Bug Fixing GetMarcSubjects.
3964 # Links parameters were mixed.
3965 #
3966 # Revision 1.218  2007/07/19 07:40:08  hdl
3967 # Adding selection by location for inventory
3968 #
3969 # Revision 1.217  2007/07/03 13:47:44  tipaul
3970 # fixing some display bugs (itemtype not properly returned and a html table bug that makes items appear strangely
3971 #
3972 # Revision 1.216  2007/07/03 09:40:58  tipaul
3973 # return itemtype description properly
3974 #
3975 # Revision 1.215  2007/07/03 09:33:05  tipaul
3976 # 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
3977 #
3978 # Revision 1.214  2007/07/02 09:13:22  tipaul
3979 # 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
3980 #
3981 # Revision 1.213  2007/06/25 15:01:45  tipaul
3982 # bugfixes on unimarc 100 handling (the field used for encoding)
3983 #
3984 # Revision 1.212  2007/06/15 13:44:44  tipaul
3985 # some fixes (and only fixes)
3986 #
3987 # Revision 1.211  2007/06/15 09:40:06  toins
3988 # do not get $3 $4 and $5 on GetMarcSubjects GetMarcAuthors on unimarc flavour.
3989 #
3990 # Revision 1.210  2007/06/13 13:03:34  toins
3991 # removing warn compilation.
3992 #
3993 # Revision 1.209  2007/05/23 16:19:40  tipaul
3994 # various bugfixes (minor) and french translation updated
3995 #
3996 # Revision 1.208  2007/05/22 09:13:54  tipaul
3997 # Bugfixes & improvements (various and minor) :
3998 # - updating templates to have tmpl_process3.pl running without any errors
3999 # - adding a drupal-like css for prog templates (with 3 small images)
4000 # - fixing some bugs in circulation & other scripts
4001 # - updating french translation
4002 # - fixing some typos in templates
4003 #
4004 # Revision 1.207  2007/05/22 08:51:19  hdl
4005 # Changing GetMarcStructure signature.
4006 # Deleting first parameter $dbh
4007 #
4008 # Revision 1.206  2007/05/21 08:44:17  btoumi
4009 # add security when u delete biblio :
4010 # u must delete linked items before delete biblio
4011 #
4012 # Revision 1.205  2007/05/11 16:04:03  btoumi
4013 # bug fix:
4014 # problem in  displayed label link  with subject in detail.tmpl
4015 # ex: label random => rdom
4016 #
4017 # Revision 1.204  2007/05/10 14:45:15  tipaul
4018 # Koha NoZebra :
4019 # - support for authorities
4020 # - some bugfixes in ordering and "CCL" parsing
4021 # - support for authorities <=> biblios walking
4022 #
4023 # Seems I can do what I want now, so I consider its done, except for bugfixes that will be needed i m sure !
4024 #
4025 # Revision 1.203  2007/05/03 15:16:02  tipaul
4026 # BUGFIX for : NoZebra
4027 # - NoZebra features : seems they work fine now (adding, modifying, deleting)
4028 # - Biblio edition major bugfix : before this commit editing a biblio resulted in an item removal in marcxml field
4029 #
4030 # Revision 1.202  2007/05/02 16:44:31  tipaul
4031 # NoZebra SQL index management :
4032 # * adding 3 subs in Biblio.pm
4033 # - GetNoZebraIndexes, that get the index structure in a new systempreference (added with this commit)
4034 # - _DelBiblioNoZebra, that retrieve all index entries for a biblio and remove in a variable the biblio reference
4035 # - _AddBiblioNoZebra, that add index entries for a biblio.
4036 # 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).
4037 # I think the code has to be more deeply tested, but it works at least partially.
4038 #
4039 # Revision 1.201  2007/04/27 14:00:49  hdl
4040 # Removing $dbh from GetMarcFromKohaField (dbh is not used in this function.)
4041 #
4042 # Revision 1.200  2007/04/25 16:26:42  tipaul
4043 # 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 :
4044 # - add nozebra table management on biblio editing
4045 # - the index table content is hardcoded. I still have to add some specific systempref to let the library update it
4046 # - manage pagination (next/previous)
4047 # - manage facets
4048 # WHAT works :
4049 # - NZgetRecords : has exactly the same API & returns as zebra getQuery, except that some parameters are unused
4050 # - search & sort works quite good
4051 # - CQL parser is better that what I thought I could do : title="harry and sally" and publicationyear>2000 not itemtype=LIVR should work fine
4052 #
4053 # Revision 1.199  2007/04/24 09:07:53  tipaul
4054 # moving dotransfer to Biblio.pm::ModItemTransfer + some CheckReserves fixes
4055 #
4056 # Revision 1.198  2007/04/23 15:21:17  tipaul
4057 # renaming currenttransfers to transferstoreceive
4058 #
4059 # Revision 1.197  2007/04/18 17:00:14  tipaul
4060 # removing all useless %env / $env
4061 #
4062 # Revision 1.196  2007/04/17 08:48:00  tipaul
4063 # circulation cleaning continued: bufixing
4064 #
4065 # Revision 1.195  2007/04/04 16:46:22  tipaul
4066 # HUGE COMMIT : code cleaning circulation.
4067 #
4068 # some stuff to do, i'll write a mail on koha-devel NOW !
4069 #
4070 # Revision 1.194  2007/03/30 12:00:42  tipaul
4071 # 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...
4072 #
4073 # Revision 1.193  2007/03/29 16:45:53  tipaul
4074 # Code cleaning of Biblio.pm (continued)
4075 #
4076 # All subs have be cleaned :
4077 # - removed useless
4078 # - merged some
4079 # - reordering Biblio.pm completly
4080 # - using only naming conventions
4081 #
4082 # Seems to have broken nothing, but it still has to be heavily tested.
4083 # Note that Biblio.pm is now much more efficient than previously & probably more reliable as well.
4084 #
4085 # Revision 1.192  2007/03/29 13:30:31  tipaul
4086 # Code cleaning :
4087 # == Biblio.pm cleaning (useless) ==
4088 # * some sub declaration dropped
4089 # * removed modbiblio sub
4090 # * removed moditem sub
4091 # * removed newitems. It was used only in finishrecieve. Replaced by a TransformKohaToMarc+AddItem, that is better.
4092 # * removed MARCkoha2marcItem
4093 # * removed MARCdelsubfield declaration
4094 # * removed MARCkoha2marcBiblio
4095 #
4096 # == Biblio.pm cleaning (naming conventions) ==
4097 # * MARCgettagslib renamed to GetMarcStructure
4098 # * MARCgetitems renamed to GetMarcItem
4099 # * MARCfind_frameworkcode renamed to GetFrameworkCode
4100 # * MARCmarc2koha renamed to TransformMarcToKoha
4101 # * MARChtml2marc renamed to TransformHtmlToMarc
4102 # * MARChtml2xml renamed to TranformeHtmlToXml
4103 # * zebraop renamed to ModZebra
4104 #
4105 # == MARC=OFF ==
4106 # * removing MARC=OFF related scripts (in cataloguing directory)
4107 # * removed checkitems (function related to MARC=off feature, that is completly broken in head. If someone want to reintroduce it, hard work coming...)
4108 # * removed getitemsbybiblioitem (used only by MARC=OFF scripts, that is removed as well)
4109 #
4110 # Revision 1.191  2007/03/29 09:42:13  tipaul
4111 # adding default value new feature into cataloguing. The system (definition) part has already been added by toins
4112 #
4113 # Revision 1.190  2007/03/29 08:45:19  hdl
4114 # Deleting ignore_errors(1) pour MARC::Charset
4115 #
4116 # Revision 1.189  2007/03/28 10:39:16  hdl
4117 # removing $dbh as a parameter in AuthoritiesMarc functions
4118 # And reporting all differences into the scripts taht relies on those functions.