C4/Items.pm

   1 package C4::Items;
   2
   3 # Copyright 2007 LibLime, Inc.
   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
  24 use C4::Context;
  25 use C4::Koha;
  26 use C4::Biblio;
  27 use C4::Dates qw/format_date format_date_in_iso/;
  28 use MARC::Record;
  29 use C4::ClassSource;
  30 use C4::Log;
  31 use C4::Reserves;
  32
  33 use vars qw($VERSION @ISA @EXPORT);
  34
  35 my $VERSION = 3.00;
  36
  37 @ISA = qw( Exporter );
  38
  39 # function exports
  40 @EXPORT = qw(
  41     GetItem
  42     AddItemFromMarc
  43     AddItem
  44     ModItemFromMarc
  45     ModItem
  46     ModDateLastSeen
  47     ModItemTransfer
  48     DelItem
  49
  50     GetItemStatus
  51     GetItemLocation
  52     GetLostItems
  53     GetItemsForInventory
  54     GetItemsCount
  55     GetItemInfosOf
  56     GetItemsByBiblioitemnumber
  57     GetItemsInfo
  58     get_itemnumbers_of
  59 );
  60
  61 =head1 NAME
  62
  63 C4::Items - item management functions
  64
  65 =head1 DESCRIPTION
  66
  67 This module contains an API for manipulating item
  68 records in Koha, and is used by cataloguing, circulation,
  69 acquisitions, and serials management.
  70
  71 A Koha item record is stored in two places: the
  72 items table and embedded in a MARC tag in the XML
  73 version of the associated bib record in C<biblioitems.marcxml>.
  74 This is done to allow the item information to be readily
  75 indexed (e.g., by Zebra), but means that each item
  76 modification transaction must keep the items table
  77 and the MARC XML in sync at all times.
  78
  79 Consequently, all code that creates, modifies, or deletes
  80 item records B<must> use an appropriate function from
  81 C<C4::Items>.  If no existing function is suitable, it is
  82 better to add one to C<C4::Items> than to use add
  83 one-off SQL statements to add or modify items.
  84
  85 The items table will be considered authoritative.  In other
  86 words, if there is ever a discrepancy between the items
  87 table and the MARC XML, the items table should be considered
  88 accurate.
  89
  90 =head1 HISTORICAL NOTE
  91
  92 Most of the functions in C<C4::Items> were originally in
  93 the C<C4::Biblio> module.
  94
  95 =head1 CORE EXPORTED FUNCTIONS
  96
  97 The following functions are meant for use by users
  98 of C<C4::Items>
  99
 100 =cut
 101
 102 =head2 GetItem
 103
 104 =over 4
 105
 106 $item = GetItem($itemnumber,$barcode);
 107
 108 =back
 109
 110 Return item information, for a given itemnumber or barcode.
 111 The return value is a hashref mapping item column
 112 names to values.
 113
 114 =cut
 115
 116 sub GetItem {
 117     my ($itemnumber,$barcode) = @_;
 118     my $dbh = C4::Context->dbh;
 119     if ($itemnumber) {
 120         my $sth = $dbh->prepare("
 121             SELECT * FROM items
 122             WHERE itemnumber = ?");
 123         $sth->execute($itemnumber);
 124         my $data = $sth->fetchrow_hashref;
 125         return $data;
 126     } else {
 127         my $sth = $dbh->prepare("
 128             SELECT * FROM items
 129             WHERE barcode = ?"
 130             );
 131         $sth->execute($barcode);
 132         my $data = $sth->fetchrow_hashref;
 133         return $data;
 134     }
 135 }    # sub GetItem
 136
 137 =head2 AddItemFromMarc
 138
 139 =over 4
 140
 141 my ($biblionumber, $biblioitemnumber, $itemnumber)
 142     = AddItemFromMarc($source_item_marc, $biblionumber);
 143
 144 =back
 145
 146 Given a MARC::Record object containing an embedded item
 147 record and a biblionumber, create a new item record.
 148
 149 =cut
 150
 151 sub AddItemFromMarc {
 152     my ( $source_item_marc, $biblionumber ) = @_;
 153     my $dbh = C4::Context->dbh;
 154
 155     # parse item hash from MARC
 156     my $frameworkcode = GetFrameworkCode( $biblionumber );
 157     my $item = &TransformMarcToKoha( $dbh, $source_item_marc, $frameworkcode );
 158
 159     return AddItem($item, $biblionumber, $dbh, $frameworkcode);
 160 }
 161
 162 =head2 AddItem
 163
 164 =over 4
 165
 166 my ($biblionumber, $biblioitemnumber, $itemnumber)
 167     = AddItem($item, $biblionumber[, $dbh, $frameworkcode]);
 168
 169 =back
 170
 171 Given a hash containing item column names as keys,
 172 create a new Koha item record.
 173
 174 The two optional parameters (C<$dbh> and C<$frameworkcode>)
 175 do not need to be supplied for general use; they exist
 176 simply to allow them to be picked up from AddItemFromMarc.
 177
 178 =cut
 179
 180 sub AddItem {
 181     my $item = shift;
 182     my $biblionumber = shift;
 183
 184     my $dbh           = @_ ? shift : C4::Context->dbh;
 185     my $frameworkcode = @_ ? shift : GetFrameworkCode( $biblionumber );
 186
 187     # needs old biblionumber and biblioitemnumber
 188     $item->{'biblionumber'} = $biblionumber;
 189     my $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
 190     $sth->execute( $item->{'biblionumber'} );
 191     ($item->{'biblioitemnumber'}) = $sth->fetchrow;
 192
 193     _set_defaults_for_add($item);
 194     _set_derived_columns_for_add($item);
 195     # FIXME - checks here
 196     my ( $itemnumber, $error ) = _koha_new_item( $dbh, $item, $item->{barcode} );
 197     $item->{'itemnumber'} = $itemnumber;
 198
 199     # create MARC tag representing item and add to bib
 200     my $new_item_marc = _marc_from_item_hash($item, $frameworkcode);
 201     _add_item_field_to_biblio($new_item_marc, $item->{'biblionumber'}, $frameworkcode );
 202
 203     logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$itemnumber,"item")
 204         if C4::Context->preference("CataloguingLog");
 205
 206     return ($item->{biblionumber}, $item->{biblioitemnumber}, $itemnumber);
 207 }
 208
 209 =head2 ModItemFromMarc
 210
 211 =over 4
 212
 213 ModItemFromMarc($item_marc, $biblionumber, $itemnumber);
 214
 215 =back
 216
 217 This function updates an item record based on a supplied
 218 C<MARC::Record> object containing an embedded item field.
 219 This API is meant for the use of C<additem.pl>; for
 220 other purposes, C<ModItem> should be used.
 221
 222 =cut
 223
 224 sub ModItemFromMarc {
 225     my $item_marc = shift;
 226     my $biblionumber = shift;
 227     my $itemnumber = shift;
 228
 229     my $dbh = C4::Context->dbh;
 230     my $frameworkcode = GetFrameworkCode( $biblionumber );
 231     my $item = &TransformMarcToKoha( $dbh, $item_marc, $frameworkcode );
 232
 233     return ModItem($item, $biblionumber, $itemnumber, $dbh, $frameworkcode);
 234 }
 235
 236 =head2 ModItem
 237
 238 =over 4
 239
 240 ModItem({ column => $newvalue }, $biblionumber, $itemnumber);
 241
 242 =back
 243
 244 Change one or more columns in an item record and update
 245 the MARC representation of the item.
 246
 247 The first argument is a hashref mapping from item column
 248 names to the new values.  The second and third arguments
 249 are the biblionumber and itemnumber, respectively.
 250
 251 If one of the changed columns is used to calculate
 252 the derived value of a column such as C<items.cn_sort>,
 253 this routine will perform the necessary calculation
 254 and set the value.
 255
 256 =cut
 257
 258 sub ModItem {
 259     my $item = shift;
 260     my $biblionumber = shift;
 261     my $itemnumber = shift;
 262
 263     # if $biblionumber is undefined, get it from the current item
 264     unless (defined $biblionumber) {
 265         $biblionumber = _get_single_item_column('biblionumber', $itemnumber);
 266     }
 267
 268     my $dbh           = @_ ? shift : C4::Context->dbh;
 269     my $frameworkcode = @_ ? shift : GetFrameworkCode( $biblionumber );
 270
 271     $item->{'itemnumber'} = $itemnumber;
 272     _set_derived_columns_for_mod($item);
 273     _do_column_fixes_for_mod($item);
 274     # FIXME add checks
 275     # duplicate barcode
 276     # attempt to change itemnumber
 277     # attempt to change biblionumber (if we want
 278     # an API to relink an item to a different bib,
 279     # it should be a separate function)
 280
 281     # update items table
 282     _koha_modify_item($dbh, $item);
 283
 284     # update biblio MARC XML
 285     my $whole_item = GetItem($itemnumber);
 286     my $new_item_marc = _marc_from_item_hash($whole_item, $frameworkcode);
 287     _replace_item_field_in_biblio($new_item_marc, $biblionumber, $itemnumber, $frameworkcode);
 288
 289     logaction(C4::Context->userenv->{'number'},"CATALOGUING","MODIFY",$itemnumber,$new_item_marc->as_formatted)
 290         if C4::Context->preference("CataloguingLog");
 291 }
 292
 293 =head2 ModItemTransfer
 294
 295 =over 4
 296
 297 ModItemTransfer($itenumber, $frombranch, $tobranch);
 298
 299 =back
 300
 301 Marks an item as being transferred from one branch
 302 to another.
 303
 304 =cut
 305
 306 sub ModItemTransfer {
 307     my ( $itemnumber, $frombranch, $tobranch ) = @_;
 308
 309     my $dbh = C4::Context->dbh;
 310
 311     #new entry in branchtransfers....
 312     my $sth = $dbh->prepare(
 313         "INSERT INTO branchtransfers (itemnumber, frombranch, datesent, tobranch)
 314         VALUES (?, ?, NOW(), ?)");
 315     $sth->execute($itemnumber, $frombranch, $tobranch);
 316
 317     ModItem({ holdingbranch => $tobranch }, undef, $itemnumber);
 318     ModDateLastSeen($itemnumber);
 319     return;
 320 }
 321
 322 =head2 ModDateLastSeen
 323
 324 =over 4
 325
 326 ModDateLastSeen($itemnum);
 327
 328 =back
 329
 330 Mark item as seen. Is called when an item is issued, returned or manually marked during inventory/stocktaking.
 331 C<$itemnum> is the item number
 332
 333 =cut
 334
 335 sub ModDateLastSeen {
 336     my ($itemnumber) = @_;
 337
 338     my $today = C4::Dates->new();
 339     ModItem({ itemlost => 0, datelastseen => $today->output("iso") }, undef, $itemnumber);
 340 }
 341
 342 =head2 DelItem
 343
 344 =over 4
 345
 346 DelItem($biblionumber, $itemnumber);
 347
 348 =back
 349
 350 Exported function (core API) for deleting an item record in Koha.
 351
 352 =cut
 353
 354 sub DelItem {
 355     my ( $dbh, $biblionumber, $itemnumber ) = @_;
 356
 357     # FIXME check the item has no current issues
 358
 359     _koha_delete_item( $dbh, $itemnumber );
 360
 361     # get the MARC record
 362     my $record = GetMarcBiblio($biblionumber);
 363     my $frameworkcode = GetFrameworkCode($biblionumber);
 364
 365     # backup the record
 366     my $copy2deleted = $dbh->prepare("UPDATE deleteditems SET marc=? WHERE itemnumber=?");
 367     $copy2deleted->execute( $record->as_usmarc(), $itemnumber );
 368
 369     #search item field code
 370     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField("items.itemnumber",$frameworkcode);
 371     my @fields = $record->field($itemtag);
 372
 373     # delete the item specified
 374     foreach my $field (@fields) {
 375         if ( $field->subfield($itemsubfield) eq $itemnumber ) {
 376             $record->delete_field($field);
 377         }
 378     }
 379     &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
 380     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","DELETE",$itemnumber,"item")
 381         if C4::Context->preference("CataloguingLog");
 382 }
 383
 384 =head1 EXPORTED SPECIAL ACCESSOR FUNCTIONS
 385
 386 The following functions provide various ways of
 387 getting an item record, a set of item records, or
 388 lists of authorized values for certain item fields.
 389
 390 Some of the functions in this group are candidates
 391 for refactoring -- for example, some of the code
 392 in C<GetItemsByBiblioitemnumber> and C<GetItemsInfo>
 393 has copy-and-paste work.
 394
 395 =cut
 396
 397 =head2 GetItemStatus
 398
 399 =over 4
 400
 401 $itemstatushash = GetItemStatus($fwkcode);
 402
 403 =back
 404
 405 Returns a list of valid values for the
 406 C<items.notforloan> field.
 407
 408 NOTE: does B<not> return an individual item's
 409 status.
 410
 411 Can be MARC dependant.
 412 fwkcode is optional.
 413 But basically could be can be loan or not
 414 Create a status selector with the following code
 415
 416 =head3 in PERL SCRIPT
 417
 418 =over 4
 419
 420 my $itemstatushash = getitemstatus;
 421 my @itemstatusloop;
 422 foreach my $thisstatus (keys %$itemstatushash) {
 423     my %row =(value => $thisstatus,
 424                 statusname => $itemstatushash->{$thisstatus}->{'statusname'},
 425             );
 426     push @itemstatusloop, \%row;
 427 }
 428 $template->param(statusloop=>\@itemstatusloop);
 429
 430 =back
 431
 432 =head3 in TEMPLATE
 433
 434 =over 4
 435
 436 <select name="statusloop">
 437     <option value="">Default</option>
 438 <!-- TMPL_LOOP name="statusloop" -->
 439     <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="statusname" --></option>
 440 <!-- /TMPL_LOOP -->
 441 </select>
 442
 443 =back
 444
 445 =cut
 446
 447 sub GetItemStatus {
 448
 449     # returns a reference to a hash of references to status...
 450     my ($fwk) = @_;
 451     my %itemstatus;
 452     my $dbh = C4::Context->dbh;
 453     my $sth;
 454     $fwk = '' unless ($fwk);
 455     my ( $tag, $subfield ) =
 456       GetMarcFromKohaField( "items.notforloan", $fwk );
 457     if ( $tag and $subfield ) {
 458         my $sth =
 459           $dbh->prepare(
 460             "SELECT authorised_value
 461             FROM marc_subfield_structure
 462             WHERE tagfield=?
 463                 AND tagsubfield=?
 464                 AND frameworkcode=?
 465             "
 466           );
 467         $sth->execute( $tag, $subfield, $fwk );
 468         if ( my ($authorisedvaluecat) = $sth->fetchrow ) {
 469             my $authvalsth =
 470               $dbh->prepare(
 471                 "SELECT authorised_value,lib
 472                 FROM authorised_values
 473                 WHERE category=?
 474                 ORDER BY lib
 475                 "
 476               );
 477             $authvalsth->execute($authorisedvaluecat);
 478             while ( my ( $authorisedvalue, $lib ) = $authvalsth->fetchrow ) {
 479                 $itemstatus{$authorisedvalue} = $lib;
 480             }
 481             $authvalsth->finish;
 482             return \%itemstatus;
 483             exit 1;
 484         }
 485         else {
 486
 487             #No authvalue list
 488             # build default
 489         }
 490         $sth->finish;
 491     }
 492
 493     #No authvalue list
 494     #build default
 495     $itemstatus{"1"} = "Not For Loan";
 496     return \%itemstatus;
 497 }
 498
 499 =head2 GetItemLocation
 500
 501 =over 4
 502
 503 $itemlochash = GetItemLocation($fwk);
 504
 505 =back
 506
 507 Returns a list of valid values for the
 508 C<items.location> field.
 509
 510 NOTE: does B<not> return an individual item's
 511 location.
 512
 513 where fwk stands for an optional framework code.
 514 Create a location selector with the following code
 515
 516 =head3 in PERL SCRIPT
 517
 518 =over 4
 519
 520 my $itemlochash = getitemlocation;
 521 my @itemlocloop;
 522 foreach my $thisloc (keys %$itemlochash) {
 523     my $selected = 1 if $thisbranch eq $branch;
 524     my %row =(locval => $thisloc,
 525                 selected => $selected,
 526                 locname => $itemlochash->{$thisloc},
 527             );
 528     push @itemlocloop, \%row;
 529 }
 530 $template->param(itemlocationloop => \@itemlocloop);
 531
 532 =back
 533
 534 =head3 in TEMPLATE
 535
 536 =over 4
 537
 538 <select name="location">
 539     <option value="">Default</option>
 540 <!-- TMPL_LOOP name="itemlocationloop" -->
 541     <option value="<!-- TMPL_VAR name="locval" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="locname" --></option>
 542 <!-- /TMPL_LOOP -->
 543 </select>
 544
 545 =back
 546
 547 =cut
 548
 549 sub GetItemLocation {
 550
 551     # returns a reference to a hash of references to location...
 552     my ($fwk) = @_;
 553     my %itemlocation;
 554     my $dbh = C4::Context->dbh;
 555     my $sth;
 556     $fwk = '' unless ($fwk);
 557     my ( $tag, $subfield ) =
 558       GetMarcFromKohaField( "items.location", $fwk );
 559     if ( $tag and $subfield ) {
 560         my $sth =
 561           $dbh->prepare(
 562             "SELECT authorised_value
 563             FROM marc_subfield_structure
 564             WHERE tagfield=?
 565                 AND tagsubfield=?
 566                 AND frameworkcode=?"
 567           );
 568         $sth->execute( $tag, $subfield, $fwk );
 569         if ( my ($authorisedvaluecat) = $sth->fetchrow ) {
 570             my $authvalsth =
 571               $dbh->prepare(
 572                 "SELECT authorised_value,lib
 573                 FROM authorised_values
 574                 WHERE category=?
 575                 ORDER BY lib"
 576               );
 577             $authvalsth->execute($authorisedvaluecat);
 578             while ( my ( $authorisedvalue, $lib ) = $authvalsth->fetchrow ) {
 579                 $itemlocation{$authorisedvalue} = $lib;
 580             }
 581             $authvalsth->finish;
 582             return \%itemlocation;
 583             exit 1;
 584         }
 585         else {
 586
 587             #No authvalue list
 588             # build default
 589         }
 590         $sth->finish;
 591     }
 592
 593     #No authvalue list
 594     #build default
 595     $itemlocation{"1"} = "Not For Loan";
 596     return \%itemlocation;
 597 }
 598
 599 =head2 GetLostItems
 600
 601 =over 4
 602
 603 $items = GetLostItems($where,$orderby);
 604
 605 =back
 606
 607 This function get the items lost into C<$items>.
 608
 609 =over 2
 610
 611 =item input:
 612 C<$where> is a hashref. it containts a field of the items table as key
 613 and the value to match as value.
 614 C<$orderby> is a field of the items table.
 615
 616 =item return:
 617 C<$items> is a reference to an array full of hasref which keys are items' table column.
 618
 619 =item usage in the perl script:
 620
 621 my %where;
 622 $where{barcode} = 0001548;
 623 my $items = GetLostItems( \%where, "homebranch" );
 624 $template->param(itemsloop => $items);
 625
 626 =back
 627
 628 =cut
 629
 630 sub GetLostItems {
 631     # Getting input args.
 632     my $where   = shift;
 633     my $orderby = shift;
 634     my $dbh     = C4::Context->dbh;
 635
 636     my $query   = "
 637         SELECT *
 638         FROM   items
 639         WHERE  itemlost IS NOT NULL
 640           AND  itemlost <> 0
 641     ";
 642     foreach my $key (keys %$where) {
 643         $query .= " AND " . $key . " LIKE '%" . $where->{$key} . "%'";
 644     }
 645     $query .= " ORDER BY ".$orderby if defined $orderby;
 646
 647     my $sth = $dbh->prepare($query);
 648     $sth->execute;
 649     my @items;
 650     while ( my $row = $sth->fetchrow_hashref ){
 651         push @items, $row;
 652     }
 653     return \@items;
 654 }
 655
 656 =head2 GetItemsForInventory
 657
 658 =over 4
 659
 660 $itemlist = GetItemsForInventory($minlocation,$maxlocation,$datelastseen,$offset,$size)
 661
 662 =back
 663
 664 Retrieve a list of title/authors/barcode/callnumber, for biblio inventory.
 665
 666 The sub returns a list of hashes, containing itemnumber, author, title, barcode & item callnumber.
 667 It is ordered by callnumber,title.
 668
 669 The minlocation & maxlocation parameters are used to specify a range of item callnumbers
 670 the datelastseen can be used to specify that you want to see items not seen since a past date only.
 671 offset & size can be used to retrieve only a part of the whole listing (defaut behaviour)
 672
 673 =cut
 674
 675 sub GetItemsForInventory {
 676     my ( $minlocation, $maxlocation,$location, $datelastseen, $branch, $offset, $size ) = @_;
 677     my $dbh = C4::Context->dbh;
 678     my $sth;
 679     if ($datelastseen) {
 680         $datelastseen=format_date_in_iso($datelastseen);
 681         my $query =
 682                 "SELECT itemnumber,barcode,itemcallnumber,title,author,biblio.biblionumber,datelastseen
 683                  FROM items
 684                    LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 685                  WHERE itemcallnumber>= ?
 686                    AND itemcallnumber <=?
 687                    AND (datelastseen< ? OR datelastseen IS NULL)";
 688         $query.= " AND items.location=".$dbh->quote($location) if $location;
 689         $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch;
 690         $query .= " ORDER BY itemcallnumber,title";
 691         $sth = $dbh->prepare($query);
 692         $sth->execute( $minlocation, $maxlocation, $datelastseen );
 693     }
 694     else {
 695         my $query ="
 696                 SELECT itemnumber,barcode,itemcallnumber,biblio.biblionumber,title,author,datelastseen
 697                 FROM items
 698                   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 699                 WHERE itemcallnumber>= ?
 700                   AND itemcallnumber <=?";
 701         $query.= " AND items.location=".$dbh->quote($location) if $location;
 702         $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch;
 703         $query .= " ORDER BY itemcallnumber,title";
 704         $sth = $dbh->prepare($query);
 705         $sth->execute( $minlocation, $maxlocation );
 706     }
 707     my @results;
 708     while ( my $row = $sth->fetchrow_hashref ) {
 709         $offset-- if ($offset);
 710         $row->{datelastseen}=format_date($row->{datelastseen});
 711         if ( ( !$offset ) && $size ) {
 712             push @results, $row;
 713             $size--;
 714         }
 715     }
 716     return \@results;
 717 }
 718
 719 =head2 GetItemsCount
 720
 721 =over 4
 722 $count = &GetItemsCount( $biblionumber);
 723
 724 =back
 725
 726 This function return count of item with $biblionumber
 727
 728 =cut
 729
 730 sub GetItemsCount {
 731     my ( $biblionumber ) = @_;
 732     my $dbh = C4::Context->dbh;
 733     my $query = "SELECT count(*)
 734           FROM  items
 735           WHERE biblionumber=?";
 736     my $sth = $dbh->prepare($query);
 737     $sth->execute($biblionumber);
 738     my $count = $sth->fetchrow;
 739     $sth->finish;
 740     return ($count);
 741 }
 742
 743 =head2 GetItemInfosOf
 744
 745 =over 4
 746
 747 GetItemInfosOf(@itemnumbers);
 748
 749 =back
 750
 751 =cut
 752
 753 sub GetItemInfosOf {
 754     my @itemnumbers = @_;
 755
 756     my $query = '
 757         SELECT *
 758         FROM items
 759         WHERE itemnumber IN (' . join( ',', @itemnumbers ) . ')
 760     ';
 761     return get_infos_of( $query, 'itemnumber' );
 762 }
 763
 764 =head2 GetItemsByBiblioitemnumber
 765
 766 =over 4
 767
 768 GetItemsByBiblioitemnumber($biblioitemnumber);
 769
 770 =back
 771
 772 Returns an arrayref of hashrefs suitable for use in a TMPL_LOOP
 773 Called by C<C4::XISBN>
 774
 775 =cut
 776
 777 sub GetItemsByBiblioitemnumber {
 778     my ( $bibitem ) = @_;
 779     my $dbh = C4::Context->dbh;
 780     my $sth = $dbh->prepare("SELECT * FROM items WHERE items.biblioitemnumber = ?") || die $dbh->errstr;
 781     # Get all items attached to a biblioitem
 782     my $i = 0;
 783     my @results;
 784     $sth->execute($bibitem) || die $sth->errstr;
 785     while ( my $data = $sth->fetchrow_hashref ) {
 786         # Foreach item, get circulation information
 787         my $sth2 = $dbh->prepare( "SELECT * FROM issues,borrowers
 788                                    WHERE itemnumber = ?
 789                                    AND returndate is NULL
 790                                    AND issues.borrowernumber = borrowers.borrowernumber"
 791         );
 792         $sth2->execute( $data->{'itemnumber'} );
 793         if ( my $data2 = $sth2->fetchrow_hashref ) {
 794             # if item is out, set the due date and who it is out too
 795             $data->{'date_due'}   = $data2->{'date_due'};
 796             $data->{'cardnumber'} = $data2->{'cardnumber'};
 797             $data->{'borrowernumber'}   = $data2->{'borrowernumber'};
 798         }
 799         else {
 800             # set date_due to blank, so in the template we check itemlost, and wthdrawn
 801             $data->{'date_due'} = '';
 802         }    # else
 803         $sth2->finish;
 804         # Find the last 3 people who borrowed this item.
 805         my $query2 = "SELECT * FROM issues, borrowers WHERE itemnumber = ?
 806                       AND issues.borrowernumber = borrowers.borrowernumber
 807                       AND returndate is not NULL
 808                       ORDER BY returndate desc,timestamp desc LIMIT 3";
 809         $sth2 = $dbh->prepare($query2) || die $dbh->errstr;
 810         $sth2->execute( $data->{'itemnumber'} ) || die $sth2->errstr;
 811         my $i2 = 0;
 812         while ( my $data2 = $sth2->fetchrow_hashref ) {
 813             $data->{"timestamp$i2"} = $data2->{'timestamp'};
 814             $data->{"card$i2"}      = $data2->{'cardnumber'};
 815             $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
 816             $i2++;
 817         }
 818         $sth2->finish;
 819         push(@results,$data);
 820     }
 821     $sth->finish;
 822     return (\@results);
 823 }
 824
 825 =head2 GetItemsInfo
 826
 827 =over 4
 828
 829 @results = GetItemsInfo($biblionumber, $type);
 830
 831 =back
 832
 833 Returns information about books with the given biblionumber.
 834
 835 C<$type> may be either C<intra> or anything else. If it is not set to
 836 C<intra>, then the search will exclude lost, very overdue, and
 837 withdrawn items.
 838
 839 C<GetItemsInfo> returns a list of references-to-hash. Each element
 840 contains a number of keys. Most of them are table items from the
 841 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
 842 Koha database. Other keys include:
 843
 844 =over 2
 845
 846 =item C<$data-E<gt>{branchname}>
 847
 848 The name (not the code) of the branch to which the book belongs.
 849
 850 =item C<$data-E<gt>{datelastseen}>
 851
 852 This is simply C<items.datelastseen>, except that while the date is
 853 stored in YYYY-MM-DD format in the database, here it is converted to
 854 DD/MM/YYYY format. A NULL date is returned as C<//>.
 855
 856 =item C<$data-E<gt>{datedue}>
 857
 858 =item C<$data-E<gt>{class}>
 859
 860 This is the concatenation of C<biblioitems.classification>, the book's
 861 Dewey code, and C<biblioitems.subclass>.
 862
 863 =item C<$data-E<gt>{ocount}>
 864
 865 I think this is the number of copies of the book available.
 866
 867 =item C<$data-E<gt>{order}>
 868
 869 If this is set, it is set to C<One Order>.
 870
 871 =back
 872
 873 =cut
 874
 875 sub GetItemsInfo {
 876     my ( $biblionumber, $type ) = @_;
 877     my $dbh   = C4::Context->dbh;
 878     my $query = "SELECT *,items.notforloan as itemnotforloan
 879                  FROM items
 880                  LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
 881                  LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
 882     $query .=  (C4::Context->preference('item-level_itypes')) ?
 883                      " LEFT JOIN itemtypes on items.itype = itemtypes.itemtype "
 884                     : " LEFT JOIN itemtypes on biblioitems.itemtype = itemtypes.itemtype ";
 885     $query .= "WHERE items.biblionumber = ? ORDER BY items.dateaccessioned desc" ;
 886     my $sth = $dbh->prepare($query);
 887     $sth->execute($biblionumber);
 888     my $i = 0;
 889     my @results;
 890     my ( $date_due, $count_reserves );
 891
 892     my $isth    = $dbh->prepare(
 893         "SELECT issues.*,borrowers.cardnumber,borrowers.surname,borrowers.firstname,borrowers.branchcode as bcode
 894         FROM   issues LEFT JOIN borrowers ON issues.borrowernumber=borrowers.borrowernumber
 895         WHERE  itemnumber = ?
 896             AND returndate IS NULL"
 897        );
 898     while ( my $data = $sth->fetchrow_hashref ) {
 899         my $datedue = '';
 900         $isth->execute( $data->{'itemnumber'} );
 901         if ( my $idata = $isth->fetchrow_hashref ) {
 902             $data->{borrowernumber} = $idata->{borrowernumber};
 903             $data->{cardnumber}     = $idata->{cardnumber};
 904             $data->{surname}     = $idata->{surname};
 905             $data->{firstname}     = $idata->{firstname};
 906             $datedue                = $idata->{'date_due'};
 907         if (C4::Context->preference("IndependantBranches")){
 908         my $userenv = C4::Context->userenv;
 909         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 910             $data->{'NOTSAMEBRANCH'} = 1 if ($idata->{'bcode'} ne $userenv->{branch});
 911         }
 912         }
 913         }
 914         if ( $datedue eq '' ) {
 915             my ( $restype, $reserves ) =
 916               C4::Reserves::CheckReserves( $data->{'itemnumber'} );
 917             if ($restype) {
 918                 $count_reserves = $restype;
 919             }
 920         }
 921         $isth->finish;
 922
 923         #get branch information.....
 924         my $bsth = $dbh->prepare(
 925             "SELECT * FROM branches WHERE branchcode = ?
 926         "
 927         );
 928         $bsth->execute( $data->{'holdingbranch'} );
 929         if ( my $bdata = $bsth->fetchrow_hashref ) {
 930             $data->{'branchname'} = $bdata->{'branchname'};
 931         }
 932         $data->{'datedue'}        = $datedue;
 933         $data->{'count_reserves'} = $count_reserves;
 934
 935         # get notforloan complete status if applicable
 936         my $sthnflstatus = $dbh->prepare(
 937             'SELECT authorised_value
 938             FROM   marc_subfield_structure
 939             WHERE  kohafield="items.notforloan"
 940         '
 941         );
 942
 943         $sthnflstatus->execute;
 944         my ($authorised_valuecode) = $sthnflstatus->fetchrow;
 945         if ($authorised_valuecode) {
 946             $sthnflstatus = $dbh->prepare(
 947                 "SELECT lib FROM authorised_values
 948                  WHERE  category=?
 949                  AND authorised_value=?"
 950             );
 951             $sthnflstatus->execute( $authorised_valuecode,
 952                 $data->{itemnotforloan} );
 953             my ($lib) = $sthnflstatus->fetchrow;
 954             $data->{notforloan} = $lib;
 955         }
 956
 957         # my stack procedures
 958         my $stackstatus = $dbh->prepare(
 959             'SELECT authorised_value
 960              FROM   marc_subfield_structure
 961              WHERE  kohafield="items.stack"
 962         '
 963         );
 964         $stackstatus->execute;
 965
 966         ($authorised_valuecode) = $stackstatus->fetchrow;
 967         if ($authorised_valuecode) {
 968             $stackstatus = $dbh->prepare(
 969                 "SELECT lib
 970                  FROM   authorised_values
 971                  WHERE  category=?
 972                  AND    authorised_value=?
 973             "
 974             );
 975             $stackstatus->execute( $authorised_valuecode, $data->{stack} );
 976             my ($lib) = $stackstatus->fetchrow;
 977             $data->{stack} = $lib;
 978         }
 979         # Find the last 3 people who borrowed this item.
 980         my $sth2 = $dbh->prepare("SELECT * FROM issues,borrowers
 981                                     WHERE itemnumber = ?
 982                                     AND issues.borrowernumber = borrowers.borrowernumber
 983                                     AND returndate IS NOT NULL LIMIT 3");
 984         $sth2->execute($data->{'itemnumber'});
 985         my $ii = 0;
 986         while (my $data2 = $sth2->fetchrow_hashref()) {
 987             $data->{"timestamp$ii"} = $data2->{'timestamp'} if $data2->{'timestamp'};
 988             $data->{"card$ii"}      = $data2->{'cardnumber'} if $data2->{'cardnumber'};
 989             $data->{"borrower$ii"}  = $data2->{'borrowernumber'} if $data2->{'borrowernumber'};
 990             $ii++;
 991         }
 992
 993         $results[$i] = $data;
 994         $i++;
 995     }
 996     $sth->finish;
 997
 998     return (@results);
 999 }
1000
1001 =head2 get_itemnumbers_of
1002
1003 =over 4
1004
1005 my @itemnumbers_of = get_itemnumbers_of(@biblionumbers);
1006
1007 =back
1008
1009 Given a list of biblionumbers, return the list of corresponding itemnumbers
1010 for each biblionumber.
1011
1012 Return a reference on a hash where keys are biblionumbers and values are
1013 references on array of itemnumbers.
1014
1015 =cut
1016
1017 sub get_itemnumbers_of {
1018     my @biblionumbers = @_;
1019
1020     my $dbh = C4::Context->dbh;
1021
1022     my $query = '
1023         SELECT itemnumber,
1024             biblionumber
1025         FROM items
1026         WHERE biblionumber IN (?' . ( ',?' x scalar @biblionumbers - 1 ) . ')
1027     ';
1028     my $sth = $dbh->prepare($query);
1029     $sth->execute(@biblionumbers);
1030
1031     my %itemnumbers_of;
1032
1033     while ( my ( $itemnumber, $biblionumber ) = $sth->fetchrow_array ) {
1034         push @{ $itemnumbers_of{$biblionumber} }, $itemnumber;
1035     }
1036
1037     return \%itemnumbers_of;
1038 }
1039
1040 =head1 LIMITED USE FUNCTIONS
1041
1042 The following functions, while part of the public API,
1043 are not exported.  This is generally because they are
1044 meant to be used by only one script for a specific
1045 purpose, and should not be used in any other context
1046 without careful thought.
1047
1048 =cut
1049
1050 =head2 GetMarcItem
1051
1052 =over 4
1053
1054 my $item_marc = GetMarcItem($biblionumber, $itemnumber);
1055
1056 =back
1057
1058 Returns MARC::Record of the item passed in parameter.
1059 This function is meant for use only in C<cataloguing/additem.pl>,
1060 where it is needed to support that script's MARC-like
1061 editor.
1062
1063 =cut
1064
1065 sub GetMarcItem {
1066     my ( $biblionumber, $itemnumber ) = @_;
1067
1068     # GetMarcItem has been revised so that it does the following:
1069     #  1. Gets the item information from the items table.
1070     #  2. Converts it to a MARC field for storage in the bib record.
1071     #
1072     # The previous behavior was:
1073     #  1. Get the bib record.
1074     #  2. Return the MARC tag corresponding to the item record.
1075     #
1076     # The difference is that one treats the items row as authoritative,
1077     # while the other treats the MARC representation as authoritative
1078     # under certain circumstances.
1079
1080     my $itemrecord = GetItem($itemnumber);
1081
1082     # Tack on 'items.' prefix to column names so that TransformKohaToMarc will work.
1083     # Also, don't emit a subfield if the underlying field is blank.
1084     my $mungeditem = { map {  $itemrecord->{$_} ne '' ? ("items.$_" => $itemrecord->{$_}) : ()  } keys %{ $itemrecord } };
1085
1086     my $itemmarc = TransformKohaToMarc($mungeditem);
1087     return $itemmarc;
1088
1089 }
1090
1091 =head1 PRIVATE FUNCTIONS AND VARIABLES
1092
1093 The following functions are not meant to be called
1094 directly, but are documented in order to explain
1095 the inner workings of C<C4::Items>.
1096
1097 =cut
1098
1099 =head2 %derived_columns
1100
1101 This hash keeps track of item columns that
1102 are strictly derived from other columns in
1103 the item record and are not meant to be set
1104 independently.
1105
1106 Each key in the hash should be the name of a
1107 column (as named by TransformMarcToKoha).  Each
1108 value should be hashref whose keys are the
1109 columns on which the derived column depends.  The
1110 hashref should also contain a 'BUILDER' key
1111 that is a reference to a sub that calculates
1112 the derived value.
1113
1114 =cut
1115
1116 my %derived_columns = (
1117     'items.cn_sort' => {
1118         'itemcallnumber' => 1,
1119         'items.cn_source' => 1,
1120         'BUILDER' => \&_calc_items_cn_sort,
1121     }
1122 );
1123
1124 =head2 _set_derived_columns_for_add
1125
1126 =over 4
1127
1128 _set_derived_column_for_add($item);
1129
1130 =back
1131
1132 Given an item hash representing a new item to be added,
1133 calculate any derived columns.  Currently the only
1134 such column is C<items.cn_sort>.
1135
1136 =cut
1137
1138 sub _set_derived_columns_for_add {
1139     my $item = shift;
1140
1141     foreach my $column (keys %derived_columns) {
1142         my $builder = $derived_columns{$column}->{'BUILDER'};
1143         my $source_values = {};
1144         foreach my $source_column (keys %{ $derived_columns{$column} }) {
1145             next if $source_column eq 'BUILDER';
1146             $source_values->{$source_column} = $item->{$source_column};
1147         }
1148         $builder->($item, $source_values);
1149     }
1150 }
1151
1152 =head2 _set_derived_columns_for_mod
1153
1154 =over 4
1155
1156 _set_derived_column_for_mod($item);
1157
1158 =back
1159
1160 Given an item hash representing a new item to be modified.
1161 calculate any derived columns.  Currently the only
1162 such column is C<items.cn_sort>.
1163
1164 This routine differs from C<_set_derived_columns_for_add>
1165 in that it needs to handle partial item records.  In other
1166 words, the caller of C<ModItem> may have supplied only one
1167 or two columns to be changed, so this function needs to
1168 determine whether any of the columns to be changed affect
1169 any of the derived columns.  Also, if a derived column
1170 depends on more than one column, but the caller is not
1171 changing all of then, this routine retrieves the unchanged
1172 values from the database in order to ensure a correct
1173 calculation.
1174
1175 =cut
1176
1177 sub _set_derived_columns_for_mod {
1178     my $item = shift;
1179
1180     foreach my $column (keys %derived_columns) {
1181         my $builder = $derived_columns{$column}->{'BUILDER'};
1182         my $source_values = {};
1183         my %missing_sources = ();
1184         my $must_recalc = 0;
1185         foreach my $source_column (keys %{ $derived_columns{$column} }) {
1186             next if $source_column eq 'BUILDER';
1187             if (exists $item->{$source_column}) {
1188                 $must_recalc = 1;
1189                 $source_values->{$source_column} = $item->{$source_column};
1190             } else {
1191                 $missing_sources{$source_column} = 1;
1192             }
1193         }
1194         if ($must_recalc) {
1195             foreach my $source_column (keys %missing_sources) {
1196                 $source_values->{$source_column} = _get_single_item_column($source_column, $item->{'itemnumber'});
1197             }
1198             $builder->($item, $source_values);
1199         }
1200     }
1201 }
1202
1203 =head2 _do_column_fixes_for_mod
1204
1205 =over 4
1206
1207 _do_column_fixes_for_mod($item);
1208
1209 =back
1210
1211 Given an item hashref containing one or more
1212 columns to modify, fix up certain values.
1213 Specifically, set to 0 any passed value
1214 of C<notforloan>, C<damaged>, C<itemlost>, or
1215 C<wthdrawn> that is either undefined or
1216 contains the empty string.
1217
1218 =cut
1219
1220 sub _do_column_fixes_for_mod {
1221     my $item = shift;
1222
1223     if (exists $item->{'notforloan'} and
1224         (not defined $item->{'notforloan'} or $item->{'notforloan'} eq '')) {
1225         $item->{'notforloan'} = 0;
1226     }
1227     if (exists $item->{'damaged'} and
1228         (not defined $item->{'damaged'} or $item->{'damaged'} eq '')) {
1229         $item->{'damaged'} = 0;
1230     }
1231     if (exists $item->{'itemlost'} and
1232         (not defined $item->{'itemlost'} or $item->{'itemlost'} eq '')) {
1233         $item->{'itemlost'} = 0;
1234     }
1235     if (exists $item->{'wthdrawn'} and
1236         (not defined $item->{'wthdrawn'} or $item->{'wthdrawn'} eq '')) {
1237         $item->{'wthdrawn'} = 0;
1238     }
1239 }
1240
1241 =head2 _get_single_item_column
1242
1243 =over 4
1244
1245 _get_single_item_column($column, $itemnumber);
1246
1247 =back
1248
1249 Retrieves the value of a single column from an C<items>
1250 row specified by C<$itemnumber>.
1251
1252 =cut
1253
1254 sub _get_single_item_column {
1255     my $column = shift;
1256     my $itemnumber = shift;
1257
1258     my $dbh = C4::Context->dbh;
1259     my $sth = $dbh->prepare("SELECT $column FROM items WHERE itemnumber = ?");
1260     $sth->execute($itemnumber);
1261     my ($value) = $sth->fetchrow();
1262     return $value;
1263 }
1264
1265 =head2 _calc_items_cn_sort
1266
1267 =over 4
1268
1269 _calc_items_cn_sort($item, $source_values);
1270
1271 =back
1272
1273 Helper routine to calculate C<items.cn_sort>.
1274
1275 =cut
1276
1277 sub _calc_items_cn_sort {
1278     my $item = shift;
1279     my $source_values = shift;
1280
1281     $item->{'items.cn_sort'} = GetClassSort($source_values->{'items.cn_source'}, $source_values->{'itemcallnumber'}, "");
1282 }
1283
1284 =head2 _set_defaults_for_add
1285
1286 =over 4
1287
1288 _set_defaults_for_add($item_hash);
1289
1290 =back
1291
1292 Given an item hash representing an item to be added, set
1293 correct default values for columns whose default value
1294 is not handled by the DBMS.  This includes the following
1295 columns:
1296
1297 =over 2
1298
1299 =item *
1300
1301 C<items.dateaccessioned>
1302
1303 =item *
1304
1305 C<items.notforloan>
1306
1307 =item *
1308
1309 C<items.damaged>
1310
1311 =item *
1312
1313 C<items.itemlost>
1314
1315 =item *
1316
1317 C<items.wthdrawn>
1318
1319 =back
1320
1321 =cut
1322
1323 sub _set_defaults_for_add {
1324     my $item = shift;
1325
1326     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1327     if (!(exists $item->{'dateaccessioned'}) ||
1328          ($item->{'dateaccessioned'} eq '')) {
1329         # FIXME add check for invalid date
1330         my $today = C4::Dates->new();
1331         $item->{'dateaccessioned'} =  $today->output("iso"); #TODO: check time issues
1332     }
1333
1334     # various item status fields cannot be null
1335     $item->{'notforloan'} = 0 unless exists $item->{'notforloan'} and defined $item->{'notforloan'};
1336     $item->{'damaged'}    = 0 unless exists $item->{'damaged'}    and defined $item->{'damaged'};
1337     $item->{'itemlost'}   = 0 unless exists $item->{'itemlost'}   and defined $item->{'itemlost'};
1338     $item->{'wthdrawn'}   = 0 unless exists $item->{'wthdrawn'}   and defined $item->{'wthdrawn'};
1339 }
1340
1341 =head2 _koha_new_item
1342
1343 =over 4
1344
1345 my ($itemnumber,$error) = _koha_new_item( $dbh, $item, $barcode );
1346
1347 =back
1348
1349 Perform the actual insert into the C<items> table.
1350
1351 =cut
1352
1353 sub _koha_new_item {
1354     my ( $dbh, $item, $barcode ) = @_;
1355     my $error;
1356
1357     my $query =
1358            "INSERT INTO items SET
1359             biblionumber        = ?,
1360             biblioitemnumber    = ?,
1361             barcode             = ?,
1362             dateaccessioned     = ?,
1363             booksellerid        = ?,
1364             homebranch          = ?,
1365             price               = ?,
1366             replacementprice    = ?,
1367             replacementpricedate = NOW(),
1368             datelastborrowed    = ?,
1369             datelastseen        = NOW(),
1370             stack               = ?,
1371             notforloan          = ?,
1372             damaged             = ?,
1373             itemlost            = ?,
1374             wthdrawn            = ?,
1375             itemcallnumber      = ?,
1376             restricted          = ?,
1377             itemnotes           = ?,
1378             holdingbranch       = ?,
1379             paidfor             = ?,
1380             location            = ?,
1381             onloan              = ?,
1382             issues              = ?,
1383             renewals            = ?,
1384             reserves            = ?,
1385             cn_source           = ?,
1386             cn_sort             = ?,
1387             ccode               = ?,
1388             itype               = ?,
1389             materials           = ?,
1390             uri                 = ?
1391           ";
1392     my $sth = $dbh->prepare($query);
1393     $sth->execute(
1394             $item->{'biblionumber'},
1395             $item->{'biblioitemnumber'},
1396             $barcode,
1397             $item->{'dateaccessioned'},
1398             $item->{'booksellerid'},
1399             $item->{'homebranch'},
1400             $item->{'price'},
1401             $item->{'replacementprice'},
1402             $item->{datelastborrowed},
1403             $item->{stack},
1404             $item->{'notforloan'},
1405             $item->{'damaged'},
1406             $item->{'itemlost'},
1407             $item->{'wthdrawn'},
1408             $item->{'itemcallnumber'},
1409             $item->{'restricted'},
1410             $item->{'itemnotes'},
1411             $item->{'holdingbranch'},
1412             $item->{'paidfor'},
1413             $item->{'location'},
1414             $item->{'onloan'},
1415             $item->{'issues'},
1416             $item->{'renewals'},
1417             $item->{'reserves'},
1418             $item->{'items.cn_source'},
1419             $item->{'items.cn_sort'},
1420             $item->{'ccode'},
1421             $item->{'itype'},
1422             $item->{'materials'},
1423             $item->{'uri'},
1424     );
1425     my $itemnumber = $dbh->{'mysql_insertid'};
1426     if ( defined $sth->errstr ) {
1427         $error.="ERROR in _koha_new_item $query".$sth->errstr;
1428     }
1429     $sth->finish();
1430     return ( $itemnumber, $error );
1431 }
1432
1433 =head2 _koha_modify_item
1434
1435 =over 4
1436
1437 my ($itemnumber,$error) =_koha_modify_item( $dbh, $item, $op );
1438
1439 =back
1440
1441 Perform the actual update of the C<items> row.  Note that this
1442 routine accepts a hashref specifying the columns to update.
1443
1444 =cut
1445
1446 sub _koha_modify_item {
1447     my ( $dbh, $item ) = @_;
1448     my $error;
1449
1450     my $query = "UPDATE items SET ";
1451     my @bind;
1452     for my $key ( keys %$item ) {
1453         $query.="$key=?,";
1454         push @bind, $item->{$key};
1455     }
1456     $query =~ s/,$//;
1457     $query .= " WHERE itemnumber=?";
1458     push @bind, $item->{'itemnumber'};
1459     my $sth = $dbh->prepare($query);
1460     $sth->execute(@bind);
1461     if ( $dbh->errstr ) {
1462         $error.="ERROR in _koha_modify_item $query".$dbh->errstr;
1463         warn $error;
1464     }
1465     $sth->finish();
1466     return ($item->{'itemnumber'},$error);
1467 }
1468
1469 =head2 _koha_delete_item
1470
1471 =over 4
1472
1473 _koha_delete_item( $dbh, $itemnum );
1474
1475 =back
1476
1477 Internal function to delete an item record from the koha tables
1478
1479 =cut
1480
1481 sub _koha_delete_item {
1482     my ( $dbh, $itemnum ) = @_;
1483
1484     # save the deleted item to deleteditems table
1485     my $sth = $dbh->prepare("SELECT * FROM items WHERE itemnumber=?");
1486     $sth->execute($itemnum);
1487     my $data = $sth->fetchrow_hashref();
1488     $sth->finish();
1489     my $query = "INSERT INTO deleteditems SET ";
1490     my @bind  = ();
1491     foreach my $key ( keys %$data ) {
1492         $query .= "$key = ?,";
1493         push( @bind, $data->{$key} );
1494     }
1495     $query =~ s/\,$//;
1496     $sth = $dbh->prepare($query);
1497     $sth->execute(@bind);
1498     $sth->finish();
1499
1500     # delete from items table
1501     $sth = $dbh->prepare("DELETE FROM items WHERE itemnumber=?");
1502     $sth->execute($itemnum);
1503     $sth->finish();
1504     return undef;
1505 }
1506
1507 =head2 _marc_from_item_hash
1508
1509 =over 4
1510
1511 my $item_marc = _marc_from_item_hash($item, $frameworkcode);
1512
1513 =back
1514
1515 Given an item hash representing a complete item record,
1516 create a C<MARC::Record> object containing an embedded
1517 tag representing that item.
1518
1519 =cut
1520
1521 sub _marc_from_item_hash {
1522     my $item = shift;
1523     my $frameworkcode = shift;
1524
1525     # Tack on 'items.' prefix to column names so lookup from MARC frameworks will work
1526     # Also, don't emit a subfield if the underlying field is blank.
1527     my $mungeditem = { map {  (defined($item->{$_}) and $item->{$_} ne '') ?
1528                                 (/^items\./ ? ($_ => $item->{$_}) : ("items.$_" => $item->{$_}))
1529                                 : ()  } keys %{ $item } };
1530
1531     my $item_marc = MARC::Record->new();
1532     foreach my $item_field (keys %{ $mungeditem }) {
1533         my ($tag, $subfield) = GetMarcFromKohaField($item_field, $frameworkcode);
1534         next unless defined $tag and defined $subfield; # skip if not mapped to MARC field
1535         if (my $field = $item_marc->field($tag)) {
1536             $field->add_subfields($subfield => $mungeditem->{$item_field});
1537         } else {
1538             $item_marc->add_fields( $tag, " ", " ", $subfield =>  $mungeditem->{$item_field});
1539         }
1540     }
1541
1542     return $item_marc;
1543 }
1544
1545 =head2 _add_item_field_to_biblio
1546
1547 =over 4
1548
1549 _add_item_field_to_biblio($item_marc, $biblionumber, $frameworkcode);
1550
1551 =back
1552
1553 Adds the fields from a MARC record containing the
1554 representation of a Koha item record to the MARC
1555 biblio record.  The input C<$item_marc> record
1556 is expect to contain just one field, the embedded
1557 item information field.
1558
1559 =cut
1560
1561 sub _add_item_field_to_biblio {
1562     my ($item_marc, $biblionumber, $frameworkcode) = @_;
1563
1564     my $biblio_marc = GetMarcBiblio($biblionumber);
1565
1566     foreach my $field ($item_marc->fields()) {
1567         $biblio_marc->append_fields($field);
1568     }
1569
1570     ModBiblioMarc($biblio_marc, $biblionumber, $frameworkcode);
1571 }
1572
1573 =head2 _replace_item_field_in_biblio
1574
1575 =over
1576
1577 &_replace_item_field_in_biblio($item_marc, $biblionumber, $itemnumber, $frameworkcode)
1578
1579 =back
1580
1581 Given a MARC::Record C<$item_marc> containing one tag with the MARC
1582 representation of the item, examine the biblio MARC
1583 for the corresponding tag for that item and
1584 replace it with the tag from C<$item_marc>.
1585
1586 =cut
1587
1588 sub _replace_item_field_in_biblio {
1589     my ($ItemRecord, $biblionumber, $itemnumber, $frameworkcode) = @_;
1590     my $dbh = C4::Context->dbh;
1591
1592     # get complete MARC record & replace the item field by the new one
1593     my $completeRecord = GetMarcBiblio($biblionumber);
1594     my ($itemtag,$itemsubfield) = GetMarcFromKohaField("items.itemnumber",$frameworkcode);
1595     my $itemField = $ItemRecord->field($itemtag);
1596     my @items = $completeRecord->field($itemtag);
1597     my $found = 0;
1598     foreach (@items) {
1599         if ($_->subfield($itemsubfield) eq $itemnumber) {
1600             $_->replace_with($itemField);
1601             $found = 1;
1602         }
1603     }
1604
1605     unless ($found) {
1606         # If we haven't found the matching field,
1607         # just add it.  However, this means that
1608         # there is likely a bug.
1609         $completeRecord->append_fields($itemField);
1610     }
1611
1612     # save the record
1613     ModBiblioMarc($completeRecord, $biblionumber, $frameworkcode);
1614 }
1615
1616 1;