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