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