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::Biblio;
  26 use C4::Dates;
  27 use MARC::Record;
  28 use C4::ClassSource;
  29 use C4::Log;
  30
  31 use vars qw($VERSION @ISA @EXPORT);
  32
  33 my $VERSION = 3.00;
  34
  35 @ISA = qw( Exporter );
  36
  37 # function exports
  38 @EXPORT = qw(
  39     GetItem
  40     AddItemFromMarc
  41     AddItem
  42     ModItemFromMarc
  43     ModItem
  44     ModDateLastSeen
  45     ModItemTransfer
  46 );
  47
  48 =head1 NAME
  49
  50 C4::Items - item management functions
  51
  52 =head1 DESCRIPTION
  53
  54 This module contains an API for manipulating item
  55 records in Koha, and is used by cataloguing, circulation,
  56 acquisitions, and serials management.
  57
  58 A Koha item record is stored in two places: the
  59 items table and embedded in a MARC tag in the XML
  60 version of the associated bib record in C<biblioitems.marcxml>.
  61 This is done to allow the item information to be readily
  62 indexed (e.g., by Zebra), but means that each item
  63 modification transaction must keep the items table
  64 and the MARC XML in sync at all times.
  65
  66 Consequently, all code that creates, modifies, or deletes
  67 item records B<must> use an appropriate function from
  68 C<C4::Items>.  If no existing function is suitable, it is
  69 better to add one to C<C4::Items> than to use add
  70 one-off SQL statements to add or modify items.
  71
  72 The items table will be considered authoritative.  In other
  73 words, if there is ever a discrepancy between the items
  74 table and the MARC XML, the items table should be considered
  75 accurate.
  76
  77 =head1 HISTORICAL NOTE
  78
  79 Most of the functions in C<C4::Items> were originally in
  80 the C<C4::Biblio> module.
  81
  82 =head1 EXPORTED FUNCTIONS
  83
  84 The following functions are meant for use by users
  85 of C<C4::Items>
  86
  87 =cut
  88
  89 =head2 GetItem
  90
  91 =over 4
  92
  93 $item = GetItem($itemnumber,$barcode);
  94
  95 =back
  96
  97 Return item information, for a given itemnumber or barcode.
  98 The return value is a hashref mapping item column
  99 names to values.
 100
 101 =cut
 102
 103 sub GetItem {
 104     my ($itemnumber,$barcode) = @_;
 105     my $dbh = C4::Context->dbh;
 106     if ($itemnumber) {
 107         my $sth = $dbh->prepare("
 108             SELECT * FROM items
 109             WHERE itemnumber = ?");
 110         $sth->execute($itemnumber);
 111         my $data = $sth->fetchrow_hashref;
 112         return $data;
 113     } else {
 114         my $sth = $dbh->prepare("
 115             SELECT * FROM items
 116             WHERE barcode = ?"
 117             );
 118         $sth->execute($barcode);
 119         my $data = $sth->fetchrow_hashref;
 120         return $data;
 121     }
 122 }    # sub GetItem
 123
 124 =head2 AddItemFromMarc
 125
 126 =over 4
 127
 128 my ($biblionumber, $biblioitemnumber, $itemnumber)
 129     = AddItemFromMarc($source_item_marc, $biblionumber);
 130
 131 =back
 132
 133 Given a MARC::Record object containing an embedded item
 134 record and a biblionumber, create a new item record.
 135
 136 =cut
 137
 138 sub AddItemFromMarc {
 139     my ( $source_item_marc, $biblionumber ) = @_;
 140     my $dbh = C4::Context->dbh;
 141
 142     # parse item hash from MARC
 143     my $frameworkcode = GetFrameworkCode( $biblionumber );
 144     my $item = &TransformMarcToKoha( $dbh, $source_item_marc, $frameworkcode );
 145
 146     return AddItem($item, $biblionumber, $dbh, $frameworkcode);
 147 }
 148
 149 =head2 AddItem
 150
 151 =over 4
 152
 153 my ($biblionumber, $biblioitemnumber, $itemnumber)
 154     = AddItem($item, $biblionumber[, $dbh, $frameworkcode]);
 155
 156 =back
 157
 158 Given a hash containing item column names as keys,
 159 create a new Koha item record.
 160
 161 The two optional parameters (C<$dbh> and C<$frameworkcode>)
 162 do not need to be supplied for general use; they exist
 163 simply to allow them to be picked up from AddItemFromMarc.
 164
 165 =cut
 166
 167 sub AddItem {
 168     my $item = shift;
 169     my $biblionumber = shift;
 170
 171     my $dbh           = @_ ? shift : C4::Context->dbh;
 172     my $frameworkcode = @_ ? shift : GetFrameworkCode( $biblionumber );
 173
 174     # needs old biblionumber and biblioitemnumber
 175     $item->{'biblionumber'} = $biblionumber;
 176     my $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
 177     $sth->execute( $item->{'biblionumber'} );
 178     ($item->{'biblioitemnumber'}) = $sth->fetchrow;
 179
 180     _set_defaults_for_add($item);
 181     _set_derived_columns_for_add($item);
 182     # FIXME - checks here
 183     my ( $itemnumber, $error ) = _koha_new_item( $dbh, $item, $item->{barcode} );
 184     $item->{'itemnumber'} = $itemnumber;
 185
 186     # create MARC tag representing item and add to bib
 187     my $new_item_marc = _marc_from_item_hash($item, $frameworkcode);
 188     _add_item_field_to_biblio($new_item_marc, $item->{'biblionumber'}, $frameworkcode );
 189
 190     logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$itemnumber,"item")
 191         if C4::Context->preference("CataloguingLog");
 192
 193     return ($item->{biblionumber}, $item->{biblioitemnumber}, $itemnumber);
 194 }
 195
 196 =head2 ModItemFromMarc
 197
 198 =over 4
 199
 200 ModItemFromMarc($item_marc, $biblionumber, $itemnumber);
 201
 202 =back
 203
 204 This function updates an item record based on a supplied
 205 C<MARC::Record> object containing an embedded item field.
 206 This API is meant for the use of C<additem.pl>; for
 207 other purposes, C<ModItem> should be used.
 208
 209 =cut
 210
 211 sub ModItemFromMarc {
 212     my $item_marc = shift;
 213     my $biblionumber = shift;
 214     my $itemnumber = shift;
 215
 216     my $dbh = C4::Context->dbh;
 217     my $frameworkcode = GetFrameworkCode( $biblionumber );
 218     my $item = &TransformMarcToKoha( $dbh, $item_marc, $frameworkcode );
 219
 220     return ModItem($item, $biblionumber, $itemnumber, $dbh, $frameworkcode);
 221 }
 222
 223 =head2 ModItem
 224
 225 =over 4
 226
 227 ModItem({ column => $newvalue }, $biblionumber, $itemnumber);
 228
 229 =back
 230
 231 Change one or more columns in an item record and update
 232 the MARC representation of the item.
 233
 234 The first argument is a hashref mapping from item column
 235 names to the new values.  The second and third arguments
 236 are the biblionumber and itemnumber, respectively.
 237
 238 If one of the changed columns is used to calculate
 239 the derived value of a column such as C<items.cn_sort>,
 240 this routine will perform the necessary calculation
 241 and set the value.
 242
 243 =cut
 244
 245 sub ModItem {
 246     my $item = shift;
 247     my $biblionumber = shift;
 248     my $itemnumber = shift;
 249
 250     # if $biblionumber is undefined, get it from the current item
 251     unless (defined $biblionumber) {
 252         $biblionumber = _get_single_item_column('biblionumber', $itemnumber);
 253     }
 254
 255     my $dbh           = @_ ? shift : C4::Context->dbh;
 256     my $frameworkcode = @_ ? shift : GetFrameworkCode( $biblionumber );
 257
 258     $item->{'itemnumber'} = $itemnumber;
 259     _set_derived_columns_for_mod($item);
 260     _do_column_fixes_for_mod($item);
 261     # FIXME add checks
 262     # duplicate barcode
 263     # attempt to change itemnumber
 264     # attempt to change biblionumber (if we want
 265     # an API to relink an item to a different bib,
 266     # it should be a separate function)
 267
 268     # update items table
 269     _koha_modify_item($dbh, $item);
 270
 271     # update biblio MARC XML
 272     my $whole_item = GetItem($itemnumber);
 273     my $new_item_marc = _marc_from_item_hash($whole_item, $frameworkcode);
 274     _replace_item_field_in_biblio($new_item_marc, $biblionumber, $itemnumber, $frameworkcode);
 275
 276     logaction(C4::Context->userenv->{'number'},"CATALOGUING","MODIFY",$itemnumber,$new_item_marc->as_formatted)
 277         if C4::Context->preference("CataloguingLog");
 278 }
 279
 280 =head2 ModItemTransfer
 281
 282 =over 4
 283
 284 ModItemTransfer($itenumber, $frombranch, $tobranch);
 285
 286 =back
 287
 288 Marks an item as being transferred from one branch
 289 to another.
 290
 291 =cut
 292
 293 sub ModItemTransfer {
 294     my ( $itemnumber, $frombranch, $tobranch ) = @_;
 295
 296     my $dbh = C4::Context->dbh;
 297
 298     #new entry in branchtransfers....
 299     my $sth = $dbh->prepare(
 300         "INSERT INTO branchtransfers (itemnumber, frombranch, datesent, tobranch)
 301         VALUES (?, ?, NOW(), ?)");
 302     $sth->execute($itemnumber, $frombranch, $tobranch);
 303
 304     ModItem({ holdingbranch => $tobranch }, undef, $itemnumber);
 305     ModDateLastSeen($itemnumber);
 306     return;
 307 }
 308
 309 =head2 ModDateLastSeen
 310
 311 =over 4
 312
 313 ModDateLastSeen($itemnum);
 314
 315 =back
 316
 317 Mark item as seen. Is called when an item is issued, returned or manually marked during inventory/stocktaking.
 318 C<$itemnum> is the item number
 319
 320 =cut
 321
 322 sub ModDateLastSeen {
 323     my ($itemnumber) = @_;
 324
 325     my $today = C4::Dates->new();
 326     ModItem({ itemlost => 0, datelastseen => $today->output("iso") }, undef, $itemnumber);
 327 }
 328
 329 =head1 LIMITED USE FUNCTIONS
 330
 331 The following functions, while part of the public API,
 332 are not exported.  This is generally because they are
 333 meant to be used by only one script for a specific
 334 purpose, and should not be used in any other context
 335 without careful thought.
 336
 337 =cut
 338
 339 =head2 GetMarcItem
 340
 341 =over 4
 342
 343 my $item_marc = GetMarcItem($biblionumber, $itemnumber);
 344
 345 =back
 346
 347 Returns MARC::Record of the item passed in parameter.
 348 This function is meant for use only in C<cataloguing/additem.pl>,
 349 where it is needed to support that script's MARC-like
 350 editor.
 351
 352 =cut
 353
 354 sub GetMarcItem {
 355     my ( $biblionumber, $itemnumber ) = @_;
 356
 357     # GetMarcItem has been revised so that it does the following:
 358     #  1. Gets the item information from the items table.
 359     #  2. Converts it to a MARC field for storage in the bib record.
 360     #
 361     # The previous behavior was:
 362     #  1. Get the bib record.
 363     #  2. Return the MARC tag corresponding to the item record.
 364     #
 365     # The difference is that one treats the items row as authoritative,
 366     # while the other treats the MARC representation as authoritative
 367     # under certain circumstances.
 368
 369     my $itemrecord = GetItem($itemnumber);
 370
 371     # Tack on 'items.' prefix to column names so that TransformKohaToMarc will work.
 372     # Also, don't emit a subfield if the underlying field is blank.
 373     my $mungeditem = { map {  $itemrecord->{$_} ne '' ? ("items.$_" => $itemrecord->{$_}) : ()  } keys %{ $itemrecord } };
 374
 375     my $itemmarc = TransformKohaToMarc($mungeditem);
 376     return $itemmarc;
 377
 378 }
 379
 380 =head1 PRIVATE FUNCTIONS AND VARIABLES
 381
 382 The following functions are not meant to be called
 383 directly, but are documented in order to explain
 384 the inner workings of C<C4::Items>.
 385
 386 =cut
 387
 388 =head2 %derived_columns
 389
 390 This hash keeps track of item columns that
 391 are strictly derived from other columns in
 392 the item record and are not meant to be set
 393 independently.
 394
 395 Each key in the hash should be the name of a
 396 column (as named by TransformMarcToKoha).  Each
 397 value should be hashref whose keys are the
 398 columns on which the derived column depends.  The
 399 hashref should also contain a 'BUILDER' key
 400 that is a reference to a sub that calculates
 401 the derived value.
 402
 403 =cut
 404
 405 my %derived_columns = (
 406     'items.cn_sort' => {
 407         'itemcallnumber' => 1,
 408         'items.cn_source' => 1,
 409         'BUILDER' => \&_calc_items_cn_sort,
 410     }
 411 );
 412
 413 =head2 _set_derived_columns_for_add
 414
 415 =over 4
 416
 417 _set_derived_column_for_add($item);
 418
 419 =back
 420
 421 Given an item hash representing a new item to be added,
 422 calculate any derived columns.  Currently the only
 423 such column is C<items.cn_sort>.
 424
 425 =cut
 426
 427 sub _set_derived_columns_for_add {
 428     my $item = shift;
 429
 430     foreach my $column (keys %derived_columns) {
 431         my $builder = $derived_columns{$column}->{'BUILDER'};
 432         my $source_values = {};
 433         foreach my $source_column (keys %{ $derived_columns{$column} }) {
 434             next if $source_column eq 'BUILDER';
 435             $source_values->{$source_column} = $item->{$source_column};
 436         }
 437         $builder->($item, $source_values);
 438     }
 439 }
 440
 441 =head2 _set_derived_columns_for_mod
 442
 443 =over 4
 444
 445 _set_derived_column_for_mod($item);
 446
 447 =back
 448
 449 Given an item hash representing a new item to be modified.
 450 calculate any derived columns.  Currently the only
 451 such column is C<items.cn_sort>.
 452
 453 This routine differs from C<_set_derived_columns_for_add>
 454 in that it needs to handle partial item records.  In other
 455 words, the caller of C<ModItem> may have supplied only one
 456 or two columns to be changed, so this function needs to
 457 determine whether any of the columns to be changed affect
 458 any of the derived columns.  Also, if a derived column
 459 depends on more than one column, but the caller is not
 460 changing all of then, this routine retrieves the unchanged
 461 values from the database in order to ensure a correct
 462 calculation.
 463
 464 =cut
 465
 466 sub _set_derived_columns_for_mod {
 467     my $item = shift;
 468
 469     foreach my $column (keys %derived_columns) {
 470         my $builder = $derived_columns{$column}->{'BUILDER'};
 471         my $source_values = {};
 472         my %missing_sources = ();
 473         my $must_recalc = 0;
 474         foreach my $source_column (keys %{ $derived_columns{$column} }) {
 475             next if $source_column eq 'BUILDER';
 476             if (exists $item->{$source_column}) {
 477                 $must_recalc = 1;
 478                 $source_values->{$source_column} = $item->{$source_column};
 479             } else {
 480                 $missing_sources{$source_column} = 1;
 481             }
 482         }
 483         if ($must_recalc) {
 484             foreach my $source_column (keys %missing_sources) {
 485                 $source_values->{$source_column} = _get_single_item_column($source_column, $item->{'itemnumber'});
 486             }
 487             $builder->($item, $source_values);
 488         }
 489     }
 490 }
 491
 492 =head2 _do_column_fixes_for_mod
 493
 494 =over 4
 495
 496 _do_column_fixes_for_mod($item);
 497
 498 =back
 499
 500 Given an item hashref containing one or more
 501 columns to modify, fix up certain values.
 502 Specifically, set to 0 any passed value
 503 of C<notforloan>, C<damaged>, C<itemlost>, or
 504 C<wthdrawn> that is either undefined or
 505 contains the empty string.
 506
 507 =cut
 508
 509 sub _do_column_fixes_for_mod {
 510     my $item = shift;
 511
 512     if (exists $item->{'notforloan'} and
 513         (not defined $item->{'notforloan'} or $item->{'notforloan'} eq '')) {
 514         $item->{'notforloan'} = 0;
 515     }
 516     if (exists $item->{'damaged'} and
 517         (not defined $item->{'damaged'} or $item->{'damaged'} eq '')) {
 518         $item->{'damaged'} = 0;
 519     }
 520     if (exists $item->{'itemlost'} and
 521         (not defined $item->{'itemlost'} or $item->{'itemlost'} eq '')) {
 522         $item->{'itemlost'} = 0;
 523     }
 524     if (exists $item->{'wthdrawn'} and
 525         (not defined $item->{'wthdrawn'} or $item->{'wthdrawn'} eq '')) {
 526         $item->{'wthdrawn'} = 0;
 527     }
 528 }
 529
 530 =head2 _get_single_item_column
 531
 532 =over 4
 533
 534 _get_single_item_column($column, $itemnumber);
 535
 536 =back
 537
 538 Retrieves the value of a single column from an C<items>
 539 row specified by C<$itemnumber>.
 540
 541 =cut
 542
 543 sub _get_single_item_column {
 544     my $column = shift;
 545     my $itemnumber = shift;
 546
 547     my $dbh = C4::Context->dbh;
 548     my $sth = $dbh->prepare("SELECT $column FROM items WHERE itemnumber = ?");
 549     $sth->execute($itemnumber);
 550     my ($value) = $sth->fetchrow();
 551     return $value;
 552 }
 553
 554 =head2 _calc_items_cn_sort
 555
 556 =over 4
 557
 558 _calc_items_cn_sort($item, $source_values);
 559
 560 =back
 561
 562 Helper routine to calculate C<items.cn_sort>.
 563
 564 =cut
 565
 566 sub _calc_items_cn_sort {
 567     my $item = shift;
 568     my $source_values = shift;
 569
 570     $item->{'items.cn_sort'} = GetClassSort($source_values->{'items.cn_source'}, $source_values->{'itemcallnumber'}, "");
 571 }
 572
 573 =head2 _set_defaults_for_add
 574
 575 =over 4
 576
 577 _set_defaults_for_add($item_hash);
 578
 579 =back
 580
 581 Given an item hash representing an item to be added, set
 582 correct default values for columns whose default value
 583 is not handled by the DBMS.  This includes the following
 584 columns:
 585
 586 =over 2
 587
 588 =item *
 589
 590 C<items.dateaccessioned>
 591
 592 =item *
 593
 594 C<items.notforloan>
 595
 596 =item *
 597
 598 C<items.damaged>
 599
 600 =item *
 601
 602 C<items.itemlost>
 603
 604 =item *
 605
 606 C<items.wthdrawn>
 607
 608 =back
 609
 610 =cut
 611
 612 sub _set_defaults_for_add {
 613     my $item = shift;
 614
 615     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
 616     if (!(exists $item->{'dateaccessioned'}) ||
 617          ($item->{'dateaccessioned'} eq '')) {
 618         # FIXME add check for invalid date
 619         my $today = C4::Dates->new();
 620         $item->{'dateaccessioned'} =  $today->output("iso"); #TODO: check time issues
 621     }
 622
 623     # various item status fields cannot be null
 624     $item->{'notforloan'} = 0 unless exists $item->{'notforloan'} and defined $item->{'notforloan'};
 625     $item->{'damaged'}    = 0 unless exists $item->{'damaged'}    and defined $item->{'damaged'};
 626     $item->{'itemlost'}   = 0 unless exists $item->{'itemlost'}   and defined $item->{'itemlost'};
 627     $item->{'wthdrawn'}   = 0 unless exists $item->{'wthdrawn'}   and defined $item->{'wthdrawn'};
 628 }
 629
 630 =head2 _koha_new_item
 631
 632 =over 4
 633
 634 my ($itemnumber,$error) = _koha_new_item( $dbh, $item, $barcode );
 635
 636 =back
 637
 638 Perform the actual insert into the C<items> table.
 639
 640 =cut
 641
 642 sub _koha_new_item {
 643     my ( $dbh, $item, $barcode ) = @_;
 644     my $error;
 645
 646     my $query =
 647            "INSERT INTO items SET
 648             biblionumber        = ?,
 649             biblioitemnumber    = ?,
 650             barcode             = ?,
 651             dateaccessioned     = ?,
 652             booksellerid        = ?,
 653             homebranch          = ?,
 654             price               = ?,
 655             replacementprice    = ?,
 656             replacementpricedate = NOW(),
 657             datelastborrowed    = ?,
 658             datelastseen        = NOW(),
 659             stack               = ?,
 660             notforloan          = ?,
 661             damaged             = ?,
 662             itemlost            = ?,
 663             wthdrawn            = ?,
 664             itemcallnumber      = ?,
 665             restricted          = ?,
 666             itemnotes           = ?,
 667             holdingbranch       = ?,
 668             paidfor             = ?,
 669             location            = ?,
 670             onloan              = ?,
 671             issues              = ?,
 672             renewals            = ?,
 673             reserves            = ?,
 674             cn_source           = ?,
 675             cn_sort             = ?,
 676             ccode               = ?,
 677             itype               = ?,
 678             materials           = ?,
 679             uri                 = ?
 680           ";
 681     my $sth = $dbh->prepare($query);
 682     $sth->execute(
 683             $item->{'biblionumber'},
 684             $item->{'biblioitemnumber'},
 685             $barcode,
 686             $item->{'dateaccessioned'},
 687             $item->{'booksellerid'},
 688             $item->{'homebranch'},
 689             $item->{'price'},
 690             $item->{'replacementprice'},
 691             $item->{datelastborrowed},
 692             $item->{stack},
 693             $item->{'notforloan'},
 694             $item->{'damaged'},
 695             $item->{'itemlost'},
 696             $item->{'wthdrawn'},
 697             $item->{'itemcallnumber'},
 698             $item->{'restricted'},
 699             $item->{'itemnotes'},
 700             $item->{'holdingbranch'},
 701             $item->{'paidfor'},
 702             $item->{'location'},
 703             $item->{'onloan'},
 704             $item->{'issues'},
 705             $item->{'renewals'},
 706             $item->{'reserves'},
 707             $item->{'items.cn_source'},
 708             $item->{'items.cn_sort'},
 709             $item->{'ccode'},
 710             $item->{'itype'},
 711             $item->{'materials'},
 712             $item->{'uri'},
 713     );
 714     my $itemnumber = $dbh->{'mysql_insertid'};
 715     if ( defined $sth->errstr ) {
 716         $error.="ERROR in _koha_new_item $query".$sth->errstr;
 717     }
 718     $sth->finish();
 719     return ( $itemnumber, $error );
 720 }
 721
 722 =head2 _koha_modify_item
 723
 724 =over 4
 725
 726 my ($itemnumber,$error) =_koha_modify_item( $dbh, $item, $op );
 727
 728 =back
 729
 730 Perform the actual update of the C<items> row.  Note that this
 731 routine accepts a hashref specifying the columns to update.
 732
 733 =cut
 734
 735 sub _koha_modify_item {
 736     my ( $dbh, $item ) = @_;
 737     my $error;
 738
 739     my $query = "UPDATE items SET ";
 740     my @bind;
 741     for my $key ( keys %$item ) {
 742         $query.="$key=?,";
 743         push @bind, $item->{$key};
 744     }
 745     $query =~ s/,$//;
 746     $query .= " WHERE itemnumber=?";
 747     push @bind, $item->{'itemnumber'};
 748     my $sth = $dbh->prepare($query);
 749     $sth->execute(@bind);
 750     if ( $dbh->errstr ) {
 751         $error.="ERROR in _koha_modify_item $query".$dbh->errstr;
 752         warn $error;
 753     }
 754     $sth->finish();
 755     return ($item->{'itemnumber'},$error);
 756 }
 757
 758 =head2 _marc_from_item_hash
 759
 760 =over 4
 761
 762 my $item_marc = _marc_from_item_hash($item, $frameworkcode);
 763
 764 =back
 765
 766 Given an item hash representing a complete item record,
 767 create a C<MARC::Record> object containing an embedded
 768 tag representing that item.
 769
 770 =cut
 771
 772 sub _marc_from_item_hash {
 773     my $item = shift;
 774     my $frameworkcode = shift;
 775
 776     # Tack on 'items.' prefix to column names so lookup from MARC frameworks will work
 777     # Also, don't emit a subfield if the underlying field is blank.
 778     my $mungeditem = { map {  (defined($item->{$_}) and $item->{$_} ne '') ?
 779                                 (/^items\./ ? ($_ => $item->{$_}) : ("items.$_" => $item->{$_}))
 780                                 : ()  } keys %{ $item } };
 781
 782     my $item_marc = MARC::Record->new();
 783     foreach my $item_field (keys %{ $mungeditem }) {
 784         my ($tag, $subfield) = GetMarcFromKohaField($item_field, $frameworkcode);
 785         next unless defined $tag and defined $subfield; # skip if not mapped to MARC field
 786         if (my $field = $item_marc->field($tag)) {
 787             $field->add_subfields($subfield => $mungeditem->{$item_field});
 788         } else {
 789             $item_marc->add_fields( $tag, " ", " ", $subfield =>  $mungeditem->{$item_field});
 790         }
 791     }
 792
 793     return $item_marc;
 794 }
 795
 796 =head2 _add_item_field_to_biblio
 797
 798 =over 4
 799
 800 _add_item_field_to_biblio($item_marc, $biblionumber, $frameworkcode);
 801
 802 =back
 803
 804 Adds the fields from a MARC record containing the
 805 representation of a Koha item record to the MARC
 806 biblio record.  The input C<$item_marc> record
 807 is expect to contain just one field, the embedded
 808 item information field.
 809
 810 =cut
 811
 812 sub _add_item_field_to_biblio {
 813     my ($item_marc, $biblionumber, $frameworkcode) = @_;
 814
 815     my $biblio_marc = GetMarcBiblio($biblionumber);
 816
 817     foreach my $field ($item_marc->fields()) {
 818         $biblio_marc->append_fields($field);
 819     }
 820
 821     ModBiblioMarc($biblio_marc, $biblionumber, $frameworkcode);
 822 }
 823
 824 =head2 _replace_item_field_in_biblio
 825
 826 =over
 827
 828 &_replace_item_field_in_biblio($item_marc, $biblionumber, $itemnumber, $frameworkcode)
 829
 830 =back
 831
 832 Given a MARC::Record C<$item_marc> containing one tag with the MARC
 833 representation of the item, examine the biblio MARC
 834 for the corresponding tag for that item and
 835 replace it with the tag from C<$item_marc>.
 836
 837 =cut
 838
 839 sub _replace_item_field_in_biblio {
 840     my ($ItemRecord, $biblionumber, $itemnumber, $frameworkcode) = @_;
 841     my $dbh = C4::Context->dbh;
 842
 843     # get complete MARC record & replace the item field by the new one
 844     my $completeRecord = GetMarcBiblio($biblionumber);
 845     my ($itemtag,$itemsubfield) = GetMarcFromKohaField("items.itemnumber",$frameworkcode);
 846     my $itemField = $ItemRecord->field($itemtag);
 847     my @items = $completeRecord->field($itemtag);
 848     my $found = 0;
 849     foreach (@items) {
 850         if ($_->subfield($itemsubfield) eq $itemnumber) {
 851             $_->replace_with($itemField);
 852             $found = 1;
 853         }
 854     }
 855
 856     unless ($found) {
 857         # If we haven't found the matching field,
 858         # just add it.  However, this means that
 859         # there is likely a bug.
 860         $completeRecord->append_fields($itemField);
 861     }
 862
 863     # save the record
 864     ModBiblioMarc($completeRecord, $biblionumber, $frameworkcode);
 865 }
 866
 867 1;