C4/Biblio.pm

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