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::Dates qw/format_date/;
  31 use C4::Log; # logaction
  32 use C4::ClassSource;
  33
  34 use vars qw($VERSION @ISA @EXPORT);
  35
  36 # TODO: fix version
  37 # $VERSION = ?;
  38
  39 @ISA = qw( Exporter );
  40
  41 # EXPORTED FUNCTIONS.
  42
  43 # to add biblios or items
  44 push @EXPORT, qw( &AddBiblio &AddItem &AddBiblioAndItems );
  45
  46 # to get something
  47 push @EXPORT, qw(
  48   &GetBiblio
  49   &GetBiblioData
  50   &GetBiblioItemData
  51   &GetBiblioItemInfosOf
  52   &GetBiblioItemByBiblioNumber
  53   &GetBiblioFromItemNumber
  54
  55   &GetMarcItem
  56   &GetItem
  57   &GetItemInfosOf
  58   &GetItemStatus
  59   &GetItemLocation
  60   &GetLostItems
  61   &GetItemsForInventory
  62   &GetItemsCount
  63
  64   &GetMarcNotes
  65   &GetMarcSubjects
  66   &GetMarcBiblio
  67   &GetMarcAuthors
  68   &GetMarcSeries
  69   GetMarcUrls
  70   &GetUsedMarcStructure
  71
  72   &GetItemsInfo
  73   &GetItemsByBiblioitemnumber
  74   &GetItemnumberFromBarcode
  75   &get_itemnumbers_of
  76   &GetXmlBiblio
  77
  78   &GetAuthorisedValueDesc
  79   &GetMarcStructure
  80   &GetMarcFromKohaField
  81   &GetFrameworkCode
  82   &GetPublisherNameFromIsbn
  83   &TransformKohaToMarc
  84 );
  85
  86 # To modify something
  87 push @EXPORT, qw(
  88   &ModBiblio
  89   &ModItem
  90   &ModItemTransfer
  91   &ModBiblioframework
  92   &ModZebra
  93   &ModItemInMarc
  94   &ModItemInMarconefield
  95   &ModDateLastSeen
  96 );
  97
  98 # To delete something
  99 push @EXPORT, qw(
 100   &DelBiblio
 101   &DelItem
 102 );
 103
 104 # Internal functions
 105 # those functions are exported but should not be used
 106 # they are usefull is few circumstances, so are exported.
 107 # but don't use them unless you're a core developer ;-)
 108 push @EXPORT, qw(
 109   &ModBiblioMarc
 110   &AddItemInMarc
 111 );
 112
 113 # Others functions
 114 push @EXPORT, qw(
 115   &TransformMarcToKoha
 116   &TransformHtmlToMarc2
 117   &TransformHtmlToMarc
 118   &TransformHtmlToXml
 119   &PrepareItemrecordDisplay
 120   &char_decode
 121   &GetNoZebraIndexes
 122 );
 123
 124 =head1 NAME
 125
 126 C4::Biblio - cataloging management functions
 127
 128 =head1 DESCRIPTION
 129
 130 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:
 131
 132 =over 4
 133
 134 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
 135
 136 =item 2. as raw MARC in the Zebra index and storage engine
 137
 138 =item 3. as raw MARC the biblioitems.marc and biblioitems.marcxml
 139
 140 =back
 141
 142 In the 3.0 version of Koha, the authoritative record-level information is in biblioitems.marcxml
 143
 144 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.
 145
 146 =over 4
 147
 148 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
 149
 150 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
 151
 152 =back
 153
 154 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:
 155
 156 =over 4
 157
 158 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
 159
 160 =item 2. _koha_* - low-level internal functions for managing the koha tables
 161
 162 =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.
 163
 164 =item 4. Zebra functions used to update the Zebra index
 165
 166 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
 167
 168 =back
 169
 170 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 :
 171
 172 =over 4
 173
 174 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
 175
 176 =item 2. add the biblionumber and biblioitemnumber into the MARC records
 177
 178 =item 3. save the marc record
 179
 180 =back
 181
 182 When dealing with items, we must :
 183
 184 =over 4
 185
 186 =item 1. save the item in items table, that gives us an itemnumber
 187
 188 =item 2. add the itemnumber to the item MARC field
 189
 190 =item 3. overwrite the MARC record (with the added item) into biblioitems.marc(xml)
 191
 192 When modifying a biblio or an item, the behaviour is quite similar.
 193
 194 =back
 195
 196 =head1 EXPORTED FUNCTIONS
 197
 198 =head2 AddBiblio
 199
 200 =over 4
 201
 202 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
 203 Exported function (core API) for adding a new biblio to koha.
 204
 205 =back
 206
 207 =cut
 208
 209 sub AddBiblio {
 210     my ( $record, $frameworkcode ) = @_;
 211     my ($biblionumber,$biblioitemnumber,$error);
 212     my $dbh = C4::Context->dbh;
 213     # transform the data into koha-table style data
 214     my $olddata = TransformMarcToKoha( $dbh, $record, $frameworkcode );
 215     ($biblionumber,$error) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
 216     $olddata->{'biblionumber'} = $biblionumber;
 217     ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $olddata );
 218
 219     _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
 220
 221     # now add the record
 222     $biblionumber = ModBiblioMarc( $record, $biblionumber, $frameworkcode );
 223
 224     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$biblionumber,"biblio")
 225         if C4::Context->preference("CataloguingLog");
 226
 227     return ( $biblionumber, $biblioitemnumber );
 228 }
 229
 230 =head2 AddBiblioAndItems
 231
 232 =over 4
 233
 234 ($biblionumber,$biblioitemnumber, $itemnumber_ref) = AddBiblioAndItems($record, $frameworkcode);
 235
 236 =back
 237
 238 Efficiently add a biblio record and create item records from its
 239 embedded item fields.  This routine is suitable for batch jobs.
 240
 241 The goal of this API is to have a similar effect to using AddBiblio
 242 and AddItems in succession, but without inefficient repeated
 243 parsing of the MARC XML bib record.
 244
 245 One functional difference is that the duplicate item barcode
 246 check is implemented in this API, instead of relying on
 247 the caller to do it, like AddItem does.
 248
 249 =cut
 250
 251 sub AddBiblioAndItems {
 252     my ( $record, $frameworkcode ) = @_;
 253     my ($biblionumber,$biblioitemnumber,$error);
 254     my @itemnumbers = ();
 255     my $dbh = C4::Context->dbh;
 256
 257     # transform the data into koha-table style data
 258     # FIXME - this paragraph copied from AddBiblio
 259     my $olddata = FasterTransformMarcToKoha( $dbh, $record, $frameworkcode );
 260     ($biblionumber,$error) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
 261     $olddata->{'biblionumber'} = $biblionumber;
 262     ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $olddata );
 263
 264     # FIXME - this paragraph copied from AddBiblio
 265     _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
 266
 267     # now we loop through the item tags and start creating items
 268     my @bad_item_fields = ();
 269     my ($itemtag, $itemsubfield) = &GetMarcFromKohaField("items.itemnumber",'');
 270     ITEMFIELD: foreach my $item_field ($record->field($itemtag)) {
 271         # we take the item field and stick it into a new
 272         # MARC record -- this is required so far because (FIXME)
 273         # TransformMarcToKoha requires a MARC::Record, not a MARC::Field
 274         # and there is no TransformMarcFieldToKoha
 275         my $temp_item_marc = MARC::Record->new();
 276         $temp_item_marc->append_fields($item_field);
 277
 278         # add biblionumber and biblioitemnumber
 279         my $item = &FasterTransformMarcToKoha( $dbh, $temp_item_marc, $frameworkcode, 'items' );
 280         $item->{'biblionumber'} = $biblionumber;
 281         $item->{'biblioitemnumber'} = $biblioitemnumber;
 282
 283         # check for duplicate barcode
 284         my $duplicate_barcode = exists($item->{'barcode'}) && GetItemnumberFromBarcode($item->{'barcode'});
 285         if ($duplicate_barcode) {
 286             warn "ERROR: cannot add item $item->{'barcode'} for biblio $biblionumber: duplicate barcode\n";
 287             push @bad_item_fields, $item_field;
 288             next ITEMFIELD;
 289         }
 290
 291         # figure out what item type to use -- biblioitem-level or item-level
 292         my $itemtype;
 293         if (C4::Context->preference('item-level_itypes')) {
 294             $itemtype = $item->{'itype'};
 295         } else {
 296             $itemtype = $olddata->{'itemtype'};
 297         }
 298
 299         # FIXME - notforloan stuff copied from AddItem
 300         my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype=?");
 301         $sth->execute($itemtype);
 302         my $notforloan = $sth->fetchrow;
 303         ##Change the notforloan field if $notforloan found
 304         if ( $notforloan > 0 ) {
 305             $item->{'notforloan'} = $notforloan;
 306             &MARCitemchange( $temp_item_marc, "items.notforloan", $notforloan );
 307         }
 308
 309         # FIXME - dateaccessioned stuff copied from AddItem
 310         if ( !$item->{'dateaccessioned'} || $item->{'dateaccessioned'} eq '' ) {
 311
 312             # find today's date
 313             my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
 314                 localtime(time);
 315             $year += 1900;
 316             $mon  += 1;
 317             my $date =
 318             "$year-" . sprintf( "%0.2d", $mon ) . "-" . sprintf( "%0.2d", $mday );
 319             $item->{'dateaccessioned'} = $date;
 320             &MARCitemchange( $temp_item_marc, "items.dateaccessioned", $date );
 321         }
 322
 323         my ( $itemnumber, $error ) = &_koha_new_items( $dbh, $item, $item->{barcode} );
 324         warn $error if $error;
 325         push @itemnumbers, $itemnumber; # FIXME not checking error
 326
 327         # FIXME - not copied from AddItem
 328         # FIXME - AddItems equiv code about passing $sth to TransformKohaToMarcOneField is stupid
 329         &MARCitemchange( $temp_item_marc, "items.itemnumber", $itemnumber );
 330
 331         &logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$itemnumber,"item")
 332         if C4::Context->preference("CataloguingLog");
 333
 334         $item_field->replace_with($temp_item_marc->field($itemtag));
 335     }
 336
 337     # remove any MARC item fields for rejected items
 338     foreach my $item_field (@bad_item_fields) {
 339         $record->delete_field($item_field);
 340     }
 341
 342     # now add the record
 343     # FIXME - this paragraph copied from AddBiblio -- however, moved  since
 344     # since we need to create the items row and plug in the itemnumbers in the
 345     # MARC
 346     $biblionumber = ModBiblioMarc( $record, $biblionumber, $frameworkcode );
 347
 348     # FIXME - when using this API, do we log both bib and item add, or just
 349     #         bib
 350     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$biblionumber,"biblio")
 351         if C4::Context->preference("CataloguingLog");
 352
 353     return ( $biblionumber, $biblioitemnumber, \@itemnumbers);
 354
 355 }
 356
 357 =head2 AddItem
 358
 359 =over 2
 360
 361     $biblionumber = AddItem( $record, $biblionumber)
 362     Exported function (core API) for adding a new item to Koha
 363
 364 =back
 365
 366 =cut
 367
 368 sub AddItem {
 369     my ( $record, $biblionumber ) = @_;
 370     my $dbh = C4::Context->dbh;
 371
 372     # add item in old-DB
 373     my $frameworkcode = GetFrameworkCode( $biblionumber );
 374     my $item = &TransformMarcToKoha( $dbh, $record, $frameworkcode );
 375
 376     # needs old biblionumber and biblioitemnumber
 377     $item->{'biblionumber'} = $biblionumber;
 378     my $sth =
 379       $dbh->prepare(
 380         "SELECT biblioitemnumber,itemtype FROM biblioitems WHERE biblionumber=?"
 381       );
 382     $sth->execute( $item->{'biblionumber'} );
 383     my $itemtype;
 384     ( $item->{'biblioitemnumber'}, $itemtype ) = $sth->fetchrow;
 385     $sth =
 386       $dbh->prepare(
 387         "SELECT notforloan FROM itemtypes WHERE itemtype=?");
 388     $sth->execute( C4::Context->preference('item-level_itypes') ? $item->{'itype'} : $itemtype );
 389     my $notforloan = $sth->fetchrow;
 390     ##Change the notforloan field if $notforloan found
 391     if ( $notforloan > 0 ) {
 392         $item->{'notforloan'} = $notforloan;
 393         &MARCitemchange( $record, "items.notforloan", $notforloan );
 394     }
 395     if ( !$item->{'dateaccessioned'} || $item->{'dateaccessioned'} eq '' ) {
 396
 397         # find today's date
 398         my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
 399           localtime(time);
 400         $year += 1900;
 401         $mon  += 1;
 402         my $date =
 403           "$year-" . sprintf( "%0.2d", $mon ) . "-" . sprintf( "%0.2d", $mday );
 404         $item->{'dateaccessioned'} = $date;
 405         &MARCitemchange( $record, "items.dateaccessioned", $date );
 406     }
 407     my ( $itemnumber, $error ) = &_koha_new_items( $dbh, $item, $item->{barcode} );
 408     # add itemnumber to MARC::Record before adding the item.
 409     $sth = $dbh->prepare(
 410 "SELECT tagfield,tagsubfield
 411 FROM marc_subfield_structure
 412 WHERE frameworkcode=?
 413     AND kohafield=?"
 414       );
 415     &TransformKohaToMarcOneField( $sth, $record, "items.itemnumber", $itemnumber,
 416         $frameworkcode );
 417
 418     # add the item
 419     &AddItemInMarc( $record, $item->{'biblionumber'},$frameworkcode );
 420
 421     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$itemnumber,"item")
 422         if C4::Context->preference("CataloguingLog");
 423
 424     return ($item->{biblionumber}, $item->{biblioitemnumber},$itemnumber);
 425 }
 426
 427 =head2 ModBiblio
 428
 429     ModBiblio( $record,$biblionumber,$frameworkcode);
 430     Exported function (core API) to modify a biblio
 431
 432 =cut
 433
 434 sub ModBiblio {
 435     my ( $record, $biblionumber, $frameworkcode ) = @_;
 436     if (C4::Context->preference("CataloguingLog")) {
 437         my $newrecord = GetMarcBiblio($biblionumber);
 438         &logaction(C4::Context->userenv->{'number'},"CATALOGUING","MODIFY",$biblionumber,"BEFORE=>".$newrecord->as_formatted);
 439     }
 440
 441     my $dbh = C4::Context->dbh;
 442
 443     $frameworkcode = "" unless $frameworkcode;
 444
 445     # get the items before and append them to the biblio before updating the record, atm we just have the biblio
 446     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField("items.itemnumber",$frameworkcode);
 447     my $oldRecord = GetMarcBiblio( $biblionumber );
 448
 449     # parse each item, and, for an unknown reason, re-encode each subfield
 450     # if you don't do that, the record will have encoding mixed
 451     # and the biblio will be re-encoded.
 452     # strange, I (Paul P.) searched more than 1 day to understand what happends
 453     # but could only solve the problem this way...
 454    my @fields = $oldRecord->field( $itemtag );
 455     foreach my $fielditem ( @fields ){
 456         my $field;
 457         foreach ($fielditem->subfields()) {
 458             if ($field) {
 459                 $field->add_subfields(Encode::encode('utf-8',$_->[0]) => Encode::encode('utf-8',$_->[1]));
 460             } else {
 461                 $field = MARC::Field->new("$itemtag",'','',Encode::encode('utf-8',$_->[0]) => Encode::encode('utf-8',$_->[1]));
 462             }
 463           }
 464         $record->append_fields($field);
 465     }
 466
 467     # update biblionumber and biblioitemnumber in MARC
 468     # FIXME - this is assuming a 1 to 1 relationship between
 469     # biblios and biblioitems
 470     my $sth =  $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
 471     $sth->execute($biblionumber);
 472     my ($biblioitemnumber) = $sth->fetchrow;
 473     $sth->finish();
 474     _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
 475
 476     # update the MARC record (that now contains biblio and items) with the new record data
 477     &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
 478
 479     # load the koha-table data object
 480     my $oldbiblio = TransformMarcToKoha( $dbh, $record, $frameworkcode );
 481
 482     # modify the other koha tables
 483     _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
 484     _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
 485     return 1;
 486 }
 487
 488 =head2 ModItem
 489
 490 =over 2
 491
 492 Exported function (core API) for modifying an item in Koha.
 493
 494 =back
 495
 496 =cut
 497
 498 sub ModItem {
 499     my ( $record, $biblionumber, $itemnumber, $delete, $new_item_hashref )
 500       = @_;
 501
 502     #logging
 503     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","MODIFY",$itemnumber,$record->as_formatted)
 504         if C4::Context->preference("CataloguingLog");
 505
 506     my $dbh = C4::Context->dbh;
 507
 508     # if we have a MARC record, we're coming from cataloging and so
 509     # we do the whole routine: update the MARC and zebra, then update the koha
 510     # tables
 511     if ($record) {
 512         my $frameworkcode = GetFrameworkCode( $biblionumber );
 513         ModItemInMarc( $record, $biblionumber, $itemnumber, $frameworkcode );
 514         my $olditem       = TransformMarcToKoha( $dbh, $record, $frameworkcode,'items');
 515         $olditem->{'biblionumber'} = $biblionumber;
 516         my $sth =  $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
 517         $sth->execute($biblionumber);
 518         my ($biblioitemnumber) = $sth->fetchrow;
 519         $sth->finish();
 520         $olditem->{'biblioitemnumber'} = $biblioitemnumber;
 521         _koha_modify_item( $dbh, $olditem );
 522         return $biblionumber;
 523     }
 524
 525     # otherwise, we're just looking to modify something quickly
 526     # (like a status) so we just update the koha tables
 527     elsif ($new_item_hashref) {
 528         _koha_modify_item( $dbh, $new_item_hashref );
 529     }
 530 }
 531
 532 sub ModItemTransfer {
 533     my ( $itemnumber, $frombranch, $tobranch ) = @_;
 534
 535     my $dbh = C4::Context->dbh;
 536
 537     #new entry in branchtransfers....
 538     my $sth = $dbh->prepare(
 539         "INSERT INTO branchtransfers (itemnumber, frombranch, datesent, tobranch)
 540         VALUES (?, ?, NOW(), ?)");
 541     $sth->execute($itemnumber, $frombranch, $tobranch);
 542     #update holdingbranch in items .....
 543      $sth= $dbh->prepare(
 544           "UPDATE items SET holdingbranch = ? WHERE items.itemnumber = ?");
 545     $sth->execute($tobranch,$itemnumber);
 546     &ModDateLastSeen($itemnumber);
 547     $sth = $dbh->prepare(
 548         "SELECT biblionumber FROM items WHERE itemnumber=?"
 549       );
 550     $sth->execute($itemnumber);
 551     while ( my ( $biblionumber ) = $sth->fetchrow ) {
 552         &ModItemInMarconefield( $biblionumber, $itemnumber,
 553             'items.holdingbranch', $tobranch );
 554     }
 555     return;
 556 }
 557
 558 =head2 ModBiblioframework
 559
 560     ModBiblioframework($biblionumber,$frameworkcode);
 561     Exported function to modify a biblio framework
 562
 563 =cut
 564
 565 sub ModBiblioframework {
 566     my ( $biblionumber, $frameworkcode ) = @_;
 567     my $dbh = C4::Context->dbh;
 568     my $sth = $dbh->prepare(
 569         "UPDATE biblio SET frameworkcode=? WHERE biblionumber=?"
 570     );
 571     $sth->execute($frameworkcode, $biblionumber);
 572     return 1;
 573 }
 574
 575 =head2 ModItemInMarconefield
 576
 577 =over
 578
 579 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)
 580 &ModItemInMarconefield( $biblionumber, $itemnumber, $itemfield, $newvalue )
 581
 582 =back
 583
 584 =cut
 585
 586 sub ModItemInMarconefield {
 587     my ( $biblionumber, $itemnumber, $itemfield, $newvalue ) = @_;
 588     my $dbh = C4::Context->dbh;
 589     if ( !defined $newvalue ) {
 590         $newvalue = "";
 591     }
 592
 593     my $record = GetMarcItem( $biblionumber, $itemnumber );
 594     my ($tagfield, $tagsubfield) = GetMarcFromKohaField( $itemfield,'');
 595     # FIXME - the condition is done this way because GetMarcFromKohaField
 596     # returns (0, 0) if it can't field a MARC tag for the kohafield.  However,
 597     # some fields like items.wthdrawn are mapped to subfield $0, making the
 598     # customary test of "if ($tagfield && $tagsubfield)" incorrect.
 599     # GetMarcFromKohaField should probably be returning (undef, undef), making
 600     # the correct test "if (defined $tagfield && defined $tagsubfield)", but
 601     # this would be a large change and consequently deferred for after 3.0.
 602     if (not(int($tagfield) == 0 && int($tagsubfield) == 0)) {
 603         my $tag = $record->field($tagfield);
 604         if ($tag) {
 605 #             my $tagsubs = $record->field($tagfield)->subfield($tagsubfield);
 606             $tag->update( $tagsubfield => $newvalue );
 607             $record->delete_field($tag);
 608             $record->insert_fields_ordered($tag);
 609             my $frameworkcode = GetFrameworkCode( $biblionumber );
 610             &ModItemInMarc( $record, $biblionumber, $itemnumber, $frameworkcode );
 611         }
 612     }
 613 }
 614
 615 =head2 ModItemInMarc
 616
 617 =over
 618
 619 &ModItemInMarc( $record, $biblionumber, $itemnumber, $frameworkcode )
 620
 621 =back
 622
 623 =cut
 624
 625 sub ModItemInMarc {
 626     my ( $ItemRecord, $biblionumber, $itemnumber, $frameworkcode) = @_;
 627     my $dbh = C4::Context->dbh;
 628
 629     # get complete MARC record & replace the item field by the new one
 630     my $completeRecord = GetMarcBiblio($biblionumber);
 631     my ($itemtag,$itemsubfield) = GetMarcFromKohaField("items.itemnumber",$frameworkcode);
 632     my $itemField = $ItemRecord->field($itemtag);
 633     my @items = $completeRecord->field($itemtag);
 634     foreach (@items) {
 635         if ($_->subfield($itemsubfield) eq $itemnumber) {
 636 #             $completeRecord->delete_field($_);
 637             $_->replace_with($itemField);
 638         }
 639     }
 640     # save the record
 641     my $sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
 642     $sth->execute( $completeRecord->as_usmarc(), $completeRecord->as_xml_record(),$biblionumber );
 643     $sth->finish;
 644     ModZebra($biblionumber,"specialUpdate","biblioserver",$completeRecord);
 645 }
 646
 647 =head2 ModDateLastSeen
 648
 649 &ModDateLastSeen($itemnum)
 650 Mark item as seen. Is called when an item is issued, returned or manually marked during inventory/stocktaking
 651 C<$itemnum> is the item number
 652
 653 =cut
 654
 655 sub ModDateLastSeen {
 656     my ($itemnum) = @_;
 657     my $dbh       = C4::Context->dbh;
 658     my $sth       =
 659       $dbh->prepare(
 660           "UPDATE items SET itemlost=0,datelastseen  = NOW() WHERE items.itemnumber = ?"
 661       );
 662     $sth->execute($itemnum);
 663     return;
 664 }
 665 =head2 DelBiblio
 666
 667 =over
 668
 669 my $error = &DelBiblio($dbh,$biblionumber);
 670 Exported function (core API) for deleting a biblio in koha.
 671 Deletes biblio record from Zebra and Koha tables (biblio,biblioitems,items)
 672 Also backs it up to deleted* tables
 673 Checks to make sure there are not issues on any of the items
 674 return:
 675 C<$error> : undef unless an error occurs
 676
 677 =back
 678
 679 =cut
 680
 681 sub DelBiblio {
 682     my ( $biblionumber ) = @_;
 683     my $dbh = C4::Context->dbh;
 684     my $error;    # for error handling
 685
 686     # First make sure this biblio has no items attached
 687     my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
 688     $sth->execute($biblionumber);
 689     if (my $itemnumber = $sth->fetchrow){
 690         # Fix this to use a status the template can understand
 691         $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
 692     }
 693
 694     return $error if $error;
 695
 696     # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
 697     # for at least 2 reasons :
 698     # - we need to read the biblio if NoZebra is set (to remove it from the indexes
 699     # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
 700     #   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)
 701     ModZebra($biblionumber, "recordDelete", "biblioserver", undef);
 702
 703     # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
 704     $sth =
 705       $dbh->prepare(
 706         "SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
 707     $sth->execute($biblionumber);
 708     while ( my $biblioitemnumber = $sth->fetchrow ) {
 709
 710         # delete this biblioitem
 711         $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
 712         return $error if $error;
 713     }
 714
 715     # delete biblio from Koha tables and save in deletedbiblio
 716     # must do this *after* _koha_delete_biblioitems, otherwise
 717     # delete cascade will prevent deletedbiblioitems rows
 718     # from being generated by _koha_delete_biblioitems
 719     $error = _koha_delete_biblio( $dbh, $biblionumber );
 720
 721     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","DELETE",$biblionumber,"")
 722         if C4::Context->preference("CataloguingLog");
 723     return;
 724 }
 725
 726 =head2 DelItem
 727
 728 =over
 729
 730 DelItem( $biblionumber, $itemnumber );
 731 Exported function (core API) for deleting an item record in Koha.
 732
 733 =back
 734
 735 =cut
 736
 737 sub DelItem {
 738     my ( $dbh, $biblionumber, $itemnumber ) = @_;
 739
 740     # check the item has no current issues
 741
 742
 743     &_koha_delete_item( $dbh, $itemnumber );
 744
 745     # get the MARC record
 746     my $record = GetMarcBiblio($biblionumber);
 747     my $frameworkcode = GetFrameworkCode($biblionumber);
 748
 749     # backup the record
 750     my $copy2deleted = $dbh->prepare("UPDATE deleteditems SET marc=? WHERE itemnumber=?");
 751     $copy2deleted->execute( $record->as_usmarc(), $itemnumber );
 752
 753     #search item field code
 754     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField("items.itemnumber",$frameworkcode);
 755     my @fields = $record->field($itemtag);
 756
 757     # delete the item specified
 758     foreach my $field (@fields) {
 759         if ( $field->subfield($itemsubfield) eq $itemnumber ) {
 760             $record->delete_field($field);
 761         }
 762     }
 763     &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
 764     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","DELETE",$itemnumber,"item")
 765         if C4::Context->preference("CataloguingLog");
 766 }
 767
 768 =head2 GetBiblioData
 769
 770 =over 4
 771
 772 $data = &GetBiblioData($biblionumber);
 773 Returns information about the book with the given biblionumber.
 774 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
 775 the C<biblio> and C<biblioitems> tables in the
 776 Koha database.
 777 In addition, C<$data-E<gt>{subject}> is the list of the book's
 778 subjects, separated by C<" , "> (space, comma, space).
 779 If there are multiple biblioitems with the given biblionumber, only
 780 the first one is considered.
 781
 782 =back
 783
 784 =cut
 785
 786 sub GetBiblioData {
 787     my ( $bibnum ) = @_;
 788     my $dbh = C4::Context->dbh;
 789
 790   #  my $query =  C4::Context->preference('item-level_itypes') ?
 791     #   " SELECT * , biblioitems.notes AS bnotes, biblio.notes
 792     #       FROM biblio
 793     #        LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
 794     #       WHERE biblio.biblionumber = ?
 795     #        AND biblioitems.biblionumber = biblio.biblionumber
 796     #";
 797
 798     my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
 799             FROM biblio
 800             LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
 801             LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
 802             WHERE biblio.biblionumber = ?
 803             AND biblioitems.biblionumber = biblio.biblionumber ";
 804
 805     my $sth = $dbh->prepare($query);
 806     $sth->execute($bibnum);
 807     my $data;
 808     $data = $sth->fetchrow_hashref;
 809     $sth->finish;
 810
 811     return ($data);
 812 }    # sub GetBiblioData
 813
 814
 815 =head2 GetItemsInfo
 816
 817 =over 4
 818
 819   @results = &GetItemsInfo($biblionumber, $type);
 820
 821 Returns information about books with the given biblionumber.
 822
 823 C<$type> may be either C<intra> or anything else. If it is not set to
 824 C<intra>, then the search will exclude lost, very overdue, and
 825 withdrawn items.
 826
 827 C<&GetItemsInfo> returns a list of references-to-hash. Each element
 828 contains a number of keys. Most of them are table items from the
 829 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
 830 Koha database. Other keys include:
 831
 832 =over 4
 833
 834 =item C<$data-E<gt>{branchname}>
 835
 836 The name (not the code) of the branch to which the book belongs.
 837
 838 =item C<$data-E<gt>{datelastseen}>
 839
 840 This is simply C<items.datelastseen>, except that while the date is
 841 stored in YYYY-MM-DD format in the database, here it is converted to
 842 DD/MM/YYYY format. A NULL date is returned as C<//>.
 843
 844 =item C<$data-E<gt>{datedue}>
 845
 846 =item C<$data-E<gt>{class}>
 847
 848 This is the concatenation of C<biblioitems.classification>, the book's
 849 Dewey code, and C<biblioitems.subclass>.
 850
 851 =item C<$data-E<gt>{ocount}>
 852
 853 I think this is the number of copies of the book available.
 854
 855 =item C<$data-E<gt>{order}>
 856
 857 If this is set, it is set to C<One Order>.
 858
 859 =back
 860
 861 =back
 862
 863 =cut
 864
 865 sub GetItemsInfo {
 866     my ( $biblionumber, $type ) = @_;
 867     my $dbh   = C4::Context->dbh;
 868     my $query = "SELECT *,items.notforloan as itemnotforloan
 869                  FROM items
 870                  LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
 871                  LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
 872     $query .=  (C4::Context->preference('item-level_itypes')) ?
 873                      " LEFT JOIN itemtypes on items.itype = itemtypes.itemtype "
 874                     : " LEFT JOIN itemtypes on biblioitems.itemtype = itemtypes.itemtype ";
 875     $query .= "WHERE items.biblionumber = ? ORDER BY items.dateaccessioned desc" ;
 876     my $sth = $dbh->prepare($query);
 877     $sth->execute($biblionumber);
 878     my $i = 0;
 879     my @results;
 880     my ( $date_due, $count_reserves );
 881
 882     my $isth    = $dbh->prepare(
 883         "SELECT issues.*,borrowers.cardnumber,borrowers.surname,borrowers.firstname,borrowers.branchcode as bcode
 884         FROM   issues LEFT JOIN borrowers ON issues.borrowernumber=borrowers.borrowernumber
 885         WHERE  itemnumber = ?
 886             AND returndate IS NULL"
 887        );
 888     while ( my $data = $sth->fetchrow_hashref ) {
 889         my $datedue = '';
 890         $isth->execute( $data->{'itemnumber'} );
 891         if ( my $idata = $isth->fetchrow_hashref ) {
 892             $data->{borrowernumber} = $idata->{borrowernumber};
 893             $data->{cardnumber}     = $idata->{cardnumber};
 894             $data->{surname}     = $idata->{surname};
 895             $data->{firstname}     = $idata->{firstname};
 896             $datedue                = $idata->{'date_due'};
 897         if (C4::Context->preference("IndependantBranches")){
 898         my $userenv = C4::Context->userenv;
 899         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 900             $data->{'NOTSAMEBRANCH'} = 1 if ($idata->{'bcode'} ne $userenv->{branch});
 901         }
 902         }
 903         }
 904         if ( $datedue eq '' ) {
 905             my ( $restype, $reserves ) =
 906               C4::Reserves::CheckReserves( $data->{'itemnumber'} );
 907             if ($restype) {
 908                 $count_reserves = $restype;
 909             }
 910         }
 911         $isth->finish;
 912
 913         #get branch information.....
 914         my $bsth = $dbh->prepare(
 915             "SELECT * FROM branches WHERE branchcode = ?
 916         "
 917         );
 918         $bsth->execute( $data->{'holdingbranch'} );
 919         if ( my $bdata = $bsth->fetchrow_hashref ) {
 920             $data->{'branchname'} = $bdata->{'branchname'};
 921         }
 922         $data->{'datedue'}        = $datedue;
 923         $data->{'count_reserves'} = $count_reserves;
 924
 925         # get notforloan complete status if applicable
 926         my $sthnflstatus = $dbh->prepare(
 927             'SELECT authorised_value
 928             FROM   marc_subfield_structure
 929             WHERE  kohafield="items.notforloan"
 930         '
 931         );
 932
 933         $sthnflstatus->execute;
 934         my ($authorised_valuecode) = $sthnflstatus->fetchrow;
 935         if ($authorised_valuecode) {
 936             $sthnflstatus = $dbh->prepare(
 937                 "SELECT lib FROM authorised_values
 938                  WHERE  category=?
 939                  AND authorised_value=?"
 940             );
 941             $sthnflstatus->execute( $authorised_valuecode,
 942                 $data->{itemnotforloan} );
 943             my ($lib) = $sthnflstatus->fetchrow;
 944             $data->{notforloan} = $lib;
 945         }
 946
 947         # my stack procedures
 948         my $stackstatus = $dbh->prepare(
 949             'SELECT authorised_value
 950              FROM   marc_subfield_structure
 951              WHERE  kohafield="items.stack"
 952         '
 953         );
 954         $stackstatus->execute;
 955
 956         ($authorised_valuecode) = $stackstatus->fetchrow;
 957         if ($authorised_valuecode) {
 958             $stackstatus = $dbh->prepare(
 959                 "SELECT lib
 960                  FROM   authorised_values
 961                  WHERE  category=?
 962                  AND    authorised_value=?
 963             "
 964             );
 965             $stackstatus->execute( $authorised_valuecode, $data->{stack} );
 966             my ($lib) = $stackstatus->fetchrow;
 967             $data->{stack} = $lib;
 968         }
 969         # Find the last 3 people who borrowed this item.
 970         my $sth2 = $dbh->prepare("SELECT * FROM issues,borrowers
 971                                     WHERE itemnumber = ?
 972                                     AND issues.borrowernumber = borrowers.borrowernumber
 973                                     AND returndate IS NOT NULL LIMIT 3");
 974         $sth2->execute($data->{'itemnumber'});
 975         my $ii = 0;
 976         while (my $data2 = $sth2->fetchrow_hashref()) {
 977             $data->{"timestamp$ii"} = $data2->{'timestamp'} if $data2->{'timestamp'};
 978             $data->{"card$ii"}      = $data2->{'cardnumber'} if $data2->{'cardnumber'};
 979             $data->{"borrower$ii"}  = $data2->{'borrowernumber'} if $data2->{'borrowernumber'};
 980             $ii++;
 981         }
 982
 983         $results[$i] = $data;
 984         $i++;
 985     }
 986     $sth->finish;
 987
 988     return (@results);
 989 }
 990
 991 =head2 getitemstatus
 992
 993 =over 4
 994
 995 $itemstatushash = &getitemstatus($fwkcode);
 996 returns information about status.
 997 Can be MARC dependant.
 998 fwkcode is optional.
 999 But basically could be can be loan or not
1000 Create a status selector with the following code
1001
1002 =head3 in PERL SCRIPT
1003
1004 my $itemstatushash = getitemstatus;
1005 my @itemstatusloop;
1006 foreach my $thisstatus (keys %$itemstatushash) {
1007     my %row =(value => $thisstatus,
1008                 statusname => $itemstatushash->{$thisstatus}->{'statusname'},
1009             );
1010     push @itemstatusloop, \%row;
1011 }
1012 $template->param(statusloop=>\@itemstatusloop);
1013
1014
1015 =head3 in TEMPLATE
1016
1017             <select name="statusloop">
1018                 <option value="">Default</option>
1019             <!-- TMPL_LOOP name="statusloop" -->
1020                 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="statusname" --></option>
1021             <!-- /TMPL_LOOP -->
1022             </select>
1023
1024 =cut
1025
1026 sub GetItemStatus {
1027
1028     # returns a reference to a hash of references to status...
1029     my ($fwk) = @_;
1030     my %itemstatus;
1031     my $dbh = C4::Context->dbh;
1032     my $sth;
1033     $fwk = '' unless ($fwk);
1034     my ( $tag, $subfield ) =
1035       GetMarcFromKohaField( "items.notforloan", $fwk );
1036     if ( $tag and $subfield ) {
1037         my $sth =
1038           $dbh->prepare(
1039             "SELECT authorised_value
1040             FROM marc_subfield_structure
1041             WHERE tagfield=?
1042                 AND tagsubfield=?
1043                 AND frameworkcode=?
1044             "
1045           );
1046         $sth->execute( $tag, $subfield, $fwk );
1047         if ( my ($authorisedvaluecat) = $sth->fetchrow ) {
1048             my $authvalsth =
1049               $dbh->prepare(
1050                 "SELECT authorised_value,lib
1051                 FROM authorised_values
1052                 WHERE category=?
1053                 ORDER BY lib
1054                 "
1055               );
1056             $authvalsth->execute($authorisedvaluecat);
1057             while ( my ( $authorisedvalue, $lib ) = $authvalsth->fetchrow ) {
1058                 $itemstatus{$authorisedvalue} = $lib;
1059             }
1060             $authvalsth->finish;
1061             return \%itemstatus;
1062             exit 1;
1063         }
1064         else {
1065
1066             #No authvalue list
1067             # build default
1068         }
1069         $sth->finish;
1070     }
1071
1072     #No authvalue list
1073     #build default
1074     $itemstatus{"1"} = "Not For Loan";
1075     return \%itemstatus;
1076 }
1077
1078 =head2 getitemlocation
1079
1080 =over 4
1081
1082 $itemlochash = &getitemlocation($fwk);
1083 returns informations about location.
1084 where fwk stands for an optional framework code.
1085 Create a location selector with the following code
1086
1087 =head3 in PERL SCRIPT
1088
1089 my $itemlochash = getitemlocation;
1090 my @itemlocloop;
1091 foreach my $thisloc (keys %$itemlochash) {
1092     my $selected = 1 if $thisbranch eq $branch;
1093     my %row =(locval => $thisloc,
1094                 selected => $selected,
1095                 locname => $itemlochash->{$thisloc},
1096             );
1097     push @itemlocloop, \%row;
1098 }
1099 $template->param(itemlocationloop => \@itemlocloop);
1100
1101 =head3 in TEMPLATE
1102
1103 <select name="location">
1104     <option value="">Default</option>
1105 <!-- TMPL_LOOP name="itemlocationloop" -->
1106     <option value="<!-- TMPL_VAR name="locval" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="locname" --></option>
1107 <!-- /TMPL_LOOP -->
1108 </select>
1109
1110 =back
1111
1112 =cut
1113
1114 sub GetItemLocation {
1115
1116     # returns a reference to a hash of references to location...
1117     my ($fwk) = @_;
1118     my %itemlocation;
1119     my $dbh = C4::Context->dbh;
1120     my $sth;
1121     $fwk = '' unless ($fwk);
1122     my ( $tag, $subfield ) =
1123       GetMarcFromKohaField( "items.location", $fwk );
1124     if ( $tag and $subfield ) {
1125         my $sth =
1126           $dbh->prepare(
1127             "SELECT authorised_value
1128             FROM marc_subfield_structure
1129             WHERE tagfield=?
1130                 AND tagsubfield=?
1131                 AND frameworkcode=?"
1132           );
1133         $sth->execute( $tag, $subfield, $fwk );
1134         if ( my ($authorisedvaluecat) = $sth->fetchrow ) {
1135             my $authvalsth =
1136               $dbh->prepare(
1137                 "SELECT authorised_value,lib
1138                 FROM authorised_values
1139                 WHERE category=?
1140                 ORDER BY lib"
1141               );
1142             $authvalsth->execute($authorisedvaluecat);
1143             while ( my ( $authorisedvalue, $lib ) = $authvalsth->fetchrow ) {
1144                 $itemlocation{$authorisedvalue} = $lib;
1145             }
1146             $authvalsth->finish;
1147             return \%itemlocation;
1148             exit 1;
1149         }
1150         else {
1151
1152             #No authvalue list
1153             # build default
1154         }
1155         $sth->finish;
1156     }
1157
1158     #No authvalue list
1159     #build default
1160     $itemlocation{"1"} = "Not For Loan";
1161     return \%itemlocation;
1162 }
1163
1164 =head2 GetLostItems
1165
1166 $items = GetLostItems($where,$orderby);
1167
1168 This function get the items lost into C<$items>.
1169
1170 =over 2
1171
1172 =item input:
1173 C<$where> is a hashref. it containts a field of the items table as key
1174 and the value to match as value.
1175 C<$orderby> is a field of the items table.
1176
1177 =item return:
1178 C<$items> is a reference to an array full of hasref which keys are items' table column.
1179
1180 =item usage in the perl script:
1181
1182 my %where;
1183 $where{barcode} = 0001548;
1184 my $items = GetLostItems( \%where, "homebranch" );
1185 $template->param(itemsloop => $items);
1186
1187 =back
1188
1189 =cut
1190
1191 sub GetLostItems {
1192     # Getting input args.
1193     my $where   = shift;
1194     my $orderby = shift;
1195     my $dbh     = C4::Context->dbh;
1196
1197     my $query   = "
1198         SELECT *
1199         FROM   items
1200         WHERE  itemlost IS NOT NULL
1201           AND  itemlost <> 0
1202     ";
1203     foreach my $key (keys %$where) {
1204         $query .= " AND " . $key . " LIKE '%" . $where->{$key} . "%'";
1205     }
1206     $query .= " ORDER BY ".$orderby if defined $orderby;
1207
1208     my $sth = $dbh->prepare($query);
1209     $sth->execute;
1210     my @items;
1211     while ( my $row = $sth->fetchrow_hashref ){
1212         push @items, $row;
1213     }
1214     return \@items;
1215 }
1216
1217 =head2 GetItemsForInventory
1218
1219 $itemlist = GetItemsForInventory($minlocation,$maxlocation,$datelastseen,$offset,$size)
1220
1221 Retrieve a list of title/authors/barcode/callnumber, for biblio inventory.
1222
1223 The sub returns a list of hashes, containing itemnumber, author, title, barcode & item callnumber.
1224 It is ordered by callnumber,title.
1225
1226 The minlocation & maxlocation parameters are used to specify a range of item callnumbers
1227 the datelastseen can be used to specify that you want to see items not seen since a past date only.
1228 offset & size can be used to retrieve only a part of the whole listing (defaut behaviour)
1229
1230 =cut
1231
1232 sub GetItemsForInventory {
1233     my ( $minlocation, $maxlocation,$location, $datelastseen, $branch, $offset, $size ) = @_;
1234     my $dbh = C4::Context->dbh;
1235     my $sth;
1236     if ($datelastseen) {
1237         $datelastseen=format_date_in_iso($datelastseen);
1238         my $query =
1239                 "SELECT itemnumber,barcode,itemcallnumber,title,author,biblio.biblionumber,datelastseen
1240                  FROM items
1241                    LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1242                  WHERE itemcallnumber>= ?
1243                    AND itemcallnumber <=?
1244                    AND (datelastseen< ? OR datelastseen IS NULL)";
1245         $query.= " AND items.location=".$dbh->quote($location) if $location;
1246         $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch;
1247         $query .= " ORDER BY itemcallnumber,title";
1248         $sth = $dbh->prepare($query);
1249         $sth->execute( $minlocation, $maxlocation, $datelastseen );
1250     }
1251     else {
1252         my $query ="
1253                 SELECT itemnumber,barcode,itemcallnumber,biblio.biblionumber,title,author,datelastseen
1254                 FROM items
1255                   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1256                 WHERE itemcallnumber>= ?
1257                   AND itemcallnumber <=?";
1258         $query.= " AND items.location=".$dbh->quote($location) if $location;
1259         $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch;
1260         $query .= " ORDER BY itemcallnumber,title";
1261         $sth = $dbh->prepare($query);
1262         $sth->execute( $minlocation, $maxlocation );
1263     }
1264     my @results;
1265     while ( my $row = $sth->fetchrow_hashref ) {
1266         $offset-- if ($offset);
1267         $row->{datelastseen}=format_date($row->{datelastseen});
1268         if ( ( !$offset ) && $size ) {
1269             push @results, $row;
1270             $size--;
1271         }
1272     }
1273     return \@results;
1274 }
1275
1276 =head2 &GetBiblioItemData
1277
1278 =over 4
1279
1280 $itemdata = &GetBiblioItemData($biblioitemnumber);
1281
1282 Looks up the biblioitem with the given biblioitemnumber. Returns a
1283 reference-to-hash. The keys are the fields from the C<biblio>,
1284 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
1285 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
1286
1287 =back
1288
1289 =cut
1290
1291 #'
1292 sub GetBiblioItemData {
1293     my ($biblioitemnumber) = @_;
1294     my $dbh       = C4::Context->dbh;
1295     my $query = "SELECT *,biblioitems.notes AS bnotes
1296         FROM biblio, biblioitems ";
1297     unless(C4::Context->preference('item-level_itypes')) {
1298         $query .= "LEFT JOIN itemtypes on biblioitems.itemtype=itemtypes.itemtype ";
1299     }
1300     $query .= " WHERE biblio.biblionumber = biblioitems.biblionumber
1301         AND biblioitemnumber = ? ";
1302     my $sth       =  $dbh->prepare($query);
1303     my $data;
1304     $sth->execute($biblioitemnumber);
1305     $data = $sth->fetchrow_hashref;
1306     $sth->finish;
1307     return ($data);
1308 }    # sub &GetBiblioItemData
1309
1310 =head2 GetItemnumberFromBarcode
1311
1312 =over 4
1313
1314 $result = GetItemnumberFromBarcode($barcode);
1315
1316 =back
1317
1318 =cut
1319
1320 sub GetItemnumberFromBarcode {
1321     my ($barcode) = @_;
1322     my $dbh = C4::Context->dbh;
1323
1324     my $rq =
1325       $dbh->prepare("SELECT itemnumber FROM items WHERE items.barcode=?");
1326     $rq->execute($barcode);
1327     my ($result) = $rq->fetchrow;
1328     return ($result);
1329 }
1330
1331 =head2 GetBiblioItemByBiblioNumber
1332
1333 =over 4
1334
1335 NOTE : This function has been copy/paste from C4/Biblio.pm from head before zebra integration.
1336
1337 =back
1338
1339 =cut
1340
1341 sub GetBiblioItemByBiblioNumber {
1342     my ($biblionumber) = @_;
1343     my $dbh = C4::Context->dbh;
1344     my $sth = $dbh->prepare("Select * FROM biblioitems WHERE biblionumber = ?");
1345     my $count = 0;
1346     my @results;
1347
1348     $sth->execute($biblionumber);
1349
1350     while ( my $data = $sth->fetchrow_hashref ) {
1351         push @results, $data;
1352     }
1353
1354     $sth->finish;
1355     return @results;
1356 }
1357
1358 =head2 GetBiblioFromItemNumber
1359
1360 =over 4
1361
1362 $item = &GetBiblioFromItemNumber($itemnumber,$barcode);
1363
1364 Looks up the item with the given itemnumber. if undef, try the barcode.
1365
1366 C<&itemnodata> returns a reference-to-hash whose keys are the fields
1367 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
1368 database.
1369
1370 =back
1371
1372 =cut
1373
1374 #'
1375 sub GetBiblioFromItemNumber {
1376     my ( $itemnumber, $barcode ) = @_;
1377     my $dbh = C4::Context->dbh;
1378     my $sth;
1379     if($itemnumber) {
1380         $sth=$dbh->prepare(  "SELECT * FROM items
1381             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1382             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
1383              WHERE items.itemnumber = ?") ;
1384         $sth->execute($itemnumber);
1385     } else {
1386         $sth=$dbh->prepare(  "SELECT * FROM items
1387             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1388             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
1389              WHERE items.barcode = ?") ;
1390         $sth->execute($barcode);
1391     }
1392     my $data = $sth->fetchrow_hashref;
1393     $sth->finish;
1394     return ($data);
1395 }
1396
1397 =head2 GetBiblio
1398
1399 =over 4
1400
1401 ( $count, @results ) = &GetBiblio($biblionumber);
1402
1403 =back
1404
1405 =cut
1406
1407 sub GetBiblio {
1408     my ($biblionumber) = @_;
1409     my $dbh = C4::Context->dbh;
1410     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber = ?");
1411     my $count = 0;
1412     my @results;
1413     $sth->execute($biblionumber);
1414     while ( my $data = $sth->fetchrow_hashref ) {
1415         $results[$count] = $data;
1416         $count++;
1417     }    # while
1418     $sth->finish;
1419     return ( $count, @results );
1420 }    # sub GetBiblio
1421
1422 =head2 GetItem
1423
1424 =over 4
1425
1426 $data = &GetItem($itemnumber,$barcode);
1427
1428 return Item information, for a given itemnumber or barcode
1429
1430 =back
1431
1432 =cut
1433
1434 sub GetItem {
1435     my ($itemnumber,$barcode) = @_;
1436     my $dbh = C4::Context->dbh;
1437     if ($itemnumber) {
1438         my $sth = $dbh->prepare("
1439             SELECT * FROM items
1440             WHERE itemnumber = ?");
1441         $sth->execute($itemnumber);
1442         my $data = $sth->fetchrow_hashref;
1443         return $data;
1444     } else {
1445         my $sth = $dbh->prepare("
1446             SELECT * FROM items
1447             WHERE barcode = ?"
1448             );
1449         $sth->execute($barcode);
1450         my $data = $sth->fetchrow_hashref;
1451         return $data;
1452     }
1453 }    # sub GetItem
1454
1455 =head2 get_itemnumbers_of
1456
1457 =over 4
1458
1459 my @itemnumbers_of = get_itemnumbers_of(@biblionumbers);
1460
1461 Given a list of biblionumbers, return the list of corresponding itemnumbers
1462 for each biblionumber.
1463
1464 Return a reference on a hash where keys are biblionumbers and values are
1465 references on array of itemnumbers.
1466
1467 =back
1468
1469 =cut
1470
1471 sub get_itemnumbers_of {
1472     my @biblionumbers = @_;
1473
1474     my $dbh = C4::Context->dbh;
1475
1476     my $query = '
1477         SELECT itemnumber,
1478             biblionumber
1479         FROM items
1480         WHERE biblionumber IN (?' . ( ',?' x scalar @biblionumbers - 1 ) . ')
1481     ';
1482     my $sth = $dbh->prepare($query);
1483     $sth->execute(@biblionumbers);
1484
1485     my %itemnumbers_of;
1486
1487     while ( my ( $itemnumber, $biblionumber ) = $sth->fetchrow_array ) {
1488         push @{ $itemnumbers_of{$biblionumber} }, $itemnumber;
1489     }
1490
1491     return \%itemnumbers_of;
1492 }
1493
1494 =head2 GetItemInfosOf
1495
1496 =over 4
1497
1498 GetItemInfosOf(@itemnumbers);
1499
1500 =back
1501
1502 =cut
1503
1504 sub GetItemInfosOf {
1505     my @itemnumbers = @_;
1506
1507     my $query = '
1508         SELECT *
1509         FROM items
1510         WHERE itemnumber IN (' . join( ',', @itemnumbers ) . ')
1511     ';
1512     return get_infos_of( $query, 'itemnumber' );
1513 }
1514
1515 =head2 GetItemsByBiblioitemnumber
1516
1517 =over 4
1518
1519 GetItemsByBiblioitemnumber($biblioitemnumber);
1520
1521 Returns an arrayref of hashrefs suitable for use in a TMPL_LOOP
1522 Called by moredetail.pl
1523
1524 =back
1525
1526 =cut
1527
1528 sub GetItemsByBiblioitemnumber {
1529     my ( $bibitem ) = @_;
1530     my $dbh = C4::Context->dbh;
1531     my $sth = $dbh->prepare("SELECT * FROM items WHERE items.biblioitemnumber = ?") || die $dbh->errstr;
1532     # Get all items attached to a biblioitem
1533     my $i = 0;
1534     my @results;
1535     $sth->execute($bibitem) || die $sth->errstr;
1536     while ( my $data = $sth->fetchrow_hashref ) {
1537         # Foreach item, get circulation information
1538         my $sth2 = $dbh->prepare( "SELECT * FROM issues,borrowers
1539                                    WHERE itemnumber = ?
1540                                    AND returndate is NULL
1541                                    AND issues.borrowernumber = borrowers.borrowernumber"
1542         );
1543         $sth2->execute( $data->{'itemnumber'} );
1544         if ( my $data2 = $sth2->fetchrow_hashref ) {
1545             # if item is out, set the due date and who it is out too
1546             $data->{'date_due'}   = $data2->{'date_due'};
1547             $data->{'cardnumber'} = $data2->{'cardnumber'};
1548             $data->{'borrowernumber'}   = $data2->{'borrowernumber'};
1549         }
1550         else {
1551             # set date_due to blank, so in the template we check itemlost, and wthdrawn
1552             $data->{'date_due'} = '';
1553         }    # else
1554         $sth2->finish;
1555         # Find the last 3 people who borrowed this item.
1556         my $query2 = "SELECT * FROM issues, borrowers WHERE itemnumber = ?
1557                       AND issues.borrowernumber = borrowers.borrowernumber
1558                       AND returndate is not NULL
1559                       ORDER BY returndate desc,timestamp desc LIMIT 3";
1560         $sth2 = $dbh->prepare($query2) || die $dbh->errstr;
1561         $sth2->execute( $data->{'itemnumber'} ) || die $sth2->errstr;
1562         my $i2 = 0;
1563         while ( my $data2 = $sth2->fetchrow_hashref ) {
1564             $data->{"timestamp$i2"} = $data2->{'timestamp'};
1565             $data->{"card$i2"}      = $data2->{'cardnumber'};
1566             $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
1567             $i2++;
1568         }
1569         $sth2->finish;
1570         push(@results,$data);
1571     }
1572     $sth->finish;
1573     return (\@results);
1574 }
1575
1576
1577 =head2 GetBiblioItemInfosOf
1578
1579 =over 4
1580
1581 GetBiblioItemInfosOf(@biblioitemnumbers);
1582
1583 =back
1584
1585 =cut
1586
1587 sub GetBiblioItemInfosOf {
1588     my @biblioitemnumbers = @_;
1589
1590     my $query = '
1591         SELECT biblioitemnumber,
1592             publicationyear,
1593             itemtype
1594         FROM biblioitems
1595         WHERE biblioitemnumber IN (' . join( ',', @biblioitemnumbers ) . ')
1596     ';
1597     return get_infos_of( $query, 'biblioitemnumber' );
1598 }
1599
1600 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
1601
1602 =head2 GetMarcStructure
1603
1604 =over 4
1605
1606 $res = GetMarcStructure($forlibrarian,$frameworkcode);
1607
1608 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
1609 $forlibrarian  :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
1610 $frameworkcode : the framework code to read
1611
1612 =back
1613
1614 =cut
1615
1616 sub GetMarcStructure {
1617     my ( $forlibrarian, $frameworkcode ) = @_;
1618     my $dbh=C4::Context->dbh;
1619     $frameworkcode = "" unless $frameworkcode;
1620     my $sth;
1621     my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
1622
1623     # check that framework exists
1624     $sth =
1625       $dbh->prepare(
1626         "SELECT COUNT(*) FROM marc_tag_structure WHERE frameworkcode=?");
1627     $sth->execute($frameworkcode);
1628     my ($total) = $sth->fetchrow;
1629     $frameworkcode = "" unless ( $total > 0 );
1630     $sth =
1631       $dbh->prepare(
1632         "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable
1633         FROM marc_tag_structure
1634         WHERE frameworkcode=?
1635         ORDER BY tagfield"
1636       );
1637     $sth->execute($frameworkcode);
1638     my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
1639
1640     while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) =
1641         $sth->fetchrow )
1642     {
1643         $res->{$tag}->{lib} =
1644           ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1645         $res->{$tab}->{tab}        = "";
1646         $res->{$tag}->{mandatory}  = $mandatory;
1647         $res->{$tag}->{repeatable} = $repeatable;
1648     }
1649
1650     $sth =
1651       $dbh->prepare(
1652             "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue
1653                 FROM marc_subfield_structure
1654             WHERE frameworkcode=?
1655                 ORDER BY tagfield,tagsubfield
1656             "
1657     );
1658
1659     $sth->execute($frameworkcode);
1660
1661     my $subfield;
1662     my $authorised_value;
1663     my $authtypecode;
1664     my $value_builder;
1665     my $kohafield;
1666     my $seealso;
1667     my $hidden;
1668     my $isurl;
1669     my $link;
1670     my $defaultvalue;
1671
1672     while (
1673         (
1674             $tag,          $subfield,      $liblibrarian,
1675             ,              $libopac,       $tab,
1676             $mandatory,    $repeatable,    $authorised_value,
1677             $authtypecode, $value_builder, $kohafield,
1678             $seealso,      $hidden,        $isurl,
1679             $link,$defaultvalue
1680         )
1681         = $sth->fetchrow
1682       )
1683     {
1684         $res->{$tag}->{$subfield}->{lib} =
1685           ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1686         $res->{$tag}->{$subfield}->{tab}              = $tab;
1687         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
1688         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
1689         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
1690         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
1691         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
1692         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
1693         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
1694         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
1695         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
1696         $res->{$tag}->{$subfield}->{'link'}           = $link;
1697         $res->{$tag}->{$subfield}->{defaultvalue}     = $defaultvalue;
1698     }
1699     return $res;
1700 }
1701
1702 =head2 GetUsedMarcStructure
1703
1704     the same function as GetMarcStructure expcet it just take field
1705     in tab 0-9. (used field)
1706
1707     my $results = GetUsedMarcStructure($frameworkcode);
1708
1709     L<$results> is a ref to an array which each case containts a ref
1710     to a hash which each keys is the columns from marc_subfield_structure
1711
1712     L<$frameworkcode> is the framework code.
1713
1714 =cut
1715
1716 sub GetUsedMarcStructure($){
1717     my $frameworkcode = shift || '';
1718     my $dbh           = C4::Context->dbh;
1719     my $query         = qq/
1720         SELECT *
1721         FROM   marc_subfield_structure
1722         WHERE   tab > -1
1723             AND frameworkcode = ?
1724     /;
1725     my @results;
1726     my $sth = $dbh->prepare($query);
1727     $sth->execute($frameworkcode);
1728     while (my $row = $sth->fetchrow_hashref){
1729         push @results,$row;
1730     }
1731     return \@results;
1732 }
1733
1734 =head2 GetMarcFromKohaField
1735
1736 =over 4
1737
1738 ($MARCfield,$MARCsubfield)=GetMarcFromKohaField($kohafield,$frameworkcode);
1739 Returns the MARC fields & subfields mapped to the koha field
1740 for the given frameworkcode
1741
1742 =back
1743
1744 =cut
1745
1746 sub GetMarcFromKohaField {
1747     my ( $kohafield, $frameworkcode ) = @_;
1748     return 0, 0 unless $kohafield;
1749     my $relations = C4::Context->marcfromkohafield;
1750     return (
1751         $relations->{$frameworkcode}->{$kohafield}->[0],
1752         $relations->{$frameworkcode}->{$kohafield}->[1]
1753     );
1754 }
1755
1756 =head2 GetMarcBiblio
1757
1758 =over 4
1759
1760 Returns MARC::Record of the biblionumber passed in parameter.
1761 the marc record contains both biblio & item datas
1762
1763 =back
1764
1765 =cut
1766
1767 sub GetMarcBiblio {
1768     my $biblionumber = shift;
1769     my $dbh          = C4::Context->dbh;
1770     my $sth          =
1771       $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1772     $sth->execute($biblionumber);
1773      my ($marcxml) = $sth->fetchrow;
1774      MARC::File::XML->default_record_format(C4::Context->preference('marcflavour'));
1775      $marcxml =~ s/\x1e//g;
1776      $marcxml =~ s/\x1f//g;
1777      $marcxml =~ s/\x1d//g;
1778      $marcxml =~ s/\x0f//g;
1779      $marcxml =~ s/\x0c//g;
1780 #   warn $marcxml;
1781     my $record = MARC::Record->new();
1782     if ($marcxml) {
1783         $record = eval {MARC::Record::new_from_xml( $marcxml, "utf8", C4::Context->preference('marcflavour'))};
1784         if ($@) {warn $@;}
1785 #      $record = MARC::Record::new_from_usmarc( $marc) if $marc;
1786         return $record;
1787     } else {
1788         return undef;
1789     }
1790 }
1791
1792 =head2 GetXmlBiblio
1793
1794 =over 4
1795
1796 my $marcxml = GetXmlBiblio($biblionumber);
1797
1798 Returns biblioitems.marcxml of the biblionumber passed in parameter.
1799 The XML contains both biblio & item datas
1800
1801 =back
1802
1803 =cut
1804
1805 sub GetXmlBiblio {
1806     my ( $biblionumber ) = @_;
1807     my $dbh = C4::Context->dbh;
1808     my $sth =
1809       $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1810     $sth->execute($biblionumber);
1811     my ($marcxml) = $sth->fetchrow;
1812     return $marcxml;
1813 }
1814
1815 =head2 GetAuthorisedValueDesc
1816
1817 =over 4
1818
1819 my $subfieldvalue =get_authorised_value_desc(
1820     $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category);
1821 Retrieve the complete description for a given authorised value.
1822
1823 Now takes $category and $value pair too.
1824 my $auth_value_desc =GetAuthorisedValueDesc(
1825     '','', 'DVD' ,'','','CCODE');
1826
1827 =back
1828
1829 =cut
1830
1831 sub GetAuthorisedValueDesc {
1832     my ( $tag, $subfield, $value, $framework, $tagslib, $category ) = @_;
1833     my $dbh = C4::Context->dbh;
1834
1835     if (!$category) {
1836 #---- branch
1837         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1838             return C4::Branch::GetBranchName($value);
1839         }
1840
1841 #---- itemtypes
1842         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1843             return getitemtypeinfo($value)->{description};
1844         }
1845
1846 #---- "true" authorized value
1847         $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'}
1848     }
1849
1850     if ( $category ne "" ) {
1851         my $sth =
1852             $dbh->prepare(
1853                     "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
1854                     );
1855         $sth->execute( $category, $value );
1856         my $data = $sth->fetchrow_hashref;
1857         return $data->{'lib'};
1858     }
1859     else {
1860         return $value;    # if nothing is found return the original value
1861     }
1862 }
1863
1864 =head2 GetMarcItem
1865
1866 =over 4
1867
1868 Returns MARC::Record of the item passed in parameter.
1869
1870 =back
1871
1872 =cut
1873
1874 sub GetMarcItem {
1875     my ( $biblionumber, $itemnumber ) = @_;
1876
1877     # GetMarcItem has been revised so that it does the following:
1878     #  1. Gets the item information from the items table.
1879     #  2. Converts it to a MARC field for storage in the bib record.
1880     #
1881     # The previous behavior was:
1882     #  1. Get the bib record.
1883     #  2. Return the MARC tag corresponding to the item record.
1884     #
1885     # The difference is that one treats the items row as authoritative,
1886     # while the other treats the MARC representation as authoritative
1887     # under certain circumstances.
1888     #
1889     # FIXME - a big one
1890     #
1891     # As of 2007-11-27, this change hopefully does not introduce
1892     # any bugs.  However, it does mean that for code that uses
1893     # ModItemInMarconefield to update one subfield (corresponding to
1894     # an items column) is now less efficient.
1895     #
1896     # The API needs to be shifted to the following:
1897     #  1. User updates items record.
1898     #  2. Linked bib is sent for indexing.
1899     #
1900     # The missing step 1.5 is updating the item tag in the bib MARC record
1901     # so that the indexes are updated.  Depending on performance considerations,
1902     # this may ultimately mean of of the following:
1903     #  a. MARC field for item is updated right away.
1904     #  b. MARC field for item is updated only as part of indexing.
1905     #  c. MARC field for item is never actually stored in bib record; instead
1906     #     it is generated only when needed for indexing, item export, and
1907     #     (maybe) OPAC display.
1908     #
1909
1910     my $itemrecord = GetItem($itemnumber);
1911
1912     # Tack on 'items.' prefix to column names so that TransformKohaToMarc will work.
1913     # Also, don't emit a subfield if the underlying field is blank.
1914     my $mungeditem = { map {  $itemrecord->{$_} ne '' ? ("items.$_" => $itemrecord->{$_}) : ()  } keys %{ $itemrecord } };
1915
1916     my $itemmarc = TransformKohaToMarc($mungeditem);
1917     return $itemmarc;
1918
1919 }
1920
1921
1922
1923 =head2 GetMarcNotes
1924
1925 =over 4
1926
1927 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1928 Get all notes from the MARC record and returns them in an array.
1929 The note are stored in differents places depending on MARC flavour
1930
1931 =back
1932
1933 =cut
1934
1935 sub GetMarcNotes {
1936     my ( $record, $marcflavour ) = @_;
1937     my $scope;
1938     if ( $marcflavour eq "MARC21" ) {
1939         $scope = '5..';
1940     }
1941     else {    # assume unimarc if not marc21
1942         $scope = '3..';
1943     }
1944     my @marcnotes;
1945     my $note = "";
1946     my $tag  = "";
1947     my $marcnote;
1948     foreach my $field ( $record->field($scope) ) {
1949         my $value = $field->as_string();
1950         if ( $note ne "" ) {
1951             $marcnote = { marcnote => $note, };
1952             push @marcnotes, $marcnote;
1953             $note = $value;
1954         }
1955         if ( $note ne $value ) {
1956             $note = $note . " " . $value;
1957         }
1958     }
1959
1960     if ( $note ) {
1961         $marcnote = { marcnote => $note };
1962         push @marcnotes, $marcnote;    #load last tag into array
1963     }
1964     return \@marcnotes;
1965 }    # end GetMarcNotes
1966
1967 =head2 GetMarcSubjects
1968
1969 =over 4
1970
1971 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1972 Get all subjects from the MARC record and returns them in an array.
1973 The subjects are stored in differents places depending on MARC flavour
1974
1975 =back
1976
1977 =cut
1978
1979 sub GetMarcSubjects {
1980     my ( $record, $marcflavour ) = @_;
1981     my ( $mintag, $maxtag );
1982     if ( $marcflavour eq "MARC21" ) {
1983         $mintag = "600";
1984         $maxtag = "699";
1985     }
1986     else {    # assume unimarc if not marc21
1987         $mintag = "600";
1988         $maxtag = "611";
1989     }
1990
1991     my @marcsubjects;
1992     my $subject = "";
1993     my $subfield = "";
1994     my $marcsubject;
1995
1996     foreach my $field ( $record->field('6..' )) {
1997         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1998         my @subfields_loop;
1999         my @subfields = $field->subfields();
2000         my $counter = 0;
2001         my @link_loop;
2002         # if there is an authority link, build the link with an= subfield9
2003         my $subfield9 = $field->subfield('9');
2004         for my $subject_subfield (@subfields ) {
2005             # don't load unimarc subfields 3,4,5
2006             next if (($marcflavour eq "UNIMARC") and ($subject_subfield->[0] =~ (3|4|5) ) );
2007             my $code = $subject_subfield->[0];
2008             my $value = $subject_subfield->[1];
2009             my $linkvalue = $value;
2010             $linkvalue =~ s/(\(|\))//g;
2011             my $operator = " and " unless $counter==0;
2012             if ($subfield9) {
2013                 @link_loop = ({'limit' => 'an' ,link => "$subfield9" });
2014             } else {
2015                 push @link_loop, {'limit' => 'su', link => $linkvalue, operator => $operator };
2016             }
2017             my $separator = C4::Context->preference("authoritysep") unless $counter==0;
2018             # ignore $9
2019             my @this_link_loop = @link_loop;
2020             push @subfields_loop, {code => $code, value => $value, link_loop => \@this_link_loop, separator => $separator} unless ($subject_subfield->[0] == 9 );
2021             $counter++;
2022         }
2023
2024         push @marcsubjects, { MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop };
2025
2026     }
2027         return \@marcsubjects;
2028 }  #end getMARCsubjects
2029
2030 =head2 GetMarcAuthors
2031
2032 =over 4
2033
2034 authors = GetMarcAuthors($record,$marcflavour);
2035 Get all authors from the MARC record and returns them in an array.
2036 The authors are stored in differents places depending on MARC flavour
2037
2038 =back
2039
2040 =cut
2041
2042 sub GetMarcAuthors {
2043     my ( $record, $marcflavour ) = @_;
2044     my ( $mintag, $maxtag );
2045     # tagslib useful for UNIMARC author reponsabilities
2046     my $tagslib = &GetMarcStructure( 1, '' ); # FIXME : we don't have the framework available, we take the default framework. May be bugguy on some setups, will be usually correct.
2047     if ( $marcflavour eq "MARC21" ) {
2048         $mintag = "700";
2049         $maxtag = "720";
2050     }
2051     elsif ( $marcflavour eq "UNIMARC" ) {    # assume unimarc if not marc21
2052         $mintag = "700";
2053         $maxtag = "712";
2054     }
2055     else {
2056         return;
2057     }
2058     my @marcauthors;
2059
2060     foreach my $field ( $record->fields ) {
2061         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
2062         my @subfields_loop;
2063         my @link_loop;
2064         my @subfields = $field->subfields();
2065         my $count_auth = 0;
2066         # if there is an authority link, build the link with Koha-Auth-Number: subfield9
2067         my $subfield9 = $field->subfield('9');
2068         for my $authors_subfield (@subfields) {
2069             # don't load unimarc subfields 3, 5
2070             next if ($marcflavour eq 'UNIMARC' and ($authors_subfield->[0] =~ (3|5) ) );
2071             my $subfieldcode = $authors_subfield->[0];
2072             my $value = $authors_subfield->[1];
2073             my $linkvalue = $value;
2074             $linkvalue =~ s/(\(|\))//g;
2075             my $operator = " and " unless $count_auth==0;
2076             # if we have an authority link, use that as the link, otherwise use standard searching
2077             if ($subfield9) {
2078                 @link_loop = ({'limit' => 'Koha-Auth-Number' ,link => "$subfield9" });
2079             }
2080             else {
2081                 # reset $linkvalue if UNIMARC author responsibility
2082                 if ( $marcflavour eq 'UNIMARC' and ($authors_subfield->[0] eq '4')) {
2083                     $linkvalue = "(".GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib ).")";
2084                 }
2085                 push @link_loop, {'limit' => 'au', link => $linkvalue, operator => $operator };
2086             }
2087             my @this_link_loop = @link_loop;
2088             my $separator = C4::Context->preference("authoritysep") unless $count_auth==0;
2089             push @subfields_loop, {code => $subfieldcode, value => $value, link_loop => \@this_link_loop, separator => $separator} unless ($authors_subfield->[0] == 9 );
2090             $count_auth++;
2091         }
2092         push @marcauthors, { MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop };
2093     }
2094     return \@marcauthors;
2095 }
2096
2097 =head2 GetMarcUrls
2098
2099 =over 4
2100
2101 $marcurls = GetMarcUrls($record,$marcflavour);
2102 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
2103 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
2104
2105 =back
2106
2107 =cut
2108
2109 sub GetMarcUrls {
2110     my ($record, $marcflavour) = @_;
2111     my @marcurls;
2112     my $marcurl;
2113     for my $field ($record->field('856')) {
2114         my $url = $field->subfield('u');
2115         my @notes;
2116         for my $note ( $field->subfield('z')) {
2117             push @notes , {note => $note};
2118         }
2119         $marcurl = {  MARCURL => $url,
2120                       notes => \@notes,
2121                     };
2122         if($marcflavour eq 'MARC21') {
2123             my $s3 = $field->subfield('3');
2124             my $link = $field->subfield('y');
2125             $marcurl->{'linktext'} = $link || $s3 || $url ;;
2126             $marcurl->{'part'} = $s3 if($link);
2127             $marcurl->{'toc'} = 1 if($s3 =~ /^[Tt]able/) ;
2128         } else {
2129             $marcurl->{'linktext'} = $url;
2130         }
2131         push @marcurls, $marcurl;
2132     }
2133     return \@marcurls;
2134 }  #end GetMarcUrls
2135
2136 =head2 GetMarcSeries
2137
2138 =over 4
2139
2140 $marcseriesarray = GetMarcSeries($record,$marcflavour);
2141 Get all series from the MARC record and returns them in an array.
2142 The series are stored in differents places depending on MARC flavour
2143
2144 =back
2145
2146 =cut
2147
2148 sub GetMarcSeries {
2149     my ($record, $marcflavour) = @_;
2150     my ($mintag, $maxtag);
2151     if ($marcflavour eq "MARC21") {
2152         $mintag = "440";
2153         $maxtag = "490";
2154     } else {           # assume unimarc if not marc21
2155         $mintag = "600";
2156         $maxtag = "619";
2157     }
2158
2159     my @marcseries;
2160     my $subjct = "";
2161     my $subfield = "";
2162     my $marcsubjct;
2163
2164     foreach my $field ($record->field('440'), $record->field('490')) {
2165         my @subfields_loop;
2166         #my $value = $field->subfield('a');
2167         #$marcsubjct = {MARCSUBJCT => $value,};
2168         my @subfields = $field->subfields();
2169         #warn "subfields:".join " ", @$subfields;
2170         my $counter = 0;
2171         my @link_loop;
2172         for my $series_subfield (@subfields) {
2173             my $volume_number;
2174             undef $volume_number;
2175             # see if this is an instance of a volume
2176             if ($series_subfield->[0] eq 'v') {
2177                 $volume_number=1;
2178             }
2179
2180             my $code = $series_subfield->[0];
2181             my $value = $series_subfield->[1];
2182             my $linkvalue = $value;
2183             $linkvalue =~ s/(\(|\))//g;
2184             my $operator = " and " unless $counter==0;
2185             push @link_loop, {link => $linkvalue, operator => $operator };
2186             my $separator = C4::Context->preference("authoritysep") unless $counter==0;
2187             if ($volume_number) {
2188             push @subfields_loop, {volumenum => $value};
2189             }
2190             else {
2191             push @subfields_loop, {code => $code, value => $value, link_loop => \@link_loop, separator => $separator, volumenum => $volume_number};
2192             }
2193             $counter++;
2194         }
2195         push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
2196         #$marcsubjct = {MARCSUBJCT => $field->as_string(),};
2197         #push @marcsubjcts, $marcsubjct;
2198         #$subjct = $value;
2199
2200     }
2201     my $marcseriessarray=\@marcseries;
2202     return $marcseriessarray;
2203 }  #end getMARCseriess
2204
2205 =head2 GetFrameworkCode
2206
2207 =over 4
2208
2209     $frameworkcode = GetFrameworkCode( $biblionumber )
2210
2211 =back
2212
2213 =cut
2214
2215 sub GetFrameworkCode {
2216     my ( $biblionumber ) = @_;
2217     my $dbh = C4::Context->dbh;
2218     my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
2219     $sth->execute($biblionumber);
2220     my ($frameworkcode) = $sth->fetchrow;
2221     return $frameworkcode;
2222 }
2223
2224 =head2 GetPublisherNameFromIsbn
2225
2226     $name = GetPublishercodeFromIsbn($isbn);
2227     if(defined $name){
2228         ...
2229     }
2230
2231 =cut
2232
2233 sub GetPublisherNameFromIsbn($){
2234     my $isbn = shift;
2235     $isbn =~ s/[- _]//g;
2236     $isbn =~ s/^0*//;
2237     my @codes = (split '-', DisplayISBN($isbn));
2238     my $code = $codes[0].$codes[1].$codes[2];
2239     my $dbh  = C4::Context->dbh;
2240     my $query = qq{
2241         SELECT distinct publishercode
2242         FROM   biblioitems
2243         WHERE  isbn LIKE ?
2244         AND    publishercode IS NOT NULL
2245         LIMIT 1
2246     };
2247     my $sth = $dbh->prepare($query);
2248     $sth->execute("$code%");
2249     my $name = $sth->fetchrow;
2250     return $name if length $name;
2251     return undef;
2252 }
2253
2254 =head2 TransformKohaToMarc
2255
2256 =over 4
2257
2258     $record = TransformKohaToMarc( $hash )
2259     This function builds partial MARC::Record from a hash
2260     Hash entries can be from biblio or biblioitems.
2261     This function is called in acquisition module, to create a basic catalogue entry from user entry
2262
2263 =back
2264
2265 =cut
2266
2267 sub TransformKohaToMarc {
2268
2269     my ( $hash ) = @_;
2270     my $dbh = C4::Context->dbh;
2271     my $sth =
2272     $dbh->prepare(
2273         "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?"
2274     );
2275     my $record = MARC::Record->new();
2276     foreach (keys %{$hash}) {
2277         &TransformKohaToMarcOneField( $sth, $record, $_,
2278             $hash->{$_}, '' );
2279         }
2280     return $record;
2281 }
2282
2283 =head2 TransformKohaToMarcOneField
2284
2285 =over 4
2286
2287     $record = TransformKohaToMarcOneField( $sth, $record, $kohafieldname, $value, $frameworkcode );
2288
2289 =back
2290
2291 =cut
2292
2293 sub TransformKohaToMarcOneField {
2294     my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_;
2295     $frameworkcode='' unless $frameworkcode;
2296     my $tagfield;
2297     my $tagsubfield;
2298
2299     if ( !defined $sth ) {
2300         my $dbh = C4::Context->dbh;
2301         $sth = $dbh->prepare(
2302             "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?"
2303         );
2304     }
2305     $sth->execute( $frameworkcode, $kohafieldname );
2306     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
2307         my $tag = $record->field($tagfield);
2308         if ($tag) {
2309             $tag->update( $tagsubfield => $value );
2310             $record->delete_field($tag);
2311             $record->insert_fields_ordered($tag);
2312         }
2313         else {
2314             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
2315         }
2316     }
2317     return $record;
2318 }
2319
2320 =head2 TransformHtmlToXml
2321
2322 =over 4
2323
2324 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type )
2325
2326 $auth_type contains :
2327 - nothing : rebuild a biblio, un UNIMARC the encoding is in 100$a pos 26/27
2328 - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2329 - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2330
2331 =back
2332
2333 =cut
2334
2335 sub TransformHtmlToXml {
2336     my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2337     my $xml = MARC::File::XML::header('UTF-8');
2338     $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2339     MARC::File::XML->default_record_format($auth_type);
2340     # in UNIMARC, field 100 contains the encoding
2341     # check that there is one, otherwise the
2342     # MARC::Record->new_from_xml will fail (and Koha will die)
2343     my $unimarc_and_100_exist=0;
2344     $unimarc_and_100_exist=1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
2345     my $prevvalue;
2346     my $prevtag = -1;
2347     my $first   = 1;
2348     my $j       = -1;
2349     for ( my $i = 0 ; $i <= @$tags ; $i++ ) {
2350         if (C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a") {
2351             # if we have a 100 field and it's values are not correct, skip them.
2352             # if we don't have any valid 100 field, we will create a default one at the end
2353             my $enc = substr( @$values[$i], 26, 2 );
2354             if ($enc eq '01' or $enc eq '50' or $enc eq '03') {
2355                 $unimarc_and_100_exist=1;
2356             } else {
2357                 next;
2358             }
2359         }
2360         @$values[$i] =~ s/&/&amp;/g;
2361         @$values[$i] =~ s/</&lt;/g;
2362         @$values[$i] =~ s/>/&gt;/g;
2363         @$values[$i] =~ s/"/&quot;/g;
2364         @$values[$i] =~ s/'/&apos;/g;
2365 #         if ( !utf8::is_utf8( @$values[$i] ) ) {
2366 #             utf8::decode( @$values[$i] );
2367 #         }
2368         if ( ( @$tags[$i] ne $prevtag ) ) {
2369             $j++ unless ( @$tags[$i] eq "" );
2370             if ( !$first ) {
2371                 $xml .= "</datafield>\n";
2372                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
2373                     && ( @$values[$i] ne "" ) )
2374                 {
2375                     my $ind1 = substr( @$indicator[$j], 0, 1 );
2376                     my $ind2;
2377                     if ( @$indicator[$j] ) {
2378                         $ind2 = substr( @$indicator[$j], 1, 1 );
2379                     }
2380                     else {
2381                         warn "Indicator in @$tags[$i] is empty";
2382                         $ind2 = " ";
2383                     }
2384                     $xml .=
2385 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2386                     $xml .=
2387 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2388                     $first = 0;
2389                 }
2390                 else {
2391                     $first = 1;
2392                 }
2393             }
2394             else {
2395                 if ( @$values[$i] ne "" ) {
2396
2397                     # leader
2398                     if ( @$tags[$i] eq "000" ) {
2399                         $xml .= "<leader>@$values[$i]</leader>\n";
2400                         $first = 1;
2401
2402                         # rest of the fixed fields
2403                     }
2404                     elsif ( @$tags[$i] < 10 ) {
2405                         $xml .=
2406 "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2407                         $first = 1;
2408                     }
2409                     else {
2410                         my $ind1 = substr( @$indicator[$j], 0, 1 );
2411                         my $ind2 = substr( @$indicator[$j], 1, 1 );
2412                         $xml .=
2413 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2414                         $xml .=
2415 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2416                         $first = 0;
2417                     }
2418                 }
2419             }
2420         }
2421         else {    # @$tags[$i] eq $prevtag
2422             if ( @$values[$i] eq "" ) {
2423             }
2424             else {
2425                 if ($first) {
2426                     my $ind1 = substr( @$indicator[$j], 0, 1 );
2427                     my $ind2 = substr( @$indicator[$j], 1, 1 );
2428                     $xml .=
2429 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2430                     $first = 0;
2431                 }
2432                 $xml .=
2433 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2434             }
2435         }
2436         $prevtag = @$tags[$i];
2437     }
2438     if (C4::Context->preference('marcflavour') and !$unimarc_and_100_exist) {
2439 #     warn "SETTING 100 for $auth_type";
2440         use POSIX qw(strftime);
2441         my $string = strftime( "%Y%m%d", localtime(time) );
2442         # set 50 to position 26 is biblios, 13 if authorities
2443         my $pos=26;
2444         $pos=13 if $auth_type eq 'UNIMARCAUTH';
2445         $string = sprintf( "%-*s", 35, $string );
2446         substr( $string, $pos , 6, "50" );
2447         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2448         $xml .= "<subfield code=\"a\">$string</subfield>\n";
2449         $xml .= "</datafield>\n";
2450     }
2451     $xml .= MARC::File::XML::footer();
2452     return $xml;
2453 }
2454
2455 =head2 TransformHtmlToMarc
2456
2457     L<$record> = TransformHtmlToMarc(L<$params>,L<$cgi>)
2458     L<$params> is a ref to an array as below:
2459     {
2460         'tag_010_indicator_531951' ,
2461         'tag_010_code_a_531951_145735' ,
2462         'tag_010_subfield_a_531951_145735' ,
2463         'tag_200_indicator_873510' ,
2464         'tag_200_code_a_873510_673465' ,
2465         'tag_200_subfield_a_873510_673465' ,
2466         'tag_200_code_b_873510_704318' ,
2467         'tag_200_subfield_b_873510_704318' ,
2468         'tag_200_code_e_873510_280822' ,
2469         'tag_200_subfield_e_873510_280822' ,
2470         'tag_200_code_f_873510_110730' ,
2471         'tag_200_subfield_f_873510_110730' ,
2472     }
2473     L<$cgi> is the CGI object which containts the value.
2474     L<$record> is the MARC::Record object.
2475
2476 =cut
2477
2478 sub TransformHtmlToMarc {
2479     my $params = shift;
2480     my $cgi    = shift;
2481
2482     # creating a new record
2483     my $record  = MARC::Record->new();
2484     my $i=0;
2485     my @fields;
2486     while ($params->[$i]){ # browse all CGI params
2487         my $param = $params->[$i];
2488         my $newfield=0;
2489         # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2490         if ($param eq 'biblionumber') {
2491             my ( $biblionumbertagfield, $biblionumbertagsubfield ) =
2492                 &GetMarcFromKohaField( "biblio.biblionumber", '' );
2493             if ($biblionumbertagfield < 10) {
2494                 $newfield = MARC::Field->new(
2495                     $biblionumbertagfield,
2496                     $cgi->param($param),
2497                 );
2498             } else {
2499                 $newfield = MARC::Field->new(
2500                     $biblionumbertagfield,
2501                     '',
2502                     '',
2503                     "$biblionumbertagsubfield" => $cgi->param($param),
2504                 );
2505             }
2506             push @fields,$newfield if($newfield);
2507         }
2508         elsif ($param =~ /^tag_(\d*)_indicator_/){ # new field start when having 'input name="..._indicator_..."
2509             my $tag  = $1;
2510
2511             my $ind1 = substr($cgi->param($param),0,1);
2512             my $ind2 = substr($cgi->param($param),1,1);
2513             $newfield=0;
2514             my $j=$i+1;
2515
2516             if($tag < 10){ # no code for theses fields
2517     # in MARC editor, 000 contains the leader.
2518                 if ($tag eq '000' ) {
2519                     $record->leader($cgi->param($params->[$j+1])) if length($cgi->param($params->[$j+1]))==24;
2520     # between 001 and 009 (included)
2521                 } else {
2522                     $newfield = MARC::Field->new(
2523                         $tag,
2524                         $cgi->param($params->[$j+1]),
2525                     );
2526                 }
2527     # > 009, deal with subfields
2528             } else {
2529                 while($params->[$j] =~ /_code_/){ # browse all it's subfield
2530                     my $inner_param = $params->[$j];
2531                     if ($newfield){
2532                         if($cgi->param($params->[$j+1])){  # only if there is a value (code => value)
2533                             $newfield->add_subfields(
2534                                 $cgi->param($inner_param) => $cgi->param($params->[$j+1])
2535                             );
2536                         }
2537                     } else {
2538                         if ( $cgi->param($params->[$j+1]) ) { # creating only if there is a value (code => value)
2539                             $newfield = MARC::Field->new(
2540                                 $tag,
2541                                 ''.$ind1,
2542                                 ''.$ind2,
2543                                 $cgi->param($inner_param) => $cgi->param($params->[$j+1]),
2544                             );
2545                         }
2546                     }
2547                     $j+=2;
2548                 }
2549             }
2550             push @fields,$newfield if($newfield);
2551         }
2552         $i++;
2553     }
2554
2555     $record->append_fields(@fields);
2556     return $record;
2557 }
2558
2559 =head2 TransformMarcToKoha
2560
2561 =over 4
2562
2563     $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
2564
2565 =back
2566
2567 =cut
2568
2569 sub TransformMarcToKoha {
2570     my ( $dbh, $record, $frameworkcode, $table ) = @_;
2571
2572     my $result;
2573
2574     # sometimes we only want to return the items data
2575     if ($table eq 'items') {
2576         my $sth = $dbh->prepare("SHOW COLUMNS FROM items");
2577         $sth->execute();
2578         while ( (my $field) = $sth->fetchrow ) {
2579             my $value = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2580             my $key = _disambiguate($table, $field);
2581             if ($result->{$key}) {
2582                 $result->{$key} .= " | " . $value;
2583             } else {
2584                 $result->{$key} = $value;
2585             }
2586         }
2587         return $result;
2588     } else {
2589         my @tables = ('biblio','biblioitems','items');
2590         foreach my $table (@tables){
2591             my $sth2 = $dbh->prepare("SHOW COLUMNS from $table");
2592             $sth2->execute;
2593             while (my ($field) = $sth2->fetchrow){
2594                 # FIXME use of _disambiguate is a temporary hack
2595                 # $result->{_disambiguate($table, $field)} = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2596                 my $value = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2597                 my $key = _disambiguate($table, $field);
2598                 if ($result->{$key}) {
2599                     # FIXME - hack to not bring in duplicates of the same value
2600                     unless (($key eq "biblionumber" or $key eq "biblioitemnumber") and ($value eq "")) {
2601                         $result->{$key} .= " | " . $value;
2602                     }
2603                 } else {
2604                     $result->{$key} = $value;
2605                 }
2606             }
2607             $sth2->finish();
2608         }
2609         # modify copyrightdate to keep only the 1st year found
2610         my $temp = $result->{'copyrightdate'};
2611         $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2612         if ( $1 > 0 ) {
2613             $result->{'copyrightdate'} = $1;
2614         }
2615         else {                      # if no cYYYY, get the 1st date.
2616             $temp =~ m/(\d\d\d\d)/;
2617             $result->{'copyrightdate'} = $1;
2618         }
2619
2620         # modify publicationyear to keep only the 1st year found
2621         $temp = $result->{'publicationyear'};
2622         $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2623         if ( $1 > 0 ) {
2624             $result->{'publicationyear'} = $1;
2625         }
2626         else {                      # if no cYYYY, get the 1st date.
2627             $temp =~ m/(\d\d\d\d)/;
2628             $result->{'publicationyear'} = $1;
2629         }
2630         return $result;
2631     }
2632 }
2633
2634
2635 # cache inverted MARC field map
2636 our $inverted_field_map;
2637
2638 =head2 FasterTransformMarcToKoha
2639
2640 =over 4
2641
2642     $result = FasterTransformMarcToKoha( $dbh, $record, $frameworkcode )
2643
2644 =back
2645
2646 Extract data from a MARC bib record into a hashref representing
2647 Koha biblio, biblioitems, and items fields.  This function will
2648 replace TransformMarcToKoha once it has been tested.
2649
2650 =cut
2651 sub FasterTransformMarcToKoha {
2652     my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
2653
2654     my $result;
2655
2656     unless (defined $inverted_field_map) {
2657         $inverted_field_map = _get_inverted_marc_field_map();
2658     }
2659
2660     my %tables = ();
2661     if ($limit_table eq 'items') {
2662         $tables{'items'} = 1;
2663     } else {
2664         $tables{'items'} = 1;
2665         $tables{'biblio'} = 1;
2666         $tables{'biblioitems'} = 1;
2667     }
2668
2669     # traverse through record
2670     MARCFIELD: foreach my $field ($record->fields()) {
2671         my $tag = $field->tag();
2672         next MARCFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag};
2673         if ($field->is_control_field()) {
2674             my $kohafields = $inverted_field_map->{$frameworkcode}->{$tag}->{list};
2675             ENTRY: foreach my $entry (@{ $kohafields }) {
2676                 my ($subfield, $table, $column) = @{ $entry };
2677                 next ENTRY unless exists $tables{$table};
2678                 my $key = _disambiguate($table, $column);
2679                 if ($result->{$key}) {
2680                     unless (($key eq "biblionumber" or $key eq "biblioitemnumber") and ($field->data() eq "")) {
2681                         $result->{$key} .= " | " . $field->data();
2682                     }
2683                 } else {
2684                     $result->{$key} = $field->data();
2685                 }
2686             }
2687         } else {
2688             # deal with subfields
2689             MARCSUBFIELD: foreach my $sf ($field->subfields()) {
2690                 my $code = $sf->[0];
2691                 next MARCSUBFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code};
2692                 my $value = $sf->[1];
2693                 SFENTRY: foreach my $entry (@{ $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code} }) {
2694                     my ($table, $column) = @{ $entry };
2695                     next SFENTRY unless exists $tables{$table};
2696                     my $key = _disambiguate($table, $column);
2697                     if ($result->{$key}) {
2698                         unless (($key eq "biblionumber" or $key eq "biblioitemnumber") and ($value eq "")) {
2699                             $result->{$key} .= " | " . $value;
2700                         }
2701                     } else {
2702                         $result->{$key} = $value;
2703                     }
2704                 }
2705             }
2706         }
2707     }
2708
2709     # modify copyrightdate to keep only the 1st year found
2710     my $temp = $result->{'copyrightdate'};
2711     $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2712     if ( $1 > 0 ) {
2713         $result->{'copyrightdate'} = $1;
2714     }
2715     else {                      # if no cYYYY, get the 1st date.
2716         $temp =~ m/(\d\d\d\d)/;
2717         $result->{'copyrightdate'} = $1;
2718     }
2719
2720     # modify publicationyear to keep only the 1st year found
2721     $temp = $result->{'publicationyear'};
2722     $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2723     if ( $1 > 0 ) {
2724         $result->{'publicationyear'} = $1;
2725     }
2726     else {                      # if no cYYYY, get the 1st date.
2727         $temp =~ m/(\d\d\d\d)/;
2728         $result->{'publicationyear'} = $1;
2729     }
2730     return $result;
2731 }
2732
2733 sub _get_inverted_marc_field_map {
2734     my $relations = C4::Context->marcfromkohafield;
2735
2736     my $field_map = {};
2737     my $relations = C4::Context->marcfromkohafield;
2738
2739     foreach my $frameworkcode (keys %{ $relations }) {
2740         foreach my $kohafield (keys %{ $relations->{$frameworkcode} }) {
2741             my $tag = $relations->{$frameworkcode}->{$kohafield}->[0];
2742             my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1];
2743             my ($table, $column) = split /[.]/, $kohafield, 2;
2744             push @{ $field_map->{$frameworkcode}->{$tag}->{list} }, [ $subfield, $table, $column ];
2745             push @{ $field_map->{$frameworkcode}->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2746         }
2747     }
2748     return $field_map;
2749 }
2750
2751 =head2 _disambiguate
2752
2753 =over 4
2754
2755 $newkey = _disambiguate($table, $field);
2756
2757 This is a temporary hack to distinguish between the
2758 following sets of columns when using TransformMarcToKoha.
2759
2760 items.cn_source & biblioitems.cn_source
2761 items.cn_sort & biblioitems.cn_sort
2762
2763 Columns that are currently NOT distinguished (FIXME
2764 due to lack of time to fully test) are:
2765
2766 biblio.notes and biblioitems.notes
2767 biblionumber
2768 timestamp
2769 biblioitemnumber
2770
2771 FIXME - this is necessary because prefixing each column
2772 name with the table name would require changing lots
2773 of code and templates, and exposing more of the DB
2774 structure than is good to the UI templates, particularly
2775 since biblio and bibloitems may well merge in a future
2776 version.  In the future, it would also be good to
2777 separate DB access and UI presentation field names
2778 more.
2779
2780 =back
2781
2782 =cut
2783
2784 sub _disambiguate {
2785     my ($table, $column) = @_;
2786     if ($column eq "cn_sort" or $column eq "cn_source") {
2787         return $table . '.' . $column;
2788     } else {
2789         return $column;
2790     }
2791
2792 }
2793
2794 =head2 get_koha_field_from_marc
2795
2796 =over 4
2797
2798 $result->{_disambiguate($table, $field)} = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2799
2800 Internal function to map data from the MARC record to a specific non-MARC field.
2801 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2802
2803 =back
2804
2805 =cut
2806
2807 sub get_koha_field_from_marc {
2808     my ($koha_table,$koha_column,$record,$frameworkcode) = @_;
2809     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table.'.'.$koha_column, $frameworkcode );
2810     my $kohafield;
2811     foreach my $field ( $record->field($tagfield) ) {
2812         if ( $field->tag() < 10 ) {
2813             if ( $kohafield ) {
2814                 $kohafield .= " | " . $field->data();
2815             }
2816             else {
2817                 $kohafield = $field->data();
2818             }
2819         }
2820         else {
2821             if ( $field->subfields ) {
2822                 my @subfields = $field->subfields();
2823                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2824                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2825                         if ( $kohafield ) {
2826                             $kohafield .=
2827                               " | " . $subfields[$subfieldcount][1];
2828                         }
2829                         else {
2830                             $kohafield =
2831                               $subfields[$subfieldcount][1];
2832                         }
2833                     }
2834                 }
2835             }
2836         }
2837     }
2838     return $kohafield;
2839 }
2840
2841
2842 =head2 TransformMarcToKohaOneField
2843
2844 =over 4
2845
2846 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2847
2848 =back
2849
2850 =cut
2851
2852 sub TransformMarcToKohaOneField {
2853
2854     # FIXME ? if a field has a repeatable subfield that is used in old-db,
2855     # only the 1st will be retrieved...
2856     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2857     my $res = "";
2858     my ( $tagfield, $subfield ) =
2859       GetMarcFromKohaField( $kohatable . "." . $kohafield,
2860         $frameworkcode );
2861     foreach my $field ( $record->field($tagfield) ) {
2862         if ( $field->tag() < 10 ) {
2863             if ( $result->{$kohafield} ) {
2864                 $result->{$kohafield} .= " | " . $field->data();
2865             }
2866             else {
2867                 $result->{$kohafield} = $field->data();
2868             }
2869         }
2870         else {
2871             if ( $field->subfields ) {
2872                 my @subfields = $field->subfields();
2873                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2874                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2875                         if ( $result->{$kohafield} ) {
2876                             $result->{$kohafield} .=
2877                               " | " . $subfields[$subfieldcount][1];
2878                         }
2879                         else {
2880                             $result->{$kohafield} =
2881                               $subfields[$subfieldcount][1];
2882                         }
2883                     }
2884                 }
2885             }
2886         }
2887     }
2888     return $result;
2889 }
2890
2891 =head1  OTHER FUNCTIONS
2892
2893 =head2 char_decode
2894
2895 =over 4
2896
2897 my $string = char_decode( $string, $encoding );
2898
2899 converts ISO 5426 coded string to UTF-8
2900 sloppy code : should be improved in next issue
2901
2902 =back
2903
2904 =cut
2905
2906 sub char_decode {
2907     my ( $string, $encoding ) = @_;
2908     $_ = $string;
2909
2910     $encoding = C4::Context->preference("marcflavour") unless $encoding;
2911     if ( $encoding eq "UNIMARC" ) {
2912
2913         #         s/\xe1/Æ/gm;
2914         s/\xe2/Ğ/gm;
2915         s/\xe9/Ø/gm;
2916         s/\xec/ş/gm;
2917         s/\xf1/æ/gm;
2918         s/\xf3/ğ/gm;
2919         s/\xf9/ø/gm;
2920         s/\xfb/ß/gm;
2921         s/\xc1\x61/à/gm;
2922         s/\xc1\x65/è/gm;
2923         s/\xc1\x69/ì/gm;
2924         s/\xc1\x6f/ò/gm;
2925         s/\xc1\x75/ù/gm;
2926         s/\xc1\x41/À/gm;
2927         s/\xc1\x45/È/gm;
2928         s/\xc1\x49/Ì/gm;
2929         s/\xc1\x4f/Ò/gm;
2930         s/\xc1\x55/Ù/gm;
2931         s/\xc2\x41/Á/gm;
2932         s/\xc2\x45/É/gm;
2933         s/\xc2\x49/Í/gm;
2934         s/\xc2\x4f/Ó/gm;
2935         s/\xc2\x55/Ú/gm;
2936         s/\xc2\x59/İ/gm;
2937         s/\xc2\x61/á/gm;
2938         s/\xc2\x65/é/gm;
2939         s/\xc2\x69/í/gm;
2940         s/\xc2\x6f/ó/gm;
2941         s/\xc2\x75/ú/gm;
2942         s/\xc2\x79/ı/gm;
2943         s/\xc3\x41/Â/gm;
2944         s/\xc3\x45/Ê/gm;
2945         s/\xc3\x49/Î/gm;
2946         s/\xc3\x4f/Ô/gm;
2947         s/\xc3\x55/Û/gm;
2948         s/\xc3\x61/â/gm;
2949         s/\xc3\x65/ê/gm;
2950         s/\xc3\x69/î/gm;
2951         s/\xc3\x6f/ô/gm;
2952         s/\xc3\x75/û/gm;
2953         s/\xc4\x41/Ã/gm;
2954         s/\xc4\x4e/Ñ/gm;
2955         s/\xc4\x4f/Õ/gm;
2956         s/\xc4\x61/ã/gm;
2957         s/\xc4\x6e/ñ/gm;
2958         s/\xc4\x6f/õ/gm;
2959         s/\xc8\x41/Ä/gm;
2960         s/\xc8\x45/Ë/gm;
2961         s/\xc8\x49/Ï/gm;
2962         s/\xc8\x61/ä/gm;
2963         s/\xc8\x65/ë/gm;
2964         s/\xc8\x69/ï/gm;
2965         s/\xc8\x6F/ö/gm;
2966         s/\xc8\x75/ü/gm;
2967         s/\xc8\x76/ÿ/gm;
2968         s/\xc9\x41/Ä/gm;
2969         s/\xc9\x45/Ë/gm;
2970         s/\xc9\x49/Ï/gm;
2971         s/\xc9\x4f/Ö/gm;
2972         s/\xc9\x55/Ü/gm;
2973         s/\xc9\x61/ä/gm;
2974         s/\xc9\x6f/ö/gm;
2975         s/\xc9\x75/ü/gm;
2976         s/\xca\x41/Å/gm;
2977         s/\xca\x61/å/gm;
2978         s/\xd0\x43/Ç/gm;
2979         s/\xd0\x63/ç/gm;
2980
2981         # this handles non-sorting blocks (if implementation requires this)
2982         $string = nsb_clean($_);
2983     }
2984     elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2985         ##MARC-8 to UTF-8
2986
2987         s/\xe1\x61/à/gm;
2988         s/\xe1\x65/è/gm;
2989         s/\xe1\x69/ì/gm;
2990         s/\xe1\x6f/ò/gm;
2991         s/\xe1\x75/ù/gm;
2992         s/\xe1\x41/À/gm;
2993         s/\xe1\x45/È/gm;
2994         s/\xe1\x49/Ì/gm;
2995         s/\xe1\x4f/Ò/gm;
2996         s/\xe1\x55/Ù/gm;
2997         s/\xe2\x41/Á/gm;
2998         s/\xe2\x45/É/gm;
2999         s/\xe2\x49/Í/gm;
3000         s/\xe2\x4f/Ó/gm;
3001         s/\xe2\x55/Ú/gm;
3002         s/\xe2\x59/İ/gm;
3003         s/\xe2\x61/á/gm;
3004         s/\xe2\x65/é/gm;
3005         s/\xe2\x69/í/gm;
3006         s/\xe2\x6f/ó/gm;
3007         s/\xe2\x75/ú/gm;
3008         s/\xe2\x79/ı/gm;
3009         s/\xe3\x41/Â/gm;
3010         s/\xe3\x45/Ê/gm;
3011         s/\xe3\x49/Î/gm;
3012         s/\xe3\x4f/Ô/gm;
3013         s/\xe3\x55/Û/gm;
3014         s/\xe3\x61/â/gm;
3015         s/\xe3\x65/ê/gm;
3016         s/\xe3\x69/î/gm;
3017         s/\xe3\x6f/ô/gm;
3018         s/\xe3\x75/û/gm;
3019         s/\xe4\x41/Ã/gm;
3020         s/\xe4\x4e/Ñ/gm;
3021         s/\xe4\x4f/Õ/gm;
3022         s/\xe4\x61/ã/gm;
3023         s/\xe4\x6e/ñ/gm;
3024         s/\xe4\x6f/õ/gm;
3025         s/\xe6\x41/Ă/gm;
3026         s/\xe6\x45/Ĕ/gm;
3027         s/\xe6\x65/ĕ/gm;
3028         s/\xe6\x61/ă/gm;
3029         s/\xe8\x45/Ë/gm;
3030         s/\xe8\x49/Ï/gm;
3031         s/\xe8\x65/ë/gm;
3032         s/\xe8\x69/ï/gm;
3033         s/\xe8\x76/ÿ/gm;
3034         s/\xe9\x41/A/gm;
3035         s/\xe9\x4f/O/gm;
3036         s/\xe9\x55/U/gm;
3037         s/\xe9\x61/a/gm;
3038         s/\xe9\x6f/o/gm;
3039         s/\xe9\x75/u/gm;
3040         s/\xea\x41/A/gm;
3041         s/\xea\x61/a/gm;
3042
3043         #Additional Turkish characters
3044         s/\x1b//gm;
3045         s/\x1e//gm;
3046         s/(\xf0)s/\xc5\x9f/gm;
3047         s/(\xf0)S/\xc5\x9e/gm;
3048         s/(\xf0)c/ç/gm;
3049         s/(\xf0)C/Ç/gm;
3050         s/\xe7\x49/\\xc4\xb0/gm;
3051         s/(\xe6)G/\xc4\x9e/gm;
3052         s/(\xe6)g/ğ\xc4\x9f/gm;
3053         s/\xB8/ı/gm;
3054         s/\xB9/£/gm;
3055         s/(\xe8|\xc8)o/ö/gm;
3056         s/(\xe8|\xc8)O/Ö/gm;
3057         s/(\xe8|\xc8)u/ü/gm;
3058         s/(\xe8|\xc8)U/Ü/gm;
3059         s/\xc2\xb8/\xc4\xb1/gm;
3060         s/¸/\xc4\xb1/gm;
3061
3062         # this handles non-sorting blocks (if implementation requires this)
3063         $string = nsb_clean($_);
3064     }
3065     return ($string);
3066 }
3067
3068 =head2 nsb_clean
3069
3070 =over 4
3071
3072 my $string = nsb_clean( $string, $encoding );
3073
3074 =back
3075
3076 =cut
3077
3078 sub nsb_clean {
3079     my $NSB      = '\x88';    # NSB : begin Non Sorting Block
3080     my $NSE      = '\x89';    # NSE : Non Sorting Block end
3081                               # handles non sorting blocks
3082     my ($string) = @_;
3083     $_ = $string;
3084     s/$NSB/(/gm;
3085     s/[ ]{0,1}$NSE/) /gm;
3086     $string = $_;
3087     return ($string);
3088 }
3089
3090 =head2 PrepareItemrecordDisplay
3091
3092 =over 4
3093
3094 PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber);
3095
3096 Returns a hash with all the fields for Display a given item data in a template
3097
3098 =back
3099
3100 =cut
3101
3102 sub PrepareItemrecordDisplay {
3103
3104     my ( $bibnum, $itemnum ) = @_;
3105
3106     my $dbh = C4::Context->dbh;
3107     my $frameworkcode = &GetFrameworkCode( $bibnum );
3108     my ( $itemtagfield, $itemtagsubfield ) =
3109       &GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
3110     my $tagslib = &GetMarcStructure( 1, $frameworkcode );
3111     my $itemrecord = GetMarcItem( $bibnum, $itemnum) if ($itemnum);
3112     my @loop_data;
3113     my $authorised_values_sth =
3114       $dbh->prepare(
3115 "SELECT authorised_value,lib FROM authorised_values WHERE category=? ORDER BY lib"
3116       );
3117     foreach my $tag ( sort keys %{$tagslib} ) {
3118         my $previous_tag = '';
3119         if ( $tag ne '' ) {
3120             # loop through each subfield
3121             my $cntsubf;
3122             foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3123                 next if ( subfield_is_koha_internal_p($subfield) );
3124                 next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
3125                 my %subfield_data;
3126                 $subfield_data{tag}           = $tag;
3127                 $subfield_data{subfield}      = $subfield;
3128                 $subfield_data{countsubfield} = $cntsubf++;
3129                 $subfield_data{kohafield}     =
3130                   $tagslib->{$tag}->{$subfield}->{'kohafield'};
3131
3132          #        $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
3133                 $subfield_data{marc_lib} =
3134                     "<span id=\"error\" title=\""
3135                   . $tagslib->{$tag}->{$subfield}->{lib} . "\">"
3136                   . substr( $tagslib->{$tag}->{$subfield}->{lib}, 0, 12 )
3137                   . "</span>";
3138                 $subfield_data{mandatory} =
3139                   $tagslib->{$tag}->{$subfield}->{mandatory};
3140                 $subfield_data{repeatable} =
3141                   $tagslib->{$tag}->{$subfield}->{repeatable};
3142                 $subfield_data{hidden} = "display:none"
3143                   if $tagslib->{$tag}->{$subfield}->{hidden};
3144                 my ( $x, $value );
3145                 ( $x, $value ) = _find_value( $tag, $subfield, $itemrecord )
3146                   if ($itemrecord);
3147                 $value =~ s/"/&quot;/g;
3148
3149                 # search for itemcallnumber if applicable
3150                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
3151                     'items.itemcallnumber'
3152                     && C4::Context->preference('itemcallnumber') )
3153                 {
3154                     my $CNtag =
3155                       substr( C4::Context->preference('itemcallnumber'), 0, 3 );
3156                     my $CNsubfield =
3157                       substr( C4::Context->preference('itemcallnumber'), 3, 1 );
3158                     my $temp = $itemrecord->field($CNtag) if ($itemrecord);
3159                     if ($temp) {
3160                         $value = $temp->subfield($CNsubfield);
3161                     }
3162                 }
3163                 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
3164                     my @authorised_values;
3165                     my %authorised_lib;
3166
3167                     # builds list, depending on authorised value...
3168                     #---- branch
3169                     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq
3170                         "branches" )
3171                     {
3172                         if ( ( C4::Context->preference("IndependantBranches") )
3173                             && ( C4::Context->userenv->{flags} != 1 ) )
3174                         {
3175                             my $sth =
3176                               $dbh->prepare(
3177                                 "SELECT branchcode,branchname FROM branches WHERE branchcode = ? ORDER BY branchname"
3178                               );
3179                             $sth->execute( C4::Context->userenv->{branch} );
3180                             push @authorised_values, ""
3181                               unless (
3182                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
3183                             while ( my ( $branchcode, $branchname ) =
3184                                 $sth->fetchrow_array )
3185                             {
3186                                 push @authorised_values, $branchcode;
3187                                 $authorised_lib{$branchcode} = $branchname;
3188                             }
3189                         }
3190                         else {
3191                             my $sth =
3192                               $dbh->prepare(
3193                                 "SELECT branchcode,branchname FROM branches ORDER BY branchname"
3194                               );
3195                             $sth->execute;
3196                             push @authorised_values, ""
3197                               unless (
3198                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
3199                             while ( my ( $branchcode, $branchname ) =
3200                                 $sth->fetchrow_array )
3201                             {
3202                                 push @authorised_values, $branchcode;
3203                                 $authorised_lib{$branchcode} = $branchname;
3204                             }
3205                         }
3206
3207                         #----- itemtypes
3208                     }
3209                     elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq
3210                         "itemtypes" )
3211                     {
3212                         my $sth =
3213                           $dbh->prepare(
3214                             "SELECT itemtype,description FROM itemtypes ORDER BY description"
3215                           );
3216                         $sth->execute;
3217                         push @authorised_values, ""
3218                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
3219                         while ( my ( $itemtype, $description ) =
3220                             $sth->fetchrow_array )
3221                         {
3222                             push @authorised_values, $itemtype;
3223                             $authorised_lib{$itemtype} = $description;
3224                         }
3225
3226                         #---- "true" authorised value
3227                     }
3228                     else {
3229                         $authorised_values_sth->execute(
3230                             $tagslib->{$tag}->{$subfield}->{authorised_value} );
3231                         push @authorised_values, ""
3232                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
3233                         while ( my ( $value, $lib ) =
3234                             $authorised_values_sth->fetchrow_array )
3235                         {
3236                             push @authorised_values, $value;
3237                             $authorised_lib{$value} = $lib;
3238                         }
3239                     }
3240                     $subfield_data{marc_value} = CGI::scrolling_list(
3241                         -name     => 'field_value',
3242                         -values   => \@authorised_values,
3243                         -default  => "$value",
3244                         -labels   => \%authorised_lib,
3245                         -size     => 1,
3246                         -tabindex => '',
3247                         -multiple => 0,
3248                     );
3249                 }
3250                 elsif ( $tagslib->{$tag}->{$subfield}->{thesaurus_category} ) {
3251                     $subfield_data{marc_value} =
3252 "<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>";
3253
3254 #"
3255 # COMMENTED OUT because No $i is provided with this API.
3256 # And thus, no value_builder can be activated.
3257 # BUT could be thought over.
3258 #         } elsif ($tagslib->{$tag}->{$subfield}->{'value_builder'}) {
3259 #             my $plugin="value_builder/".$tagslib->{$tag}->{$subfield}->{'value_builder'};
3260 #             require $plugin;
3261 #             my $extended_param = plugin_parameters($dbh,$itemrecord,$tagslib,$i,0);
3262 #             my ($function_name,$javascript) = plugin_javascript($dbh,$record,$tagslib,$i,0);
3263 #             $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";
3264                 }
3265                 else {
3266                     $subfield_data{marc_value} =
3267 "<input type=\"text\" name=\"field_value\" value=\"$value\" size=50 maxlength=255>";
3268                 }
3269                 push( @loop_data, \%subfield_data );
3270             }
3271         }
3272     }
3273     my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
3274       if ( $itemrecord && $itemrecord->field($itemtagfield) );
3275     return {
3276         'itemtagfield'    => $itemtagfield,
3277         'itemtagsubfield' => $itemtagsubfield,
3278         'itemnumber'      => $itemnumber,
3279         'iteminformation' => \@loop_data
3280     };
3281 }
3282 #"
3283
3284 #
3285 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
3286 # at the same time
3287 # replaced by a zebraqueue table, that is filled with ModZebra to run.
3288 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
3289 # =head2 ModZebrafiles
3290 #
3291 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
3292 #
3293 # =cut
3294 #
3295 # sub ModZebrafiles {
3296 #
3297 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
3298 #
3299 #     my $op;
3300 #     my $zebradir =
3301 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
3302 #     unless ( opendir( DIR, "$zebradir" ) ) {
3303 #         warn "$zebradir not found";
3304 #         return;
3305 #     }
3306 #     closedir DIR;
3307 #     my $filename = $zebradir . $biblionumber;
3308 #
3309 #     if ($record) {
3310 #         open( OUTPUT, ">", $filename . ".xml" );
3311 #         print OUTPUT $record;
3312 #         close OUTPUT;
3313 #     }
3314 # }
3315
3316 =head2 ModZebra
3317
3318 =over 4
3319
3320 ModZebra( $biblionumber, $op, $server, $newRecord );
3321
3322     $biblionumber is the biblionumber we want to index
3323     $op is specialUpdate or delete, and is used to know what we want to do
3324     $server is the server that we want to update
3325     $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.
3326
3327 =back
3328
3329 =cut
3330
3331 sub ModZebra {
3332 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
3333     my ( $biblionumber, $op, $server, $newRecord ) = @_;
3334     my $dbh=C4::Context->dbh;
3335
3336     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
3337     # at the same time
3338     # replaced by a zebraqueue table, that is filled with ModZebra to run.
3339     # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
3340
3341     if (C4::Context->preference("NoZebra")) {
3342         # lock the nozebra table : we will read index lines, update them in Perl process
3343         # and write everything in 1 transaction.
3344         # lock the table to avoid someone else overwriting what we are doing
3345         $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE');
3346         my %result; # the result hash that will be builded by deletion / add, and written on mySQL at the end, to improve speed
3347         my $record;
3348         if ($server eq 'biblioserver') {
3349             $record= GetMarcBiblio($biblionumber);
3350         } else {
3351             $record= C4::AuthoritiesMarc::GetAuthority($biblionumber);
3352         }
3353         if ($op eq 'specialUpdate') {
3354             # OK, we have to add or update the record
3355             # 1st delete (virtually, in indexes), if record actually exists
3356             if ($record) {
3357                 %result = _DelBiblioNoZebra($biblionumber,$record,$server);
3358             }
3359             # ... add the record
3360             %result=_AddBiblioNoZebra($biblionumber,$newRecord, $server, %result);
3361         } else {
3362             # it's a deletion, delete the record...
3363             # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
3364             %result=_DelBiblioNoZebra($biblionumber,$record,$server);
3365         }
3366         # ok, now update the database...
3367         my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
3368         foreach my $key (keys %result) {
3369             foreach my $index (keys %{$result{$key}}) {
3370                 $sth->execute($result{$key}->{$index}, $server, $key, $index);
3371             }
3372         }
3373         $dbh->do('UNLOCK TABLES');
3374
3375     } else {
3376         #
3377         # we use zebra, just fill zebraqueue table
3378         #
3379         my $sth=$dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
3380         $sth->execute($biblionumber,$server,$op);
3381         $sth->finish;
3382     }
3383 }
3384
3385 =head2 GetNoZebraIndexes
3386
3387     %indexes = GetNoZebraIndexes;
3388
3389     return the data from NoZebraIndexes syspref.
3390
3391 =cut
3392
3393 sub GetNoZebraIndexes {
3394     my $index = C4::Context->preference('NoZebraIndexes');
3395     my %indexes;
3396     foreach my $line (split /('|"),/,$index) {
3397         $line =~ /(.*)=>(.*)/;
3398 warn $line;
3399         my $index = substr($1,1); # get the index, don't forget to remove initial ' or "
3400         my $fields = $2;
3401         $index =~ s/'|"|\s//g;
3402
3403
3404         $fields =~ s/'|"|\s//g;
3405         $indexes{$index}=$fields;
3406     }
3407     return %indexes;
3408 }
3409
3410 =head1 INTERNAL FUNCTIONS
3411
3412 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
3413
3414     function to delete a biblio in NoZebra indexes
3415     This function does NOT delete anything in database : it reads all the indexes entries
3416     that have to be deleted & delete them in the hash
3417     The SQL part is done either :
3418     - after the Add if we are modifying a biblio (delete + add again)
3419     - immediatly after this sub if we are doing a true deletion.
3420     $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
3421
3422 =cut
3423
3424
3425 sub _DelBiblioNoZebra {
3426     my ($biblionumber, $record, $server)=@_;
3427
3428     # Get the indexes
3429     my $dbh = C4::Context->dbh;
3430     # Get the indexes
3431     my %index;
3432     my $title;
3433     if ($server eq 'biblioserver') {
3434         %index=GetNoZebraIndexes;
3435         # get title of the record (to store the 10 first letters with the index)
3436         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
3437         $title = lc($record->subfield($titletag,$titlesubfield));
3438     } else {
3439         # for authorities, the "title" is the $a mainentry
3440         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
3441         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
3442         $title = $record->subfield($authref->{auth_tag_to_report},'a');
3443         $index{'mainmainentry'}= $authref->{'auth_tag_to_report'}.'a';
3444         $index{'mainentry'}    = $authref->{'auth_tag_to_report'}.'*';
3445         $index{'auth_type'}    = '152b';
3446     }
3447
3448     my %result;
3449     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3450     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
3451     # limit to 10 char, should be enough, and limit the DB size
3452     $title = substr($title,0,10);
3453     #parse each field
3454     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3455     foreach my $field ($record->fields()) {
3456         #parse each subfield
3457         next if $field->tag <10;
3458         foreach my $subfield ($field->subfields()) {
3459             my $tag = $field->tag();
3460             my $subfieldcode = $subfield->[0];
3461             my $indexed=0;
3462             # check each index to see if the subfield is stored somewhere
3463             # otherwise, store it in __RAW__ index
3464             foreach my $key (keys %index) {
3465 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3466                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
3467                     $indexed=1;
3468                     my $line= lc $subfield->[1];
3469                     # remove meaningless value in the field...
3470                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3471                     # ... and split in words
3472                     foreach (split / /,$line) {
3473                         next unless $_; # skip  empty values (multiple spaces)
3474                         # if the entry is already here, do nothing, the biblionumber has already be removed
3475                         unless ($result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) {
3476                             # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
3477                             $sth2->execute($server,$key,$_);
3478                             my $existing_biblionumbers = $sth2->fetchrow;
3479                             # it exists
3480                             if ($existing_biblionumbers) {
3481 #                                 warn " existing for $key $_: $existing_biblionumbers";
3482                                 $result{$key}->{$_} =$existing_biblionumbers;
3483                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3484                             }
3485                         }
3486                     }
3487                 }
3488             }
3489             # the subfield is not indexed, store it in __RAW__ index anyway
3490             unless ($indexed) {
3491                 my $line= lc $subfield->[1];
3492                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3493                 # ... and split in words
3494                 foreach (split / /,$line) {
3495                     next unless $_; # skip  empty values (multiple spaces)
3496                     # if the entry is already here, do nothing, the biblionumber has already be removed
3497                     unless ($result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/) {
3498                         # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
3499                         $sth2->execute($server,'__RAW__',$_);
3500                         my $existing_biblionumbers = $sth2->fetchrow;
3501                         # it exists
3502                         if ($existing_biblionumbers) {
3503                             $result{'__RAW__'}->{$_} =$existing_biblionumbers;
3504                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3505                         }
3506                     }
3507                 }
3508             }
3509         }
3510     }
3511     return %result;
3512 }
3513
3514 =head2 _AddBiblioNoZebra($biblionumber, $record, $server, %result);
3515
3516     function to add a biblio in NoZebra indexes
3517
3518 =cut
3519
3520 sub _AddBiblioNoZebra {
3521     my ($biblionumber, $record, $server, %result)=@_;
3522     my $dbh = C4::Context->dbh;
3523     # Get the indexes
3524     my %index;
3525     my $title;
3526     if ($server eq 'biblioserver') {
3527         %index=GetNoZebraIndexes;
3528         # get title of the record (to store the 10 first letters with the index)
3529         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
3530         $title = lc($record->subfield($titletag,$titlesubfield));
3531     } else {
3532         # warn "server : $server";
3533         # for authorities, the "title" is the $a mainentry
3534         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
3535         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
3536         $title = $record->subfield($authref->{auth_tag_to_report},'a');
3537         $index{'mainmainentry'} = $authref->{auth_tag_to_report}.'a';
3538         $index{'mainentry'}     = $authref->{auth_tag_to_report}.'*';
3539         $index{'auth_type'}     = '152b';
3540     }
3541
3542     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3543     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
3544     # limit to 10 char, should be enough, and limit the DB size
3545     $title = substr($title,0,10);
3546     #parse each field
3547     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3548     foreach my $field ($record->fields()) {
3549         #parse each subfield
3550         next if $field->tag <10;
3551         foreach my $subfield ($field->subfields()) {
3552             my $tag = $field->tag();
3553             my $subfieldcode = $subfield->[0];
3554             my $indexed=0;
3555             # check each index to see if the subfield is stored somewhere
3556             # otherwise, store it in __RAW__ index
3557             foreach my $key (keys %index) {
3558 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3559                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
3560                     $indexed=1;
3561                     my $line= lc $subfield->[1];
3562                     # remove meaningless value in the field...
3563                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3564                     # ... and split in words
3565                     foreach (split / /,$line) {
3566                         next unless $_; # skip  empty values (multiple spaces)
3567                         # if the entry is already here, improve weight
3568 #                         warn "managing $_";
3569                         if ($result{$key}->{"$_"} =~ /$biblionumber,$title\-(\d);/) {
3570                             my $weight=$1+1;
3571                             $result{$key}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3572                             $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3573                         } else {
3574                             # get the value if it exist in the nozebra table, otherwise, create it
3575                             $sth2->execute($server,$key,$_);
3576                             my $existing_biblionumbers = $sth2->fetchrow;
3577                             # it exists
3578                             if ($existing_biblionumbers) {
3579                                 $result{$key}->{"$_"} =$existing_biblionumbers;
3580                                 my $weight=$1+1;
3581                                 $result{$key}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3582                                 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3583                             # create a new ligne for this entry
3584                             } else {
3585 #                             warn "INSERT : $server / $key / $_";
3586                                 $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).', indexname='.$dbh->quote($key).',value='.$dbh->quote($_));
3587                                 $result{$key}->{"$_"}.="$biblionumber,$title-1;";
3588                             }
3589                         }
3590                     }
3591                 }
3592             }
3593             # the subfield is not indexed, store it in __RAW__ index anyway
3594             unless ($indexed) {
3595                 my $line= lc $subfield->[1];
3596                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3597                 # ... and split in words
3598                 foreach (split / /,$line) {
3599                     next unless $_; # skip  empty values (multiple spaces)
3600                     # if the entry is already here, improve weight
3601                     if ($result{'__RAW__'}->{"$_"} =~ /$biblionumber,$title\-(\d);/) {
3602                         my $weight=$1+1;
3603                         $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3604                         $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3605                     } else {
3606                         # get the value if it exist in the nozebra table, otherwise, create it
3607                         $sth2->execute($server,'__RAW__',$_);
3608                         my $existing_biblionumbers = $sth2->fetchrow;
3609                         # it exists
3610                         if ($existing_biblionumbers) {
3611                             $result{'__RAW__'}->{"$_"} =$existing_biblionumbers;
3612                             my $weight=$1+1;
3613                             $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3614                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3615                         # create a new ligne for this entry
3616                         } else {
3617                             $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).',  indexname="__RAW__",value='.$dbh->quote($_));
3618                             $result{'__RAW__'}->{"$_"}.="$biblionumber,$title-1;";
3619                         }
3620                     }
3621                 }
3622             }
3623         }
3624     }
3625     return %result;
3626 }
3627
3628
3629 =head2 MARCitemchange
3630
3631 =over 4
3632
3633 &MARCitemchange( $record, $itemfield, $newvalue )
3634
3635 Function to update a single value in an item field.
3636 Used twice, could probably be replaced by something else, but works well...
3637
3638 =back
3639
3640 =back
3641
3642 =cut
3643
3644 sub MARCitemchange {
3645     my ( $record, $itemfield, $newvalue ) = @_;
3646     my $dbh = C4::Context->dbh;
3647
3648     my ( $tagfield, $tagsubfield ) =
3649       GetMarcFromKohaField( $itemfield, "" );
3650     if ( ($tagfield) && ($tagsubfield) ) {
3651         my $tag = $record->field($tagfield);
3652         if ($tag) {
3653             $tag->update( $tagsubfield => $newvalue );
3654             $record->delete_field($tag);
3655             $record->insert_fields_ordered($tag);
3656         }
3657     }
3658 }
3659 =head2 _find_value
3660
3661 =over 4
3662
3663 ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
3664
3665 Find the given $subfield in the given $tag in the given
3666 MARC::Record $record.  If the subfield is found, returns
3667 the (indicators, value) pair; otherwise, (undef, undef) is
3668 returned.
3669
3670 PROPOSITION :
3671 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
3672 I suggest we export it from this module.
3673
3674 =back
3675
3676 =cut
3677
3678 sub _find_value {
3679     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
3680     my @result;
3681     my $indicator;
3682     if ( $tagfield < 10 ) {
3683         if ( $record->field($tagfield) ) {
3684             push @result, $record->field($tagfield)->data();
3685         }
3686         else {
3687             push @result, "";
3688         }
3689     }
3690     else {
3691         foreach my $field ( $record->field($tagfield) ) {
3692             my @subfields = $field->subfields();
3693             foreach my $subfield (@subfields) {
3694                 if ( @$subfield[0] eq $insubfield ) {
3695                     push @result, @$subfield[1];
3696                     $indicator = $field->indicator(1) . $field->indicator(2);
3697                 }
3698             }
3699         }
3700     }
3701     return ( $indicator, @result );
3702 }
3703
3704 =head2 _koha_marc_update_bib_ids
3705
3706 =over 4
3707
3708 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
3709
3710 Internal function to add or update biblionumber and biblioitemnumber to
3711 the MARC XML.
3712
3713 =back
3714
3715 =cut
3716
3717 sub _koha_marc_update_bib_ids {
3718     my ($record, $frameworkcode, $biblionumber, $biblioitemnumber) = @_;
3719
3720     # we must add bibnum and bibitemnum in MARC::Record...
3721     # we build the new field with biblionumber and biblioitemnumber
3722     # we drop the original field
3723     # we add the new builded field.
3724     my ($biblio_tag, $biblio_subfield ) = GetMarcFromKohaField("biblio.biblionumber",$frameworkcode);
3725     my ($biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.biblioitemnumber",$frameworkcode);
3726
3727     if ($biblio_tag != $biblioitem_tag) {
3728         # biblionumber & biblioitemnumber are in different fields
3729
3730         # deal with biblionumber
3731         my ($new_field, $old_field);
3732         if ($biblio_tag < 10) {
3733             $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
3734         } else {
3735             $new_field =
3736               MARC::Field->new( $biblio_tag, '', '',
3737                 "$biblio_subfield" => $biblionumber );
3738         }
3739
3740         # drop old field and create new one...
3741         $old_field = $record->field($biblio_tag);
3742         $record->delete_field($old_field);
3743         $record->append_fields($new_field);
3744
3745         # deal with biblioitemnumber
3746         if ($biblioitem_tag < 10) {
3747             $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
3748         } else {
3749             $new_field =
3750               MARC::Field->new( $biblioitem_tag, '', '',
3751                 "$biblioitem_subfield" => $biblioitemnumber, );
3752         }
3753         # drop old field and create new one...
3754         $old_field = $record->field($biblioitem_tag);
3755         $record->delete_field($old_field);
3756         $record->insert_fields_ordered($new_field);
3757
3758     } else {
3759         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
3760         my $new_field = MARC::Field->new(
3761             $biblio_tag, '', '',
3762             "$biblio_subfield" => $biblionumber,
3763             "$biblioitem_subfield" => $biblioitemnumber
3764         );
3765
3766         # drop old field and create new one...
3767         my $old_field = $record->field($biblio_tag);
3768         $record->delete_field($old_field);
3769         $record->insert_fields_ordered($new_field);
3770     }
3771 }
3772
3773 =head2 _koha_add_biblio
3774
3775 =over 4
3776
3777 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3778
3779 Internal function to add a biblio ($biblio is a hash with the values)
3780
3781 =back
3782
3783 =cut
3784
3785 sub _koha_add_biblio {
3786     my ( $dbh, $biblio, $frameworkcode ) = @_;
3787
3788     my $error;
3789
3790     # set the series flag
3791     my $serial = 0;
3792     if ( $biblio->{'seriestitle'} ) { $serial = 1 };
3793
3794     my $query =
3795         "INSERT INTO biblio
3796         SET frameworkcode = ?,
3797             author = ?,
3798             title = ?,
3799             unititle =?,
3800             notes = ?,
3801             serial = ?,
3802             seriestitle = ?,
3803             copyrightdate = ?,
3804             datecreated=NOW(),
3805             abstract = ?
3806         ";
3807     my $sth = $dbh->prepare($query);
3808     $sth->execute(
3809         $frameworkcode,
3810         $biblio->{'author'},
3811         $biblio->{'title'},
3812         $biblio->{'unititle'},
3813         $biblio->{'notes'},
3814         $serial,
3815         $biblio->{'seriestitle'},
3816         $biblio->{'copyrightdate'},
3817         $biblio->{'abstract'}
3818     );
3819
3820     my $biblionumber = $dbh->{'mysql_insertid'};
3821     if ( $dbh->errstr ) {
3822         $error.="ERROR in _koha_add_biblio $query".$dbh->errstr;
3823         warn $error;
3824     }
3825
3826     $sth->finish();
3827     #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3828     return ($biblionumber,$error);
3829 }
3830
3831 =head2 _koha_modify_biblio
3832
3833 =over 4
3834
3835 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3836
3837 Internal function for updating the biblio table
3838
3839 =back
3840
3841 =cut
3842
3843 sub _koha_modify_biblio {
3844     my ( $dbh, $biblio, $frameworkcode ) = @_;
3845     my $error;
3846
3847     my $query = "
3848         UPDATE biblio
3849         SET    frameworkcode = ?,
3850                author = ?,
3851                title = ?,
3852                unititle = ?,
3853                notes = ?,
3854                serial = ?,
3855                seriestitle = ?,
3856                copyrightdate = ?,
3857                abstract = ?
3858         WHERE  biblionumber = ?
3859         "
3860     ;
3861     my $sth = $dbh->prepare($query);
3862
3863     $sth->execute(
3864         $frameworkcode,
3865         $biblio->{'author'},
3866         $biblio->{'title'},
3867         $biblio->{'unititle'},
3868         $biblio->{'notes'},
3869         $biblio->{'serial'},
3870         $biblio->{'seriestitle'},
3871         $biblio->{'copyrightdate'},
3872         $biblio->{'abstract'},
3873         $biblio->{'biblionumber'}
3874     ) if $biblio->{'biblionumber'};
3875
3876     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3877         $error.="ERROR in _koha_modify_biblio $query".$dbh->errstr;
3878         warn $error;
3879     }
3880     return ( $biblio->{'biblionumber'},$error );
3881 }
3882
3883 =head2 _koha_modify_biblioitem_nonmarc
3884
3885 =over 4
3886
3887 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3888
3889 Updates biblioitems row except for marc and marcxml, which should be changed
3890 via ModBiblioMarc
3891
3892 =back
3893
3894 =cut
3895
3896 sub _koha_modify_biblioitem_nonmarc {
3897     my ( $dbh, $biblioitem ) = @_;
3898     my $error;
3899
3900     # re-calculate the cn_sort, it may have changed
3901     my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3902
3903     my $query =
3904     "UPDATE biblioitems
3905     SET biblionumber    = ?,
3906         volume          = ?,
3907         number          = ?,
3908         itemtype        = ?,
3909         isbn            = ?,
3910         issn            = ?,
3911         publicationyear = ?,
3912         publishercode   = ?,
3913         volumedate      = ?,
3914         volumedesc      = ?,
3915         collectiontitle = ?,
3916         collectionissn  = ?,
3917         collectionvolume= ?,
3918         editionstatement= ?,
3919         editionresponsibility = ?,
3920         illus           = ?,
3921         pages           = ?,
3922         notes           = ?,
3923         size            = ?,
3924         place           = ?,
3925         lccn            = ?,
3926         url             = ?,
3927         cn_source       = ?,
3928         cn_class        = ?,
3929         cn_item         = ?,
3930         cn_suffix       = ?,
3931         cn_sort         = ?,
3932         totalissues     = ?
3933         where biblioitemnumber = ?
3934         ";
3935     my $sth = $dbh->prepare($query);
3936     $sth->execute(
3937         $biblioitem->{'biblionumber'},
3938         $biblioitem->{'volume'},
3939         $biblioitem->{'number'},
3940         $biblioitem->{'itemtype'},
3941         $biblioitem->{'isbn'},
3942         $biblioitem->{'issn'},
3943         $biblioitem->{'publicationyear'},
3944         $biblioitem->{'publishercode'},
3945         $biblioitem->{'volumedate'},
3946         $biblioitem->{'volumedesc'},
3947         $biblioitem->{'collectiontitle'},
3948         $biblioitem->{'collectionissn'},
3949         $biblioitem->{'collectionvolume'},
3950         $biblioitem->{'editionstatement'},
3951         $biblioitem->{'editionresponsibility'},
3952         $biblioitem->{'illus'},
3953         $biblioitem->{'pages'},
3954         $biblioitem->{'bnotes'},
3955         $biblioitem->{'size'},
3956         $biblioitem->{'place'},
3957         $biblioitem->{'lccn'},
3958         $biblioitem->{'url'},
3959         $biblioitem->{'biblioitems.cn_source'},
3960         $biblioitem->{'cn_class'},
3961         $biblioitem->{'cn_item'},
3962         $biblioitem->{'cn_suffix'},
3963         $cn_sort,
3964         $biblioitem->{'totalissues'},
3965         $biblioitem->{'biblioitemnumber'}
3966     );
3967     if ( $dbh->errstr ) {
3968         $error.="ERROR in _koha_modify_biblioitem_nonmarc $query".$dbh->errstr;
3969         warn $error;
3970     }
3971     return ($biblioitem->{'biblioitemnumber'},$error);
3972 }
3973
3974 =head2 _koha_add_biblioitem
3975
3976 =over 4
3977
3978 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3979
3980 Internal function to add a biblioitem
3981
3982 =back
3983
3984 =cut
3985
3986 sub _koha_add_biblioitem {
3987     my ( $dbh, $biblioitem ) = @_;
3988     my $error;
3989
3990     my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3991     my $query =
3992     "INSERT INTO biblioitems SET
3993         biblionumber    = ?,
3994         volume          = ?,
3995         number          = ?,
3996         itemtype        = ?,
3997         isbn            = ?,
3998         issn            = ?,
3999         publicationyear = ?,
4000         publishercode   = ?,
4001         volumedate      = ?,
4002         volumedesc      = ?,
4003         collectiontitle = ?,
4004         collectionissn  = ?,
4005         collectionvolume= ?,
4006         editionstatement= ?,
4007         editionresponsibility = ?,
4008         illus           = ?,
4009         pages           = ?,
4010         notes           = ?,
4011         size            = ?,
4012         place           = ?,
4013         lccn            = ?,
4014         marc            = ?,
4015         url             = ?,
4016         cn_source       = ?,
4017         cn_class        = ?,
4018         cn_item         = ?,
4019         cn_suffix       = ?,
4020         cn_sort         = ?,
4021         totalissues     = ?
4022         ";
4023     my $sth = $dbh->prepare($query);
4024     $sth->execute(
4025         $biblioitem->{'biblionumber'},
4026         $biblioitem->{'volume'},
4027         $biblioitem->{'number'},
4028         $biblioitem->{'itemtype'},
4029         $biblioitem->{'isbn'},
4030         $biblioitem->{'issn'},
4031         $biblioitem->{'publicationyear'},
4032         $biblioitem->{'publishercode'},
4033         $biblioitem->{'volumedate'},
4034         $biblioitem->{'volumedesc'},
4035         $biblioitem->{'collectiontitle'},
4036         $biblioitem->{'collectionissn'},
4037         $biblioitem->{'collectionvolume'},
4038         $biblioitem->{'editionstatement'},
4039         $biblioitem->{'editionresponsibility'},
4040         $biblioitem->{'illus'},
4041         $biblioitem->{'pages'},
4042         $biblioitem->{'bnotes'},
4043         $biblioitem->{'size'},
4044         $biblioitem->{'place'},
4045         $biblioitem->{'lccn'},
4046         $biblioitem->{'marc'},
4047         $biblioitem->{'url'},
4048         $biblioitem->{'biblioitems.cn_source'},
4049         $biblioitem->{'cn_class'},
4050         $biblioitem->{'cn_item'},
4051         $biblioitem->{'cn_suffix'},
4052         $cn_sort,
4053         $biblioitem->{'totalissues'}
4054     );
4055     my $bibitemnum = $dbh->{'mysql_insertid'};
4056     if ( $dbh->errstr ) {
4057         $error.="ERROR in _koha_add_biblioitem $query".$dbh->errstr;
4058         warn $error;
4059     }
4060     $sth->finish();
4061     return ($bibitemnum,$error);
4062 }
4063
4064 =head2 _koha_new_items
4065
4066 =over 4
4067
4068 my ($itemnumber,$error) = _koha_new_items( $dbh, $item, $barcode );
4069
4070 =back
4071
4072 =cut
4073
4074 sub _koha_new_items {
4075     my ( $dbh, $item, $barcode ) = @_;
4076     my $error;
4077
4078     my ($items_cn_sort) = GetClassSort($item->{'items.cn_source'}, $item->{'itemcallnumber'}, "");
4079
4080     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
4081     if ( $item->{'dateaccessioned'} eq '' || !$item->{'dateaccessioned'} ) {
4082         my $today = C4::Dates->new();
4083         $item->{'dateaccessioned'} =  $today->output("iso"); #TODO: check time issues
4084     }
4085     my $query =
4086            "INSERT INTO items SET
4087             biblionumber        = ?,
4088             biblioitemnumber    = ?,
4089             barcode             = ?,
4090             dateaccessioned     = ?,
4091             booksellerid        = ?,
4092             homebranch          = ?,
4093             price               = ?,
4094             replacementprice    = ?,
4095             replacementpricedate = NOW(),
4096             datelastborrowed    = ?,
4097             datelastseen        = NOW(),
4098             stack               = ?,
4099             notforloan          = ?,
4100             damaged             = ?,
4101             itemlost            = ?,
4102             wthdrawn            = ?,
4103             itemcallnumber      = ?,
4104             restricted          = ?,
4105             itemnotes           = ?,
4106             holdingbranch       = ?,
4107             paidfor             = ?,
4108             location            = ?,
4109             onloan              = ?,
4110             issues              = ?,
4111             renewals            = ?,
4112             reserves            = ?,
4113             cn_source           = ?,
4114             cn_sort             = ?,
4115             ccode               = ?,
4116             itype               = ?,
4117             materials           = ?,
4118             uri                 = ?
4119           ";
4120     my $sth = $dbh->prepare($query);
4121     $sth->execute(
4122             $item->{'biblionumber'},
4123             $item->{'biblioitemnumber'},
4124             $barcode,
4125             $item->{'dateaccessioned'},
4126             $item->{'booksellerid'},
4127             $item->{'homebranch'},
4128             $item->{'price'},
4129             $item->{'replacementprice'},
4130             $item->{datelastborrowed},
4131             $item->{stack},
4132             $item->{'notforloan'},
4133             $item->{'damaged'},
4134             $item->{'itemlost'},
4135             $item->{'wthdrawn'},
4136             $item->{'itemcallnumber'},
4137             $item->{'restricted'},
4138             $item->{'itemnotes'},
4139             $item->{'holdingbranch'},
4140             $item->{'paidfor'},
4141             $item->{'location'},
4142             $item->{'onloan'},
4143             $item->{'issues'},
4144             $item->{'renewals'},
4145             $item->{'reserves'},
4146             $item->{'items.cn_source'},
4147             $items_cn_sort,
4148             $item->{'ccode'},
4149             $item->{'itype'},
4150             $item->{'materials'},
4151             $item->{'uri'},
4152     );
4153     my $itemnumber = $dbh->{'mysql_insertid'};
4154     if ( defined $sth->errstr ) {
4155         $error.="ERROR in _koha_new_items $query".$sth->errstr;
4156     }
4157     $sth->finish();
4158     return ( $itemnumber, $error );
4159 }
4160
4161 =head2 _koha_modify_item
4162
4163 =over 4
4164
4165 my ($itemnumber,$error) =_koha_modify_item( $dbh, $item, $op );
4166
4167 =back
4168
4169 =cut
4170
4171 sub _koha_modify_item {
4172     my ( $dbh, $item ) = @_;
4173     my $error;
4174
4175     # calculate items.cn_sort
4176     if($item->{'itemcallnumber'}) {
4177         # This works, even when user is setting the call number blank (in which case
4178         # how would we get here to calculate new (blank) of items.cn_sort?).
4179         #
4180         # Why?  Because at present the only way to update itemcallnumber is via
4181         # additem.pl; since it uses a MARC data-entry form, TransformMarcToKoha
4182         # already has created $item->{'items.cn_sort'} and set it to undef because the
4183         # subfield for items.cn_sort in the framework is specified as ignored, meaning
4184         # that it is not supplied or passed to the form.  Thus, if the user has
4185         # blanked itemcallnumber, there is already a undef value for $item->{'items.cn_sort'}.
4186         #
4187         # This is subtle; it is also fragile.
4188         $item->{'items.cn_sort'} = GetClassSort($item->{'items.cn_source'}, $item->{'itemcallnumber'}, "");
4189     }
4190     my $query = "UPDATE items SET ";
4191     my @bind;
4192     for my $key ( keys %$item ) {
4193         $query.="$key=?,";
4194         push @bind, $item->{$key};
4195     }
4196     $query =~ s/,$//;
4197     $query .= " WHERE itemnumber=?";
4198     push @bind, $item->{'itemnumber'};
4199     my $sth = $dbh->prepare($query);
4200     $sth->execute(@bind);
4201     if ( $dbh->errstr ) {
4202         $error.="ERROR in _koha_modify_item $query".$dbh->errstr;
4203         warn $error;
4204     }
4205     $sth->finish();
4206     return ($item->{'itemnumber'},$error);
4207 }
4208
4209 =head2 _koha_delete_biblio
4210
4211 =over 4
4212
4213 $error = _koha_delete_biblio($dbh,$biblionumber);
4214
4215 Internal sub for deleting from biblio table -- also saves to deletedbiblio
4216
4217 C<$dbh> - the database handle
4218 C<$biblionumber> - the biblionumber of the biblio to be deleted
4219
4220 =back
4221
4222 =cut
4223
4224 # FIXME: add error handling
4225
4226 sub _koha_delete_biblio {
4227     my ( $dbh, $biblionumber ) = @_;
4228
4229     # get all the data for this biblio
4230     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
4231     $sth->execute($biblionumber);
4232
4233     if ( my $data = $sth->fetchrow_hashref ) {
4234
4235         # save the record in deletedbiblio
4236         # find the fields to save
4237         my $query = "INSERT INTO deletedbiblio SET ";
4238         my @bind  = ();
4239         foreach my $temp ( keys %$data ) {
4240             $query .= "$temp = ?,";
4241             push( @bind, $data->{$temp} );
4242         }
4243
4244         # replace the last , by ",?)"
4245         $query =~ s/\,$//;
4246         my $bkup_sth = $dbh->prepare($query);
4247         $bkup_sth->execute(@bind);
4248         $bkup_sth->finish;
4249
4250         # delete the biblio
4251         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
4252         $del_sth->execute($biblionumber);
4253         $del_sth->finish;
4254     }
4255     $sth->finish;
4256     return undef;
4257 }
4258
4259 =head2 _koha_delete_biblioitems
4260
4261 =over 4
4262
4263 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
4264
4265 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
4266
4267 C<$dbh> - the database handle
4268 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
4269
4270 =back
4271
4272 =cut
4273
4274 # FIXME: add error handling
4275
4276 sub _koha_delete_biblioitems {
4277     my ( $dbh, $biblioitemnumber ) = @_;
4278
4279     # get all the data for this biblioitem
4280     my $sth =
4281       $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
4282     $sth->execute($biblioitemnumber);
4283
4284     if ( my $data = $sth->fetchrow_hashref ) {
4285
4286         # save the record in deletedbiblioitems
4287         # find the fields to save
4288         my $query = "INSERT INTO deletedbiblioitems SET ";
4289         my @bind  = ();
4290         foreach my $temp ( keys %$data ) {
4291             $query .= "$temp = ?,";
4292             push( @bind, $data->{$temp} );
4293         }
4294
4295         # replace the last , by ",?)"
4296         $query =~ s/\,$//;
4297         my $bkup_sth = $dbh->prepare($query);
4298         $bkup_sth->execute(@bind);
4299         $bkup_sth->finish;
4300
4301         # delete the biblioitem
4302         my $del_sth =
4303           $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
4304         $del_sth->execute($biblioitemnumber);
4305         $del_sth->finish;
4306     }
4307     $sth->finish;
4308     return undef;
4309 }
4310
4311 =head2 _koha_delete_item
4312
4313 =over 4
4314
4315 _koha_delete_item( $dbh, $itemnum );
4316
4317 Internal function to delete an item record from the koha tables
4318
4319 =back
4320
4321 =cut
4322
4323 sub _koha_delete_item {
4324     my ( $dbh, $itemnum ) = @_;
4325
4326     # save the deleted item to deleteditems table
4327     my $sth = $dbh->prepare("SELECT * FROM items WHERE itemnumber=?");
4328     $sth->execute($itemnum);
4329     my $data = $sth->fetchrow_hashref();
4330     $sth->finish();
4331     my $query = "INSERT INTO deleteditems SET ";
4332     my @bind  = ();
4333     foreach my $key ( keys %$data ) {
4334         $query .= "$key = ?,";
4335         push( @bind, $data->{$key} );
4336     }
4337     $query =~ s/\,$//;
4338     $sth = $dbh->prepare($query);
4339     $sth->execute(@bind);
4340     $sth->finish();
4341
4342     # delete from items table
4343     $sth = $dbh->prepare("DELETE FROM items WHERE itemnumber=?");
4344     $sth->execute($itemnum);
4345     $sth->finish();
4346     return undef;
4347 }
4348
4349 =head1 UNEXPORTED FUNCTIONS
4350
4351 =head2 ModBiblioMarc
4352
4353     &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
4354
4355     Add MARC data for a biblio to koha
4356
4357     Function exported, but should NOT be used, unless you really know what you're doing
4358
4359 =cut
4360
4361 sub ModBiblioMarc {
4362
4363 # pass the MARC::Record to this function, and it will create the records in the marc field
4364     my ( $record, $biblionumber, $frameworkcode ) = @_;
4365     my $dbh = C4::Context->dbh;
4366     my @fields = $record->fields();
4367     if ( !$frameworkcode ) {
4368         $frameworkcode = "";
4369     }
4370     my $sth =
4371       $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
4372     $sth->execute( $frameworkcode, $biblionumber );
4373     $sth->finish;
4374     my $encoding = C4::Context->preference("marcflavour");
4375
4376     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
4377     if ( $encoding eq "UNIMARC" ) {
4378         my $string;
4379         if ( length($record->subfield( 100, "a" )) == 35 ) {
4380             $string = $record->subfield( 100, "a" );
4381             my $f100 = $record->field(100);
4382             $record->delete_field($f100);
4383         }
4384         else {
4385             $string = POSIX::strftime( "%Y%m%d", localtime );
4386             $string =~ s/\-//g;
4387             $string = sprintf( "%-*s", 35, $string );
4388         }
4389         substr( $string, 22, 6, "frey50" );
4390         unless ( $record->subfield( 100, "a" ) ) {
4391             $record->insert_grouped_field(
4392                 MARC::Field->new( 100, "", "", "a" => $string ) );
4393         }
4394     }
4395     ModZebra($biblionumber,"specialUpdate","biblioserver",$record);
4396     $sth =
4397       $dbh->prepare(
4398         "UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
4399     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding),
4400         $biblionumber );
4401     $sth->finish;
4402     return $biblionumber;
4403 }
4404
4405 =head2 AddItemInMarc
4406
4407 =over 4
4408
4409 $newbiblionumber = AddItemInMarc( $record, $biblionumber, $frameworkcode );
4410
4411 Add an item in a MARC record and save the MARC record
4412
4413 Function exported, but should NOT be used, unless you really know what you're doing
4414
4415 =back
4416
4417 =cut
4418
4419 sub AddItemInMarc {
4420
4421     # pass the MARC::Record to this function, and it will create the records in the marc tables
4422     my ( $record, $biblionumber, $frameworkcode ) = @_;
4423     my $newrec = &GetMarcBiblio($biblionumber);
4424
4425     # create it
4426     my @fields = $record->fields();
4427     foreach my $field (@fields) {
4428         $newrec->append_fields($field);
4429     }
4430
4431     # FIXME: should we be making sure the biblionumbers are the same?
4432     my $newbiblionumber =
4433       &ModBiblioMarc( $newrec, $biblionumber, $frameworkcode );
4434     return $newbiblionumber;
4435 }
4436
4437 =head2 z3950_extended_services
4438
4439 z3950_extended_services($serviceType,$serviceOptions,$record);
4440
4441     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.
4442
4443 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
4444
4445 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
4446
4447     action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
4448
4449 and maybe
4450
4451     recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
4452     syntax => the record syntax (transfer syntax)
4453     databaseName = Database from connection object
4454
4455     To set serviceOptions, call set_service_options($serviceType)
4456
4457 C<$record> the record, if one is needed for the service type
4458
4459     A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
4460
4461 =cut
4462
4463 sub z3950_extended_services {
4464     my ( $server, $serviceType, $action, $serviceOptions ) = @_;
4465
4466     # get our connection object
4467     my $Zconn = C4::Context->Zconn( $server, 0, 1 );
4468
4469     # create a new package object
4470     my $Zpackage = $Zconn->package();
4471
4472     # set our options
4473     $Zpackage->option( action => $action );
4474
4475     if ( $serviceOptions->{'databaseName'} ) {
4476         $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
4477     }
4478     if ( $serviceOptions->{'recordIdNumber'} ) {
4479         $Zpackage->option(
4480             recordIdNumber => $serviceOptions->{'recordIdNumber'} );
4481     }
4482     if ( $serviceOptions->{'recordIdOpaque'} ) {
4483         $Zpackage->option(
4484             recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
4485     }
4486
4487  # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
4488  #if ($serviceType eq 'itemorder') {
4489  #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
4490  #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
4491  #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
4492  #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
4493  #}
4494
4495     if ( $serviceOptions->{record} ) {
4496         $Zpackage->option( record => $serviceOptions->{record} );
4497
4498         # can be xml or marc
4499         if ( $serviceOptions->{'syntax'} ) {
4500             $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
4501         }
4502     }
4503
4504     # send the request, handle any exception encountered
4505     eval { $Zpackage->send($serviceType) };
4506     if ( $@ && $@->isa("ZOOM::Exception") ) {
4507         return "error:  " . $@->code() . " " . $@->message() . "\n";
4508     }
4509
4510     # free up package resources
4511     $Zpackage->destroy();
4512 }
4513
4514 =head2 set_service_options
4515
4516 my $serviceOptions = set_service_options($serviceType);
4517
4518 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
4519
4520 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
4521
4522 =cut
4523
4524 sub set_service_options {
4525     my ($serviceType) = @_;
4526     my $serviceOptions;
4527
4528 # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
4529 #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
4530
4531     if ( $serviceType eq 'commit' ) {
4532
4533         # nothing to do
4534     }
4535     if ( $serviceType eq 'create' ) {
4536
4537         # nothing to do
4538     }
4539     if ( $serviceType eq 'drop' ) {
4540         die "ERROR: 'drop' not currently supported (by Zebra)";
4541     }
4542     return $serviceOptions;
4543 }
4544
4545 =head2 GetItemsCount
4546
4547 $count = &GetItemsCount( $biblionumber);
4548 this function return count of item with $biblionumber
4549 =cut
4550
4551 sub GetItemsCount {
4552     my ( $biblionumber ) = @_;
4553     my $dbh = C4::Context->dbh;
4554     my $query = "SELECT count(*)
4555           FROM  items
4556           WHERE biblionumber=?";
4557     my $sth = $dbh->prepare($query);
4558     $sth->execute($biblionumber);
4559     my $count = $sth->fetchrow;
4560     $sth->finish;
4561     return ($count);
4562 }
4563
4564 END { }    # module clean-up code here (global destructor)
4565
4566 1;
4567
4568 __END__
4569
4570 =head1 AUTHOR
4571
4572 Koha Developement team <info@koha.org>
4573
4574 Paul POULAIN paul.poulain@free.fr
4575
4576 Joshua Ferraro jmf@liblime.com
4577
4578 =cut