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