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