C4/Biblio.pm

   1 package C4::Biblio;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20 use strict;
  21
  22 require Exporter;
  23 # use utf8;
  24 use C4::Context;
  25 use MARC::Record;
  26 use MARC::File::USMARC;
  27 use MARC::File::XML;
  28 use ZOOM;
  29 use C4::Koha;
  30 use C4::Dates qw/format_date/;
  31 use C4::Log; # logaction
  32 use C4::ClassSource;
  33
  34 use vars qw($VERSION @ISA @EXPORT);
  35
  36 # TODO: fix version
  37 # $VERSION = ?;
  38
  39 @ISA = qw( Exporter );
  40
  41 # EXPORTED FUNCTIONS.
  42
  43 # to add biblios or items
  44 push @EXPORT, qw( &AddBiblio &AddItem );
  45
  46 # to get something
  47 push @EXPORT, qw(
  48   &GetBiblio
  49   &GetBiblioData
  50   &GetBiblioItemData
  51   &GetBiblioItemInfosOf
  52   &GetBiblioItemByBiblioNumber
  53   &GetBiblioFromItemNumber
  54
  55   &GetMarcItem
  56   &GetItem
  57   &GetItemInfosOf
  58   &GetItemStatus
  59   &GetItemLocation
  60   &GetLostItems
  61   &GetItemsForInventory
  62   &GetItemsCount
  63
  64   &GetMarcNotes
  65   &GetMarcSubjects
  66   &GetMarcBiblio
  67   &GetMarcAuthors
  68   &GetMarcSeries
  69   GetMarcUrls
  70   &GetUsedMarcStructure
  71
  72   &GetItemsInfo
  73   &GetItemsByBiblioitemnumber
  74   &GetItemnumberFromBarcode
  75   &get_itemnumbers_of
  76   &GetXmlBiblio
  77
  78   &GetAuthorisedValueDesc
  79   &GetMarcStructure
  80   &GetMarcFromKohaField
  81   &GetFrameworkCode
  82   &GetPublisherNameFromIsbn
  83   &TransformKohaToMarc
  84 );
  85
  86 # To modify something
  87 push @EXPORT, qw(
  88   &ModBiblio
  89   &ModItem
  90   &ModItemTransfer
  91   &ModBiblioframework
  92   &ModZebra
  93   &ModItemInMarc
  94   &ModItemInMarconefield
  95   &ModDateLastSeen
  96 );
  97
  98 # To delete something
  99 push @EXPORT, qw(
 100   &DelBiblio
 101   &DelItem
 102 );
 103
 104 # Internal functions
 105 # those functions are exported but should not be used
 106 # they are usefull is few circumstances, so are exported.
 107 # but don't use them unless you're a core developer ;-)
 108 push @EXPORT, qw(
 109   &ModBiblioMarc
 110   &AddItemInMarc
 111 );
 112
 113 # Others functions
 114 push @EXPORT, qw(
 115   &TransformMarcToKoha
 116   &TransformHtmlToMarc2
 117   &TransformHtmlToMarc
 118   &TransformHtmlToXml
 119   &PrepareItemrecordDisplay
 120   &char_decode
 121   &GetNoZebraIndexes
 122 );
 123
 124 =head1 NAME
 125
 126 C4::Biblio - cataloging management functions
 127
 128 =head1 DESCRIPTION
 129
 130 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:
 131
 132 =over 4
 133
 134 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
 135
 136 =item 2. as raw MARC in the Zebra index and storage engine
 137
 138 =item 3. as raw MARC the biblioitems.marc and biblioitems.marcxml
 139
 140 =back
 141
 142 In the 3.0 version of Koha, the authoritative record-level information is in biblioitems.marcxml
 143
 144 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.
 145
 146 =over 4
 147
 148 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
 149
 150 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
 151
 152 =back
 153
 154 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:
 155
 156 =over 4
 157
 158 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
 159
 160 =item 2. _koha_* - low-level internal functions for managing the koha tables
 161
 162 =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.
 163
 164 =item 4. Zebra functions used to update the Zebra index
 165
 166 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
 167
 168 =back
 169
 170 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 :
 171
 172 =over 4
 173
 174 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
 175
 176 =item 2. add the biblionumber and biblioitemnumber into the MARC records
 177
 178 =item 3. save the marc record
 179
 180 =back
 181
 182 When dealing with items, we must :
 183
 184 =over 4
 185
 186 =item 1. save the item in items table, that gives us an itemnumber
 187
 188 =item 2. add the itemnumber to the item MARC field
 189
 190 =item 3. overwrite the MARC record (with the added item) into biblioitems.marc(xml)
 191
 192 When modifying a biblio or an item, the behaviour is quite similar.
 193
 194 =back
 195
 196 =head1 EXPORTED FUNCTIONS
 197
 198 =head2 AddBiblio
 199
 200 =over 4
 201
 202 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
 203 Exported function (core API) for adding a new biblio to koha.
 204
 205 =back
 206
 207 =cut
 208
 209 sub AddBiblio {
 210     my ( $record, $frameworkcode ) = @_;
 211         my ($biblionumber,$biblioitemnumber,$error);
 212     my $dbh = C4::Context->dbh;
 213     # transform the data into koha-table style data
 214     my $olddata = TransformMarcToKoha( $dbh, $record, $frameworkcode );
 215     ($biblionumber,$error) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
 216     $olddata->{'biblionumber'} = $biblionumber;
 217     ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $olddata );
 218
 219     _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
 220
 221     # now add the record
 222     $biblionumber = ModBiblioMarc( $record, $biblionumber, $frameworkcode );
 223
 224     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$biblionumber,"biblio")
 225         if C4::Context->preference("CataloguingLog");
 226
 227     return ( $biblionumber, $biblioitemnumber );
 228 }
 229
 230 =head2 AddItem
 231
 232 =over 2
 233
 234     $biblionumber = AddItem( $record, $biblionumber)
 235     Exported function (core API) for adding a new item to Koha
 236
 237 =back
 238
 239 =cut
 240
 241 sub AddItem {
 242     my ( $record, $biblionumber ) = @_;
 243     my $dbh = C4::Context->dbh;
 244
 245     # add item in old-DB
 246     my $frameworkcode = GetFrameworkCode( $biblionumber );
 247     my $item = &TransformMarcToKoha( $dbh, $record, $frameworkcode );
 248
 249     # needs old biblionumber and biblioitemnumber
 250     $item->{'biblionumber'} = $biblionumber;
 251     my $sth =
 252       $dbh->prepare(
 253         "SELECT biblioitemnumber,itemtype FROM biblioitems WHERE biblionumber=?"
 254       );
 255     $sth->execute( $item->{'biblionumber'} );
 256     my $itemtype;
 257     ( $item->{'biblioitemnumber'}, $itemtype ) = $sth->fetchrow;
 258     $sth =
 259       $dbh->prepare(
 260         "SELECT notforloan FROM itemtypes WHERE itemtype='$itemtype'");
 261     $sth->execute();
 262     my $notforloan = $sth->fetchrow;
 263     ##Change the notforloan field if $notforloan found
 264     if ( $notforloan > 0 ) {
 265         $item->{'notforloan'} = $notforloan;
 266         &MARCitemchange( $record, "items.notforloan", $notforloan );
 267     }
 268     if ( !$item->{'dateaccessioned'} || $item->{'dateaccessioned'} eq '' ) {
 269
 270         # find today's date
 271         my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
 272           localtime(time);
 273         $year += 1900;
 274         $mon  += 1;
 275         my $date =
 276           "$year-" . sprintf( "%0.2d", $mon ) . "-" . sprintf( "%0.2d", $mday );
 277         $item->{'dateaccessioned'} = $date;
 278         &MARCitemchange( $record, "items.dateaccessioned", $date );
 279     }
 280     my ( $itemnumber, $error ) = &_koha_new_items( $dbh, $item, $item->{barcode} );
 281     # add itemnumber to MARC::Record before adding the item.
 282     $sth = $dbh->prepare(
 283 "SELECT tagfield,tagsubfield
 284 FROM marc_subfield_structure
 285 WHERE frameworkcode=?
 286         AND kohafield=?"
 287       );
 288     &TransformKohaToMarcOneField( $sth, $record, "items.itemnumber", $itemnumber,
 289         $frameworkcode );
 290
 291     # add the item
 292     &AddItemInMarc( $record, $item->{'biblionumber'},$frameworkcode );
 293
 294     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$itemnumber,"item")
 295         if C4::Context->preference("CataloguingLog");
 296
 297     return ($item->{biblionumber}, $item->{biblioitemnumber},$itemnumber);
 298 }
 299
 300 =head2 ModBiblio
 301
 302     ModBiblio( $record,$biblionumber,$frameworkcode);
 303     Exported function (core API) to modify a biblio
 304
 305 =cut
 306
 307 sub ModBiblio {
 308     my ( $record, $biblionumber, $frameworkcode ) = @_;
 309     if (C4::Context->preference("CataloguingLog")) {
 310         my $newrecord = GetMarcBiblio($biblionumber);
 311         &logaction(C4::Context->userenv->{'number'},"CATALOGUING","MODIFY",$biblionumber,"BEFORE=>".$newrecord->as_formatted);
 312     }
 313
 314     my $dbh = C4::Context->dbh;
 315
 316     $frameworkcode = "" unless $frameworkcode;
 317
 318     # get the items before and append them to the biblio before updating the record, atm we just have the biblio
 319     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField("items.itemnumber",$frameworkcode);
 320     my $oldRecord = GetMarcBiblio( $biblionumber );
 321
 322     # parse each item, and, for an unknown reason, re-encode each subfield
 323     # if you don't do that, the record will have encoding mixed
 324     # and the biblio will be re-encoded.
 325     # strange, I (Paul P.) searched more than 1 day to understand what happends
 326     # but could only solve the problem this way...
 327    my @fields = $oldRecord->field( $itemtag );
 328     foreach my $fielditem ( @fields ){
 329         my $field;
 330         foreach ($fielditem->subfields()) {
 331             if ($field) {
 332                 $field->add_subfields(Encode::encode('utf-8',$_->[0]) => Encode::encode('utf-8',$_->[1]));
 333             } else {
 334                 $field = MARC::Field->new("$itemtag",'','',Encode::encode('utf-8',$_->[0]) => Encode::encode('utf-8',$_->[1]));
 335             }
 336           }
 337         $record->append_fields($field);
 338     }
 339
 340     # update biblionumber and biblioitemnumber in MARC
 341     # FIXME - this is assuming a 1 to 1 relationship between
 342     # biblios and biblioitems
 343     my $sth =  $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
 344     $sth->execute($biblionumber);
 345     my ($biblioitemnumber) = $sth->fetchrow;
 346     $sth->finish();
 347     _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
 348
 349     # update the MARC record (that now contains biblio and items) with the new record data
 350     &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
 351
 352     # load the koha-table data object
 353     my $oldbiblio = TransformMarcToKoha( $dbh, $record, $frameworkcode );
 354
 355     # modify the other koha tables
 356     _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
 357     _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
 358     return 1;
 359 }
 360
 361 =head2 ModItem
 362
 363 =over 2
 364
 365 Exported function (core API) for modifying an item in Koha.
 366
 367 =back
 368
 369 =cut
 370
 371 sub ModItem {
 372     my ( $record, $biblionumber, $itemnumber, $delete, $new_item_hashref )
 373       = @_;
 374
 375     #logging
 376     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","MODIFY",$itemnumber,$record->as_formatted)
 377         if C4::Context->preference("CataloguingLog");
 378
 379     my $dbh = C4::Context->dbh;
 380
 381     # if we have a MARC record, we're coming from cataloging and so
 382     # we do the whole routine: update the MARC and zebra, then update the koha
 383     # tables
 384     if ($record) {
 385         my $frameworkcode = GetFrameworkCode( $biblionumber );
 386         ModItemInMarc( $record, $biblionumber, $itemnumber, $frameworkcode );
 387         my $olditem       = TransformMarcToKoha( $dbh, $record, $frameworkcode,'items');
 388         $olditem->{'biblionumber'} = $biblionumber;
 389         my $sth =  $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
 390         $sth->execute($biblionumber);
 391         my ($biblioitemnumber) = $sth->fetchrow;
 392         $sth->finish();
 393         $olditem->{'biblioitemnumber'} = $biblioitemnumber;
 394         _koha_modify_item( $dbh, $olditem );
 395         return $biblionumber;
 396     }
 397
 398     # otherwise, we're just looking to modify something quickly
 399     # (like a status) so we just update the koha tables
 400     elsif ($new_item_hashref) {
 401         _koha_modify_item( $dbh, $new_item_hashref );
 402     }
 403 }
 404
 405 sub ModItemTransfer {
 406     my ( $itemnumber, $frombranch, $tobranch ) = @_;
 407
 408     my $dbh = C4::Context->dbh;
 409
 410     #new entry in branchtransfers....
 411     my $sth = $dbh->prepare(
 412         "INSERT INTO branchtransfers (itemnumber, frombranch, datesent, tobranch)
 413         VALUES (?, ?, NOW(), ?)");
 414     $sth->execute($itemnumber, $frombranch, $tobranch);
 415     #update holdingbranch in items .....
 416      $sth= $dbh->prepare(
 417           "UPDATE items SET holdingbranch = ? WHERE items.itemnumber = ?");
 418     $sth->execute($tobranch,$itemnumber);
 419     &ModDateLastSeen($itemnumber);
 420     $sth = $dbh->prepare(
 421         "SELECT biblionumber FROM items WHERE itemnumber=?"
 422       );
 423     $sth->execute($itemnumber);
 424     while ( my ( $biblionumber ) = $sth->fetchrow ) {
 425         &ModItemInMarconefield( $biblionumber, $itemnumber,
 426             'items.holdingbranch', $tobranch );
 427     }
 428     return;
 429 }
 430
 431 =head2 ModBiblioframework
 432
 433     ModBiblioframework($biblionumber,$frameworkcode);
 434     Exported function to modify a biblio framework
 435
 436 =cut
 437
 438 sub ModBiblioframework {
 439     my ( $biblionumber, $frameworkcode ) = @_;
 440     my $dbh = C4::Context->dbh;
 441     my $sth = $dbh->prepare(
 442         "UPDATE biblio SET frameworkcode=? WHERE biblionumber=?"
 443     );
 444     $sth->execute($frameworkcode, $biblionumber);
 445     return 1;
 446 }
 447
 448 =head2 ModItemInMarconefield
 449
 450 =over
 451
 452 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)
 453 &ModItemInMarconefield( $biblionumber, $itemnumber, $itemfield, $newvalue )
 454
 455 =back
 456
 457 =cut
 458
 459 sub ModItemInMarconefield {
 460     my ( $biblionumber, $itemnumber, $itemfield, $newvalue ) = @_;
 461     my $dbh = C4::Context->dbh;
 462     if ( !defined $newvalue ) {
 463         $newvalue = "";
 464     }
 465
 466     my $record = GetMarcItem( $biblionumber, $itemnumber );
 467     my ($tagfield, $tagsubfield) = GetMarcFromKohaField( $itemfield,'');
 468     if ($tagfield && $tagsubfield) {
 469         my $tag = $record->field($tagfield);
 470         if ($tag) {
 471 #             my $tagsubs = $record->field($tagfield)->subfield($tagsubfield);
 472             $tag->update( $tagsubfield => $newvalue );
 473             $record->delete_field($tag);
 474             $record->insert_fields_ordered($tag);
 475             &ModItemInMarc( $record, $biblionumber, $itemnumber, 0 );
 476         }
 477     }
 478 }
 479
 480 =head2 ModItemInMarc
 481
 482 =over
 483
 484 &ModItemInMarc( $record, $biblionumber, $itemnumber )
 485
 486 =back
 487
 488 =cut
 489
 490 sub ModItemInMarc {
 491     my ( $ItemRecord, $biblionumber, $itemnumber, $frameworkcode) = @_;
 492     my $dbh = C4::Context->dbh;
 493
 494     # get complete MARC record & replace the item field by the new one
 495     my $completeRecord = GetMarcBiblio($biblionumber);
 496     my ($itemtag,$itemsubfield) = GetMarcFromKohaField("items.itemnumber",$frameworkcode);
 497     my $itemField = $ItemRecord->field($itemtag);
 498     my @items = $completeRecord->field($itemtag);
 499     foreach (@items) {
 500         if ($_->subfield($itemsubfield) eq $itemnumber) {
 501 #             $completeRecord->delete_field($_);
 502             $_->replace_with($itemField);
 503         }
 504     }
 505     # save the record
 506     my $sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
 507     $sth->execute( $completeRecord->as_usmarc(), $completeRecord->as_xml_record(),$biblionumber );
 508     $sth->finish;
 509     ModZebra($biblionumber,"specialUpdate","biblioserver",$completeRecord);
 510 }
 511
 512 =head2 ModDateLastSeen
 513
 514 &ModDateLastSeen($itemnum)
 515 Mark item as seen. Is called when an item is issued, returned or manually marked during inventory/stocktaking
 516 C<$itemnum> is the item number
 517
 518 =cut
 519
 520 sub ModDateLastSeen {
 521     my ($itemnum) = @_;
 522     my $dbh       = C4::Context->dbh;
 523     my $sth       =
 524       $dbh->prepare(
 525           "UPDATE items SET itemlost=0,datelastseen  = NOW() WHERE items.itemnumber = ?"
 526       );
 527     $sth->execute($itemnum);
 528     return;
 529 }
 530 =head2 DelBiblio
 531
 532 =over
 533
 534 my $error = &DelBiblio($dbh,$biblionumber);
 535 Exported function (core API) for deleting a biblio in koha.
 536 Deletes biblio record from Zebra and Koha tables (biblio,biblioitems,items)
 537 Also backs it up to deleted* tables
 538 Checks to make sure there are not issues on any of the items
 539 return:
 540 C<$error> : undef unless an error occurs
 541
 542 =back
 543
 544 =cut
 545
 546 sub DelBiblio {
 547     my ( $biblionumber ) = @_;
 548     my $dbh = C4::Context->dbh;
 549     my $error;    # for error handling
 550
 551         # First make sure this biblio has no items attached
 552         my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
 553         $sth->execute($biblionumber);
 554         if (my $itemnumber = $sth->fetchrow){
 555                 # Fix this to use a status the template can understand
 556                 $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
 557         }
 558
 559     return $error if $error;
 560
 561     # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
 562     # for at least 2 reasons :
 563     # - we need to read the biblio if NoZebra is set (to remove it from the indexes
 564     # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
 565     #   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)
 566     ModZebra($biblionumber, "delete_record", "biblioserver", undef);
 567
 568     # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
 569     $sth =
 570       $dbh->prepare(
 571         "SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
 572     $sth->execute($biblionumber);
 573     while ( my $biblioitemnumber = $sth->fetchrow ) {
 574
 575         # delete this biblioitem
 576         $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
 577         return $error if $error;
 578     }
 579
 580     # delete biblio from Koha tables and save in deletedbiblio
 581     # must do this *after* _koha_delete_biblioitems, otherwise
 582     # delete cascade will prevent deletedbiblioitems rows
 583     # from being generated by _koha_delete_biblioitems
 584     $error = _koha_delete_biblio( $dbh, $biblionumber );
 585
 586     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","DELETE",$biblionumber,"")
 587         if C4::Context->preference("CataloguingLog");
 588     return;
 589 }
 590
 591 =head2 DelItem
 592
 593 =over
 594
 595 DelItem( $biblionumber, $itemnumber );
 596 Exported function (core API) for deleting an item record in Koha.
 597
 598 =back
 599
 600 =cut
 601
 602 sub DelItem {
 603     my ( $dbh, $biblionumber, $itemnumber ) = @_;
 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     if ($marcxml) {
1619         $record = eval {MARC::Record::new_from_xml( $marcxml, "utf8", C4::Context->preference('marcflavour'))};
1620         if ($@) {warn $@;}
1621 #      $record = MARC::Record::new_from_usmarc( $marc) if $marc;
1622         return $record;
1623     } else {
1624         return undef;
1625     }
1626 }
1627
1628 =head2 GetXmlBiblio
1629
1630 =over 4
1631
1632 my $marcxml = GetXmlBiblio($biblionumber);
1633
1634 Returns biblioitems.marcxml of the biblionumber passed in parameter.
1635 The XML contains both biblio & item datas
1636
1637 =back
1638
1639 =cut
1640
1641 sub GetXmlBiblio {
1642     my ( $biblionumber ) = @_;
1643     my $dbh = C4::Context->dbh;
1644     my $sth =
1645       $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1646     $sth->execute($biblionumber);
1647     my ($marcxml) = $sth->fetchrow;
1648     return $marcxml;
1649 }
1650
1651 =head2 GetAuthorisedValueDesc
1652
1653 =over 4
1654
1655 my $subfieldvalue =get_authorised_value_desc(
1656     $tag, $subf[$i][0],$subf[$i][1], '', $taglib);
1657 Retrieve the complete description for a given authorised value.
1658
1659 =back
1660
1661 =cut
1662
1663 sub GetAuthorisedValueDesc {
1664     my ( $tag, $subfield, $value, $framework, $tagslib ) = @_;
1665     my $dbh = C4::Context->dbh;
1666
1667     #---- branch
1668     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1669         return C4::Branch::GetBranchName($value);
1670     }
1671
1672     #---- itemtypes
1673     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1674         return getitemtypeinfo($value)->{description};
1675     }
1676
1677     #---- "true" authorized value
1678     my $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1679     if ( $category ne "" ) {
1680         my $sth =
1681           $dbh->prepare(
1682             "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
1683           );
1684         $sth->execute( $category, $value );
1685         my $data = $sth->fetchrow_hashref;
1686         return $data->{'lib'};
1687     }
1688     else {
1689         return $value;    # if nothing is found return the original value
1690     }
1691 }
1692
1693 =head2 GetMarcItem
1694
1695 =over 4
1696
1697 Returns MARC::Record of the item passed in parameter.
1698
1699 =back
1700
1701 =cut
1702
1703 sub GetMarcItem {
1704     my ( $biblionumber, $itemnumber ) = @_;
1705     my $dbh = C4::Context->dbh;
1706     my $newrecord = MARC::Record->new();
1707     my $marcflavour = C4::Context->preference('marcflavour');
1708
1709     my $marcxml = GetXmlBiblio($biblionumber);
1710     my $record = MARC::Record->new();
1711     $record = MARC::Record::new_from_xml( $marcxml, "utf8", $marcflavour );
1712     # now, find where the itemnumber is stored & extract only the item
1713     my ( $itemnumberfield, $itemnumbersubfield ) =
1714       GetMarcFromKohaField( 'items.itemnumber', '' );
1715     my @fields = $record->field($itemnumberfield);
1716     foreach my $field (@fields) {
1717         if ( $field->subfield($itemnumbersubfield) eq $itemnumber ) {
1718             $newrecord->insert_fields_ordered($field);
1719         }
1720     }
1721     return $newrecord;
1722 }
1723
1724
1725
1726 =head2 GetMarcNotes
1727
1728 =over 4
1729
1730 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1731 Get all notes from the MARC record and returns them in an array.
1732 The note are stored in differents places depending on MARC flavour
1733
1734 =back
1735
1736 =cut
1737
1738 sub GetMarcNotes {
1739     my ( $record, $marcflavour ) = @_;
1740     my $scope;
1741     if ( $marcflavour eq "MARC21" ) {
1742         $scope = '5..';
1743     }
1744     else {    # assume unimarc if not marc21
1745         $scope = '3..';
1746     }
1747     my @marcnotes;
1748     my $note = "";
1749     my $tag  = "";
1750     my $marcnote;
1751     foreach my $field ( $record->field($scope) ) {
1752         my $value = $field->as_string();
1753         if ( $note ne "" ) {
1754             $marcnote = { marcnote => $note, };
1755             push @marcnotes, $marcnote;
1756             $note = $value;
1757         }
1758         if ( $note ne $value ) {
1759             $note = $note . " " . $value;
1760         }
1761     }
1762
1763     if ( $note ) {
1764         $marcnote = { marcnote => $note };
1765         push @marcnotes, $marcnote;    #load last tag into array
1766     }
1767     return \@marcnotes;
1768 }    # end GetMarcNotes
1769
1770 =head2 GetMarcSubjects
1771
1772 =over 4
1773
1774 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1775 Get all subjects from the MARC record and returns them in an array.
1776 The subjects are stored in differents places depending on MARC flavour
1777
1778 =back
1779
1780 =cut
1781
1782 sub GetMarcSubjects {
1783     my ( $record, $marcflavour ) = @_;
1784     my ( $mintag, $maxtag );
1785     if ( $marcflavour eq "MARC21" ) {
1786         $mintag = "600";
1787         $maxtag = "699";
1788     }
1789     else {    # assume unimarc if not marc21
1790         $mintag = "600";
1791         $maxtag = "611";
1792     }
1793
1794     my @marcsubjects;
1795         my $subject = "";
1796         my $subfield = "";
1797         my $marcsubject;
1798
1799     foreach my $field ( $record->field('6..' )) {
1800         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1801                 my @subfields_loop;
1802         my @subfields = $field->subfields();
1803                 my $counter = 0;
1804                 my @link_loop;
1805                 for my $subject_subfield (@subfields ) {
1806                         # don't load unimarc subfields 3,4,5
1807                         next if (($marcflavour eq "UNIMARC") and ($subject_subfield->[0] =~ (3|4|5) ) );
1808                         my $code = $subject_subfield->[0];
1809                         my $value = $subject_subfield->[1];
1810                         my $linkvalue = $value;
1811                         $linkvalue =~ s/(\(|\))//g;
1812                         my $operator = " and " unless $counter==0;
1813                         push @link_loop, {link => $linkvalue, operator => $operator };
1814                         my $separator = C4::Context->preference("authoritysep") unless $counter==0;
1815                         # ignore $9
1816                         push @subfields_loop, {code => $code, value => $value, link_loop => \@link_loop, separator => $separator} unless ($subject_subfield->[0] == 9 );
1817                         # this needs to be added back in in a way that the template can expose it properly
1818                         #if ( $code == 9 ) {
1819             #    $link = "an:".$subject_subfield->[1];
1820             #    $flag = 1;
1821             #}
1822                         $counter++;
1823                 }
1824
1825                 push @marcsubjects, { MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop };
1826
1827         }
1828         return \@marcsubjects;
1829 }  #end getMARCsubjects
1830
1831 =head2 GetMarcAuthors
1832
1833 =over 4
1834
1835 authors = GetMarcAuthors($record,$marcflavour);
1836 Get all authors from the MARC record and returns them in an array.
1837 The authors are stored in differents places depending on MARC flavour
1838
1839 =back
1840
1841 =cut
1842
1843 sub GetMarcAuthors {
1844     my ( $record, $marcflavour ) = @_;
1845     my ( $mintag, $maxtag );
1846     # tagslib useful for UNIMARC author reponsabilities
1847     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.
1848     if ( $marcflavour eq "MARC21" ) {
1849         $mintag = "700";
1850         $maxtag = "720";
1851     }
1852     elsif ( $marcflavour eq "UNIMARC" ) {    # assume unimarc if not marc21
1853         $mintag = "701";
1854         $maxtag = "712";
1855     }
1856         else {
1857                 return;
1858         }
1859     my @marcauthors;
1860
1861     foreach my $field ( $record->fields ) {
1862         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1863         my %hash;
1864         my @subfields = $field->subfields();
1865         my $count_auth = 0;
1866         for my $authors_subfield (@subfields) {
1867                         #unimarc-specific line
1868             next if ($marcflavour eq 'UNIMARC' and (($authors_subfield->[0] eq '3') or ($authors_subfield->[0] eq '5')));
1869             my $subfieldcode = $authors_subfield->[0];
1870             my $value;
1871             # deal with UNIMARC author responsibility
1872                         if ( $marcflavour eq 'UNIMARC' and ($authors_subfield->[0] eq '4')) {
1873                 $value = "(".GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib ).")";
1874             } else {
1875                 $value        = $authors_subfield->[1];
1876             }
1877             $hash{tag}       = $field->tag;
1878             $hash{value}    .= $value . " " if ($subfieldcode != 9) ;
1879             $hash{link}     .= $value if ($subfieldcode eq 9);
1880         }
1881         push @marcauthors, \%hash;
1882     }
1883     return \@marcauthors;
1884 }
1885
1886 =head2 GetMarcUrls
1887
1888 =over 4
1889
1890 $marcurls = GetMarcUrls($record,$marcflavour);
1891 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1892 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1893
1894 =back
1895
1896 =cut
1897
1898 sub GetMarcUrls {
1899     my ($record, $marcflavour) = @_;
1900     my @marcurls;
1901     my $marcurl;
1902     for my $field ($record->field('856')) {
1903         my $url = $field->subfield('u');
1904         my @notes;
1905         for my $note ( $field->subfield('z')) {
1906             push @notes , {note => $note};
1907         }
1908         $marcurl = {  MARCURL => $url,
1909                       notes => \@notes,
1910                                         };
1911                 if($marcflavour eq 'MARC21') {
1912                 my $s3 = $field->subfield('3');
1913                         my $link = $field->subfield('y');
1914             $marcurl->{'linktext'} = $link || $s3 || $url ;;
1915             $marcurl->{'part'} = $s3 if($link);
1916             $marcurl->{'toc'} = 1 if($s3 =~ /^[Tt]able/) ;
1917                 } else {
1918                         $marcurl->{'linktext'} = $url;
1919                 }
1920         push @marcurls, $marcurl;
1921         }
1922     return \@marcurls;
1923 }  #end GetMarcUrls
1924
1925 =head2 GetMarcSeries
1926
1927 =over 4
1928
1929 $marcseriesarray = GetMarcSeries($record,$marcflavour);
1930 Get all series from the MARC record and returns them in an array.
1931 The series are stored in differents places depending on MARC flavour
1932
1933 =back
1934
1935 =cut
1936
1937 sub GetMarcSeries {
1938     my ($record, $marcflavour) = @_;
1939     my ($mintag, $maxtag);
1940     if ($marcflavour eq "MARC21") {
1941         $mintag = "440";
1942         $maxtag = "490";
1943     } else {           # assume unimarc if not marc21
1944         $mintag = "600";
1945         $maxtag = "619";
1946     }
1947
1948     my @marcseries;
1949     my $subjct = "";
1950     my $subfield = "";
1951     my $marcsubjct;
1952
1953     foreach my $field ($record->field('440'), $record->field('490')) {
1954         my @subfields_loop;
1955         #my $value = $field->subfield('a');
1956         #$marcsubjct = {MARCSUBJCT => $value,};
1957         my @subfields = $field->subfields();
1958         #warn "subfields:".join " ", @$subfields;
1959         my $counter = 0;
1960         my @link_loop;
1961         for my $series_subfield (@subfields) {
1962                         my $volume_number;
1963                         undef $volume_number;
1964                         # see if this is an instance of a volume
1965                         if ($series_subfield->[0] eq 'v') {
1966                                 $volume_number=1;
1967                         }
1968
1969             my $code = $series_subfield->[0];
1970             my $value = $series_subfield->[1];
1971             my $linkvalue = $value;
1972             $linkvalue =~ s/(\(|\))//g;
1973             my $operator = " and " unless $counter==0;
1974             push @link_loop, {link => $linkvalue, operator => $operator };
1975             my $separator = C4::Context->preference("authoritysep") unless $counter==0;
1976                         if ($volume_number) {
1977                         push @subfields_loop, {volumenum => $value};
1978                         }
1979                         else {
1980             push @subfields_loop, {code => $code, value => $value, link_loop => \@link_loop, separator => $separator, volumenum => $volume_number};
1981                         }
1982             $counter++;
1983         }
1984         push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1985         #$marcsubjct = {MARCSUBJCT => $field->as_string(),};
1986         #push @marcsubjcts, $marcsubjct;
1987         #$subjct = $value;
1988
1989     }
1990     my $marcseriessarray=\@marcseries;
1991     return $marcseriessarray;
1992 }  #end getMARCseriess
1993
1994 =head2 GetFrameworkCode
1995
1996 =over 4
1997
1998     $frameworkcode = GetFrameworkCode( $biblionumber )
1999
2000 =back
2001
2002 =cut
2003
2004 sub GetFrameworkCode {
2005     my ( $biblionumber ) = @_;
2006     my $dbh = C4::Context->dbh;
2007     my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
2008     $sth->execute($biblionumber);
2009     my ($frameworkcode) = $sth->fetchrow;
2010     return $frameworkcode;
2011 }
2012
2013 =head2 GetPublisherNameFromIsbn
2014
2015     $name = GetPublishercodeFromIsbn($isbn);
2016     if(defined $name){
2017         ...
2018     }
2019
2020 =cut
2021
2022 sub GetPublisherNameFromIsbn($){
2023     my $isbn = shift;
2024     $isbn =~ s/[- _]//g;
2025     $isbn =~ s/^0*//;
2026     my @codes = (split '-', DisplayISBN($isbn));
2027     my $code = $codes[0].$codes[1].$codes[2];
2028     my $dbh  = C4::Context->dbh;
2029     my $query = qq{
2030         SELECT distinct publishercode
2031         FROM   biblioitems
2032         WHERE  isbn LIKE ?
2033         AND    publishercode IS NOT NULL
2034         LIMIT 1
2035     };
2036     my $sth = $dbh->prepare($query);
2037     $sth->execute("$code%");
2038     my $name = $sth->fetchrow;
2039     return $name if length $name;
2040     return undef;
2041 }
2042
2043 =head2 TransformKohaToMarc
2044
2045 =over 4
2046
2047     $record = TransformKohaToMarc( $hash )
2048     This function builds partial MARC::Record from a hash
2049     Hash entries can be from biblio or biblioitems.
2050     This function is called in acquisition module, to create a basic catalogue entry from user entry
2051
2052 =back
2053
2054 =cut
2055
2056 sub TransformKohaToMarc {
2057
2058     my ( $hash ) = @_;
2059     my $dbh = C4::Context->dbh;
2060     my $sth =
2061     $dbh->prepare(
2062         "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?"
2063     );
2064     my $record = MARC::Record->new();
2065     foreach (keys %{$hash}) {
2066         &TransformKohaToMarcOneField( $sth, $record, $_,
2067             $hash->{$_}, '' );
2068         }
2069     return $record;
2070 }
2071
2072 =head2 TransformKohaToMarcOneField
2073
2074 =over 4
2075
2076     $record = TransformKohaToMarcOneField( $sth, $record, $kohafieldname, $value, $frameworkcode );
2077
2078 =back
2079
2080 =cut
2081
2082 sub TransformKohaToMarcOneField {
2083     my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_;
2084     $frameworkcode='' unless $frameworkcode;
2085     my $tagfield;
2086     my $tagsubfield;
2087
2088     if ( !defined $sth ) {
2089         my $dbh = C4::Context->dbh;
2090         $sth = $dbh->prepare(
2091             "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?"
2092         );
2093     }
2094     $sth->execute( $frameworkcode, $kohafieldname );
2095     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
2096         my $tag = $record->field($tagfield);
2097         if ($tag) {
2098             $tag->update( $tagsubfield => $value );
2099             $record->delete_field($tag);
2100             $record->insert_fields_ordered($tag);
2101         }
2102         else {
2103             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
2104         }
2105     }
2106     return $record;
2107 }
2108
2109 =head2 TransformHtmlToXml
2110
2111 =over 4
2112
2113 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type )
2114
2115 $auth_type contains :
2116 - nothing : rebuild a biblio, un UNIMARC the encoding is in 100$a pos 26/27
2117 - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2118 - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2119
2120 =back
2121
2122 =cut
2123
2124 sub TransformHtmlToXml {
2125     my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2126     my $xml = MARC::File::XML::header('UTF-8');
2127     $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2128     MARC::File::XML->default_record_format($auth_type);
2129     # in UNIMARC, field 100 contains the encoding
2130     # check that there is one, otherwise the
2131     # MARC::Record->new_from_xml will fail (and Koha will die)
2132     my $unimarc_and_100_exist=0;
2133     $unimarc_and_100_exist=1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
2134     my $prevvalue;
2135     my $prevtag = -1;
2136     my $first   = 1;
2137     my $j       = -1;
2138     for ( my $i = 0 ; $i <= @$tags ; $i++ ) {
2139         if (C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a") {
2140             # if we have a 100 field and it's values are not correct, skip them.
2141             # if we don't have any valid 100 field, we will create a default one at the end
2142             my $enc = substr( @$values[$i], 26, 2 );
2143             if ($enc eq '01' or $enc eq '50' or $enc eq '03') {
2144                 $unimarc_and_100_exist=1;
2145             } else {
2146                 next;
2147             }
2148         }
2149         @$values[$i] =~ s/&/&amp;/g;
2150         @$values[$i] =~ s/</&lt;/g;
2151         @$values[$i] =~ s/>/&gt;/g;
2152         @$values[$i] =~ s/"/&quot;/g;
2153         @$values[$i] =~ s/'/&apos;/g;
2154 #         if ( !utf8::is_utf8( @$values[$i] ) ) {
2155 #             utf8::decode( @$values[$i] );
2156 #         }
2157         if ( ( @$tags[$i] ne $prevtag ) ) {
2158             $j++ unless ( @$tags[$i] eq "" );
2159             if ( !$first ) {
2160                 $xml .= "</datafield>\n";
2161                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
2162                     && ( @$values[$i] ne "" ) )
2163                 {
2164                     my $ind1 = substr( @$indicator[$j], 0, 1 );
2165                     my $ind2;
2166                     if ( @$indicator[$j] ) {
2167                         $ind2 = substr( @$indicator[$j], 1, 1 );
2168                     }
2169                     else {
2170                         warn "Indicator in @$tags[$i] is empty";
2171                         $ind2 = " ";
2172                     }
2173                     $xml .=
2174 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2175                     $xml .=
2176 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2177                     $first = 0;
2178                 }
2179                 else {
2180                     $first = 1;
2181                 }
2182             }
2183             else {
2184                 if ( @$values[$i] ne "" ) {
2185
2186                     # leader
2187                     if ( @$tags[$i] eq "000" ) {
2188                         $xml .= "<leader>@$values[$i]</leader>\n";
2189                         $first = 1;
2190
2191                         # rest of the fixed fields
2192                     }
2193                     elsif ( @$tags[$i] < 10 ) {
2194                         $xml .=
2195 "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2196                         $first = 1;
2197                     }
2198                     else {
2199                         my $ind1 = substr( @$indicator[$j], 0, 1 );
2200                         my $ind2 = substr( @$indicator[$j], 1, 1 );
2201                         $xml .=
2202 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2203                         $xml .=
2204 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2205                         $first = 0;
2206                     }
2207                 }
2208             }
2209         }
2210         else {    # @$tags[$i] eq $prevtag
2211             if ( @$values[$i] eq "" ) {
2212             }
2213             else {
2214                 if ($first) {
2215                     my $ind1 = substr( @$indicator[$j], 0, 1 );
2216                     my $ind2 = substr( @$indicator[$j], 1, 1 );
2217                     $xml .=
2218 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2219                     $first = 0;
2220                 }
2221                 $xml .=
2222 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2223             }
2224         }
2225         $prevtag = @$tags[$i];
2226     }
2227     if (C4::Context->preference('marcflavour') and !$unimarc_and_100_exist) {
2228 #     warn "SETTING 100 for $auth_type";
2229         use POSIX qw(strftime);
2230         my $string = strftime( "%Y%m%d", localtime(time) );
2231         # set 50 to position 26 is biblios, 13 if authorities
2232         my $pos=26;
2233         $pos=13 if $auth_type eq 'UNIMARCAUTH';
2234         $string = sprintf( "%-*s", 35, $string );
2235         substr( $string, $pos , 6, "50" );
2236         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2237         $xml .= "<subfield code=\"a\">$string</subfield>\n";
2238         $xml .= "</datafield>\n";
2239     }
2240     $xml .= MARC::File::XML::footer();
2241     return $xml;
2242 }
2243
2244 =head2 TransformHtmlToMarc
2245
2246     L<$record> = TransformHtmlToMarc(L<$params>,L<$cgi>)
2247     L<$params> is a ref to an array as below:
2248     {
2249         'tag_010_indicator_531951' ,
2250         'tag_010_code_a_531951_145735' ,
2251         'tag_010_subfield_a_531951_145735' ,
2252         'tag_200_indicator_873510' ,
2253         'tag_200_code_a_873510_673465' ,
2254         'tag_200_subfield_a_873510_673465' ,
2255         'tag_200_code_b_873510_704318' ,
2256         'tag_200_subfield_b_873510_704318' ,
2257         'tag_200_code_e_873510_280822' ,
2258         'tag_200_subfield_e_873510_280822' ,
2259         'tag_200_code_f_873510_110730' ,
2260         'tag_200_subfield_f_873510_110730' ,
2261     }
2262     L<$cgi> is the CGI object which containts the value.
2263     L<$record> is the MARC::Record object.
2264
2265 =cut
2266
2267 sub TransformHtmlToMarc {
2268     my $params = shift;
2269     my $cgi    = shift;
2270
2271     # creating a new record
2272     my $record  = MARC::Record->new();
2273     my $i=0;
2274     my @fields;
2275     while ($params->[$i]){ # browse all CGI params
2276         my $param = $params->[$i];
2277         my $newfield=0;
2278         # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2279         if ($param eq 'biblionumber') {
2280             my ( $biblionumbertagfield, $biblionumbertagsubfield ) =
2281                 &GetMarcFromKohaField( "biblio.biblionumber", '' );
2282             if ($biblionumbertagfield < 10) {
2283                 $newfield = MARC::Field->new(
2284                     $biblionumbertagfield,
2285                     $cgi->param($param),
2286                 );
2287             } else {
2288                 $newfield = MARC::Field->new(
2289                     $biblionumbertagfield,
2290                     '',
2291                     '',
2292                     "$biblionumbertagsubfield" => $cgi->param($param),
2293                 );
2294             }
2295             push @fields,$newfield if($newfield);
2296         }
2297         elsif ($param =~ /^tag_(\d*)_indicator_/){ # new field start when having 'input name="..._indicator_..."
2298             my $tag  = $1;
2299
2300             my $ind1 = substr($cgi->param($param),0,1);
2301             my $ind2 = substr($cgi->param($param),1,1);
2302             $newfield=0;
2303             my $j=$i+1;
2304
2305             if($tag < 10){ # no code for theses fields
2306     # in MARC editor, 000 contains the leader.
2307                 if ($tag eq '000' ) {
2308                     $record->leader($cgi->param($params->[$j+1])) if length($cgi->param($params->[$j+1]))==25;
2309     # between 001 and 009 (included)
2310                 } else {
2311                     $newfield = MARC::Field->new(
2312                         $tag,
2313                         $cgi->param($params->[$j+1]),
2314                     );
2315                 }
2316     # > 009, deal with subfields
2317             } else {
2318                 while($params->[$j] =~ /_code_/){ # browse all it's subfield
2319                     my $inner_param = $params->[$j];
2320                     if ($newfield){
2321                         if($cgi->param($params->[$j+1])){  # only if there is a value (code => value)
2322                             $newfield->add_subfields(
2323                                 $cgi->param($inner_param) => $cgi->param($params->[$j+1])
2324                             );
2325                         }
2326                     } else {
2327                         if ( $cgi->param($params->[$j+1]) ) { # creating only if there is a value (code => value)
2328                             $newfield = MARC::Field->new(
2329                                 $tag,
2330                                 ''.$ind1,
2331                                 ''.$ind2,
2332                                 $cgi->param($inner_param) => $cgi->param($params->[$j+1]),
2333                             );
2334                         }
2335                     }
2336                     $j+=2;
2337                 }
2338             }
2339             push @fields,$newfield if($newfield);
2340         }
2341         $i++;
2342     }
2343
2344     $record->append_fields(@fields);
2345     warn "RESULT : ".$record->as_formatted;
2346     return $record;
2347 }
2348
2349 =head2 TransformMarcToKoha
2350
2351 =over 4
2352
2353         $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
2354
2355 =back
2356
2357 =cut
2358
2359 sub TransformMarcToKoha {
2360     my ( $dbh, $record, $frameworkcode, $table ) = @_;
2361
2362     my $result;
2363
2364     # sometimes we only want to return the items data
2365     if ($table eq 'items') {
2366         my $sth = $dbh->prepare("SHOW COLUMNS FROM items");
2367         $sth->execute();
2368         while ( (my $field) = $sth->fetchrow ) {
2369             my $value = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2370             my $key = _disambiguate($table, $field);
2371             if ($result->{$key}) {
2372                 $result->{$key} .= " | " . $value;
2373             } else {
2374                 $result->{$key} = $value;
2375             }
2376         }
2377         return $result;
2378     } else {
2379         my @tables = ('biblio','biblioitems','items');
2380         foreach my $table (@tables){
2381             my $sth2 = $dbh->prepare("SHOW COLUMNS from $table");
2382             $sth2->execute;
2383             while (my ($field) = $sth2->fetchrow){
2384                 # FIXME use of _disambiguate is a temporary hack
2385                 # $result->{_disambiguate($table, $field)} = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2386                 my $value = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2387                 my $key = _disambiguate($table, $field);
2388                 if ($result->{$key}) {
2389                     # FIXME - hack to not bring in duplicates of the same value
2390                     unless (($key eq "biblionumber" or $key eq "biblioitemnumber") and ($value eq "")) {
2391                         $result->{$key} .= " | " . $value;
2392                     }
2393                 } else {
2394                     $result->{$key} = $value;
2395                 }
2396             }
2397             $sth2->finish();
2398         }
2399         # modify copyrightdate to keep only the 1st year found
2400         my $temp = $result->{'copyrightdate'};
2401         $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2402         if ( $1 > 0 ) {
2403             $result->{'copyrightdate'} = $1;
2404         }
2405         else {                      # if no cYYYY, get the 1st date.
2406             $temp =~ m/(\d\d\d\d)/;
2407             $result->{'copyrightdate'} = $1;
2408         }
2409
2410         # modify publicationyear to keep only the 1st year found
2411         $temp = $result->{'publicationyear'};
2412         $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2413         if ( $1 > 0 ) {
2414             $result->{'publicationyear'} = $1;
2415         }
2416         else {                      # if no cYYYY, get the 1st date.
2417             $temp =~ m/(\d\d\d\d)/;
2418             $result->{'publicationyear'} = $1;
2419         }
2420         return $result;
2421     }
2422 }
2423
2424
2425 =head2 _disambiguate
2426
2427 =over 4
2428
2429 $newkey = _disambiguate($table, $field);
2430
2431 This is a temporary hack to distinguish between the
2432 following sets of columns when using TransformMarcToKoha.
2433
2434 items.cn_source & biblioitems.cn_source
2435 items.cn_sort & biblioitems.cn_sort
2436
2437 Columns that are currently NOT distinguished (FIXME
2438 due to lack of time to fully test) are:
2439
2440 biblio.notes and biblioitems.notes
2441 biblionumber
2442 timestamp
2443 biblioitemnumber
2444
2445 FIXME - this is necessary because prefixing each column
2446 name with the table name would require changing lots
2447 of code and templates, and exposing more of the DB
2448 structure than is good to the UI templates, particularly
2449 since biblio and bibloitems may well merge in a future
2450 version.  In the future, it would also be good to
2451 separate DB access and UI presentation field names
2452 more.
2453
2454 =back
2455
2456 =cut
2457
2458 sub _disambiguate {
2459     my ($table, $column) = @_;
2460     if ($column eq "cn_sort" or $column eq "cn_source") {
2461         return $table . '.' . $column;
2462     } else {
2463         return $column;
2464     }
2465
2466 }
2467
2468 =head2 get_koha_field_from_marc
2469
2470 =over 4
2471
2472 $result->{_disambiguate($table, $field)} = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2473
2474 Internal function to map data from the MARC record to a specific non-MARC field.
2475 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2476
2477 =back
2478
2479 =cut
2480
2481 sub get_koha_field_from_marc {
2482     my ($koha_table,$koha_column,$record,$frameworkcode) = @_;
2483     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table.'.'.$koha_column, $frameworkcode );
2484     my $kohafield;
2485     foreach my $field ( $record->field($tagfield) ) {
2486         if ( $field->tag() < 10 ) {
2487             if ( $kohafield ) {
2488                 $kohafield .= " | " . $field->data();
2489             }
2490             else {
2491                 $kohafield = $field->data();
2492             }
2493         }
2494         else {
2495             if ( $field->subfields ) {
2496                 my @subfields = $field->subfields();
2497                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2498                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2499                         if ( $kohafield ) {
2500                             $kohafield .=
2501                               " | " . $subfields[$subfieldcount][1];
2502                         }
2503                         else {
2504                             $kohafield =
2505                               $subfields[$subfieldcount][1];
2506                         }
2507                     }
2508                 }
2509             }
2510         }
2511     }
2512     return $kohafield;
2513 }
2514
2515
2516 =head2 TransformMarcToKohaOneField
2517
2518 =over 4
2519
2520 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2521
2522 =back
2523
2524 =cut
2525
2526 sub TransformMarcToKohaOneField {
2527
2528     # FIXME ? if a field has a repeatable subfield that is used in old-db,
2529     # only the 1st will be retrieved...
2530     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2531     my $res = "";
2532     my ( $tagfield, $subfield ) =
2533       GetMarcFromKohaField( $kohatable . "." . $kohafield,
2534         $frameworkcode );
2535     foreach my $field ( $record->field($tagfield) ) {
2536         if ( $field->tag() < 10 ) {
2537             if ( $result->{$kohafield} ) {
2538                 $result->{$kohafield} .= " | " . $field->data();
2539             }
2540             else {
2541                 $result->{$kohafield} = $field->data();
2542             }
2543         }
2544         else {
2545             if ( $field->subfields ) {
2546                 my @subfields = $field->subfields();
2547                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2548                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2549                         if ( $result->{$kohafield} ) {
2550                             $result->{$kohafield} .=
2551                               " | " . $subfields[$subfieldcount][1];
2552                         }
2553                         else {
2554                             $result->{$kohafield} =
2555                               $subfields[$subfieldcount][1];
2556                         }
2557                     }
2558                 }
2559             }
2560         }
2561     }
2562     return $result;
2563 }
2564
2565 =head1  OTHER FUNCTIONS
2566
2567 =head2 char_decode
2568
2569 =over 4
2570
2571 my $string = char_decode( $string, $encoding );
2572
2573 converts ISO 5426 coded string to UTF-8
2574 sloppy code : should be improved in next issue
2575
2576 =back
2577
2578 =cut
2579
2580 sub char_decode {
2581     my ( $string, $encoding ) = @_;
2582     $_ = $string;
2583
2584     $encoding = C4::Context->preference("marcflavour") unless $encoding;
2585     if ( $encoding eq "UNIMARC" ) {
2586
2587         #         s/\xe1/Æ/gm;
2588         s/\xe2/Ğ/gm;
2589         s/\xe9/Ø/gm;
2590         s/\xec/ş/gm;
2591         s/\xf1/æ/gm;
2592         s/\xf3/ğ/gm;
2593         s/\xf9/ø/gm;
2594         s/\xfb/ß/gm;
2595         s/\xc1\x61/à/gm;
2596         s/\xc1\x65/è/gm;
2597         s/\xc1\x69/ì/gm;
2598         s/\xc1\x6f/ò/gm;
2599         s/\xc1\x75/ù/gm;
2600         s/\xc1\x41/À/gm;
2601         s/\xc1\x45/È/gm;
2602         s/\xc1\x49/Ì/gm;
2603         s/\xc1\x4f/Ò/gm;
2604         s/\xc1\x55/Ù/gm;
2605         s/\xc2\x41/Á/gm;
2606         s/\xc2\x45/É/gm;
2607         s/\xc2\x49/Í/gm;
2608         s/\xc2\x4f/Ó/gm;
2609         s/\xc2\x55/Ú/gm;
2610         s/\xc2\x59/İ/gm;
2611         s/\xc2\x61/á/gm;
2612         s/\xc2\x65/é/gm;
2613         s/\xc2\x69/í/gm;
2614         s/\xc2\x6f/ó/gm;
2615         s/\xc2\x75/ú/gm;
2616         s/\xc2\x79/ı/gm;
2617         s/\xc3\x41/Â/gm;
2618         s/\xc3\x45/Ê/gm;
2619         s/\xc3\x49/Î/gm;
2620         s/\xc3\x4f/Ô/gm;
2621         s/\xc3\x55/Û/gm;
2622         s/\xc3\x61/â/gm;
2623         s/\xc3\x65/ê/gm;
2624         s/\xc3\x69/î/gm;
2625         s/\xc3\x6f/ô/gm;
2626         s/\xc3\x75/û/gm;
2627         s/\xc4\x41/Ã/gm;
2628         s/\xc4\x4e/Ñ/gm;
2629         s/\xc4\x4f/Õ/gm;
2630         s/\xc4\x61/ã/gm;
2631         s/\xc4\x6e/ñ/gm;
2632         s/\xc4\x6f/õ/gm;
2633         s/\xc8\x41/Ä/gm;
2634         s/\xc8\x45/Ë/gm;
2635         s/\xc8\x49/Ï/gm;
2636         s/\xc8\x61/ä/gm;
2637         s/\xc8\x65/ë/gm;
2638         s/\xc8\x69/ï/gm;
2639         s/\xc8\x6F/ö/gm;
2640         s/\xc8\x75/ü/gm;
2641         s/\xc8\x76/ÿ/gm;
2642         s/\xc9\x41/Ä/gm;
2643         s/\xc9\x45/Ë/gm;
2644         s/\xc9\x49/Ï/gm;
2645         s/\xc9\x4f/Ö/gm;
2646         s/\xc9\x55/Ü/gm;
2647         s/\xc9\x61/ä/gm;
2648         s/\xc9\x6f/ö/gm;
2649         s/\xc9\x75/ü/gm;
2650         s/\xca\x41/Å/gm;
2651         s/\xca\x61/å/gm;
2652         s/\xd0\x43/Ç/gm;
2653         s/\xd0\x63/ç/gm;
2654
2655         # this handles non-sorting blocks (if implementation requires this)
2656         $string = nsb_clean($_);
2657     }
2658     elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2659         ##MARC-8 to UTF-8
2660
2661         s/\xe1\x61/à/gm;
2662         s/\xe1\x65/è/gm;
2663         s/\xe1\x69/ì/gm;
2664         s/\xe1\x6f/ò/gm;
2665         s/\xe1\x75/ù/gm;
2666         s/\xe1\x41/À/gm;
2667         s/\xe1\x45/È/gm;
2668         s/\xe1\x49/Ì/gm;
2669         s/\xe1\x4f/Ò/gm;
2670         s/\xe1\x55/Ù/gm;
2671         s/\xe2\x41/Á/gm;
2672         s/\xe2\x45/É/gm;
2673         s/\xe2\x49/Í/gm;
2674         s/\xe2\x4f/Ó/gm;
2675         s/\xe2\x55/Ú/gm;
2676         s/\xe2\x59/İ/gm;
2677         s/\xe2\x61/á/gm;
2678         s/\xe2\x65/é/gm;
2679         s/\xe2\x69/í/gm;
2680         s/\xe2\x6f/ó/gm;
2681         s/\xe2\x75/ú/gm;
2682         s/\xe2\x79/ı/gm;
2683         s/\xe3\x41/Â/gm;
2684         s/\xe3\x45/Ê/gm;
2685         s/\xe3\x49/Î/gm;
2686         s/\xe3\x4f/Ô/gm;
2687         s/\xe3\x55/Û/gm;
2688         s/\xe3\x61/â/gm;
2689         s/\xe3\x65/ê/gm;
2690         s/\xe3\x69/î/gm;
2691         s/\xe3\x6f/ô/gm;
2692         s/\xe3\x75/û/gm;
2693         s/\xe4\x41/Ã/gm;
2694         s/\xe4\x4e/Ñ/gm;
2695         s/\xe4\x4f/Õ/gm;
2696         s/\xe4\x61/ã/gm;
2697         s/\xe4\x6e/ñ/gm;
2698         s/\xe4\x6f/õ/gm;
2699         s/\xe6\x41/Ă/gm;
2700         s/\xe6\x45/Ĕ/gm;
2701         s/\xe6\x65/ĕ/gm;
2702         s/\xe6\x61/ă/gm;
2703         s/\xe8\x45/Ë/gm;
2704         s/\xe8\x49/Ï/gm;
2705         s/\xe8\x65/ë/gm;
2706         s/\xe8\x69/ï/gm;
2707         s/\xe8\x76/ÿ/gm;
2708         s/\xe9\x41/A/gm;
2709         s/\xe9\x4f/O/gm;
2710         s/\xe9\x55/U/gm;
2711         s/\xe9\x61/a/gm;
2712         s/\xe9\x6f/o/gm;
2713         s/\xe9\x75/u/gm;
2714         s/\xea\x41/A/gm;
2715         s/\xea\x61/a/gm;
2716
2717         #Additional Turkish characters
2718         s/\x1b//gm;
2719         s/\x1e//gm;
2720         s/(\xf0)s/\xc5\x9f/gm;
2721         s/(\xf0)S/\xc5\x9e/gm;
2722         s/(\xf0)c/ç/gm;
2723         s/(\xf0)C/Ç/gm;
2724         s/\xe7\x49/\\xc4\xb0/gm;
2725         s/(\xe6)G/\xc4\x9e/gm;
2726         s/(\xe6)g/ğ\xc4\x9f/gm;
2727         s/\xB8/ı/gm;
2728         s/\xB9/£/gm;
2729         s/(\xe8|\xc8)o/ö/gm;
2730         s/(\xe8|\xc8)O/Ö/gm;
2731         s/(\xe8|\xc8)u/ü/gm;
2732         s/(\xe8|\xc8)U/Ü/gm;
2733         s/\xc2\xb8/\xc4\xb1/gm;
2734         s/¸/\xc4\xb1/gm;
2735
2736         # this handles non-sorting blocks (if implementation requires this)
2737         $string = nsb_clean($_);
2738     }
2739     return ($string);
2740 }
2741
2742 =head2 nsb_clean
2743
2744 =over 4
2745
2746 my $string = nsb_clean( $string, $encoding );
2747
2748 =back
2749
2750 =cut
2751
2752 sub nsb_clean {
2753     my $NSB      = '\x88';    # NSB : begin Non Sorting Block
2754     my $NSE      = '\x89';    # NSE : Non Sorting Block end
2755                               # handles non sorting blocks
2756     my ($string) = @_;
2757     $_ = $string;
2758     s/$NSB/(/gm;
2759     s/[ ]{0,1}$NSE/) /gm;
2760     $string = $_;
2761     return ($string);
2762 }
2763
2764 =head2 PrepareItemrecordDisplay
2765
2766 =over 4
2767
2768 PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber);
2769
2770 Returns a hash with all the fields for Display a given item data in a template
2771
2772 =back
2773
2774 =cut
2775
2776 sub PrepareItemrecordDisplay {
2777
2778     my ( $bibnum, $itemnum ) = @_;
2779
2780     my $dbh = C4::Context->dbh;
2781     my $frameworkcode = &GetFrameworkCode( $bibnum );
2782     my ( $itemtagfield, $itemtagsubfield ) =
2783       &GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2784     my $tagslib = &GetMarcStructure( 1, $frameworkcode );
2785     my $itemrecord = GetMarcItem( $bibnum, $itemnum) if ($itemnum);
2786     my @loop_data;
2787     my $authorised_values_sth =
2788       $dbh->prepare(
2789 "SELECT authorised_value,lib FROM authorised_values WHERE category=? ORDER BY lib"
2790       );
2791     foreach my $tag ( sort keys %{$tagslib} ) {
2792         my $previous_tag = '';
2793         if ( $tag ne '' ) {
2794             # loop through each subfield
2795             my $cntsubf;
2796             foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
2797                 next if ( subfield_is_koha_internal_p($subfield) );
2798                 next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
2799                 my %subfield_data;
2800                 $subfield_data{tag}           = $tag;
2801                 $subfield_data{subfield}      = $subfield;
2802                 $subfield_data{countsubfield} = $cntsubf++;
2803                 $subfield_data{kohafield}     =
2804                   $tagslib->{$tag}->{$subfield}->{'kohafield'};
2805
2806          #        $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
2807                 $subfield_data{marc_lib} =
2808                     "<span id=\"error\" title=\""
2809                   . $tagslib->{$tag}->{$subfield}->{lib} . "\">"
2810                   . substr( $tagslib->{$tag}->{$subfield}->{lib}, 0, 12 )
2811                   . "</span>";
2812                 $subfield_data{mandatory} =
2813                   $tagslib->{$tag}->{$subfield}->{mandatory};
2814                 $subfield_data{repeatable} =
2815                   $tagslib->{$tag}->{$subfield}->{repeatable};
2816                 $subfield_data{hidden} = "display:none"
2817                   if $tagslib->{$tag}->{$subfield}->{hidden};
2818                 my ( $x, $value );
2819                 ( $x, $value ) = _find_value( $tag, $subfield, $itemrecord )
2820                   if ($itemrecord);
2821                 $value =~ s/"/&quot;/g;
2822
2823                 # search for itemcallnumber if applicable
2824                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
2825                     'items.itemcallnumber'
2826                     && C4::Context->preference('itemcallnumber') )
2827                 {
2828                     my $CNtag =
2829                       substr( C4::Context->preference('itemcallnumber'), 0, 3 );
2830                     my $CNsubfield =
2831                       substr( C4::Context->preference('itemcallnumber'), 3, 1 );
2832                     my $temp = $itemrecord->field($CNtag) if ($itemrecord);
2833                     if ($temp) {
2834                         $value = $temp->subfield($CNsubfield);
2835                     }
2836                 }
2837                 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
2838                     my @authorised_values;
2839                     my %authorised_lib;
2840
2841                     # builds list, depending on authorised value...
2842                     #---- branch
2843                     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq
2844                         "branches" )
2845                     {
2846                         if ( ( C4::Context->preference("IndependantBranches") )
2847                             && ( C4::Context->userenv->{flags} != 1 ) )
2848                         {
2849                             my $sth =
2850                               $dbh->prepare(
2851                                                                 "SELECT branchcode,branchname FROM branches WHERE branchcode = ? ORDER BY branchname"
2852                               );
2853                             $sth->execute( C4::Context->userenv->{branch} );
2854                             push @authorised_values, ""
2855                               unless (
2856                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
2857                             while ( my ( $branchcode, $branchname ) =
2858                                 $sth->fetchrow_array )
2859                             {
2860                                 push @authorised_values, $branchcode;
2861                                 $authorised_lib{$branchcode} = $branchname;
2862                             }
2863                         }
2864                         else {
2865                             my $sth =
2866                               $dbh->prepare(
2867                                                                 "SELECT branchcode,branchname FROM branches ORDER BY branchname"
2868                               );
2869                             $sth->execute;
2870                             push @authorised_values, ""
2871                               unless (
2872                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
2873                             while ( my ( $branchcode, $branchname ) =
2874                                 $sth->fetchrow_array )
2875                             {
2876                                 push @authorised_values, $branchcode;
2877                                 $authorised_lib{$branchcode} = $branchname;
2878                             }
2879                         }
2880
2881                         #----- itemtypes
2882                     }
2883                     elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq
2884                         "itemtypes" )
2885                     {
2886                         my $sth =
2887                           $dbh->prepare(
2888                                                         "SELECT itemtype,description FROM itemtypes ORDER BY description"
2889                           );
2890                         $sth->execute;
2891                         push @authorised_values, ""
2892                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2893                         while ( my ( $itemtype, $description ) =
2894                             $sth->fetchrow_array )
2895                         {
2896                             push @authorised_values, $itemtype;
2897                             $authorised_lib{$itemtype} = $description;
2898                         }
2899
2900                         #---- "true" authorised value
2901                     }
2902                     else {
2903                         $authorised_values_sth->execute(
2904                             $tagslib->{$tag}->{$subfield}->{authorised_value} );
2905                         push @authorised_values, ""
2906                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2907                         while ( my ( $value, $lib ) =
2908                             $authorised_values_sth->fetchrow_array )
2909                         {
2910                             push @authorised_values, $value;
2911                             $authorised_lib{$value} = $lib;
2912                         }
2913                     }
2914                     $subfield_data{marc_value} = CGI::scrolling_list(
2915                         -name     => 'field_value',
2916                         -values   => \@authorised_values,
2917                         -default  => "$value",
2918                         -labels   => \%authorised_lib,
2919                         -size     => 1,
2920                         -tabindex => '',
2921                         -multiple => 0,
2922                     );
2923                 }
2924                 elsif ( $tagslib->{$tag}->{$subfield}->{thesaurus_category} ) {
2925                     $subfield_data{marc_value} =
2926 "<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>";
2927
2928 #"
2929 # COMMENTED OUT because No $i is provided with this API.
2930 # And thus, no value_builder can be activated.
2931 # BUT could be thought over.
2932 #         } elsif ($tagslib->{$tag}->{$subfield}->{'value_builder'}) {
2933 #             my $plugin="value_builder/".$tagslib->{$tag}->{$subfield}->{'value_builder'};
2934 #             require $plugin;
2935 #             my $extended_param = plugin_parameters($dbh,$itemrecord,$tagslib,$i,0);
2936 #             my ($function_name,$javascript) = plugin_javascript($dbh,$record,$tagslib,$i,0);
2937 #             $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";
2938                 }
2939                 else {
2940                     $subfield_data{marc_value} =
2941 "<input type=\"text\" name=\"field_value\" value=\"$value\" size=50 maxlength=255>";
2942                 }
2943                 push( @loop_data, \%subfield_data );
2944             }
2945         }
2946     }
2947     my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
2948       if ( $itemrecord && $itemrecord->field($itemtagfield) );
2949     return {
2950         'itemtagfield'    => $itemtagfield,
2951         'itemtagsubfield' => $itemtagsubfield,
2952         'itemnumber'      => $itemnumber,
2953         'iteminformation' => \@loop_data
2954     };
2955 }
2956 #"
2957
2958 #
2959 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2960 # at the same time
2961 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2962 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2963 # =head2 ModZebrafiles
2964 #
2965 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2966 #
2967 # =cut
2968 #
2969 # sub ModZebrafiles {
2970 #
2971 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2972 #
2973 #     my $op;
2974 #     my $zebradir =
2975 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2976 #     unless ( opendir( DIR, "$zebradir" ) ) {
2977 #         warn "$zebradir not found";
2978 #         return;
2979 #     }
2980 #     closedir DIR;
2981 #     my $filename = $zebradir . $biblionumber;
2982 #
2983 #     if ($record) {
2984 #         open( OUTPUT, ">", $filename . ".xml" );
2985 #         print OUTPUT $record;
2986 #         close OUTPUT;
2987 #     }
2988 # }
2989
2990 =head2 ModZebra
2991
2992 =over 4
2993
2994 ModZebra( $biblionumber, $op, $server, $newRecord );
2995
2996     $biblionumber is the biblionumber we want to index
2997     $op is specialUpdate or delete, and is used to know what we want to do
2998     $server is the server that we want to update
2999     $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.
3000
3001 =back
3002
3003 =cut
3004
3005 sub ModZebra {
3006 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
3007     my ( $biblionumber, $op, $server, $newRecord ) = @_;
3008     my $dbh=C4::Context->dbh;
3009
3010     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
3011     # at the same time
3012     # replaced by a zebraqueue table, that is filled with ModZebra to run.
3013     # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
3014
3015     if (C4::Context->preference("NoZebra")) {
3016         # lock the nozebra table : we will read index lines, update them in Perl process
3017         # and write everything in 1 transaction.
3018         # lock the table to avoid someone else overwriting what we are doing
3019         $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE');
3020         my %result; # the result hash that will be builded by deletion / add, and written on mySQL at the end, to improve speed
3021         my $record;
3022         if ($server eq 'biblioserver') {
3023             $record= GetMarcBiblio($biblionumber);
3024         } else {
3025             $record= C4::AuthoritiesMarc::GetAuthority($biblionumber);
3026         }
3027         if ($op eq 'specialUpdate') {
3028             # OK, we have to add or update the record
3029             # 1st delete (virtually, in indexes) ...
3030             %result = _DelBiblioNoZebra($biblionumber,$record,$server);
3031             # ... add the record
3032             %result=_AddBiblioNoZebra($biblionumber,$newRecord, $server, %result);
3033         } else {
3034             # it's a deletion, delete the record...
3035             # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
3036             %result=_DelBiblioNoZebra($biblionumber,$record,$server);
3037         }
3038         # ok, now update the database...
3039         my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
3040         foreach my $key (keys %result) {
3041             foreach my $index (keys %{$result{$key}}) {
3042                 $sth->execute($result{$key}->{$index}, $server, $key, $index);
3043             }
3044         }
3045         $dbh->do('UNLOCK TABLES');
3046
3047     } else {
3048         #
3049         # we use zebra, just fill zebraqueue table
3050         #
3051         my $sth=$dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
3052         $sth->execute($biblionumber,$server,$op);
3053         $sth->finish;
3054     }
3055 }
3056
3057 =head2 GetNoZebraIndexes
3058
3059     %indexes = GetNoZebraIndexes;
3060
3061     return the data from NoZebraIndexes syspref.
3062
3063 =cut
3064
3065 sub GetNoZebraIndexes {
3066     my $index = C4::Context->preference('NoZebraIndexes');
3067     my %indexes;
3068     foreach my $line (split /('|"),/,$index) {
3069         $line =~ /(.*)=>(.*)/;
3070         my $index = substr($1,1); # get the index, don't forget to remove initial ' or "
3071         my $fields = $2;
3072         $index =~ s/'|"| //g;
3073         $fields =~ s/'|"| //g;
3074         $indexes{$index}=$fields;
3075     }
3076     return %indexes;
3077 }
3078
3079 =head1 INTERNAL FUNCTIONS
3080
3081 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
3082
3083     function to delete a biblio in NoZebra indexes
3084     This function does NOT delete anything in database : it reads all the indexes entries
3085     that have to be deleted & delete them in the hash
3086     The SQL part is done either :
3087     - after the Add if we are modifying a biblio (delete + add again)
3088     - immediatly after this sub if we are doing a true deletion.
3089     $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
3090
3091 =cut
3092
3093
3094 sub _DelBiblioNoZebra {
3095     my ($biblionumber, $record, $server)=@_;
3096
3097     # Get the indexes
3098     my $dbh = C4::Context->dbh;
3099     # Get the indexes
3100     my %index;
3101     my $title;
3102     if ($server eq 'biblioserver') {
3103         %index=GetNoZebraIndexes;
3104         # get title of the record (to store the 10 first letters with the index)
3105         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
3106         $title = lc($record->subfield($titletag,$titlesubfield));
3107     } else {
3108         # for authorities, the "title" is the $a mainentry
3109         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
3110         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
3111         $title = $record->subfield($authref->{auth_tag_to_report},'a');
3112         $index{'mainmainentry'}= $authref->{'auth_tag_to_report'}.'a';
3113         $index{'mainentry'}    = $authref->{'auth_tag_to_report'}.'*';
3114         $index{'auth_type'}    = '152b';
3115     }
3116
3117     my %result;
3118     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3119     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
3120     # limit to 10 char, should be enough, and limit the DB size
3121     $title = substr($title,0,10);
3122     #parse each field
3123     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3124     foreach my $field ($record->fields()) {
3125         #parse each subfield
3126         next if $field->tag <10;
3127         foreach my $subfield ($field->subfields()) {
3128             my $tag = $field->tag();
3129             my $subfieldcode = $subfield->[0];
3130             my $indexed=0;
3131             # check each index to see if the subfield is stored somewhere
3132             # otherwise, store it in __RAW__ index
3133             foreach my $key (keys %index) {
3134 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3135                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
3136                     $indexed=1;
3137                     my $line= lc $subfield->[1];
3138                     # remove meaningless value in the field...
3139                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3140                     # ... and split in words
3141                     foreach (split / /,$line) {
3142                         next unless $_; # skip  empty values (multiple spaces)
3143                         # if the entry is already here, do nothing, the biblionumber has already be removed
3144                         unless ($result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) {
3145                             # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
3146                             $sth2->execute($server,$key,$_);
3147                             my $existing_biblionumbers = $sth2->fetchrow;
3148                             # it exists
3149                             if ($existing_biblionumbers) {
3150 #                                 warn " existing for $key $_: $existing_biblionumbers";
3151                                 $result{$key}->{$_} =$existing_biblionumbers;
3152                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3153                             }
3154                         }
3155                     }
3156                 }
3157             }
3158             # the subfield is not indexed, store it in __RAW__ index anyway
3159             unless ($indexed) {
3160                 my $line= lc $subfield->[1];
3161                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3162                 # ... and split in words
3163                 foreach (split / /,$line) {
3164                     next unless $_; # skip  empty values (multiple spaces)
3165                     # if the entry is already here, do nothing, the biblionumber has already be removed
3166                     unless ($result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/) {
3167                         # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
3168                         $sth2->execute($server,'__RAW__',$_);
3169                         my $existing_biblionumbers = $sth2->fetchrow;
3170                         # it exists
3171                         if ($existing_biblionumbers) {
3172                             $result{'__RAW__'}->{$_} =$existing_biblionumbers;
3173                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3174                         }
3175                     }
3176                 }
3177             }
3178         }
3179     }
3180     return %result;
3181 }
3182
3183 =head2 _AddBiblioNoZebra($biblionumber, $record, $server, %result);
3184
3185     function to add a biblio in NoZebra indexes
3186
3187 =cut
3188
3189 sub _AddBiblioNoZebra {
3190     my ($biblionumber, $record, $server, %result)=@_;
3191     my $dbh = C4::Context->dbh;
3192     # Get the indexes
3193     my %index;
3194     my $title;
3195     if ($server eq 'biblioserver') {
3196         %index=GetNoZebraIndexes;
3197         # get title of the record (to store the 10 first letters with the index)
3198         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
3199         $title = lc($record->subfield($titletag,$titlesubfield));
3200     } else {
3201         # warn "server : $server";
3202         # for authorities, the "title" is the $a mainentry
3203         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
3204         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
3205         $title = $record->subfield($authref->{auth_tag_to_report},'a');
3206         $index{'mainmainentry'} = $authref->{auth_tag_to_report}.'a';
3207         $index{'mainentry'}     = $authref->{auth_tag_to_report}.'*';
3208         $index{'auth_type'}     = '152b';
3209     }
3210
3211     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3212     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
3213     # limit to 10 char, should be enough, and limit the DB size
3214     $title = substr($title,0,10);
3215     #parse each field
3216     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3217     foreach my $field ($record->fields()) {
3218         #parse each subfield
3219         next if $field->tag <10;
3220         foreach my $subfield ($field->subfields()) {
3221             my $tag = $field->tag();
3222             my $subfieldcode = $subfield->[0];
3223             my $indexed=0;
3224             # check each index to see if the subfield is stored somewhere
3225             # otherwise, store it in __RAW__ index
3226             foreach my $key (keys %index) {
3227 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3228                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
3229                     $indexed=1;
3230                     my $line= lc $subfield->[1];
3231                     # remove meaningless value in the field...
3232                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3233                     # ... and split in words
3234                     foreach (split / /,$line) {
3235                         next unless $_; # skip  empty values (multiple spaces)
3236                         # if the entry is already here, improve weight
3237 #                         warn "managing $_";
3238                         if ($result{$key}->{"$_"} =~ /$biblionumber,$title\-(\d);/) {
3239                             my $weight=$1+1;
3240                             $result{$key}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3241                             $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3242                         } else {
3243                             # get the value if it exist in the nozebra table, otherwise, create it
3244                             $sth2->execute($server,$key,$_);
3245                             my $existing_biblionumbers = $sth2->fetchrow;
3246                             # it exists
3247                             if ($existing_biblionumbers) {
3248                                 $result{$key}->{"$_"} =$existing_biblionumbers;
3249                                 my $weight=$1+1;
3250                                 $result{$key}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3251                                 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3252                             # create a new ligne for this entry
3253                             } else {
3254 #                             warn "INSERT : $server / $key / $_";
3255                                 $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).', indexname='.$dbh->quote($key).',value='.$dbh->quote($_));
3256                                 $result{$key}->{"$_"}.="$biblionumber,$title-1;";
3257                             }
3258                         }
3259                     }
3260                 }
3261             }
3262             # the subfield is not indexed, store it in __RAW__ index anyway
3263             unless ($indexed) {
3264                 my $line= lc $subfield->[1];
3265                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3266                 # ... and split in words
3267                 foreach (split / /,$line) {
3268                     next unless $_; # skip  empty values (multiple spaces)
3269                     # if the entry is already here, improve weight
3270                     if ($result{'__RAW__'}->{"$_"} =~ /$biblionumber,$title\-(\d);/) {
3271                         my $weight=$1+1;
3272                         $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3273                         $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3274                     } else {
3275                         # get the value if it exist in the nozebra table, otherwise, create it
3276                         $sth2->execute($server,'__RAW__',$_);
3277                         my $existing_biblionumbers = $sth2->fetchrow;
3278                         # it exists
3279                         if ($existing_biblionumbers) {
3280                             $result{'__RAW__'}->{"$_"} =$existing_biblionumbers;
3281                             my $weight=$1+1;
3282                             $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3283                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3284                         # create a new ligne for this entry
3285                         } else {
3286                             $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).',  indexname="__RAW__",value='.$dbh->quote($_));
3287                             $result{'__RAW__'}->{"$_"}.="$biblionumber,$title-1;";
3288                         }
3289                     }
3290                 }
3291             }
3292         }
3293     }
3294     return %result;
3295 }
3296
3297
3298 =head2 MARCitemchange
3299
3300 =over 4
3301
3302 &MARCitemchange( $record, $itemfield, $newvalue )
3303
3304 Function to update a single value in an item field.
3305 Used twice, could probably be replaced by something else, but works well...
3306
3307 =back
3308
3309 =back
3310
3311 =cut
3312
3313 sub MARCitemchange {
3314     my ( $record, $itemfield, $newvalue ) = @_;
3315     my $dbh = C4::Context->dbh;
3316
3317     my ( $tagfield, $tagsubfield ) =
3318       GetMarcFromKohaField( $itemfield, "" );
3319     if ( ($tagfield) && ($tagsubfield) ) {
3320         my $tag = $record->field($tagfield);
3321         if ($tag) {
3322             $tag->update( $tagsubfield => $newvalue );
3323             $record->delete_field($tag);
3324             $record->insert_fields_ordered($tag);
3325         }
3326     }
3327 }
3328 =head2 _find_value
3329
3330 =over 4
3331
3332 ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
3333
3334 Find the given $subfield in the given $tag in the given
3335 MARC::Record $record.  If the subfield is found, returns
3336 the (indicators, value) pair; otherwise, (undef, undef) is
3337 returned.
3338
3339 PROPOSITION :
3340 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
3341 I suggest we export it from this module.
3342
3343 =back
3344
3345 =cut
3346
3347 sub _find_value {
3348     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
3349     my @result;
3350     my $indicator;
3351     if ( $tagfield < 10 ) {
3352         if ( $record->field($tagfield) ) {
3353             push @result, $record->field($tagfield)->data();
3354         }
3355         else {
3356             push @result, "";
3357         }
3358     }
3359     else {
3360         foreach my $field ( $record->field($tagfield) ) {
3361             my @subfields = $field->subfields();
3362             foreach my $subfield (@subfields) {
3363                 if ( @$subfield[0] eq $insubfield ) {
3364                     push @result, @$subfield[1];
3365                     $indicator = $field->indicator(1) . $field->indicator(2);
3366                 }
3367             }
3368         }
3369     }
3370     return ( $indicator, @result );
3371 }
3372
3373 =head2 _koha_marc_update_bib_ids
3374
3375 =over 4
3376
3377 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
3378
3379 Internal function to add or update biblionumber and biblioitemnumber to
3380 the MARC XML.
3381
3382 =back
3383
3384 =cut
3385
3386 sub _koha_marc_update_bib_ids {
3387     my ($record, $frameworkcode, $biblionumber, $biblioitemnumber) = @_;
3388
3389     # we must add bibnum and bibitemnum in MARC::Record...
3390     # we build the new field with biblionumber and biblioitemnumber
3391     # we drop the original field
3392     # we add the new builded field.
3393     my ($biblio_tag, $biblio_subfield ) = GetMarcFromKohaField("biblio.biblionumber",$frameworkcode);
3394     my ($biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.biblioitemnumber",$frameworkcode);
3395
3396     if ($biblio_tag != $biblioitem_tag) {
3397         # biblionumber & biblioitemnumber are in different fields
3398
3399         # deal with biblionumber
3400         my ($new_field, $old_field);
3401         if ($biblio_tag < 10) {
3402             $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
3403         } else {
3404             $new_field =
3405               MARC::Field->new( $biblio_tag, '', '',
3406                 "$biblio_subfield" => $biblionumber );
3407         }
3408
3409         # drop old field and create new one...
3410         $old_field = $record->field($biblio_tag);
3411         $record->delete_field($old_field);
3412         $record->append_fields($new_field);
3413
3414         # deal with biblioitemnumber
3415         if ($biblioitem_tag < 10) {
3416             $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
3417         } else {
3418             $new_field =
3419               MARC::Field->new( $biblioitem_tag, '', '',
3420                 "$biblioitem_subfield" => $biblioitemnumber, );
3421         }
3422         # drop old field and create new one...
3423         $old_field = $record->field($biblioitem_tag);
3424         $record->delete_field($old_field);
3425         $record->insert_fields_ordered($new_field);
3426
3427     } else {
3428         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
3429         my $new_field = MARC::Field->new(
3430             $biblio_tag, '', '',
3431             "$biblio_subfield" => $biblionumber,
3432             "$biblioitem_subfield" => $biblioitemnumber
3433         );
3434
3435         # drop old field and create new one...
3436         my $old_field = $record->field($biblio_tag);
3437         $record->delete_field($old_field);
3438         $record->insert_fields_ordered($new_field);
3439     }
3440 }
3441
3442 =head2 _koha_add_biblio
3443
3444 =over 4
3445
3446 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3447
3448 Internal function to add a biblio ($biblio is a hash with the values)
3449
3450 =back
3451
3452 =cut
3453
3454 sub _koha_add_biblio {
3455     my ( $dbh, $biblio, $frameworkcode ) = @_;
3456
3457         my $error;
3458
3459         # set the series flag
3460     my $serial = 0;
3461     if ( $biblio->{'seriestitle'} ) { $serial = 1 };
3462
3463         my $query =
3464         "INSERT INTO biblio
3465                 SET frameworkcode = ?,
3466                         author = ?,
3467                         title = ?,
3468                         unititle =?,
3469                         notes = ?,
3470                         serial = ?,
3471                         seriestitle = ?,
3472                         copyrightdate = ?,
3473                         datecreated=NOW(),
3474                         abstract = ?
3475                 ";
3476     my $sth = $dbh->prepare($query);
3477     $sth->execute(
3478                 $frameworkcode,
3479         $biblio->{'author'},
3480         $biblio->{'title'},
3481                 $biblio->{'unititle'},
3482         $biblio->{'notes'},
3483                 $serial,
3484         $biblio->{'seriestitle'},
3485                 $biblio->{'copyrightdate'},
3486         $biblio->{'abstract'}
3487     );
3488
3489     my $biblionumber = $dbh->{'mysql_insertid'};
3490         if ( $dbh->errstr ) {
3491                 $error.="ERROR in _koha_add_biblio $query".$dbh->errstr;
3492         warn $error;
3493     }
3494
3495     $sth->finish();
3496         #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3497     return ($biblionumber,$error);
3498 }
3499
3500 =head2 _koha_modify_biblio
3501
3502 =over 4
3503
3504 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3505
3506 Internal function for updating the biblio table
3507
3508 =back
3509
3510 =cut
3511
3512 sub _koha_modify_biblio {
3513     my ( $dbh, $biblio, $frameworkcode ) = @_;
3514         my $error;
3515
3516     my $query = "
3517         UPDATE biblio
3518         SET    frameworkcode = ?,
3519                            author = ?,
3520                            title = ?,
3521                            unititle = ?,
3522                            notes = ?,
3523                            serial = ?,
3524                            seriestitle = ?,
3525                            copyrightdate = ?,
3526                abstract = ?
3527         WHERE  biblionumber = ?
3528                 "
3529         ;
3530     my $sth = $dbh->prepare($query);
3531
3532     $sth->execute(
3533                 $frameworkcode,
3534         $biblio->{'author'},
3535         $biblio->{'title'},
3536         $biblio->{'unititle'},
3537         $biblio->{'notes'},
3538         $biblio->{'serial'},
3539         $biblio->{'seriestitle'},
3540         $biblio->{'copyrightdate'},
3541                 $biblio->{'abstract'},
3542         $biblio->{'biblionumber'}
3543     ) if $biblio->{'biblionumber'};
3544
3545     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3546                 $error.="ERROR in _koha_modify_biblio $query".$dbh->errstr;
3547         warn $error;
3548     }
3549     return ( $biblio->{'biblionumber'},$error );
3550 }
3551
3552 =head2 _koha_modify_biblioitem_nonmarc
3553
3554 =over 4
3555
3556 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3557
3558 Updates biblioitems row except for marc and marcxml, which should be changed
3559 via ModBiblioMarc
3560
3561 =back
3562
3563 =cut
3564
3565 sub _koha_modify_biblioitem_nonmarc {
3566     my ( $dbh, $biblioitem ) = @_;
3567         my $error;
3568
3569         # re-calculate the cn_sort, it may have changed
3570         my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3571
3572         my $query =
3573         "UPDATE biblioitems
3574         SET biblionumber        = ?,
3575                 volume                  = ?,
3576                 number                  = ?,
3577         itemtype        = ?,
3578         isbn            = ?,
3579         issn            = ?,
3580                 publicationyear = ?,
3581         publishercode   = ?,
3582                 volumedate      = ?,
3583                 volumedesc      = ?,
3584                 collectiontitle = ?,
3585                 collectionissn  = ?,
3586                 collectionvolume= ?,
3587                 editionstatement= ?,
3588                 editionresponsibility = ?,
3589                 illus                   = ?,
3590                 pages                   = ?,
3591                 notes                   = ?,
3592                 size                    = ?,
3593                 place                   = ?,
3594                 lccn                    = ?,
3595                 url                     = ?,
3596         cn_source               = ?,
3597         cn_class        = ?,
3598         cn_item         = ?,
3599                 cn_suffix       = ?,
3600                 cn_sort         = ?,
3601                 totalissues     = ?
3602         where biblioitemnumber = ?
3603                 ";
3604         my $sth = $dbh->prepare($query);
3605         $sth->execute(
3606                 $biblioitem->{'biblionumber'},
3607                 $biblioitem->{'volume'},
3608                 $biblioitem->{'number'},
3609                 $biblioitem->{'itemtype'},
3610                 $biblioitem->{'isbn'},
3611                 $biblioitem->{'issn'},
3612                 $biblioitem->{'publicationyear'},
3613                 $biblioitem->{'publishercode'},
3614                 $biblioitem->{'volumedate'},
3615                 $biblioitem->{'volumedesc'},
3616                 $biblioitem->{'collectiontitle'},
3617                 $biblioitem->{'collectionissn'},
3618                 $biblioitem->{'collectionvolume'},
3619                 $biblioitem->{'editionstatement'},
3620                 $biblioitem->{'editionresponsibility'},
3621                 $biblioitem->{'illus'},
3622                 $biblioitem->{'pages'},
3623                 $biblioitem->{'bnotes'},
3624                 $biblioitem->{'size'},
3625                 $biblioitem->{'place'},
3626                 $biblioitem->{'lccn'},
3627                 $biblioitem->{'url'},
3628                 $biblioitem->{'biblioitems.cn_source'},
3629                 $biblioitem->{'cn_class'},
3630                 $biblioitem->{'cn_item'},
3631                 $biblioitem->{'cn_suffix'},
3632                 $cn_sort,
3633                 $biblioitem->{'totalissues'},
3634                 $biblioitem->{'biblioitemnumber'}
3635         );
3636     if ( $dbh->errstr ) {
3637                 $error.="ERROR in _koha_modify_biblioitem_nonmarc $query".$dbh->errstr;
3638         warn $error;
3639     }
3640         return ($biblioitem->{'biblioitemnumber'},$error);
3641 }
3642
3643 =head2 _koha_add_biblioitem
3644
3645 =over 4
3646
3647 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3648
3649 Internal function to add a biblioitem
3650
3651 =back
3652
3653 =cut
3654
3655 sub _koha_add_biblioitem {
3656     my ( $dbh, $biblioitem ) = @_;
3657         my $error;
3658
3659         my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3660     my $query =
3661     "INSERT INTO biblioitems SET
3662         biblionumber    = ?,
3663         volume          = ?,
3664         number          = ?,
3665         itemtype        = ?,
3666         isbn            = ?,
3667         issn            = ?,
3668         publicationyear = ?,
3669         publishercode   = ?,
3670         volumedate      = ?,
3671         volumedesc      = ?,
3672         collectiontitle = ?,
3673         collectionissn  = ?,
3674         collectionvolume= ?,
3675         editionstatement= ?,
3676         editionresponsibility = ?,
3677         illus           = ?,
3678         pages           = ?,
3679         notes           = ?,
3680         size            = ?,
3681         place           = ?,
3682         lccn            = ?,
3683         marc            = ?,
3684         url             = ?,
3685         cn_source       = ?,
3686         cn_class        = ?,
3687         cn_item         = ?,
3688         cn_suffix       = ?,
3689         cn_sort         = ?,
3690         totalissues     = ?
3691         ";
3692         my $sth = $dbh->prepare($query);
3693     $sth->execute(
3694         $biblioitem->{'biblionumber'},
3695         $biblioitem->{'volume'},
3696         $biblioitem->{'number'},
3697         $biblioitem->{'itemtype'},
3698         $biblioitem->{'isbn'},
3699         $biblioitem->{'issn'},
3700         $biblioitem->{'publicationyear'},
3701         $biblioitem->{'publishercode'},
3702         $biblioitem->{'volumedate'},
3703         $biblioitem->{'volumedesc'},
3704         $biblioitem->{'collectiontitle'},
3705         $biblioitem->{'collectionissn'},
3706         $biblioitem->{'collectionvolume'},
3707         $biblioitem->{'editionstatement'},
3708         $biblioitem->{'editionresponsibility'},
3709         $biblioitem->{'illus'},
3710         $biblioitem->{'pages'},
3711         $biblioitem->{'bnotes'},
3712         $biblioitem->{'size'},
3713         $biblioitem->{'place'},
3714         $biblioitem->{'lccn'},
3715         $biblioitem->{'marc'},
3716         $biblioitem->{'url'},
3717         $biblioitem->{'biblioitems.cn_source'},
3718         $biblioitem->{'cn_class'},
3719         $biblioitem->{'cn_item'},
3720         $biblioitem->{'cn_suffix'},
3721         $cn_sort,
3722         $biblioitem->{'totalissues'}
3723     );
3724     my $bibitemnum = $dbh->{'mysql_insertid'};
3725     if ( $dbh->errstr ) {
3726                 $error.="ERROR in _koha_add_biblioitem $query".$dbh->errstr;
3727                 warn $error;
3728     }
3729     $sth->finish();
3730     return ($bibitemnum,$error);
3731 }
3732
3733 =head2 _koha_new_items
3734
3735 =over 4
3736
3737 my ($itemnumber,$error) = _koha_new_items( $dbh, $item, $barcode );
3738
3739 =back
3740
3741 =cut
3742
3743 sub _koha_new_items {
3744     my ( $dbh, $item, $barcode ) = @_;
3745         my $error;
3746
3747     my ($items_cn_sort) = GetClassSort($item->{'items.cn_source'}, $item->{'itemcallnumber'}, "");
3748
3749     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
3750     if ( $item->{'dateaccessioned'} eq '' || !$item->{'dateaccessioned'} ) {
3751                 my $today = C4::Dates->new();
3752                 $item->{'dateaccessioned'} =  $today->output("iso"); #TODO: check time issues
3753         }
3754         my $query =
3755            "INSERT INTO items SET
3756                         biblionumber            = ?,
3757             biblioitemnumber    = ?,
3758                         barcode                 = ?,
3759                         dateaccessioned         = ?,
3760                         booksellerid        = ?,
3761             homebranch          = ?,
3762             price               = ?,
3763                         replacementprice        = ?,
3764             replacementpricedate = NOW(),
3765                         datelastborrowed        = ?,
3766                         datelastseen            = NOW(),
3767                         stack                   = ?,
3768                         notforloan                      = ?,
3769                         damaged                         = ?,
3770             itemlost            = ?,
3771                         wthdrawn                = ?,
3772                         itemcallnumber          = ?,
3773                         restricted                      = ?,
3774                         itemnotes                       = ?,
3775                         holdingbranch           = ?,
3776             paidfor             = ?,
3777                         location                        = ?,
3778                         onloan                          = ?,
3779                         cn_source                       = ?,
3780                         cn_sort                         = ?,
3781                         ccode                           = ?,
3782                         materials                       = ?,
3783                         uri                             = ?
3784           ";
3785     my $sth = $dbh->prepare($query);
3786         $sth->execute(
3787                         $item->{'biblionumber'},
3788                         $item->{'biblioitemnumber'},
3789             $barcode,
3790                         $item->{'dateaccessioned'},
3791                         $item->{'booksellerid'},
3792             $item->{'homebranch'},
3793             $item->{'price'},
3794                         $item->{'replacementprice'},
3795                         $item->{datelastborrowed},
3796                         $item->{stack},
3797                         $item->{'notforloan'},
3798                         $item->{'damaged'},
3799             $item->{'itemlost'},
3800                         $item->{'wthdrawn'},
3801                         $item->{'itemcallnumber'},
3802             $item->{'restricted'},
3803                         $item->{'itemnotes'},
3804                         $item->{'holdingbranch'},
3805                         $item->{'paidfor'},
3806                         $item->{'location'},
3807                         $item->{'onloan'},
3808                         $item->{'items.cn_source'},
3809                         $items_cn_sort,
3810                         $item->{'ccode'},
3811                         $item->{'materials'},
3812                         $item->{'uri'},
3813     );
3814     my $itemnumber = $dbh->{'mysql_insertid'};
3815     if ( defined $sth->errstr ) {
3816         $error.="ERROR in _koha_new_items $query".$sth->errstr;
3817     }
3818         $sth->finish();
3819     return ( $itemnumber, $error );
3820 }
3821
3822 =head2 _koha_modify_item
3823
3824 =over 4
3825
3826 my ($itemnumber,$error) =_koha_modify_item( $dbh, $item, $op );
3827
3828 =back
3829
3830 =cut
3831
3832 sub _koha_modify_item {
3833     my ( $dbh, $item ) = @_;
3834         my $error;
3835
3836         # calculate items.cn_sort
3837     $item->{'cn_sort'} = GetClassSort($item->{'items.cn_source'}, $item->{'itemcallnumber'}, "");
3838
3839     my $query = "UPDATE items SET ";
3840         my @bind;
3841         for my $key ( keys %$item ) {
3842                 $query.="$key=?,";
3843                 push @bind, $item->{$key};
3844     }
3845         $query =~ s/,$//;
3846     $query .= " WHERE itemnumber=?";
3847     push @bind, $item->{'itemnumber'};
3848     my $sth = $dbh->prepare($query);
3849     $sth->execute(@bind);
3850     if ( $dbh->errstr ) {
3851         $error.="ERROR in _koha_modify_item $query".$dbh->errstr;
3852         warn $error;
3853     }
3854     $sth->finish();
3855         return ($item->{'itemnumber'},$error);
3856 }
3857
3858 =head2 _koha_delete_biblio
3859
3860 =over 4
3861
3862 $error = _koha_delete_biblio($dbh,$biblionumber);
3863
3864 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3865
3866 C<$dbh> - the database handle
3867 C<$biblionumber> - the biblionumber of the biblio to be deleted
3868
3869 =back
3870
3871 =cut
3872
3873 # FIXME: add error handling
3874
3875 sub _koha_delete_biblio {
3876     my ( $dbh, $biblionumber ) = @_;
3877
3878     # get all the data for this biblio
3879     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3880     $sth->execute($biblionumber);
3881
3882     if ( my $data = $sth->fetchrow_hashref ) {
3883
3884         # save the record in deletedbiblio
3885         # find the fields to save
3886         my $query = "INSERT INTO deletedbiblio SET ";
3887         my @bind  = ();
3888         foreach my $temp ( keys %$data ) {
3889             $query .= "$temp = ?,";
3890             push( @bind, $data->{$temp} );
3891         }
3892
3893         # replace the last , by ",?)"
3894         $query =~ s/\,$//;
3895         my $bkup_sth = $dbh->prepare($query);
3896         $bkup_sth->execute(@bind);
3897         $bkup_sth->finish;
3898
3899         # delete the biblio
3900         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3901         $del_sth->execute($biblionumber);
3902         $del_sth->finish;
3903     }
3904     $sth->finish;
3905     return undef;
3906 }
3907
3908 =head2 _koha_delete_biblioitems
3909
3910 =over 4
3911
3912 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3913
3914 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3915
3916 C<$dbh> - the database handle
3917 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3918
3919 =back
3920
3921 =cut
3922
3923 # FIXME: add error handling
3924
3925 sub _koha_delete_biblioitems {
3926     my ( $dbh, $biblioitemnumber ) = @_;
3927
3928     # get all the data for this biblioitem
3929     my $sth =
3930       $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3931     $sth->execute($biblioitemnumber);
3932
3933     if ( my $data = $sth->fetchrow_hashref ) {
3934
3935         # save the record in deletedbiblioitems
3936         # find the fields to save
3937         my $query = "INSERT INTO deletedbiblioitems SET ";
3938         my @bind  = ();
3939         foreach my $temp ( keys %$data ) {
3940             $query .= "$temp = ?,";
3941             push( @bind, $data->{$temp} );
3942         }
3943
3944         # replace the last , by ",?)"
3945         $query =~ s/\,$//;
3946         my $bkup_sth = $dbh->prepare($query);
3947         $bkup_sth->execute(@bind);
3948         $bkup_sth->finish;
3949
3950         # delete the biblioitem
3951         my $del_sth =
3952           $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3953         $del_sth->execute($biblioitemnumber);
3954         $del_sth->finish;
3955     }
3956     $sth->finish;
3957     return undef;
3958 }
3959
3960 =head2 _koha_delete_item
3961
3962 =over 4
3963
3964 _koha_delete_item( $dbh, $itemnum );
3965
3966 Internal function to delete an item record from the koha tables
3967
3968 =back
3969
3970 =cut
3971
3972 sub _koha_delete_item {
3973     my ( $dbh, $itemnum ) = @_;
3974
3975         # save the deleted item to deleteditems table
3976     my $sth = $dbh->prepare("SELECT * FROM items WHERE itemnumber=?");
3977     $sth->execute($itemnum);
3978     my $data = $sth->fetchrow_hashref();
3979     $sth->finish();
3980     my $query = "INSERT INTO deleteditems SET ";
3981     my @bind  = ();
3982     foreach my $key ( keys %$data ) {
3983         $query .= "$key = ?,";
3984         push( @bind, $data->{$key} );
3985     }
3986     $query =~ s/\,$//;
3987     $sth = $dbh->prepare($query);
3988     $sth->execute(@bind);
3989     $sth->finish();
3990
3991         # delete from items table
3992     $sth = $dbh->prepare("DELETE FROM items WHERE itemnumber=?");
3993     $sth->execute($itemnum);
3994     $sth->finish();
3995         return undef;
3996 }
3997
3998 =head1 UNEXPORTED FUNCTIONS
3999
4000 =head2 ModBiblioMarc
4001
4002     &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
4003
4004     Add MARC data for a biblio to koha
4005
4006     Function exported, but should NOT be used, unless you really know what you're doing
4007
4008 =cut
4009
4010 sub ModBiblioMarc {
4011
4012 # pass the MARC::Record to this function, and it will create the records in the marc field
4013     my ( $record, $biblionumber, $frameworkcode ) = @_;
4014     my $dbh = C4::Context->dbh;
4015     my @fields = $record->fields();
4016     if ( !$frameworkcode ) {
4017         $frameworkcode = "";
4018     }
4019     my $sth =
4020       $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
4021     $sth->execute( $frameworkcode, $biblionumber );
4022     $sth->finish;
4023     my $encoding = C4::Context->preference("marcflavour");
4024
4025     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
4026     if ( $encoding eq "UNIMARC" ) {
4027         my $string;
4028         if ( length($record->subfield( 100, "a" )) == 35 ) {
4029             $string = $record->subfield( 100, "a" );
4030             my $f100 = $record->field(100);
4031             $record->delete_field($f100);
4032         }
4033         else {
4034             $string = POSIX::strftime( "%Y%m%d", localtime );
4035             $string =~ s/\-//g;
4036             $string = sprintf( "%-*s", 35, $string );
4037         }
4038         substr( $string, 22, 6, "frey50" );
4039         unless ( $record->subfield( 100, "a" ) ) {
4040             $record->insert_grouped_field(
4041                 MARC::Field->new( 100, "", "", "a" => $string ) );
4042         }
4043     }
4044     ModZebra($biblionumber,"specialUpdate","biblioserver",$record);
4045     $sth =
4046       $dbh->prepare(
4047         "UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
4048     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding),
4049         $biblionumber );
4050     $sth->finish;
4051     return $biblionumber;
4052 }
4053
4054 =head2 AddItemInMarc
4055
4056 =over 4
4057
4058 $newbiblionumber = AddItemInMarc( $record, $biblionumber, $frameworkcode );
4059
4060 Add an item in a MARC record and save the MARC record
4061
4062 Function exported, but should NOT be used, unless you really know what you're doing
4063
4064 =back
4065
4066 =cut
4067
4068 sub AddItemInMarc {
4069
4070     # pass the MARC::Record to this function, and it will create the records in the marc tables
4071     my ( $record, $biblionumber, $frameworkcode ) = @_;
4072     my $newrec = &GetMarcBiblio($biblionumber);
4073
4074     # create it
4075     my @fields = $record->fields();
4076     foreach my $field (@fields) {
4077         $newrec->append_fields($field);
4078     }
4079
4080     # FIXME: should we be making sure the biblionumbers are the same?
4081     my $newbiblionumber =
4082       &ModBiblioMarc( $newrec, $biblionumber, $frameworkcode );
4083     return $newbiblionumber;
4084 }
4085
4086 =head2 z3950_extended_services
4087
4088 z3950_extended_services($serviceType,$serviceOptions,$record);
4089
4090     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.
4091
4092 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
4093
4094 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
4095
4096     action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
4097
4098 and maybe
4099
4100     recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
4101     syntax => the record syntax (transfer syntax)
4102     databaseName = Database from connection object
4103
4104     To set serviceOptions, call set_service_options($serviceType)
4105
4106 C<$record> the record, if one is needed for the service type
4107
4108     A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
4109
4110 =cut
4111
4112 sub z3950_extended_services {
4113     my ( $server, $serviceType, $action, $serviceOptions ) = @_;
4114
4115     # get our connection object
4116     my $Zconn = C4::Context->Zconn( $server, 0, 1 );
4117
4118     # create a new package object
4119     my $Zpackage = $Zconn->package();
4120
4121     # set our options
4122     $Zpackage->option( action => $action );
4123
4124     if ( $serviceOptions->{'databaseName'} ) {
4125         $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
4126     }
4127     if ( $serviceOptions->{'recordIdNumber'} ) {
4128         $Zpackage->option(
4129             recordIdNumber => $serviceOptions->{'recordIdNumber'} );
4130     }
4131     if ( $serviceOptions->{'recordIdOpaque'} ) {
4132         $Zpackage->option(
4133             recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
4134     }
4135
4136  # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
4137  #if ($serviceType eq 'itemorder') {
4138  #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
4139  #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
4140  #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
4141  #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
4142  #}
4143
4144     if ( $serviceOptions->{record} ) {
4145         $Zpackage->option( record => $serviceOptions->{record} );
4146
4147         # can be xml or marc
4148         if ( $serviceOptions->{'syntax'} ) {
4149             $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
4150         }
4151     }
4152
4153     # send the request, handle any exception encountered
4154     eval { $Zpackage->send($serviceType) };
4155     if ( $@ && $@->isa("ZOOM::Exception") ) {
4156         return "error:  " . $@->code() . " " . $@->message() . "\n";
4157     }
4158
4159     # free up package resources
4160     $Zpackage->destroy();
4161 }
4162
4163 =head2 set_service_options
4164
4165 my $serviceOptions = set_service_options($serviceType);
4166
4167 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
4168
4169 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
4170
4171 =cut
4172
4173 sub set_service_options {
4174     my ($serviceType) = @_;
4175     my $serviceOptions;
4176
4177 # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
4178 #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
4179
4180     if ( $serviceType eq 'commit' ) {
4181
4182         # nothing to do
4183     }
4184     if ( $serviceType eq 'create' ) {
4185
4186         # nothing to do
4187     }
4188     if ( $serviceType eq 'drop' ) {
4189         die "ERROR: 'drop' not currently supported (by Zebra)";
4190     }
4191     return $serviceOptions;
4192 }
4193
4194 =head2 GetItemsCount
4195
4196 $count = &GetItemsCount( $biblionumber);
4197 this function return count of item with $biblionumber
4198 =cut
4199
4200 sub GetItemsCount {
4201     my ( $biblionumber ) = @_;
4202     my $dbh = C4::Context->dbh;
4203     my $query = "SELECT count(*)
4204                   FROM  items
4205                   WHERE biblionumber=?";
4206     my $sth = $dbh->prepare($query);
4207     $sth->execute($biblionumber);
4208     my $count = $sth->fetchrow;
4209     $sth->finish;
4210     return ($count);
4211 }
4212
4213 END { }    # module clean-up code here (global destructor)
4214
4215 1;
4216
4217 __END__
4218
4219 =head1 AUTHOR
4220
4221 Koha Developement team <info@koha.org>
4222
4223 Paul POULAIN paul.poulain@free.fr
4224
4225 Joshua Ferraro jmf@liblime.com
4226
4227 =cut