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