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