C4/Biblio.pm

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