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 = FasterTransformMarcToKoha( $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 = &FasterTransformMarcToKoha( $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 =head2 TransformMarcToKoha
2700
2701 =over 4
2702
2703     $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
2704
2705 =back
2706
2707 =cut
2708
2709 sub TransformMarcToKoha {
2710     my ( $dbh, $record, $frameworkcode, $table ) = @_;
2711
2712     my $result;
2713
2714     # sometimes we only want to return the items data
2715     if ($table eq 'items') {
2716         my $sth = $dbh->prepare("SHOW COLUMNS FROM items");
2717         $sth->execute();
2718         while ( (my $field) = $sth->fetchrow ) {
2719             my $value = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2720             my $key = _disambiguate($table, $field);
2721             if ($result->{$key}) {
2722                 $result->{$key} .= " | " . $value;
2723             } else {
2724                 $result->{$key} = $value;
2725             }
2726         }
2727         return $result;
2728     } else {
2729         my @tables = ('biblio','biblioitems','items');
2730         foreach my $table (@tables){
2731             my $sth2 = $dbh->prepare("SHOW COLUMNS from $table");
2732             $sth2->execute;
2733             while (my ($field) = $sth2->fetchrow){
2734                 # FIXME use of _disambiguate is a temporary hack
2735                 # $result->{_disambiguate($table, $field)} = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2736                 my $value = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2737                 my $key = _disambiguate($table, $field);
2738                 if ($result->{$key}) {
2739                     # FIXME - hack to not bring in duplicates of the same value
2740                     unless (($key eq "biblionumber" or $key eq "biblioitemnumber") and ($value eq "")) {
2741                         $result->{$key} .= " | " . $value;
2742                     }
2743                 } else {
2744                     $result->{$key} = $value;
2745                 }
2746             }
2747             $sth2->finish();
2748         }
2749         # modify copyrightdate to keep only the 1st year found
2750         my $temp = $result->{'copyrightdate'};
2751         $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2752         if ( $1 > 0 ) {
2753             $result->{'copyrightdate'} = $1;
2754         }
2755         else {                      # if no cYYYY, get the 1st date.
2756             $temp =~ m/(\d\d\d\d)/;
2757             $result->{'copyrightdate'} = $1;
2758         }
2759
2760         # modify publicationyear to keep only the 1st year found
2761         $temp = $result->{'publicationyear'};
2762         $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2763         if ( $1 > 0 ) {
2764             $result->{'publicationyear'} = $1;
2765         }
2766         else {                      # if no cYYYY, get the 1st date.
2767             $temp =~ m/(\d\d\d\d)/;
2768             $result->{'publicationyear'} = $1;
2769         }
2770         return $result;
2771     }
2772 }
2773
2774
2775 # cache inverted MARC field map
2776 our $inverted_field_map;
2777
2778 =head2 FasterTransformMarcToKoha
2779
2780 =over 4
2781
2782     $result = FasterTransformMarcToKoha( $dbh, $record, $frameworkcode )
2783
2784 =back
2785
2786 Extract data from a MARC bib record into a hashref representing
2787 Koha biblio, biblioitems, and items fields.  This function will
2788 replace TransformMarcToKoha once it has been tested.
2789
2790 =cut
2791 sub FasterTransformMarcToKoha {
2792     my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
2793
2794     my $result;
2795
2796     unless (defined $inverted_field_map) {
2797         $inverted_field_map = _get_inverted_marc_field_map();
2798     }
2799
2800     my %tables = ();
2801     if ($limit_table eq 'items') {
2802         $tables{'items'} = 1;
2803     } else {
2804         $tables{'items'} = 1;
2805         $tables{'biblio'} = 1;
2806         $tables{'biblioitems'} = 1;
2807     }
2808
2809     # traverse through record
2810     MARCFIELD: foreach my $field ($record->fields()) {
2811         my $tag = $field->tag();
2812         next MARCFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag};
2813         if ($field->is_control_field()) {
2814             my $kohafields = $inverted_field_map->{$frameworkcode}->{$tag}->{list};
2815             ENTRY: foreach my $entry (@{ $kohafields }) {
2816                 my ($subfield, $table, $column) = @{ $entry };
2817                 next ENTRY unless exists $tables{$table};
2818                 my $key = _disambiguate($table, $column);
2819                 if ($result->{$key}) {
2820                     unless (($key eq "biblionumber" or $key eq "biblioitemnumber") and ($field->data() eq "")) {
2821                         $result->{$key} .= " | " . $field->data();
2822                     }
2823                 } else {
2824                     $result->{$key} = $field->data();
2825                 }
2826             }
2827         } else {
2828             # deal with subfields
2829             MARCSUBFIELD: foreach my $sf ($field->subfields()) {
2830                 my $code = $sf->[0];
2831                 next MARCSUBFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code};
2832                 my $value = $sf->[1];
2833                 SFENTRY: foreach my $entry (@{ $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code} }) {
2834                     my ($table, $column) = @{ $entry };
2835                     next SFENTRY unless exists $tables{$table};
2836                     my $key = _disambiguate($table, $column);
2837                     if ($result->{$key}) {
2838                         unless (($key eq "biblionumber" or $key eq "biblioitemnumber") and ($value eq "")) {
2839                             $result->{$key} .= " | " . $value;
2840                         }
2841                     } else {
2842                         $result->{$key} = $value;
2843                     }
2844                 }
2845             }
2846         }
2847     }
2848
2849     # modify copyrightdate to keep only the 1st year found
2850     my $temp = $result->{'copyrightdate'};
2851     $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2852     if ( $1 > 0 ) {
2853         $result->{'copyrightdate'} = $1;
2854     }
2855     else {                      # if no cYYYY, get the 1st date.
2856         $temp =~ m/(\d\d\d\d)/;
2857         $result->{'copyrightdate'} = $1;
2858     }
2859
2860     # modify publicationyear to keep only the 1st year found
2861     $temp = $result->{'publicationyear'};
2862     $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2863     if ( $1 > 0 ) {
2864         $result->{'publicationyear'} = $1;
2865     }
2866     else {                      # if no cYYYY, get the 1st date.
2867         $temp =~ m/(\d\d\d\d)/;
2868         $result->{'publicationyear'} = $1;
2869     }
2870     return $result;
2871 }
2872
2873 sub _get_inverted_marc_field_map {
2874     my $relations = C4::Context->marcfromkohafield;
2875
2876     my $field_map = {};
2877     my $relations = C4::Context->marcfromkohafield;
2878
2879     foreach my $frameworkcode (keys %{ $relations }) {
2880         foreach my $kohafield (keys %{ $relations->{$frameworkcode} }) {
2881             my $tag = $relations->{$frameworkcode}->{$kohafield}->[0];
2882             my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1];
2883             my ($table, $column) = split /[.]/, $kohafield, 2;
2884             push @{ $field_map->{$frameworkcode}->{$tag}->{list} }, [ $subfield, $table, $column ];
2885             push @{ $field_map->{$frameworkcode}->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2886         }
2887     }
2888     return $field_map;
2889 }
2890
2891 =head2 _disambiguate
2892
2893 =over 4
2894
2895 $newkey = _disambiguate($table, $field);
2896
2897 This is a temporary hack to distinguish between the
2898 following sets of columns when using TransformMarcToKoha.
2899
2900 items.cn_source & biblioitems.cn_source
2901 items.cn_sort & biblioitems.cn_sort
2902
2903 Columns that are currently NOT distinguished (FIXME
2904 due to lack of time to fully test) are:
2905
2906 biblio.notes and biblioitems.notes
2907 biblionumber
2908 timestamp
2909 biblioitemnumber
2910
2911 FIXME - this is necessary because prefixing each column
2912 name with the table name would require changing lots
2913 of code and templates, and exposing more of the DB
2914 structure than is good to the UI templates, particularly
2915 since biblio and bibloitems may well merge in a future
2916 version.  In the future, it would also be good to
2917 separate DB access and UI presentation field names
2918 more.
2919
2920 =back
2921
2922 =cut
2923
2924 sub _disambiguate {
2925     my ($table, $column) = @_;
2926     if ($column eq "cn_sort" or $column eq "cn_source") {
2927         return $table . '.' . $column;
2928     } else {
2929         return $column;
2930     }
2931
2932 }
2933
2934 =head2 get_koha_field_from_marc
2935
2936 =over 4
2937
2938 $result->{_disambiguate($table, $field)} = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2939
2940 Internal function to map data from the MARC record to a specific non-MARC field.
2941 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2942
2943 =back
2944
2945 =cut
2946
2947 sub get_koha_field_from_marc {
2948     my ($koha_table,$koha_column,$record,$frameworkcode) = @_;
2949     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table.'.'.$koha_column, $frameworkcode );
2950     my $kohafield;
2951     foreach my $field ( $record->field($tagfield) ) {
2952         if ( $field->tag() < 10 ) {
2953             if ( $kohafield ) {
2954                 $kohafield .= " | " . $field->data();
2955             }
2956             else {
2957                 $kohafield = $field->data();
2958             }
2959         }
2960         else {
2961             if ( $field->subfields ) {
2962                 my @subfields = $field->subfields();
2963                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2964                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2965                         if ( $kohafield ) {
2966                             $kohafield .=
2967                               " | " . $subfields[$subfieldcount][1];
2968                         }
2969                         else {
2970                             $kohafield =
2971                               $subfields[$subfieldcount][1];
2972                         }
2973                     }
2974                 }
2975             }
2976         }
2977     }
2978     return $kohafield;
2979 }
2980
2981
2982 =head2 TransformMarcToKohaOneField
2983
2984 =over 4
2985
2986 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2987
2988 =back
2989
2990 =cut
2991
2992 sub TransformMarcToKohaOneField {
2993
2994     # FIXME ? if a field has a repeatable subfield that is used in old-db,
2995     # only the 1st will be retrieved...
2996     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2997     my $res = "";
2998     my ( $tagfield, $subfield ) =
2999       GetMarcFromKohaField( $kohatable . "." . $kohafield,
3000         $frameworkcode );
3001     foreach my $field ( $record->field($tagfield) ) {
3002         if ( $field->tag() < 10 ) {
3003             if ( $result->{$kohafield} ) {
3004                 $result->{$kohafield} .= " | " . $field->data();
3005             }
3006             else {
3007                 $result->{$kohafield} = $field->data();
3008             }
3009         }
3010         else {
3011             if ( $field->subfields ) {
3012                 my @subfields = $field->subfields();
3013                 foreach my $subfieldcount ( 0 .. $#subfields ) {
3014                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
3015                         if ( $result->{$kohafield} ) {
3016                             $result->{$kohafield} .=
3017                               " | " . $subfields[$subfieldcount][1];
3018                         }
3019                         else {
3020                             $result->{$kohafield} =
3021                               $subfields[$subfieldcount][1];
3022                         }
3023                     }
3024                 }
3025             }
3026         }
3027     }
3028     return $result;
3029 }
3030
3031 =head1  OTHER FUNCTIONS
3032
3033 =head2 char_decode
3034
3035 =over 4
3036
3037 my $string = char_decode( $string, $encoding );
3038
3039 converts ISO 5426 coded string to UTF-8
3040 sloppy code : should be improved in next issue
3041
3042 =back
3043
3044 =cut
3045
3046 sub char_decode {
3047     my ( $string, $encoding ) = @_;
3048     $_ = $string;
3049
3050     $encoding = C4::Context->preference("marcflavour") unless $encoding;
3051     if ( $encoding eq "UNIMARC" ) {
3052
3053         #         s/\xe1/Æ/gm;
3054         s/\xe2/Ğ/gm;
3055         s/\xe9/Ø/gm;
3056         s/\xec/ş/gm;
3057         s/\xf1/æ/gm;
3058         s/\xf3/ğ/gm;
3059         s/\xf9/ø/gm;
3060         s/\xfb/ß/gm;
3061         s/\xc1\x61/à/gm;
3062         s/\xc1\x65/è/gm;
3063         s/\xc1\x69/ì/gm;
3064         s/\xc1\x6f/ò/gm;
3065         s/\xc1\x75/ù/gm;
3066         s/\xc1\x41/À/gm;
3067         s/\xc1\x45/È/gm;
3068         s/\xc1\x49/Ì/gm;
3069         s/\xc1\x4f/Ò/gm;
3070         s/\xc1\x55/Ù/gm;
3071         s/\xc2\x41/Á/gm;
3072         s/\xc2\x45/É/gm;
3073         s/\xc2\x49/Í/gm;
3074         s/\xc2\x4f/Ó/gm;
3075         s/\xc2\x55/Ú/gm;
3076         s/\xc2\x59/İ/gm;
3077         s/\xc2\x61/á/gm;
3078         s/\xc2\x65/é/gm;
3079         s/\xc2\x69/í/gm;
3080         s/\xc2\x6f/ó/gm;
3081         s/\xc2\x75/ú/gm;
3082         s/\xc2\x79/ı/gm;
3083         s/\xc3\x41/Â/gm;
3084         s/\xc3\x45/Ê/gm;
3085         s/\xc3\x49/Î/gm;
3086         s/\xc3\x4f/Ô/gm;
3087         s/\xc3\x55/Û/gm;
3088         s/\xc3\x61/â/gm;
3089         s/\xc3\x65/ê/gm;
3090         s/\xc3\x69/î/gm;
3091         s/\xc3\x6f/ô/gm;
3092         s/\xc3\x75/û/gm;
3093         s/\xc4\x41/Ã/gm;
3094         s/\xc4\x4e/Ñ/gm;
3095         s/\xc4\x4f/Õ/gm;
3096         s/\xc4\x61/ã/gm;
3097         s/\xc4\x6e/ñ/gm;
3098         s/\xc4\x6f/õ/gm;
3099         s/\xc8\x41/Ä/gm;
3100         s/\xc8\x45/Ë/gm;
3101         s/\xc8\x49/Ï/gm;
3102         s/\xc8\x61/ä/gm;
3103         s/\xc8\x65/ë/gm;
3104         s/\xc8\x69/ï/gm;
3105         s/\xc8\x6F/ö/gm;
3106         s/\xc8\x75/ü/gm;
3107         s/\xc8\x76/ÿ/gm;
3108         s/\xc9\x41/Ä/gm;
3109         s/\xc9\x45/Ë/gm;
3110         s/\xc9\x49/Ï/gm;
3111         s/\xc9\x4f/Ö/gm;
3112         s/\xc9\x55/Ü/gm;
3113         s/\xc9\x61/ä/gm;
3114         s/\xc9\x6f/ö/gm;
3115         s/\xc9\x75/ü/gm;
3116         s/\xca\x41/Å/gm;
3117         s/\xca\x61/å/gm;
3118         s/\xd0\x43/Ç/gm;
3119         s/\xd0\x63/ç/gm;
3120
3121         # this handles non-sorting blocks (if implementation requires this)
3122         $string = nsb_clean($_);
3123     }
3124     elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
3125         ##MARC-8 to UTF-8
3126
3127         s/\xe1\x61/à/gm;
3128         s/\xe1\x65/è/gm;
3129         s/\xe1\x69/ì/gm;
3130         s/\xe1\x6f/ò/gm;
3131         s/\xe1\x75/ù/gm;
3132         s/\xe1\x41/À/gm;
3133         s/\xe1\x45/È/gm;
3134         s/\xe1\x49/Ì/gm;
3135         s/\xe1\x4f/Ò/gm;
3136         s/\xe1\x55/Ù/gm;
3137         s/\xe2\x41/Á/gm;
3138         s/\xe2\x45/É/gm;
3139         s/\xe2\x49/Í/gm;
3140         s/\xe2\x4f/Ó/gm;
3141         s/\xe2\x55/Ú/gm;
3142         s/\xe2\x59/İ/gm;
3143         s/\xe2\x61/á/gm;
3144         s/\xe2\x65/é/gm;
3145         s/\xe2\x69/í/gm;
3146         s/\xe2\x6f/ó/gm;
3147         s/\xe2\x75/ú/gm;
3148         s/\xe2\x79/ı/gm;
3149         s/\xe3\x41/Â/gm;
3150         s/\xe3\x45/Ê/gm;
3151         s/\xe3\x49/Î/gm;
3152         s/\xe3\x4f/Ô/gm;
3153         s/\xe3\x55/Û/gm;
3154         s/\xe3\x61/â/gm;
3155         s/\xe3\x65/ê/gm;
3156         s/\xe3\x69/î/gm;
3157         s/\xe3\x6f/ô/gm;
3158         s/\xe3\x75/û/gm;
3159         s/\xe4\x41/Ã/gm;
3160         s/\xe4\x4e/Ñ/gm;
3161         s/\xe4\x4f/Õ/gm;
3162         s/\xe4\x61/ã/gm;
3163         s/\xe4\x6e/ñ/gm;
3164         s/\xe4\x6f/õ/gm;
3165         s/\xe6\x41/Ă/gm;
3166         s/\xe6\x45/Ĕ/gm;
3167         s/\xe6\x65/ĕ/gm;
3168         s/\xe6\x61/ă/gm;
3169         s/\xe8\x45/Ë/gm;
3170         s/\xe8\x49/Ï/gm;
3171         s/\xe8\x65/ë/gm;
3172         s/\xe8\x69/ï/gm;
3173         s/\xe8\x76/ÿ/gm;
3174         s/\xe9\x41/A/gm;
3175         s/\xe9\x4f/O/gm;
3176         s/\xe9\x55/U/gm;
3177         s/\xe9\x61/a/gm;
3178         s/\xe9\x6f/o/gm;
3179         s/\xe9\x75/u/gm;
3180         s/\xea\x41/A/gm;
3181         s/\xea\x61/a/gm;
3182
3183         #Additional Turkish characters
3184         s/\x1b//gm;
3185         s/\x1e//gm;
3186         s/(\xf0)s/\xc5\x9f/gm;
3187         s/(\xf0)S/\xc5\x9e/gm;
3188         s/(\xf0)c/ç/gm;
3189         s/(\xf0)C/Ç/gm;
3190         s/\xe7\x49/\\xc4\xb0/gm;
3191         s/(\xe6)G/\xc4\x9e/gm;
3192         s/(\xe6)g/ğ\xc4\x9f/gm;
3193         s/\xB8/ı/gm;
3194         s/\xB9/£/gm;
3195         s/(\xe8|\xc8)o/ö/gm;
3196         s/(\xe8|\xc8)O/Ö/gm;
3197         s/(\xe8|\xc8)u/ü/gm;
3198         s/(\xe8|\xc8)U/Ü/gm;
3199         s/\xc2\xb8/\xc4\xb1/gm;
3200         s/¸/\xc4\xb1/gm;
3201
3202         # this handles non-sorting blocks (if implementation requires this)
3203         $string = nsb_clean($_);
3204     }
3205     return ($string);
3206 }
3207
3208 =head2 nsb_clean
3209
3210 =over 4
3211
3212 my $string = nsb_clean( $string, $encoding );
3213
3214 =back
3215
3216 =cut
3217
3218 sub nsb_clean {
3219     my $NSB      = '\x88';    # NSB : begin Non Sorting Block
3220     my $NSE      = '\x89';    # NSE : Non Sorting Block end
3221                               # handles non sorting blocks
3222     my ($string) = @_;
3223     $_ = $string;
3224     s/$NSB/(/gm;
3225     s/[ ]{0,1}$NSE/) /gm;
3226     $string = $_;
3227     return ($string);
3228 }
3229
3230 =head2 PrepareItemrecordDisplay
3231
3232 =over 4
3233
3234 PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber);
3235
3236 Returns a hash with all the fields for Display a given item data in a template
3237
3238 =back
3239
3240 =cut
3241
3242 sub PrepareItemrecordDisplay {
3243
3244     my ( $bibnum, $itemnum ) = @_;
3245
3246     my $dbh = C4::Context->dbh;
3247     my $frameworkcode = &GetFrameworkCode( $bibnum );
3248     my ( $itemtagfield, $itemtagsubfield ) =
3249       &GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
3250     my $tagslib = &GetMarcStructure( 1, $frameworkcode );
3251     my $itemrecord = GetMarcItem( $bibnum, $itemnum) if ($itemnum);
3252     my @loop_data;
3253     my $authorised_values_sth =
3254       $dbh->prepare(
3255 "SELECT authorised_value,lib FROM authorised_values WHERE category=? ORDER BY lib"
3256       );
3257     foreach my $tag ( sort keys %{$tagslib} ) {
3258         my $previous_tag = '';
3259         if ( $tag ne '' ) {
3260             # loop through each subfield
3261             my $cntsubf;
3262             foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3263                 next if ( subfield_is_koha_internal_p($subfield) );
3264                 next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
3265                 my %subfield_data;
3266                 $subfield_data{tag}           = $tag;
3267                 $subfield_data{subfield}      = $subfield;
3268                 $subfield_data{countsubfield} = $cntsubf++;
3269                 $subfield_data{kohafield}     =
3270                   $tagslib->{$tag}->{$subfield}->{'kohafield'};
3271
3272          #        $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
3273                 $subfield_data{marc_lib} =
3274                     "<span id=\"error\" title=\""
3275                   . $tagslib->{$tag}->{$subfield}->{lib} . "\">"
3276                   . substr( $tagslib->{$tag}->{$subfield}->{lib}, 0, 12 )
3277                   . "</span>";
3278                 $subfield_data{mandatory} =
3279                   $tagslib->{$tag}->{$subfield}->{mandatory};
3280                 $subfield_data{repeatable} =
3281                   $tagslib->{$tag}->{$subfield}->{repeatable};
3282                 $subfield_data{hidden} = "display:none"
3283                   if $tagslib->{$tag}->{$subfield}->{hidden};
3284                 my ( $x, $value );
3285                 ( $x, $value ) = _find_value( $tag, $subfield, $itemrecord )
3286                   if ($itemrecord);
3287                 $value =~ s/"/&quot;/g;
3288
3289                 # search for itemcallnumber if applicable
3290                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
3291                     'items.itemcallnumber'
3292                     && C4::Context->preference('itemcallnumber') )
3293                 {
3294                     my $CNtag =
3295                       substr( C4::Context->preference('itemcallnumber'), 0, 3 );
3296                     my $CNsubfield =
3297                       substr( C4::Context->preference('itemcallnumber'), 3, 1 );
3298                     my $temp = $itemrecord->field($CNtag) if ($itemrecord);
3299                     if ($temp) {
3300                         $value = $temp->subfield($CNsubfield);
3301                     }
3302                 }
3303                 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
3304                     my @authorised_values;
3305                     my %authorised_lib;
3306
3307                     # builds list, depending on authorised value...
3308                     #---- branch
3309                     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq
3310                         "branches" )
3311                     {
3312                         if ( ( C4::Context->preference("IndependantBranches") )
3313                             && ( C4::Context->userenv->{flags} != 1 ) )
3314                         {
3315                             my $sth =
3316                               $dbh->prepare(
3317                                 "SELECT branchcode,branchname FROM branches WHERE branchcode = ? ORDER BY branchname"
3318                               );
3319                             $sth->execute( C4::Context->userenv->{branch} );
3320                             push @authorised_values, ""
3321                               unless (
3322                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
3323                             while ( my ( $branchcode, $branchname ) =
3324                                 $sth->fetchrow_array )
3325                             {
3326                                 push @authorised_values, $branchcode;
3327                                 $authorised_lib{$branchcode} = $branchname;
3328                             }
3329                         }
3330                         else {
3331                             my $sth =
3332                               $dbh->prepare(
3333                                 "SELECT branchcode,branchname FROM branches ORDER BY branchname"
3334                               );
3335                             $sth->execute;
3336                             push @authorised_values, ""
3337                               unless (
3338                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
3339                             while ( my ( $branchcode, $branchname ) =
3340                                 $sth->fetchrow_array )
3341                             {
3342                                 push @authorised_values, $branchcode;
3343                                 $authorised_lib{$branchcode} = $branchname;
3344                             }
3345                         }
3346
3347                         #----- itemtypes
3348                     }
3349                     elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq
3350                         "itemtypes" )
3351                     {
3352                         my $sth =
3353                           $dbh->prepare(
3354                             "SELECT itemtype,description FROM itemtypes ORDER BY description"
3355                           );
3356                         $sth->execute;
3357                         push @authorised_values, ""
3358                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
3359                         while ( my ( $itemtype, $description ) =
3360                             $sth->fetchrow_array )
3361                         {
3362                             push @authorised_values, $itemtype;
3363                             $authorised_lib{$itemtype} = $description;
3364                         }
3365
3366                         #---- "true" authorised value
3367                     }
3368                     else {
3369                         $authorised_values_sth->execute(
3370                             $tagslib->{$tag}->{$subfield}->{authorised_value} );
3371                         push @authorised_values, ""
3372                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
3373                         while ( my ( $value, $lib ) =
3374                             $authorised_values_sth->fetchrow_array )
3375                         {
3376                             push @authorised_values, $value;
3377                             $authorised_lib{$value} = $lib;
3378                         }
3379                     }
3380                     $subfield_data{marc_value} = CGI::scrolling_list(
3381                         -name     => 'field_value',
3382                         -values   => \@authorised_values,
3383                         -default  => "$value",
3384                         -labels   => \%authorised_lib,
3385                         -size     => 1,
3386                         -tabindex => '',
3387                         -multiple => 0,
3388                     );
3389                 }
3390                 elsif ( $tagslib->{$tag}->{$subfield}->{thesaurus_category} ) {
3391                     $subfield_data{marc_value} =
3392 "<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>";
3393
3394 #"
3395 # COMMENTED OUT because No $i is provided with this API.
3396 # And thus, no value_builder can be activated.
3397 # BUT could be thought over.
3398 #         } elsif ($tagslib->{$tag}->{$subfield}->{'value_builder'}) {
3399 #             my $plugin="value_builder/".$tagslib->{$tag}->{$subfield}->{'value_builder'};
3400 #             require $plugin;
3401 #             my $extended_param = plugin_parameters($dbh,$itemrecord,$tagslib,$i,0);
3402 #             my ($function_name,$javascript) = plugin_javascript($dbh,$record,$tagslib,$i,0);
3403 #             $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";
3404                 }
3405                 else {
3406                     $subfield_data{marc_value} =
3407 "<input type=\"text\" name=\"field_value\" value=\"$value\" size=50 maxlength=255>";
3408                 }
3409                 push( @loop_data, \%subfield_data );
3410             }
3411         }
3412     }
3413     my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
3414       if ( $itemrecord && $itemrecord->field($itemtagfield) );
3415     return {
3416         'itemtagfield'    => $itemtagfield,
3417         'itemtagsubfield' => $itemtagsubfield,
3418         'itemnumber'      => $itemnumber,
3419         'iteminformation' => \@loop_data
3420     };
3421 }
3422 #"
3423
3424 #
3425 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
3426 # at the same time
3427 # replaced by a zebraqueue table, that is filled with ModZebra to run.
3428 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
3429 # =head2 ModZebrafiles
3430 #
3431 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
3432 #
3433 # =cut
3434 #
3435 # sub ModZebrafiles {
3436 #
3437 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
3438 #
3439 #     my $op;
3440 #     my $zebradir =
3441 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
3442 #     unless ( opendir( DIR, "$zebradir" ) ) {
3443 #         warn "$zebradir not found";
3444 #         return;
3445 #     }
3446 #     closedir DIR;
3447 #     my $filename = $zebradir . $biblionumber;
3448 #
3449 #     if ($record) {
3450 #         open( OUTPUT, ">", $filename . ".xml" );
3451 #         print OUTPUT $record;
3452 #         close OUTPUT;
3453 #     }
3454 # }
3455
3456 =head2 ModZebra
3457
3458 =over 4
3459
3460 ModZebra( $biblionumber, $op, $server, $newRecord );
3461
3462     $biblionumber is the biblionumber we want to index
3463     $op is specialUpdate or delete, and is used to know what we want to do
3464     $server is the server that we want to update
3465     $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.
3466
3467 =back
3468
3469 =cut
3470
3471 sub ModZebra {
3472 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
3473     my ( $biblionumber, $op, $server, $newRecord ) = @_;
3474     my $dbh=C4::Context->dbh;
3475
3476     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
3477     # at the same time
3478     # replaced by a zebraqueue table, that is filled with ModZebra to run.
3479     # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
3480
3481     if (C4::Context->preference("NoZebra")) {
3482         # lock the nozebra table : we will read index lines, update them in Perl process
3483         # and write everything in 1 transaction.
3484         # lock the table to avoid someone else overwriting what we are doing
3485         $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE');
3486         my %result; # the result hash that will be builded by deletion / add, and written on mySQL at the end, to improve speed
3487         my $record;
3488         if ($server eq 'biblioserver') {
3489             $record= GetMarcBiblio($biblionumber);
3490         } else {
3491             $record= C4::AuthoritiesMarc::GetAuthority($biblionumber);
3492         }
3493         if ($op eq 'specialUpdate') {
3494             # OK, we have to add or update the record
3495             # 1st delete (virtually, in indexes), if record actually exists
3496             if ($record) {
3497                 %result = _DelBiblioNoZebra($biblionumber,$record,$server);
3498             }
3499             # ... add the record
3500             %result=_AddBiblioNoZebra($biblionumber,$newRecord, $server, %result);
3501         } else {
3502             # it's a deletion, delete the record...
3503             # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
3504             %result=_DelBiblioNoZebra($biblionumber,$record,$server);
3505         }
3506         # ok, now update the database...
3507         my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
3508         foreach my $key (keys %result) {
3509             foreach my $index (keys %{$result{$key}}) {
3510                 $sth->execute($result{$key}->{$index}, $server, $key, $index);
3511             }
3512         }
3513         $dbh->do('UNLOCK TABLES');
3514
3515     } else {
3516         #
3517         # we use zebra, just fill zebraqueue table
3518         #
3519         my $sth=$dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
3520         $sth->execute($biblionumber,$server,$op);
3521         $sth->finish;
3522     }
3523 }
3524
3525 =head2 GetNoZebraIndexes
3526
3527     %indexes = GetNoZebraIndexes;
3528
3529     return the data from NoZebraIndexes syspref.
3530
3531 =cut
3532
3533 sub GetNoZebraIndexes {
3534     my $index = C4::Context->preference('NoZebraIndexes');
3535     my %indexes;
3536     foreach my $line (split /('|"),/,$index) {
3537         $line =~ /(.*)=>(.*)/;
3538 warn $line;
3539         my $index = substr($1,1); # get the index, don't forget to remove initial ' or "
3540         my $fields = $2;
3541         $index =~ s/'|"|\s//g;
3542
3543
3544         $fields =~ s/'|"|\s//g;
3545         $indexes{$index}=$fields;
3546     }
3547     return %indexes;
3548 }
3549
3550 =head1 INTERNAL FUNCTIONS
3551
3552 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
3553
3554     function to delete a biblio in NoZebra indexes
3555     This function does NOT delete anything in database : it reads all the indexes entries
3556     that have to be deleted & delete them in the hash
3557     The SQL part is done either :
3558     - after the Add if we are modifying a biblio (delete + add again)
3559     - immediatly after this sub if we are doing a true deletion.
3560     $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
3561
3562 =cut
3563
3564
3565 sub _DelBiblioNoZebra {
3566     my ($biblionumber, $record, $server)=@_;
3567
3568     # Get the indexes
3569     my $dbh = C4::Context->dbh;
3570     # Get the indexes
3571     my %index;
3572     my $title;
3573     if ($server eq 'biblioserver') {
3574         %index=GetNoZebraIndexes;
3575         # get title of the record (to store the 10 first letters with the index)
3576         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
3577         $title = lc($record->subfield($titletag,$titlesubfield));
3578     } else {
3579         # for authorities, the "title" is the $a mainentry
3580         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
3581         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
3582         $title = $record->subfield($authref->{auth_tag_to_report},'a');
3583         $index{'mainmainentry'}= $authref->{'auth_tag_to_report'}.'a';
3584         $index{'mainentry'}    = $authref->{'auth_tag_to_report'}.'*';
3585         $index{'auth_type'}    = '152b';
3586     }
3587
3588     my %result;
3589     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3590     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
3591     # limit to 10 char, should be enough, and limit the DB size
3592     $title = substr($title,0,10);
3593     #parse each field
3594     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3595     foreach my $field ($record->fields()) {
3596         #parse each subfield
3597         next if $field->tag <10;
3598         foreach my $subfield ($field->subfields()) {
3599             my $tag = $field->tag();
3600             my $subfieldcode = $subfield->[0];
3601             my $indexed=0;
3602             # check each index to see if the subfield is stored somewhere
3603             # otherwise, store it in __RAW__ index
3604             foreach my $key (keys %index) {
3605 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3606                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
3607                     $indexed=1;
3608                     my $line= lc $subfield->[1];
3609                     # remove meaningless value in the field...
3610                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3611                     # ... and split in words
3612                     foreach (split / /,$line) {
3613                         next unless $_; # skip  empty values (multiple spaces)
3614                         # if the entry is already here, do nothing, the biblionumber has already be removed
3615                         unless ($result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) {
3616                             # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
3617                             $sth2->execute($server,$key,$_);
3618                             my $existing_biblionumbers = $sth2->fetchrow;
3619                             # it exists
3620                             if ($existing_biblionumbers) {
3621 #                                 warn " existing for $key $_: $existing_biblionumbers";
3622                                 $result{$key}->{$_} =$existing_biblionumbers;
3623                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3624                             }
3625                         }
3626                     }
3627                 }
3628             }
3629             # the subfield is not indexed, store it in __RAW__ index anyway
3630             unless ($indexed) {
3631                 my $line= lc $subfield->[1];
3632                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3633                 # ... and split in words
3634                 foreach (split / /,$line) {
3635                     next unless $_; # skip  empty values (multiple spaces)
3636                     # if the entry is already here, do nothing, the biblionumber has already be removed
3637                     unless ($result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/) {
3638                         # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
3639                         $sth2->execute($server,'__RAW__',$_);
3640                         my $existing_biblionumbers = $sth2->fetchrow;
3641                         # it exists
3642                         if ($existing_biblionumbers) {
3643                             $result{'__RAW__'}->{$_} =$existing_biblionumbers;
3644                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3645                         }
3646                     }
3647                 }
3648             }
3649         }
3650     }
3651     return %result;
3652 }
3653
3654 =head2 _AddBiblioNoZebra($biblionumber, $record, $server, %result);
3655
3656     function to add a biblio in NoZebra indexes
3657
3658 =cut
3659
3660 sub _AddBiblioNoZebra {
3661     my ($biblionumber, $record, $server, %result)=@_;
3662     my $dbh = C4::Context->dbh;
3663     # Get the indexes
3664     my %index;
3665     my $title;
3666     if ($server eq 'biblioserver') {
3667         %index=GetNoZebraIndexes;
3668         # get title of the record (to store the 10 first letters with the index)
3669         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
3670         $title = lc($record->subfield($titletag,$titlesubfield));
3671     } else {
3672         # warn "server : $server";
3673         # for authorities, the "title" is the $a mainentry
3674         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
3675         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
3676         $title = $record->subfield($authref->{auth_tag_to_report},'a');
3677         $index{'mainmainentry'} = $authref->{auth_tag_to_report}.'a';
3678         $index{'mainentry'}     = $authref->{auth_tag_to_report}.'*';
3679         $index{'auth_type'}     = '152b';
3680     }
3681
3682     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3683     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
3684     # limit to 10 char, should be enough, and limit the DB size
3685     $title = substr($title,0,10);
3686     #parse each field
3687     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3688     foreach my $field ($record->fields()) {
3689         #parse each subfield
3690         next if $field->tag <10;
3691         foreach my $subfield ($field->subfields()) {
3692             my $tag = $field->tag();
3693             my $subfieldcode = $subfield->[0];
3694             my $indexed=0;
3695             # check each index to see if the subfield is stored somewhere
3696             # otherwise, store it in __RAW__ index
3697             foreach my $key (keys %index) {
3698 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3699                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
3700                     $indexed=1;
3701                     my $line= lc $subfield->[1];
3702                     # remove meaningless value in the field...
3703                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3704                     # ... and split in words
3705                     foreach (split / /,$line) {
3706                         next unless $_; # skip  empty values (multiple spaces)
3707                         # if the entry is already here, improve weight
3708 #                         warn "managing $_";
3709                         if ($result{$key}->{"$_"} =~ /$biblionumber,$title\-(\d);/) {
3710                             my $weight=$1+1;
3711                             $result{$key}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3712                             $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3713                         } else {
3714                             # get the value if it exist in the nozebra table, otherwise, create it
3715                             $sth2->execute($server,$key,$_);
3716                             my $existing_biblionumbers = $sth2->fetchrow;
3717                             # it exists
3718                             if ($existing_biblionumbers) {
3719                                 $result{$key}->{"$_"} =$existing_biblionumbers;
3720                                 my $weight=$1+1;
3721                                 $result{$key}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3722                                 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3723                             # create a new ligne for this entry
3724                             } else {
3725 #                             warn "INSERT : $server / $key / $_";
3726                                 $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).', indexname='.$dbh->quote($key).',value='.$dbh->quote($_));
3727                                 $result{$key}->{"$_"}.="$biblionumber,$title-1;";
3728                             }
3729                         }
3730                     }
3731                 }
3732             }
3733             # the subfield is not indexed, store it in __RAW__ index anyway
3734             unless ($indexed) {
3735                 my $line= lc $subfield->[1];
3736                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3737                 # ... and split in words
3738                 foreach (split / /,$line) {
3739                     next unless $_; # skip  empty values (multiple spaces)
3740                     # if the entry is already here, improve weight
3741                     if ($result{'__RAW__'}->{"$_"} =~ /$biblionumber,$title\-(\d);/) {
3742                         my $weight=$1+1;
3743                         $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3744                         $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3745                     } else {
3746                         # get the value if it exist in the nozebra table, otherwise, create it
3747                         $sth2->execute($server,'__RAW__',$_);
3748                         my $existing_biblionumbers = $sth2->fetchrow;
3749                         # it exists
3750                         if ($existing_biblionumbers) {
3751                             $result{'__RAW__'}->{"$_"} =$existing_biblionumbers;
3752                             my $weight=$1+1;
3753                             $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3754                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3755                         # create a new ligne for this entry
3756                         } else {
3757                             $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).',  indexname="__RAW__",value='.$dbh->quote($_));
3758                             $result{'__RAW__'}->{"$_"}.="$biblionumber,$title-1;";
3759                         }
3760                     }
3761                 }
3762             }
3763         }
3764     }
3765     return %result;
3766 }
3767
3768
3769 =head2 MARCitemchange
3770
3771 =over 4
3772
3773 &MARCitemchange( $record, $itemfield, $newvalue )
3774
3775 Function to update a single value in an item field.
3776 Used twice, could probably be replaced by something else, but works well...
3777
3778 =back
3779
3780 =back
3781
3782 =cut
3783
3784 sub MARCitemchange {
3785     my ( $record, $itemfield, $newvalue ) = @_;
3786     my $dbh = C4::Context->dbh;
3787
3788     my ( $tagfield, $tagsubfield ) =
3789       GetMarcFromKohaField( $itemfield, "" );
3790     if ( ($tagfield) && ($tagsubfield) ) {
3791         my $tag = $record->field($tagfield);
3792         if ($tag) {
3793             $tag->update( $tagsubfield => $newvalue );
3794             $record->delete_field($tag);
3795             $record->insert_fields_ordered($tag);
3796         }
3797     }
3798 }
3799 =head2 _find_value
3800
3801 =over 4
3802
3803 ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
3804
3805 Find the given $subfield in the given $tag in the given
3806 MARC::Record $record.  If the subfield is found, returns
3807 the (indicators, value) pair; otherwise, (undef, undef) is
3808 returned.
3809
3810 PROPOSITION :
3811 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
3812 I suggest we export it from this module.
3813
3814 =back
3815
3816 =cut
3817
3818 sub _find_value {
3819     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
3820     my @result;
3821     my $indicator;
3822     if ( $tagfield < 10 ) {
3823         if ( $record->field($tagfield) ) {
3824             push @result, $record->field($tagfield)->data();
3825         }
3826         else {
3827             push @result, "";
3828         }
3829     }
3830     else {
3831         foreach my $field ( $record->field($tagfield) ) {
3832             my @subfields = $field->subfields();
3833             foreach my $subfield (@subfields) {
3834                 if ( @$subfield[0] eq $insubfield ) {
3835                     push @result, @$subfield[1];
3836                     $indicator = $field->indicator(1) . $field->indicator(2);
3837                 }
3838             }
3839         }
3840     }
3841     return ( $indicator, @result );
3842 }
3843
3844 =head2 _koha_marc_update_bib_ids
3845
3846 =over 4
3847
3848 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
3849
3850 Internal function to add or update biblionumber and biblioitemnumber to
3851 the MARC XML.
3852
3853 =back
3854
3855 =cut
3856
3857 sub _koha_marc_update_bib_ids {
3858     my ($record, $frameworkcode, $biblionumber, $biblioitemnumber) = @_;
3859
3860     # we must add bibnum and bibitemnum in MARC::Record...
3861     # we build the new field with biblionumber and biblioitemnumber
3862     # we drop the original field
3863     # we add the new builded field.
3864     my ($biblio_tag, $biblio_subfield ) = GetMarcFromKohaField("biblio.biblionumber",$frameworkcode);
3865     my ($biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.biblioitemnumber",$frameworkcode);
3866
3867     if ($biblio_tag != $biblioitem_tag) {
3868         # biblionumber & biblioitemnumber are in different fields
3869
3870         # deal with biblionumber
3871         my ($new_field, $old_field);
3872         if ($biblio_tag < 10) {
3873             $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
3874         } else {
3875             $new_field =
3876               MARC::Field->new( $biblio_tag, '', '',
3877                 "$biblio_subfield" => $biblionumber );
3878         }
3879
3880         # drop old field and create new one...
3881         $old_field = $record->field($biblio_tag);
3882         $record->delete_field($old_field);
3883         $record->append_fields($new_field);
3884
3885         # deal with biblioitemnumber
3886         if ($biblioitem_tag < 10) {
3887             $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
3888         } else {
3889             $new_field =
3890               MARC::Field->new( $biblioitem_tag, '', '',
3891                 "$biblioitem_subfield" => $biblioitemnumber, );
3892         }
3893         # drop old field and create new one...
3894         $old_field = $record->field($biblioitem_tag);
3895         $record->delete_field($old_field);
3896         $record->insert_fields_ordered($new_field);
3897
3898     } else {
3899         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
3900         my $new_field = MARC::Field->new(
3901             $biblio_tag, '', '',
3902             "$biblio_subfield" => $biblionumber,
3903             "$biblioitem_subfield" => $biblioitemnumber
3904         );
3905
3906         # drop old field and create new one...
3907         my $old_field = $record->field($biblio_tag);
3908         $record->delete_field($old_field);
3909         $record->insert_fields_ordered($new_field);
3910     }
3911 }
3912
3913 =head2 _koha_add_biblio
3914
3915 =over 4
3916
3917 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3918
3919 Internal function to add a biblio ($biblio is a hash with the values)
3920
3921 =back
3922
3923 =cut
3924
3925 sub _koha_add_biblio {
3926     my ( $dbh, $biblio, $frameworkcode ) = @_;
3927
3928     my $error;
3929
3930     # set the series flag
3931     my $serial = 0;
3932     if ( $biblio->{'seriestitle'} ) { $serial = 1 };
3933
3934     my $query =
3935         "INSERT INTO biblio
3936         SET frameworkcode = ?,
3937             author = ?,
3938             title = ?,
3939             unititle =?,
3940             notes = ?,
3941             serial = ?,
3942             seriestitle = ?,
3943             copyrightdate = ?,
3944             datecreated=NOW(),
3945             abstract = ?
3946         ";
3947     my $sth = $dbh->prepare($query);
3948     $sth->execute(
3949         $frameworkcode,
3950         $biblio->{'author'},
3951         $biblio->{'title'},
3952         $biblio->{'unititle'},
3953         $biblio->{'notes'},
3954         $serial,
3955         $biblio->{'seriestitle'},
3956         $biblio->{'copyrightdate'},
3957         $biblio->{'abstract'}
3958     );
3959
3960     my $biblionumber = $dbh->{'mysql_insertid'};
3961     if ( $dbh->errstr ) {
3962         $error.="ERROR in _koha_add_biblio $query".$dbh->errstr;
3963         warn $error;
3964     }
3965
3966     $sth->finish();
3967     #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3968     return ($biblionumber,$error);
3969 }
3970
3971 =head2 _koha_modify_biblio
3972
3973 =over 4
3974
3975 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3976
3977 Internal function for updating the biblio table
3978
3979 =back
3980
3981 =cut
3982
3983 sub _koha_modify_biblio {
3984     my ( $dbh, $biblio, $frameworkcode ) = @_;
3985     my $error;
3986
3987     my $query = "
3988         UPDATE biblio
3989         SET    frameworkcode = ?,
3990                author = ?,
3991                title = ?,
3992                unititle = ?,
3993                notes = ?,
3994                serial = ?,
3995                seriestitle = ?,
3996                copyrightdate = ?,
3997                abstract = ?
3998         WHERE  biblionumber = ?
3999         "
4000     ;
4001     my $sth = $dbh->prepare($query);
4002
4003     $sth->execute(
4004         $frameworkcode,
4005         $biblio->{'author'},
4006         $biblio->{'title'},
4007         $biblio->{'unititle'},
4008         $biblio->{'notes'},
4009         $biblio->{'serial'},
4010         $biblio->{'seriestitle'},
4011         $biblio->{'copyrightdate'},
4012         $biblio->{'abstract'},
4013         $biblio->{'biblionumber'}
4014     ) if $biblio->{'biblionumber'};
4015
4016     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
4017         $error.="ERROR in _koha_modify_biblio $query".$dbh->errstr;
4018         warn $error;
4019     }
4020     return ( $biblio->{'biblionumber'},$error );
4021 }
4022
4023 =head2 _koha_modify_biblioitem_nonmarc
4024
4025 =over 4
4026
4027 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
4028
4029 Updates biblioitems row except for marc and marcxml, which should be changed
4030 via ModBiblioMarc
4031
4032 =back
4033
4034 =cut
4035
4036 sub _koha_modify_biblioitem_nonmarc {
4037     my ( $dbh, $biblioitem ) = @_;
4038     my $error;
4039
4040     # re-calculate the cn_sort, it may have changed
4041     my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
4042
4043     my $query =
4044     "UPDATE biblioitems
4045     SET biblionumber    = ?,
4046         volume          = ?,
4047         number          = ?,
4048         itemtype        = ?,
4049         isbn            = ?,
4050         issn            = ?,
4051         publicationyear = ?,
4052         publishercode   = ?,
4053         volumedate      = ?,
4054         volumedesc      = ?,
4055         collectiontitle = ?,
4056         collectionissn  = ?,
4057         collectionvolume= ?,
4058         editionstatement= ?,
4059         editionresponsibility = ?,
4060         illus           = ?,
4061         pages           = ?,
4062         notes           = ?,
4063         size            = ?,
4064         place           = ?,
4065         lccn            = ?,
4066         url             = ?,
4067         cn_source       = ?,
4068         cn_class        = ?,
4069         cn_item         = ?,
4070         cn_suffix       = ?,
4071         cn_sort         = ?,
4072         totalissues     = ?
4073         where biblioitemnumber = ?
4074         ";
4075     my $sth = $dbh->prepare($query);
4076     $sth->execute(
4077         $biblioitem->{'biblionumber'},
4078         $biblioitem->{'volume'},
4079         $biblioitem->{'number'},
4080         $biblioitem->{'itemtype'},
4081         $biblioitem->{'isbn'},
4082         $biblioitem->{'issn'},
4083         $biblioitem->{'publicationyear'},
4084         $biblioitem->{'publishercode'},
4085         $biblioitem->{'volumedate'},
4086         $biblioitem->{'volumedesc'},
4087         $biblioitem->{'collectiontitle'},
4088         $biblioitem->{'collectionissn'},
4089         $biblioitem->{'collectionvolume'},
4090         $biblioitem->{'editionstatement'},
4091         $biblioitem->{'editionresponsibility'},
4092         $biblioitem->{'illus'},
4093         $biblioitem->{'pages'},
4094         $biblioitem->{'bnotes'},
4095         $biblioitem->{'size'},
4096         $biblioitem->{'place'},
4097         $biblioitem->{'lccn'},
4098         $biblioitem->{'url'},
4099         $biblioitem->{'biblioitems.cn_source'},
4100         $biblioitem->{'cn_class'},
4101         $biblioitem->{'cn_item'},
4102         $biblioitem->{'cn_suffix'},
4103         $cn_sort,
4104         $biblioitem->{'totalissues'},
4105         $biblioitem->{'biblioitemnumber'}
4106     );
4107     if ( $dbh->errstr ) {
4108         $error.="ERROR in _koha_modify_biblioitem_nonmarc $query".$dbh->errstr;
4109         warn $error;
4110     }
4111     return ($biblioitem->{'biblioitemnumber'},$error);
4112 }
4113
4114 =head2 _koha_add_biblioitem
4115
4116 =over 4
4117
4118 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
4119
4120 Internal function to add a biblioitem
4121
4122 =back
4123
4124 =cut
4125
4126 sub _koha_add_biblioitem {
4127     my ( $dbh, $biblioitem ) = @_;
4128     my $error;
4129
4130     my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
4131     my $query =
4132     "INSERT INTO biblioitems SET
4133         biblionumber    = ?,
4134         volume          = ?,
4135         number          = ?,
4136         itemtype        = ?,
4137         isbn            = ?,
4138         issn            = ?,
4139         publicationyear = ?,
4140         publishercode   = ?,
4141         volumedate      = ?,
4142         volumedesc      = ?,
4143         collectiontitle = ?,
4144         collectionissn  = ?,
4145         collectionvolume= ?,
4146         editionstatement= ?,
4147         editionresponsibility = ?,
4148         illus           = ?,
4149         pages           = ?,
4150         notes           = ?,
4151         size            = ?,
4152         place           = ?,
4153         lccn            = ?,
4154         marc            = ?,
4155         url             = ?,
4156         cn_source       = ?,
4157         cn_class        = ?,
4158         cn_item         = ?,
4159         cn_suffix       = ?,
4160         cn_sort         = ?,
4161         totalissues     = ?
4162         ";
4163     my $sth = $dbh->prepare($query);
4164     $sth->execute(
4165         $biblioitem->{'biblionumber'},
4166         $biblioitem->{'volume'},
4167         $biblioitem->{'number'},
4168         $biblioitem->{'itemtype'},
4169         $biblioitem->{'isbn'},
4170         $biblioitem->{'issn'},
4171         $biblioitem->{'publicationyear'},
4172         $biblioitem->{'publishercode'},
4173         $biblioitem->{'volumedate'},
4174         $biblioitem->{'volumedesc'},
4175         $biblioitem->{'collectiontitle'},
4176         $biblioitem->{'collectionissn'},
4177         $biblioitem->{'collectionvolume'},
4178         $biblioitem->{'editionstatement'},
4179         $biblioitem->{'editionresponsibility'},
4180         $biblioitem->{'illus'},
4181         $biblioitem->{'pages'},
4182         $biblioitem->{'bnotes'},
4183         $biblioitem->{'size'},
4184         $biblioitem->{'place'},
4185         $biblioitem->{'lccn'},
4186         $biblioitem->{'marc'},
4187         $biblioitem->{'url'},
4188         $biblioitem->{'biblioitems.cn_source'},
4189         $biblioitem->{'cn_class'},
4190         $biblioitem->{'cn_item'},
4191         $biblioitem->{'cn_suffix'},
4192         $cn_sort,
4193         $biblioitem->{'totalissues'}
4194     );
4195     my $bibitemnum = $dbh->{'mysql_insertid'};
4196     if ( $dbh->errstr ) {
4197         $error.="ERROR in _koha_add_biblioitem $query".$dbh->errstr;
4198         warn $error;
4199     }
4200     $sth->finish();
4201     return ($bibitemnum,$error);
4202 }
4203
4204 =head2 _koha_new_items
4205
4206 =over 4
4207
4208 my ($itemnumber,$error) = _koha_new_items( $dbh, $item, $barcode );
4209
4210 =back
4211
4212 =cut
4213
4214 sub _koha_new_items {
4215     my ( $dbh, $item, $barcode ) = @_;
4216     my $error;
4217
4218     my ($items_cn_sort) = GetClassSort($item->{'items.cn_source'}, $item->{'itemcallnumber'}, "");
4219
4220     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
4221     if ( $item->{'dateaccessioned'} eq '' || !$item->{'dateaccessioned'} ) {
4222         my $today = C4::Dates->new();
4223         $item->{'dateaccessioned'} =  $today->output("iso"); #TODO: check time issues
4224     }
4225     my $query =
4226            "INSERT INTO items SET
4227             biblionumber        = ?,
4228             biblioitemnumber    = ?,
4229             barcode             = ?,
4230             dateaccessioned     = ?,
4231             booksellerid        = ?,
4232             homebranch          = ?,
4233             price               = ?,
4234             replacementprice    = ?,
4235             replacementpricedate = NOW(),
4236             datelastborrowed    = ?,
4237             datelastseen        = NOW(),
4238             stack               = ?,
4239             notforloan          = ?,
4240             damaged             = ?,
4241             itemlost            = ?,
4242             wthdrawn            = ?,
4243             itemcallnumber      = ?,
4244             restricted          = ?,
4245             itemnotes           = ?,
4246             holdingbranch       = ?,
4247             paidfor             = ?,
4248             location            = ?,
4249             onloan              = ?,
4250             issues              = ?,
4251             renewals            = ?,
4252             reserves            = ?,
4253             cn_source           = ?,
4254             cn_sort             = ?,
4255             ccode               = ?,
4256             itype               = ?,
4257             materials           = ?,
4258             uri                 = ?
4259           ";
4260     my $sth = $dbh->prepare($query);
4261     $sth->execute(
4262             $item->{'biblionumber'},
4263             $item->{'biblioitemnumber'},
4264             $barcode,
4265             $item->{'dateaccessioned'},
4266             $item->{'booksellerid'},
4267             $item->{'homebranch'},
4268             $item->{'price'},
4269             $item->{'replacementprice'},
4270             $item->{datelastborrowed},
4271             $item->{stack},
4272             $item->{'notforloan'},
4273             $item->{'damaged'},
4274             $item->{'itemlost'},
4275             $item->{'wthdrawn'},
4276             $item->{'itemcallnumber'},
4277             $item->{'restricted'},
4278             $item->{'itemnotes'},
4279             $item->{'holdingbranch'},
4280             $item->{'paidfor'},
4281             $item->{'location'},
4282             $item->{'onloan'},
4283             $item->{'issues'},
4284             $item->{'renewals'},
4285             $item->{'reserves'},
4286             $item->{'items.cn_source'},
4287             $items_cn_sort,
4288             $item->{'ccode'},
4289             $item->{'itype'},
4290             $item->{'materials'},
4291             $item->{'uri'},
4292     );
4293     my $itemnumber = $dbh->{'mysql_insertid'};
4294     if ( defined $sth->errstr ) {
4295         $error.="ERROR in _koha_new_items $query".$sth->errstr;
4296     }
4297     $sth->finish();
4298     return ( $itemnumber, $error );
4299 }
4300
4301 =head2 _koha_modify_item
4302
4303 =over 4
4304
4305 my ($itemnumber,$error) =_koha_modify_item( $dbh, $item, $op );
4306
4307 =back
4308
4309 =cut
4310
4311 sub _koha_modify_item {
4312     my ( $dbh, $item ) = @_;
4313     my $error;
4314
4315     # calculate items.cn_sort
4316     if($item->{'itemcallnumber'}) {
4317         # This works, even when user is setting the call number blank (in which case
4318         # how would we get here to calculate new (blank) of items.cn_sort?).
4319         #
4320         # Why?  Because at present the only way to update itemcallnumber is via
4321         # additem.pl; since it uses a MARC data-entry form, TransformMarcToKoha
4322         # already has created $item->{'items.cn_sort'} and set it to undef because the
4323         # subfield for items.cn_sort in the framework is specified as ignored, meaning
4324         # that it is not supplied or passed to the form.  Thus, if the user has
4325         # blanked itemcallnumber, there is already a undef value for $item->{'items.cn_sort'}.
4326         #
4327         # This is subtle; it is also fragile.
4328         $item->{'items.cn_sort'} = GetClassSort($item->{'items.cn_source'}, $item->{'itemcallnumber'}, "");
4329     }
4330     my $query = "UPDATE items SET ";
4331     my @bind;
4332     for my $key ( keys %$item ) {
4333         $query.="$key=?,";
4334         push @bind, $item->{$key};
4335     }
4336     $query =~ s/,$//;
4337     $query .= " WHERE itemnumber=?";
4338     push @bind, $item->{'itemnumber'};
4339     my $sth = $dbh->prepare($query);
4340     $sth->execute(@bind);
4341     if ( $dbh->errstr ) {
4342         $error.="ERROR in _koha_modify_item $query".$dbh->errstr;
4343         warn $error;
4344     }
4345     $sth->finish();
4346     return ($item->{'itemnumber'},$error);
4347 }
4348
4349 =head2 _koha_delete_biblio
4350
4351 =over 4
4352
4353 $error = _koha_delete_biblio($dbh,$biblionumber);
4354
4355 Internal sub for deleting from biblio table -- also saves to deletedbiblio
4356
4357 C<$dbh> - the database handle
4358 C<$biblionumber> - the biblionumber of the biblio to be deleted
4359
4360 =back
4361
4362 =cut
4363
4364 # FIXME: add error handling
4365
4366 sub _koha_delete_biblio {
4367     my ( $dbh, $biblionumber ) = @_;
4368
4369     # get all the data for this biblio
4370     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
4371     $sth->execute($biblionumber);
4372
4373     if ( my $data = $sth->fetchrow_hashref ) {
4374
4375         # save the record in deletedbiblio
4376         # find the fields to save
4377         my $query = "INSERT INTO deletedbiblio SET ";
4378         my @bind  = ();
4379         foreach my $temp ( keys %$data ) {
4380             $query .= "$temp = ?,";
4381             push( @bind, $data->{$temp} );
4382         }
4383
4384         # replace the last , by ",?)"
4385         $query =~ s/\,$//;
4386         my $bkup_sth = $dbh->prepare($query);
4387         $bkup_sth->execute(@bind);
4388         $bkup_sth->finish;
4389
4390         # delete the biblio
4391         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
4392         $del_sth->execute($biblionumber);
4393         $del_sth->finish;
4394     }
4395     $sth->finish;
4396     return undef;
4397 }
4398
4399 =head2 _koha_delete_biblioitems
4400
4401 =over 4
4402
4403 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
4404
4405 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
4406
4407 C<$dbh> - the database handle
4408 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
4409
4410 =back
4411
4412 =cut
4413
4414 # FIXME: add error handling
4415
4416 sub _koha_delete_biblioitems {
4417     my ( $dbh, $biblioitemnumber ) = @_;
4418
4419     # get all the data for this biblioitem
4420     my $sth =
4421       $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
4422     $sth->execute($biblioitemnumber);
4423
4424     if ( my $data = $sth->fetchrow_hashref ) {
4425
4426         # save the record in deletedbiblioitems
4427         # find the fields to save
4428         my $query = "INSERT INTO deletedbiblioitems SET ";
4429         my @bind  = ();
4430         foreach my $temp ( keys %$data ) {
4431             $query .= "$temp = ?,";
4432             push( @bind, $data->{$temp} );
4433         }
4434
4435         # replace the last , by ",?)"
4436         $query =~ s/\,$//;
4437         my $bkup_sth = $dbh->prepare($query);
4438         $bkup_sth->execute(@bind);
4439         $bkup_sth->finish;
4440
4441         # delete the biblioitem
4442         my $del_sth =
4443           $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
4444         $del_sth->execute($biblioitemnumber);
4445         $del_sth->finish;
4446     }
4447     $sth->finish;
4448     return undef;
4449 }
4450
4451 =head2 _koha_delete_item
4452
4453 =over 4
4454
4455 _koha_delete_item( $dbh, $itemnum );
4456
4457 Internal function to delete an item record from the koha tables
4458
4459 =back
4460
4461 =cut
4462
4463 sub _koha_delete_item {
4464     my ( $dbh, $itemnum ) = @_;
4465
4466     # save the deleted item to deleteditems table
4467     my $sth = $dbh->prepare("SELECT * FROM items WHERE itemnumber=?");
4468     $sth->execute($itemnum);
4469     my $data = $sth->fetchrow_hashref();
4470     $sth->finish();
4471     my $query = "INSERT INTO deleteditems SET ";
4472     my @bind  = ();
4473     foreach my $key ( keys %$data ) {
4474         $query .= "$key = ?,";
4475         push( @bind, $data->{$key} );
4476     }
4477     $query =~ s/\,$//;
4478     $sth = $dbh->prepare($query);
4479     $sth->execute(@bind);
4480     $sth->finish();
4481
4482     # delete from items table
4483     $sth = $dbh->prepare("DELETE FROM items WHERE itemnumber=?");
4484     $sth->execute($itemnum);
4485     $sth->finish();
4486     return undef;
4487 }
4488
4489 =head1 UNEXPORTED FUNCTIONS
4490
4491 =head2 ModBiblioMarc
4492
4493     &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
4494
4495     Add MARC data for a biblio to koha
4496
4497     Function exported, but should NOT be used, unless you really know what you're doing
4498
4499 =cut
4500
4501 sub ModBiblioMarc {
4502
4503 # pass the MARC::Record to this function, and it will create the records in the marc field
4504     my ( $record, $biblionumber, $frameworkcode ) = @_;
4505     my $dbh = C4::Context->dbh;
4506     my @fields = $record->fields();
4507     if ( !$frameworkcode ) {
4508         $frameworkcode = "";
4509     }
4510     my $sth =
4511       $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
4512     $sth->execute( $frameworkcode, $biblionumber );
4513     $sth->finish;
4514     my $encoding = C4::Context->preference("marcflavour");
4515
4516     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
4517     if ( $encoding eq "UNIMARC" ) {
4518         my $string;
4519         if ( length($record->subfield( 100, "a" )) == 35 ) {
4520             $string = $record->subfield( 100, "a" );
4521             my $f100 = $record->field(100);
4522             $record->delete_field($f100);
4523         }
4524         else {
4525             $string = POSIX::strftime( "%Y%m%d", localtime );
4526             $string =~ s/\-//g;
4527             $string = sprintf( "%-*s", 35, $string );
4528         }
4529         substr( $string, 22, 6, "frey50" );
4530         unless ( $record->subfield( 100, "a" ) ) {
4531             $record->insert_grouped_field(
4532                 MARC::Field->new( 100, "", "", "a" => $string ) );
4533         }
4534     }
4535     ModZebra($biblionumber,"specialUpdate","biblioserver",$record);
4536     $sth =
4537       $dbh->prepare(
4538         "UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
4539     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding),
4540         $biblionumber );
4541     $sth->finish;
4542     return $biblionumber;
4543 }
4544
4545 =head2 AddItemInMarc
4546
4547 =over 4
4548
4549 $newbiblionumber = AddItemInMarc( $record, $biblionumber, $frameworkcode );
4550
4551 Add an item in a MARC record and save the MARC record
4552
4553 Function exported, but should NOT be used, unless you really know what you're doing
4554
4555 =back
4556
4557 =cut
4558
4559 sub AddItemInMarc {
4560
4561     # pass the MARC::Record to this function, and it will create the records in the marc tables
4562     my ( $record, $biblionumber, $frameworkcode ) = @_;
4563     my $newrec = &GetMarcBiblio($biblionumber);
4564
4565     # create it
4566     my @fields = $record->fields();
4567     foreach my $field (@fields) {
4568         $newrec->append_fields($field);
4569     }
4570
4571     # FIXME: should we be making sure the biblionumbers are the same?
4572     my $newbiblionumber =
4573       &ModBiblioMarc( $newrec, $biblionumber, $frameworkcode );
4574     return $newbiblionumber;
4575 }
4576
4577 =head2 z3950_extended_services
4578
4579 z3950_extended_services($serviceType,$serviceOptions,$record);
4580
4581     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.
4582
4583 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
4584
4585 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
4586
4587     action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
4588
4589 and maybe
4590
4591     recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
4592     syntax => the record syntax (transfer syntax)
4593     databaseName = Database from connection object
4594
4595     To set serviceOptions, call set_service_options($serviceType)
4596
4597 C<$record> the record, if one is needed for the service type
4598
4599     A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
4600
4601 =cut
4602
4603 sub z3950_extended_services {
4604     my ( $server, $serviceType, $action, $serviceOptions ) = @_;
4605
4606     # get our connection object
4607     my $Zconn = C4::Context->Zconn( $server, 0, 1 );
4608
4609     # create a new package object
4610     my $Zpackage = $Zconn->package();
4611
4612     # set our options
4613     $Zpackage->option( action => $action );
4614
4615     if ( $serviceOptions->{'databaseName'} ) {
4616         $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
4617     }
4618     if ( $serviceOptions->{'recordIdNumber'} ) {
4619         $Zpackage->option(
4620             recordIdNumber => $serviceOptions->{'recordIdNumber'} );
4621     }
4622     if ( $serviceOptions->{'recordIdOpaque'} ) {
4623         $Zpackage->option(
4624             recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
4625     }
4626
4627  # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
4628  #if ($serviceType eq 'itemorder') {
4629  #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
4630  #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
4631  #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
4632  #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
4633  #}
4634
4635     if ( $serviceOptions->{record} ) {
4636         $Zpackage->option( record => $serviceOptions->{record} );
4637
4638         # can be xml or marc
4639         if ( $serviceOptions->{'syntax'} ) {
4640             $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
4641         }
4642     }
4643
4644     # send the request, handle any exception encountered
4645     eval { $Zpackage->send($serviceType) };
4646     if ( $@ && $@->isa("ZOOM::Exception") ) {
4647         return "error:  " . $@->code() . " " . $@->message() . "\n";
4648     }
4649
4650     # free up package resources
4651     $Zpackage->destroy();
4652 }
4653
4654 =head2 set_service_options
4655
4656 my $serviceOptions = set_service_options($serviceType);
4657
4658 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
4659
4660 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
4661
4662 =cut
4663
4664 sub set_service_options {
4665     my ($serviceType) = @_;
4666     my $serviceOptions;
4667
4668 # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
4669 #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
4670
4671     if ( $serviceType eq 'commit' ) {
4672
4673         # nothing to do
4674     }
4675     if ( $serviceType eq 'create' ) {
4676
4677         # nothing to do
4678     }
4679     if ( $serviceType eq 'drop' ) {
4680         die "ERROR: 'drop' not currently supported (by Zebra)";
4681     }
4682     return $serviceOptions;
4683 }
4684
4685 =head2 GetItemsCount
4686
4687 $count = &GetItemsCount( $biblionumber);
4688 this function return count of item with $biblionumber
4689 =cut
4690
4691 sub GetItemsCount {
4692     my ( $biblionumber ) = @_;
4693     my $dbh = C4::Context->dbh;
4694     my $query = "SELECT count(*)
4695           FROM  items
4696           WHERE biblionumber=?";
4697     my $sth = $dbh->prepare($query);
4698     $sth->execute($biblionumber);
4699     my $count = $sth->fetchrow;
4700     $sth->finish;
4701     return ($count);
4702 }
4703
4704 END { }    # module clean-up code here (global destructor)
4705
4706 1;
4707
4708 __END__
4709
4710 =head1 AUTHOR
4711
4712 Koha Developement team <info@koha.org>
4713
4714 Paul POULAIN paul.poulain@free.fr
4715
4716 Joshua Ferraro jmf@liblime.com
4717
4718 =cut