koha-dev.rot13.org Git - koha_gimpoz/blob - C4/Biblio.pm

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