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 warn $line;
3462         my $index = substr($1,1); # get the index, don't forget to remove initial ' or "
3463         my $fields = $2;
3464         $index =~ s/'|"|\s//g;
3465
3466
3467         $fields =~ s/'|"|\s//g;
3468         $indexes{$index}=$fields;
3469     }
3470     return %indexes;
3471 }
3472
3473 =head1 INTERNAL FUNCTIONS
3474
3475 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
3476
3477     function to delete a biblio in NoZebra indexes
3478     This function does NOT delete anything in database : it reads all the indexes entries
3479     that have to be deleted & delete them in the hash
3480     The SQL part is done either :
3481     - after the Add if we are modifying a biblio (delete + add again)
3482     - immediatly after this sub if we are doing a true deletion.
3483     $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
3484
3485 =cut
3486
3487
3488 sub _DelBiblioNoZebra {
3489     my ($biblionumber, $record, $server)=@_;
3490
3491     # Get the indexes
3492     my $dbh = C4::Context->dbh;
3493     # Get the indexes
3494     my %index;
3495     my $title;
3496     if ($server eq 'biblioserver') {
3497         %index=GetNoZebraIndexes;
3498         # get title of the record (to store the 10 first letters with the index)
3499         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
3500         $title = lc($record->subfield($titletag,$titlesubfield));
3501     } else {
3502         # for authorities, the "title" is the $a mainentry
3503         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
3504         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
3505         $title = $record->subfield($authref->{auth_tag_to_report},'a');
3506         $index{'mainmainentry'}= $authref->{'auth_tag_to_report'}.'a';
3507         $index{'mainentry'}    = $authref->{'auth_tag_to_report'}.'*';
3508         $index{'auth_type'}    = '152b';
3509     }
3510
3511     my %result;
3512     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3513     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
3514     # limit to 10 char, should be enough, and limit the DB size
3515     $title = substr($title,0,10);
3516     #parse each field
3517     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3518     foreach my $field ($record->fields()) {
3519         #parse each subfield
3520         next if $field->tag <10;
3521         foreach my $subfield ($field->subfields()) {
3522             my $tag = $field->tag();
3523             my $subfieldcode = $subfield->[0];
3524             my $indexed=0;
3525             # check each index to see if the subfield is stored somewhere
3526             # otherwise, store it in __RAW__ index
3527             foreach my $key (keys %index) {
3528 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3529                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
3530                     $indexed=1;
3531                     my $line= lc $subfield->[1];
3532                     # remove meaningless value in the field...
3533                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3534                     # ... and split in words
3535                     foreach (split / /,$line) {
3536                         next unless $_; # skip  empty values (multiple spaces)
3537                         # if the entry is already here, do nothing, the biblionumber has already be removed
3538                         unless ($result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) {
3539                             # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
3540                             $sth2->execute($server,$key,$_);
3541                             my $existing_biblionumbers = $sth2->fetchrow;
3542                             # it exists
3543                             if ($existing_biblionumbers) {
3544 #                                 warn " existing for $key $_: $existing_biblionumbers";
3545                                 $result{$key}->{$_} =$existing_biblionumbers;
3546                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3547                             }
3548                         }
3549                     }
3550                 }
3551             }
3552             # the subfield is not indexed, store it in __RAW__ index anyway
3553             unless ($indexed) {
3554                 my $line= lc $subfield->[1];
3555                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3556                 # ... and split in words
3557                 foreach (split / /,$line) {
3558                     next unless $_; # skip  empty values (multiple spaces)
3559                     # if the entry is already here, do nothing, the biblionumber has already be removed
3560                     unless ($result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/) {
3561                         # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
3562                         $sth2->execute($server,'__RAW__',$_);
3563                         my $existing_biblionumbers = $sth2->fetchrow;
3564                         # it exists
3565                         if ($existing_biblionumbers) {
3566                             $result{'__RAW__'}->{$_} =$existing_biblionumbers;
3567                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3568                         }
3569                     }
3570                 }
3571             }
3572         }
3573     }
3574     return %result;
3575 }
3576
3577 =head2 _AddBiblioNoZebra($biblionumber, $record, $server, %result);
3578
3579     function to add a biblio in NoZebra indexes
3580
3581 =cut
3582
3583 sub _AddBiblioNoZebra {
3584     my ($biblionumber, $record, $server, %result)=@_;
3585     my $dbh = C4::Context->dbh;
3586     # Get the indexes
3587     my %index;
3588     my $title;
3589     if ($server eq 'biblioserver') {
3590         %index=GetNoZebraIndexes;
3591         # get title of the record (to store the 10 first letters with the index)
3592         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
3593         $title = lc($record->subfield($titletag,$titlesubfield));
3594     } else {
3595         # warn "server : $server";
3596         # for authorities, the "title" is the $a mainentry
3597         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
3598         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
3599         $title = $record->subfield($authref->{auth_tag_to_report},'a');
3600         $index{'mainmainentry'} = $authref->{auth_tag_to_report}.'a';
3601         $index{'mainentry'}     = $authref->{auth_tag_to_report}.'*';
3602         $index{'auth_type'}     = '152b';
3603     }
3604
3605     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3606     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
3607     # limit to 10 char, should be enough, and limit the DB size
3608     $title = substr($title,0,10);
3609     #parse each field
3610     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3611     foreach my $field ($record->fields()) {
3612         #parse each subfield
3613         next if $field->tag <10;
3614         foreach my $subfield ($field->subfields()) {
3615             my $tag = $field->tag();
3616             my $subfieldcode = $subfield->[0];
3617             my $indexed=0;
3618             # check each index to see if the subfield is stored somewhere
3619             # otherwise, store it in __RAW__ index
3620             foreach my $key (keys %index) {
3621 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3622                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
3623                     $indexed=1;
3624                     my $line= lc $subfield->[1];
3625                     # remove meaningless value in the field...
3626                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3627                     # ... and split in words
3628                     foreach (split / /,$line) {
3629                         next unless $_; # skip  empty values (multiple spaces)
3630                         # if the entry is already here, improve weight
3631 #                         warn "managing $_";
3632                         if ($result{$key}->{"$_"} =~ /$biblionumber,$title\-(\d);/) {
3633                             my $weight=$1+1;
3634                             $result{$key}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3635                             $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3636                         } else {
3637                             # get the value if it exist in the nozebra table, otherwise, create it
3638                             $sth2->execute($server,$key,$_);
3639                             my $existing_biblionumbers = $sth2->fetchrow;
3640                             # it exists
3641                             if ($existing_biblionumbers) {
3642                                 $result{$key}->{"$_"} =$existing_biblionumbers;
3643                                 my $weight=$1+1;
3644                                 $result{$key}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3645                                 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3646                             # create a new ligne for this entry
3647                             } else {
3648 #                             warn "INSERT : $server / $key / $_";
3649                                 $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).', indexname='.$dbh->quote($key).',value='.$dbh->quote($_));
3650                                 $result{$key}->{"$_"}.="$biblionumber,$title-1;";
3651                             }
3652                         }
3653                     }
3654                 }
3655             }
3656             # the subfield is not indexed, store it in __RAW__ index anyway
3657             unless ($indexed) {
3658                 my $line= lc $subfield->[1];
3659                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3660                 # ... and split in words
3661                 foreach (split / /,$line) {
3662                     next unless $_; # skip  empty values (multiple spaces)
3663                     # if the entry is already here, improve weight
3664                     if ($result{'__RAW__'}->{"$_"} =~ /$biblionumber,$title\-(\d);/) {
3665                         my $weight=$1+1;
3666                         $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3667                         $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3668                     } else {
3669                         # get the value if it exist in the nozebra table, otherwise, create it
3670                         $sth2->execute($server,'__RAW__',$_);
3671                         my $existing_biblionumbers = $sth2->fetchrow;
3672                         # it exists
3673                         if ($existing_biblionumbers) {
3674                             $result{'__RAW__'}->{"$_"} =$existing_biblionumbers;
3675                             my $weight=$1+1;
3676                             $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3677                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3678                         # create a new ligne for this entry
3679                         } else {
3680                             $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).',  indexname="__RAW__",value='.$dbh->quote($_));
3681                             $result{'__RAW__'}->{"$_"}.="$biblionumber,$title-1;";
3682                         }
3683                     }
3684                 }
3685             }
3686         }
3687     }
3688     return %result;
3689 }
3690
3691
3692 =head2 MARCitemchange
3693
3694 =over 4
3695
3696 &MARCitemchange( $record, $itemfield, $newvalue )
3697
3698 Function to update a single value in an item field.
3699 Used twice, could probably be replaced by something else, but works well...
3700
3701 =back
3702
3703 =back
3704
3705 =cut
3706
3707 sub MARCitemchange {
3708     my ( $record, $itemfield, $newvalue ) = @_;
3709     my $dbh = C4::Context->dbh;
3710
3711     my ( $tagfield, $tagsubfield ) =
3712       GetMarcFromKohaField( $itemfield, "" );
3713     if ( ($tagfield) && ($tagsubfield) ) {
3714         my $tag = $record->field($tagfield);
3715         if ($tag) {
3716             $tag->update( $tagsubfield => $newvalue );
3717             $record->delete_field($tag);
3718             $record->insert_fields_ordered($tag);
3719         }
3720     }
3721 }
3722 =head2 _find_value
3723
3724 =over 4
3725
3726 ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
3727
3728 Find the given $subfield in the given $tag in the given
3729 MARC::Record $record.  If the subfield is found, returns
3730 the (indicators, value) pair; otherwise, (undef, undef) is
3731 returned.
3732
3733 PROPOSITION :
3734 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
3735 I suggest we export it from this module.
3736
3737 =back
3738
3739 =cut
3740
3741 sub _find_value {
3742     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
3743     my @result;
3744     my $indicator;
3745     if ( $tagfield < 10 ) {
3746         if ( $record->field($tagfield) ) {
3747             push @result, $record->field($tagfield)->data();
3748         }
3749         else {
3750             push @result, "";
3751         }
3752     }
3753     else {
3754         foreach my $field ( $record->field($tagfield) ) {
3755             my @subfields = $field->subfields();
3756             foreach my $subfield (@subfields) {
3757                 if ( @$subfield[0] eq $insubfield ) {
3758                     push @result, @$subfield[1];
3759                     $indicator = $field->indicator(1) . $field->indicator(2);
3760                 }
3761             }
3762         }
3763     }
3764     return ( $indicator, @result );
3765 }
3766
3767 =head2 _koha_marc_update_bib_ids
3768
3769 =over 4
3770
3771 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
3772
3773 Internal function to add or update biblionumber and biblioitemnumber to
3774 the MARC XML.
3775
3776 =back
3777
3778 =cut
3779
3780 sub _koha_marc_update_bib_ids {
3781     my ($record, $frameworkcode, $biblionumber, $biblioitemnumber) = @_;
3782
3783     # we must add bibnum and bibitemnum in MARC::Record...
3784     # we build the new field with biblionumber and biblioitemnumber
3785     # we drop the original field
3786     # we add the new builded field.
3787     my ($biblio_tag, $biblio_subfield ) = GetMarcFromKohaField("biblio.biblionumber",$frameworkcode);
3788     my ($biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.biblioitemnumber",$frameworkcode);
3789
3790     if ($biblio_tag != $biblioitem_tag) {
3791         # biblionumber & biblioitemnumber are in different fields
3792
3793         # deal with biblionumber
3794         my ($new_field, $old_field);
3795         if ($biblio_tag < 10) {
3796             $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
3797         } else {
3798             $new_field =
3799               MARC::Field->new( $biblio_tag, '', '',
3800                 "$biblio_subfield" => $biblionumber );
3801         }
3802
3803         # drop old field and create new one...
3804         $old_field = $record->field($biblio_tag);
3805         $record->delete_field($old_field);
3806         $record->append_fields($new_field);
3807
3808         # deal with biblioitemnumber
3809         if ($biblioitem_tag < 10) {
3810             $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
3811         } else {
3812             $new_field =
3813               MARC::Field->new( $biblioitem_tag, '', '',
3814                 "$biblioitem_subfield" => $biblioitemnumber, );
3815         }
3816         # drop old field and create new one...
3817         $old_field = $record->field($biblioitem_tag);
3818         $record->delete_field($old_field);
3819         $record->insert_fields_ordered($new_field);
3820
3821     } else {
3822         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
3823         my $new_field = MARC::Field->new(
3824             $biblio_tag, '', '',
3825             "$biblio_subfield" => $biblionumber,
3826             "$biblioitem_subfield" => $biblioitemnumber
3827         );
3828
3829         # drop old field and create new one...
3830         my $old_field = $record->field($biblio_tag);
3831         $record->delete_field($old_field);
3832         $record->insert_fields_ordered($new_field);
3833     }
3834 }
3835
3836 =head2 _koha_add_biblio
3837
3838 =over 4
3839
3840 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3841
3842 Internal function to add a biblio ($biblio is a hash with the values)
3843
3844 =back
3845
3846 =cut
3847
3848 sub _koha_add_biblio {
3849     my ( $dbh, $biblio, $frameworkcode ) = @_;
3850
3851     my $error;
3852
3853     # set the series flag
3854     my $serial = 0;
3855     if ( $biblio->{'seriestitle'} ) { $serial = 1 };
3856
3857     my $query =
3858         "INSERT INTO biblio
3859         SET frameworkcode = ?,
3860             author = ?,
3861             title = ?,
3862             unititle =?,
3863             notes = ?,
3864             serial = ?,
3865             seriestitle = ?,
3866             copyrightdate = ?,
3867             datecreated=NOW(),
3868             abstract = ?
3869         ";
3870     my $sth = $dbh->prepare($query);
3871     $sth->execute(
3872         $frameworkcode,
3873         $biblio->{'author'},
3874         $biblio->{'title'},
3875         $biblio->{'unititle'},
3876         $biblio->{'notes'},
3877         $serial,
3878         $biblio->{'seriestitle'},
3879         $biblio->{'copyrightdate'},
3880         $biblio->{'abstract'}
3881     );
3882
3883     my $biblionumber = $dbh->{'mysql_insertid'};
3884     if ( $dbh->errstr ) {
3885         $error.="ERROR in _koha_add_biblio $query".$dbh->errstr;
3886         warn $error;
3887     }
3888
3889     $sth->finish();
3890     #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3891     return ($biblionumber,$error);
3892 }
3893
3894 =head2 _koha_modify_biblio
3895
3896 =over 4
3897
3898 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3899
3900 Internal function for updating the biblio table
3901
3902 =back
3903
3904 =cut
3905
3906 sub _koha_modify_biblio {
3907     my ( $dbh, $biblio, $frameworkcode ) = @_;
3908     my $error;
3909
3910     my $query = "
3911         UPDATE biblio
3912         SET    frameworkcode = ?,
3913                author = ?,
3914                title = ?,
3915                unititle = ?,
3916                notes = ?,
3917                serial = ?,
3918                seriestitle = ?,
3919                copyrightdate = ?,
3920                abstract = ?
3921         WHERE  biblionumber = ?
3922         "
3923     ;
3924     my $sth = $dbh->prepare($query);
3925
3926     $sth->execute(
3927         $frameworkcode,
3928         $biblio->{'author'},
3929         $biblio->{'title'},
3930         $biblio->{'unititle'},
3931         $biblio->{'notes'},
3932         $biblio->{'serial'},
3933         $biblio->{'seriestitle'},
3934         $biblio->{'copyrightdate'},
3935         $biblio->{'abstract'},
3936         $biblio->{'biblionumber'}
3937     ) if $biblio->{'biblionumber'};
3938
3939     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3940         $error.="ERROR in _koha_modify_biblio $query".$dbh->errstr;
3941         warn $error;
3942     }
3943     return ( $biblio->{'biblionumber'},$error );
3944 }
3945
3946 =head2 _koha_modify_biblioitem_nonmarc
3947
3948 =over 4
3949
3950 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3951
3952 Updates biblioitems row except for marc and marcxml, which should be changed
3953 via ModBiblioMarc
3954
3955 =back
3956
3957 =cut
3958
3959 sub _koha_modify_biblioitem_nonmarc {
3960     my ( $dbh, $biblioitem ) = @_;
3961     my $error;
3962
3963     # re-calculate the cn_sort, it may have changed
3964     my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3965
3966     my $query =
3967     "UPDATE biblioitems
3968     SET biblionumber    = ?,
3969         volume          = ?,
3970         number          = ?,
3971         itemtype        = ?,
3972         isbn            = ?,
3973         issn            = ?,
3974         publicationyear = ?,
3975         publishercode   = ?,
3976         volumedate      = ?,
3977         volumedesc      = ?,
3978         collectiontitle = ?,
3979         collectionissn  = ?,
3980         collectionvolume= ?,
3981         editionstatement= ?,
3982         editionresponsibility = ?,
3983         illus           = ?,
3984         pages           = ?,
3985         notes           = ?,
3986         size            = ?,
3987         place           = ?,
3988         lccn            = ?,
3989         url             = ?,
3990         cn_source       = ?,
3991         cn_class        = ?,
3992         cn_item         = ?,
3993         cn_suffix       = ?,
3994         cn_sort         = ?,
3995         totalissues     = ?
3996         where biblioitemnumber = ?
3997         ";
3998     my $sth = $dbh->prepare($query);
3999     $sth->execute(
4000         $biblioitem->{'biblionumber'},
4001         $biblioitem->{'volume'},
4002         $biblioitem->{'number'},
4003         $biblioitem->{'itemtype'},
4004         $biblioitem->{'isbn'},
4005         $biblioitem->{'issn'},
4006         $biblioitem->{'publicationyear'},
4007         $biblioitem->{'publishercode'},
4008         $biblioitem->{'volumedate'},
4009         $biblioitem->{'volumedesc'},
4010         $biblioitem->{'collectiontitle'},
4011         $biblioitem->{'collectionissn'},
4012         $biblioitem->{'collectionvolume'},
4013         $biblioitem->{'editionstatement'},
4014         $biblioitem->{'editionresponsibility'},
4015         $biblioitem->{'illus'},
4016         $biblioitem->{'pages'},
4017         $biblioitem->{'bnotes'},
4018         $biblioitem->{'size'},
4019         $biblioitem->{'place'},
4020         $biblioitem->{'lccn'},
4021         $biblioitem->{'url'},
4022         $biblioitem->{'biblioitems.cn_source'},
4023         $biblioitem->{'cn_class'},
4024         $biblioitem->{'cn_item'},
4025         $biblioitem->{'cn_suffix'},
4026         $cn_sort,
4027         $biblioitem->{'totalissues'},
4028         $biblioitem->{'biblioitemnumber'}
4029     );
4030     if ( $dbh->errstr ) {
4031         $error.="ERROR in _koha_modify_biblioitem_nonmarc $query".$dbh->errstr;
4032         warn $error;
4033     }
4034     return ($biblioitem->{'biblioitemnumber'},$error);
4035 }
4036
4037 =head2 _koha_add_biblioitem
4038
4039 =over 4
4040
4041 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
4042
4043 Internal function to add a biblioitem
4044
4045 =back
4046
4047 =cut
4048
4049 sub _koha_add_biblioitem {
4050     my ( $dbh, $biblioitem ) = @_;
4051     my $error;
4052
4053     my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
4054     my $query =
4055     "INSERT INTO biblioitems SET
4056         biblionumber    = ?,
4057         volume          = ?,
4058         number          = ?,
4059         itemtype        = ?,
4060         isbn            = ?,
4061         issn            = ?,
4062         publicationyear = ?,
4063         publishercode   = ?,
4064         volumedate      = ?,
4065         volumedesc      = ?,
4066         collectiontitle = ?,
4067         collectionissn  = ?,
4068         collectionvolume= ?,
4069         editionstatement= ?,
4070         editionresponsibility = ?,
4071         illus           = ?,
4072         pages           = ?,
4073         notes           = ?,
4074         size            = ?,
4075         place           = ?,
4076         lccn            = ?,
4077         marc            = ?,
4078         url             = ?,
4079         cn_source       = ?,
4080         cn_class        = ?,
4081         cn_item         = ?,
4082         cn_suffix       = ?,
4083         cn_sort         = ?,
4084         totalissues     = ?
4085         ";
4086     my $sth = $dbh->prepare($query);
4087     $sth->execute(
4088         $biblioitem->{'biblionumber'},
4089         $biblioitem->{'volume'},
4090         $biblioitem->{'number'},
4091         $biblioitem->{'itemtype'},
4092         $biblioitem->{'isbn'},
4093         $biblioitem->{'issn'},
4094         $biblioitem->{'publicationyear'},
4095         $biblioitem->{'publishercode'},
4096         $biblioitem->{'volumedate'},
4097         $biblioitem->{'volumedesc'},
4098         $biblioitem->{'collectiontitle'},
4099         $biblioitem->{'collectionissn'},
4100         $biblioitem->{'collectionvolume'},
4101         $biblioitem->{'editionstatement'},
4102         $biblioitem->{'editionresponsibility'},
4103         $biblioitem->{'illus'},
4104         $biblioitem->{'pages'},
4105         $biblioitem->{'bnotes'},
4106         $biblioitem->{'size'},
4107         $biblioitem->{'place'},
4108         $biblioitem->{'lccn'},
4109         $biblioitem->{'marc'},
4110         $biblioitem->{'url'},
4111         $biblioitem->{'biblioitems.cn_source'},
4112         $biblioitem->{'cn_class'},
4113         $biblioitem->{'cn_item'},
4114         $biblioitem->{'cn_suffix'},
4115         $cn_sort,
4116         $biblioitem->{'totalissues'}
4117     );
4118     my $bibitemnum = $dbh->{'mysql_insertid'};
4119     if ( $dbh->errstr ) {
4120         $error.="ERROR in _koha_add_biblioitem $query".$dbh->errstr;
4121         warn $error;
4122     }
4123     $sth->finish();
4124     return ($bibitemnum,$error);
4125 }
4126
4127 =head2 _koha_new_items
4128
4129 =over 4
4130
4131 my ($itemnumber,$error) = _koha_new_items( $dbh, $item, $barcode );
4132
4133 =back
4134
4135 =cut
4136
4137 sub _koha_new_items {
4138     my ( $dbh, $item, $barcode ) = @_;
4139     my $error;
4140
4141     my ($items_cn_sort) = GetClassSort($item->{'items.cn_source'}, $item->{'itemcallnumber'}, "");
4142
4143     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
4144     if ( $item->{'dateaccessioned'} eq '' || !$item->{'dateaccessioned'} ) {
4145         my $today = C4::Dates->new();
4146         $item->{'dateaccessioned'} =  $today->output("iso"); #TODO: check time issues
4147     }
4148     my $query =
4149            "INSERT INTO items SET
4150             biblionumber        = ?,
4151             biblioitemnumber    = ?,
4152             barcode             = ?,
4153             dateaccessioned     = ?,
4154             booksellerid        = ?,
4155             homebranch          = ?,
4156             price               = ?,
4157             replacementprice    = ?,
4158             replacementpricedate = NOW(),
4159             datelastborrowed    = ?,
4160             datelastseen        = NOW(),
4161             stack               = ?,
4162             notforloan          = ?,
4163             damaged             = ?,
4164             itemlost            = ?,
4165             wthdrawn            = ?,
4166             itemcallnumber      = ?,
4167             restricted          = ?,
4168             itemnotes           = ?,
4169             holdingbranch       = ?,
4170             paidfor             = ?,
4171             location            = ?,
4172             onloan              = ?,
4173             issues              = ?,
4174             renewals            = ?,
4175             reserves            = ?,
4176             cn_source           = ?,
4177             cn_sort             = ?,
4178             ccode               = ?,
4179             itype               = ?,
4180             materials           = ?,
4181             uri                 = ?
4182           ";
4183     my $sth = $dbh->prepare($query);
4184     $sth->execute(
4185             $item->{'biblionumber'},
4186             $item->{'biblioitemnumber'},
4187             $barcode,
4188             $item->{'dateaccessioned'},
4189             $item->{'booksellerid'},
4190             $item->{'homebranch'},
4191             $item->{'price'},
4192             $item->{'replacementprice'},
4193             $item->{datelastborrowed},
4194             $item->{stack},
4195             $item->{'notforloan'},
4196             $item->{'damaged'},
4197             $item->{'itemlost'},
4198             $item->{'wthdrawn'},
4199             $item->{'itemcallnumber'},
4200             $item->{'restricted'},
4201             $item->{'itemnotes'},
4202             $item->{'holdingbranch'},
4203             $item->{'paidfor'},
4204             $item->{'location'},
4205             $item->{'onloan'},
4206             $item->{'issues'},
4207             $item->{'renewals'},
4208             $item->{'reserves'},
4209             $item->{'items.cn_source'},
4210             $items_cn_sort,
4211             $item->{'ccode'},
4212             $item->{'itype'},
4213             $item->{'materials'},
4214             $item->{'uri'},
4215     );
4216     my $itemnumber = $dbh->{'mysql_insertid'};
4217     if ( defined $sth->errstr ) {
4218         $error.="ERROR in _koha_new_items $query".$sth->errstr;
4219     }
4220     $sth->finish();
4221     return ( $itemnumber, $error );
4222 }
4223
4224 =head2 _koha_modify_item
4225
4226 =over 4
4227
4228 my ($itemnumber,$error) =_koha_modify_item( $dbh, $item, $op );
4229
4230 =back
4231
4232 =cut
4233
4234 sub _koha_modify_item {
4235     my ( $dbh, $item ) = @_;
4236     my $error;
4237
4238     # calculate items.cn_sort
4239     if($item->{'itemcallnumber'}) {
4240         # This works, even when user is setting the call number blank (in which case
4241         # how would we get here to calculate new (blank) of items.cn_sort?).
4242         #
4243         # Why?  Because at present the only way to update itemcallnumber is via
4244         # additem.pl; since it uses a MARC data-entry form, TransformMarcToKoha
4245         # already has created $item->{'items.cn_sort'} and set it to undef because the
4246         # subfield for items.cn_sort in the framework is specified as ignored, meaning
4247         # that it is not supplied or passed to the form.  Thus, if the user has
4248         # blanked itemcallnumber, there is already a undef value for $item->{'items.cn_sort'}.
4249         #
4250         # This is subtle; it is also fragile.
4251         $item->{'items.cn_sort'} = GetClassSort($item->{'items.cn_source'}, $item->{'itemcallnumber'}, "");
4252     }
4253     my $query = "UPDATE items SET ";
4254     my @bind;
4255     for my $key ( keys %$item ) {
4256         $query.="$key=?,";
4257         push @bind, $item->{$key};
4258     }
4259     $query =~ s/,$//;
4260     $query .= " WHERE itemnumber=?";
4261     push @bind, $item->{'itemnumber'};
4262     my $sth = $dbh->prepare($query);
4263     $sth->execute(@bind);
4264     if ( $dbh->errstr ) {
4265         $error.="ERROR in _koha_modify_item $query".$dbh->errstr;
4266         warn $error;
4267     }
4268     $sth->finish();
4269     return ($item->{'itemnumber'},$error);
4270 }
4271
4272 =head2 _koha_delete_biblio
4273
4274 =over 4
4275
4276 $error = _koha_delete_biblio($dbh,$biblionumber);
4277
4278 Internal sub for deleting from biblio table -- also saves to deletedbiblio
4279
4280 C<$dbh> - the database handle
4281 C<$biblionumber> - the biblionumber of the biblio to be deleted
4282
4283 =back
4284
4285 =cut
4286
4287 # FIXME: add error handling
4288
4289 sub _koha_delete_biblio {
4290     my ( $dbh, $biblionumber ) = @_;
4291
4292     # get all the data for this biblio
4293     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
4294     $sth->execute($biblionumber);
4295
4296     if ( my $data = $sth->fetchrow_hashref ) {
4297
4298         # save the record in deletedbiblio
4299         # find the fields to save
4300         my $query = "INSERT INTO deletedbiblio SET ";
4301         my @bind  = ();
4302         foreach my $temp ( keys %$data ) {
4303             $query .= "$temp = ?,";
4304             push( @bind, $data->{$temp} );
4305         }
4306
4307         # replace the last , by ",?)"
4308         $query =~ s/\,$//;
4309         my $bkup_sth = $dbh->prepare($query);
4310         $bkup_sth->execute(@bind);
4311         $bkup_sth->finish;
4312
4313         # delete the biblio
4314         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
4315         $del_sth->execute($biblionumber);
4316         $del_sth->finish;
4317     }
4318     $sth->finish;
4319     return undef;
4320 }
4321
4322 =head2 _koha_delete_biblioitems
4323
4324 =over 4
4325
4326 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
4327
4328 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
4329
4330 C<$dbh> - the database handle
4331 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
4332
4333 =back
4334
4335 =cut
4336
4337 # FIXME: add error handling
4338
4339 sub _koha_delete_biblioitems {
4340     my ( $dbh, $biblioitemnumber ) = @_;
4341
4342     # get all the data for this biblioitem
4343     my $sth =
4344       $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
4345     $sth->execute($biblioitemnumber);
4346
4347     if ( my $data = $sth->fetchrow_hashref ) {
4348
4349         # save the record in deletedbiblioitems
4350         # find the fields to save
4351         my $query = "INSERT INTO deletedbiblioitems SET ";
4352         my @bind  = ();
4353         foreach my $temp ( keys %$data ) {
4354             $query .= "$temp = ?,";
4355             push( @bind, $data->{$temp} );
4356         }
4357
4358         # replace the last , by ",?)"
4359         $query =~ s/\,$//;
4360         my $bkup_sth = $dbh->prepare($query);
4361         $bkup_sth->execute(@bind);
4362         $bkup_sth->finish;
4363
4364         # delete the biblioitem
4365         my $del_sth =
4366           $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
4367         $del_sth->execute($biblioitemnumber);
4368         $del_sth->finish;
4369     }
4370     $sth->finish;
4371     return undef;
4372 }
4373
4374 =head2 _koha_delete_item
4375
4376 =over 4
4377
4378 _koha_delete_item( $dbh, $itemnum );
4379
4380 Internal function to delete an item record from the koha tables
4381
4382 =back
4383
4384 =cut
4385
4386 sub _koha_delete_item {
4387     my ( $dbh, $itemnum ) = @_;
4388
4389     # save the deleted item to deleteditems table
4390     my $sth = $dbh->prepare("SELECT * FROM items WHERE itemnumber=?");
4391     $sth->execute($itemnum);
4392     my $data = $sth->fetchrow_hashref();
4393     $sth->finish();
4394     my $query = "INSERT INTO deleteditems SET ";
4395     my @bind  = ();
4396     foreach my $key ( keys %$data ) {
4397         $query .= "$key = ?,";
4398         push( @bind, $data->{$key} );
4399     }
4400     $query =~ s/\,$//;
4401     $sth = $dbh->prepare($query);
4402     $sth->execute(@bind);
4403     $sth->finish();
4404
4405     # delete from items table
4406     $sth = $dbh->prepare("DELETE FROM items WHERE itemnumber=?");
4407     $sth->execute($itemnum);
4408     $sth->finish();
4409     return undef;
4410 }
4411
4412 =head1 UNEXPORTED FUNCTIONS
4413
4414 =head2 ModBiblioMarc
4415
4416     &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
4417
4418     Add MARC data for a biblio to koha
4419
4420     Function exported, but should NOT be used, unless you really know what you're doing
4421
4422 =cut
4423
4424 sub ModBiblioMarc {
4425
4426 # pass the MARC::Record to this function, and it will create the records in the marc field
4427     my ( $record, $biblionumber, $frameworkcode ) = @_;
4428     my $dbh = C4::Context->dbh;
4429     my @fields = $record->fields();
4430     if ( !$frameworkcode ) {
4431         $frameworkcode = "";
4432     }
4433     my $sth =
4434       $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
4435     $sth->execute( $frameworkcode, $biblionumber );
4436     $sth->finish;
4437     my $encoding = C4::Context->preference("marcflavour");
4438
4439     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
4440     if ( $encoding eq "UNIMARC" ) {
4441         my $string;
4442         if ( length($record->subfield( 100, "a" )) == 35 ) {
4443             $string = $record->subfield( 100, "a" );
4444             my $f100 = $record->field(100);
4445             $record->delete_field($f100);
4446         }
4447         else {
4448             $string = POSIX::strftime( "%Y%m%d", localtime );
4449             $string =~ s/\-//g;
4450             $string = sprintf( "%-*s", 35, $string );
4451         }
4452         substr( $string, 22, 6, "frey50" );
4453         unless ( $record->subfield( 100, "a" ) ) {
4454             $record->insert_grouped_field(
4455                 MARC::Field->new( 100, "", "", "a" => $string ) );
4456         }
4457     }
4458     ModZebra($biblionumber,"specialUpdate","biblioserver",$record);
4459     $sth =
4460       $dbh->prepare(
4461         "UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
4462     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding),
4463         $biblionumber );
4464     $sth->finish;
4465     return $biblionumber;
4466 }
4467
4468 =head2 AddItemInMarc
4469
4470 =over 4
4471
4472 $newbiblionumber = AddItemInMarc( $record, $biblionumber, $frameworkcode );
4473
4474 Add an item in a MARC record and save the MARC record
4475
4476 Function exported, but should NOT be used, unless you really know what you're doing
4477
4478 =back
4479
4480 =cut
4481
4482 sub AddItemInMarc {
4483
4484     # pass the MARC::Record to this function, and it will create the records in the marc tables
4485     my ( $record, $biblionumber, $frameworkcode ) = @_;
4486     my $newrec = &GetMarcBiblio($biblionumber);
4487
4488     # create it
4489     my @fields = $record->fields();
4490     foreach my $field (@fields) {
4491         $newrec->append_fields($field);
4492     }
4493
4494     # FIXME: should we be making sure the biblionumbers are the same?
4495     my $newbiblionumber =
4496       &ModBiblioMarc( $newrec, $biblionumber, $frameworkcode );
4497     return $newbiblionumber;
4498 }
4499
4500 =head2 z3950_extended_services
4501
4502 z3950_extended_services($serviceType,$serviceOptions,$record);
4503
4504     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.
4505
4506 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
4507
4508 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
4509
4510     action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
4511
4512 and maybe
4513
4514     recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
4515     syntax => the record syntax (transfer syntax)
4516     databaseName = Database from connection object
4517
4518     To set serviceOptions, call set_service_options($serviceType)
4519
4520 C<$record> the record, if one is needed for the service type
4521
4522     A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
4523
4524 =cut
4525
4526 sub z3950_extended_services {
4527     my ( $server, $serviceType, $action, $serviceOptions ) = @_;
4528
4529     # get our connection object
4530     my $Zconn = C4::Context->Zconn( $server, 0, 1 );
4531
4532     # create a new package object
4533     my $Zpackage = $Zconn->package();
4534
4535     # set our options
4536     $Zpackage->option( action => $action );
4537
4538     if ( $serviceOptions->{'databaseName'} ) {
4539         $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
4540     }
4541     if ( $serviceOptions->{'recordIdNumber'} ) {
4542         $Zpackage->option(
4543             recordIdNumber => $serviceOptions->{'recordIdNumber'} );
4544     }
4545     if ( $serviceOptions->{'recordIdOpaque'} ) {
4546         $Zpackage->option(
4547             recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
4548     }
4549
4550  # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
4551  #if ($serviceType eq 'itemorder') {
4552  #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
4553  #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
4554  #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
4555  #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
4556  #}
4557
4558     if ( $serviceOptions->{record} ) {
4559         $Zpackage->option( record => $serviceOptions->{record} );
4560
4561         # can be xml or marc
4562         if ( $serviceOptions->{'syntax'} ) {
4563             $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
4564         }
4565     }
4566
4567     # send the request, handle any exception encountered
4568     eval { $Zpackage->send($serviceType) };
4569     if ( $@ && $@->isa("ZOOM::Exception") ) {
4570         return "error:  " . $@->code() . " " . $@->message() . "\n";
4571     }
4572
4573     # free up package resources
4574     $Zpackage->destroy();
4575 }
4576
4577 =head2 set_service_options
4578
4579 my $serviceOptions = set_service_options($serviceType);
4580
4581 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
4582
4583 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
4584
4585 =cut
4586
4587 sub set_service_options {
4588     my ($serviceType) = @_;
4589     my $serviceOptions;
4590
4591 # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
4592 #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
4593
4594     if ( $serviceType eq 'commit' ) {
4595
4596         # nothing to do
4597     }
4598     if ( $serviceType eq 'create' ) {
4599
4600         # nothing to do
4601     }
4602     if ( $serviceType eq 'drop' ) {
4603         die "ERROR: 'drop' not currently supported (by Zebra)";
4604     }
4605     return $serviceOptions;
4606 }
4607
4608 =head2 GetItemsCount
4609
4610 $count = &GetItemsCount( $biblionumber);
4611 this function return count of item with $biblionumber
4612 =cut
4613
4614 sub GetItemsCount {
4615     my ( $biblionumber ) = @_;
4616     my $dbh = C4::Context->dbh;
4617     my $query = "SELECT count(*)
4618           FROM  items
4619           WHERE biblionumber=?";
4620     my $sth = $dbh->prepare($query);
4621     $sth->execute($biblionumber);
4622     my $count = $sth->fetchrow;
4623     $sth->finish;
4624     return ($count);
4625 }
4626
4627 END { }    # module clean-up code here (global destructor)
4628
4629 1;
4630
4631 __END__
4632
4633 =head1 AUTHOR
4634
4635 Koha Developement team <info@koha.org>
4636
4637 Paul POULAIN paul.poulain@free.fr
4638
4639 Joshua Ferraro jmf@liblime.com
4640
4641 =cut