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