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