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