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