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