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