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