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