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                 # if there is an authority link, build the link with an= subfield9
1825                 my $subfield9 = $field->subfield('9');
1826                 for my $subject_subfield (@subfields ) {
1827                         # don't load unimarc subfields 3,4,5
1828                         next if (($marcflavour eq "UNIMARC") and ($subject_subfield->[0] =~ (3|4|5) ) );
1829                         my $code = $subject_subfield->[0];
1830                         my $value = $subject_subfield->[1];
1831                         my $linkvalue = $value;
1832                         $linkvalue =~ s/(\(|\))//g;
1833                         my $operator = " and " unless $counter==0;
1834                         if ($subfield9) {
1835                 @link_loop = ({'limit' => 'an' ,link => "$subfield9" });
1836             } else {
1837                 push @link_loop, {'limit' => 'su', link => $linkvalue, operator => $operator };
1838             }
1839                         my $separator = C4::Context->preference("authoritysep") unless $counter==0;
1840                         # ignore $9
1841                         push @subfields_loop, {code => $code, value => $value, link_loop => \@link_loop, separator => $separator} unless ($subject_subfield->[0] == 9 );
1842                         # this needs to be added back in in a way that the template can expose it properly
1843                         #if ( $code == 9 ) {
1844             #    $link = "an:".$subject_subfield->[1];
1845             #    $flag = 1;
1846             #}
1847                         $counter++;
1848                 }
1849
1850                 push @marcsubjects, { MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop };
1851
1852         }
1853         return \@marcsubjects;
1854 }  #end getMARCsubjects
1855
1856 =head2 GetMarcAuthors
1857
1858 =over 4
1859
1860 authors = GetMarcAuthors($record,$marcflavour);
1861 Get all authors from the MARC record and returns them in an array.
1862 The authors are stored in differents places depending on MARC flavour
1863
1864 =back
1865
1866 =cut
1867
1868 sub GetMarcAuthors {
1869     my ( $record, $marcflavour ) = @_;
1870     my ( $mintag, $maxtag );
1871     # tagslib useful for UNIMARC author reponsabilities
1872     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.
1873     if ( $marcflavour eq "MARC21" ) {
1874         $mintag = "700";
1875         $maxtag = "720";
1876     }
1877     elsif ( $marcflavour eq "UNIMARC" ) {    # assume unimarc if not marc21
1878         $mintag = "700";
1879         $maxtag = "712";
1880     }
1881         else {
1882                 return;
1883         }
1884     my @marcauthors;
1885
1886     foreach my $field ( $record->fields ) {
1887         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1888         my %hash;
1889         my @subfields = $field->subfields();
1890         my $count_auth = 0;
1891         for my $authors_subfield (@subfields) {
1892                         #unimarc-specific line
1893             next if ($marcflavour eq 'UNIMARC' and (($authors_subfield->[0] eq '3') or ($authors_subfield->[0] eq '5')));
1894             my $subfieldcode = $authors_subfield->[0];
1895             my $value;
1896             # deal with UNIMARC author responsibility
1897                         if ( $marcflavour eq 'UNIMARC' and ($authors_subfield->[0] eq '4')) {
1898                 $value = "(".GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib ).")";
1899             } else {
1900                 $value        = $authors_subfield->[1];
1901             }
1902             $hash{tag}       = $field->tag;
1903             $hash{value}    .= $value . " " if ($subfieldcode != 9) ;
1904             $hash{link}     .= $value if ($subfieldcode eq 9);
1905         }
1906         push @marcauthors, \%hash;
1907     }
1908     return \@marcauthors;
1909 }
1910
1911 =head2 GetMarcUrls
1912
1913 =over 4
1914
1915 $marcurls = GetMarcUrls($record,$marcflavour);
1916 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1917 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1918
1919 =back
1920
1921 =cut
1922
1923 sub GetMarcUrls {
1924     my ($record, $marcflavour) = @_;
1925     my @marcurls;
1926     my $marcurl;
1927     for my $field ($record->field('856')) {
1928         my $url = $field->subfield('u');
1929         my @notes;
1930         for my $note ( $field->subfield('z')) {
1931             push @notes , {note => $note};
1932         }
1933         $marcurl = {  MARCURL => $url,
1934                       notes => \@notes,
1935                                         };
1936                 if($marcflavour eq 'MARC21') {
1937                 my $s3 = $field->subfield('3');
1938                         my $link = $field->subfield('y');
1939             $marcurl->{'linktext'} = $link || $s3 || $url ;;
1940             $marcurl->{'part'} = $s3 if($link);
1941             $marcurl->{'toc'} = 1 if($s3 =~ /^[Tt]able/) ;
1942                 } else {
1943                         $marcurl->{'linktext'} = $url;
1944                 }
1945         push @marcurls, $marcurl;
1946         }
1947     return \@marcurls;
1948 }  #end GetMarcUrls
1949
1950 =head2 GetMarcSeries
1951
1952 =over 4
1953
1954 $marcseriesarray = GetMarcSeries($record,$marcflavour);
1955 Get all series from the MARC record and returns them in an array.
1956 The series are stored in differents places depending on MARC flavour
1957
1958 =back
1959
1960 =cut
1961
1962 sub GetMarcSeries {
1963     my ($record, $marcflavour) = @_;
1964     my ($mintag, $maxtag);
1965     if ($marcflavour eq "MARC21") {
1966         $mintag = "440";
1967         $maxtag = "490";
1968     } else {           # assume unimarc if not marc21
1969         $mintag = "600";
1970         $maxtag = "619";
1971     }
1972
1973     my @marcseries;
1974     my $subjct = "";
1975     my $subfield = "";
1976     my $marcsubjct;
1977
1978     foreach my $field ($record->field('440'), $record->field('490')) {
1979         my @subfields_loop;
1980         #my $value = $field->subfield('a');
1981         #$marcsubjct = {MARCSUBJCT => $value,};
1982         my @subfields = $field->subfields();
1983         #warn "subfields:".join " ", @$subfields;
1984         my $counter = 0;
1985         my @link_loop;
1986         for my $series_subfield (@subfields) {
1987                         my $volume_number;
1988                         undef $volume_number;
1989                         # see if this is an instance of a volume
1990                         if ($series_subfield->[0] eq 'v') {
1991                                 $volume_number=1;
1992                         }
1993
1994             my $code = $series_subfield->[0];
1995             my $value = $series_subfield->[1];
1996             my $linkvalue = $value;
1997             $linkvalue =~ s/(\(|\))//g;
1998             my $operator = " and " unless $counter==0;
1999             push @link_loop, {link => $linkvalue, operator => $operator };
2000             my $separator = C4::Context->preference("authoritysep") unless $counter==0;
2001                         if ($volume_number) {
2002                         push @subfields_loop, {volumenum => $value};
2003                         }
2004                         else {
2005             push @subfields_loop, {code => $code, value => $value, link_loop => \@link_loop, separator => $separator, volumenum => $volume_number};
2006                         }
2007             $counter++;
2008         }
2009         push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
2010         #$marcsubjct = {MARCSUBJCT => $field->as_string(),};
2011         #push @marcsubjcts, $marcsubjct;
2012         #$subjct = $value;
2013
2014     }
2015     my $marcseriessarray=\@marcseries;
2016     return $marcseriessarray;
2017 }  #end getMARCseriess
2018
2019 =head2 GetFrameworkCode
2020
2021 =over 4
2022
2023     $frameworkcode = GetFrameworkCode( $biblionumber )
2024
2025 =back
2026
2027 =cut
2028
2029 sub GetFrameworkCode {
2030     my ( $biblionumber ) = @_;
2031     my $dbh = C4::Context->dbh;
2032     my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
2033     $sth->execute($biblionumber);
2034     my ($frameworkcode) = $sth->fetchrow;
2035     return $frameworkcode;
2036 }
2037
2038 =head2 GetPublisherNameFromIsbn
2039
2040     $name = GetPublishercodeFromIsbn($isbn);
2041     if(defined $name){
2042         ...
2043     }
2044
2045 =cut
2046
2047 sub GetPublisherNameFromIsbn($){
2048     my $isbn = shift;
2049     $isbn =~ s/[- _]//g;
2050     $isbn =~ s/^0*//;
2051     my @codes = (split '-', DisplayISBN($isbn));
2052     my $code = $codes[0].$codes[1].$codes[2];
2053     my $dbh  = C4::Context->dbh;
2054     my $query = qq{
2055         SELECT distinct publishercode
2056         FROM   biblioitems
2057         WHERE  isbn LIKE ?
2058         AND    publishercode IS NOT NULL
2059         LIMIT 1
2060     };
2061     my $sth = $dbh->prepare($query);
2062     $sth->execute("$code%");
2063     my $name = $sth->fetchrow;
2064     return $name if length $name;
2065     return undef;
2066 }
2067
2068 =head2 TransformKohaToMarc
2069
2070 =over 4
2071
2072     $record = TransformKohaToMarc( $hash )
2073     This function builds partial MARC::Record from a hash
2074     Hash entries can be from biblio or biblioitems.
2075     This function is called in acquisition module, to create a basic catalogue entry from user entry
2076
2077 =back
2078
2079 =cut
2080
2081 sub TransformKohaToMarc {
2082
2083     my ( $hash ) = @_;
2084     my $dbh = C4::Context->dbh;
2085     my $sth =
2086     $dbh->prepare(
2087         "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?"
2088     );
2089     my $record = MARC::Record->new();
2090     foreach (keys %{$hash}) {
2091         &TransformKohaToMarcOneField( $sth, $record, $_,
2092             $hash->{$_}, '' );
2093         }
2094     return $record;
2095 }
2096
2097 =head2 TransformKohaToMarcOneField
2098
2099 =over 4
2100
2101     $record = TransformKohaToMarcOneField( $sth, $record, $kohafieldname, $value, $frameworkcode );
2102
2103 =back
2104
2105 =cut
2106
2107 sub TransformKohaToMarcOneField {
2108     my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_;
2109     $frameworkcode='' unless $frameworkcode;
2110     my $tagfield;
2111     my $tagsubfield;
2112
2113     if ( !defined $sth ) {
2114         my $dbh = C4::Context->dbh;
2115         $sth = $dbh->prepare(
2116             "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?"
2117         );
2118     }
2119     $sth->execute( $frameworkcode, $kohafieldname );
2120     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
2121         my $tag = $record->field($tagfield);
2122         if ($tag) {
2123             $tag->update( $tagsubfield => $value );
2124             $record->delete_field($tag);
2125             $record->insert_fields_ordered($tag);
2126         }
2127         else {
2128             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
2129         }
2130     }
2131     return $record;
2132 }
2133
2134 =head2 TransformHtmlToXml
2135
2136 =over 4
2137
2138 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type )
2139
2140 $auth_type contains :
2141 - nothing : rebuild a biblio, un UNIMARC the encoding is in 100$a pos 26/27
2142 - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2143 - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2144
2145 =back
2146
2147 =cut
2148
2149 sub TransformHtmlToXml {
2150     my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2151     my $xml = MARC::File::XML::header('UTF-8');
2152     $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2153     MARC::File::XML->default_record_format($auth_type);
2154     # in UNIMARC, field 100 contains the encoding
2155     # check that there is one, otherwise the
2156     # MARC::Record->new_from_xml will fail (and Koha will die)
2157     my $unimarc_and_100_exist=0;
2158     $unimarc_and_100_exist=1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
2159     my $prevvalue;
2160     my $prevtag = -1;
2161     my $first   = 1;
2162     my $j       = -1;
2163     for ( my $i = 0 ; $i <= @$tags ; $i++ ) {
2164         if (C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a") {
2165             # if we have a 100 field and it's values are not correct, skip them.
2166             # if we don't have any valid 100 field, we will create a default one at the end
2167             my $enc = substr( @$values[$i], 26, 2 );
2168             if ($enc eq '01' or $enc eq '50' or $enc eq '03') {
2169                 $unimarc_and_100_exist=1;
2170             } else {
2171                 next;
2172             }
2173         }
2174         @$values[$i] =~ s/&/&amp;/g;
2175         @$values[$i] =~ s/</&lt;/g;
2176         @$values[$i] =~ s/>/&gt;/g;
2177         @$values[$i] =~ s/"/&quot;/g;
2178         @$values[$i] =~ s/'/&apos;/g;
2179 #         if ( !utf8::is_utf8( @$values[$i] ) ) {
2180 #             utf8::decode( @$values[$i] );
2181 #         }
2182         if ( ( @$tags[$i] ne $prevtag ) ) {
2183             $j++ unless ( @$tags[$i] eq "" );
2184             if ( !$first ) {
2185                 $xml .= "</datafield>\n";
2186                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
2187                     && ( @$values[$i] ne "" ) )
2188                 {
2189                     my $ind1 = substr( @$indicator[$j], 0, 1 );
2190                     my $ind2;
2191                     if ( @$indicator[$j] ) {
2192                         $ind2 = substr( @$indicator[$j], 1, 1 );
2193                     }
2194                     else {
2195                         warn "Indicator in @$tags[$i] is empty";
2196                         $ind2 = " ";
2197                     }
2198                     $xml .=
2199 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2200                     $xml .=
2201 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2202                     $first = 0;
2203                 }
2204                 else {
2205                     $first = 1;
2206                 }
2207             }
2208             else {
2209                 if ( @$values[$i] ne "" ) {
2210
2211                     # leader
2212                     if ( @$tags[$i] eq "000" ) {
2213                         $xml .= "<leader>@$values[$i]</leader>\n";
2214                         $first = 1;
2215
2216                         # rest of the fixed fields
2217                     }
2218                     elsif ( @$tags[$i] < 10 ) {
2219                         $xml .=
2220 "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2221                         $first = 1;
2222                     }
2223                     else {
2224                         my $ind1 = substr( @$indicator[$j], 0, 1 );
2225                         my $ind2 = substr( @$indicator[$j], 1, 1 );
2226                         $xml .=
2227 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2228                         $xml .=
2229 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2230                         $first = 0;
2231                     }
2232                 }
2233             }
2234         }
2235         else {    # @$tags[$i] eq $prevtag
2236             if ( @$values[$i] eq "" ) {
2237             }
2238             else {
2239                 if ($first) {
2240                     my $ind1 = substr( @$indicator[$j], 0, 1 );
2241                     my $ind2 = substr( @$indicator[$j], 1, 1 );
2242                     $xml .=
2243 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2244                     $first = 0;
2245                 }
2246                 $xml .=
2247 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2248             }
2249         }
2250         $prevtag = @$tags[$i];
2251     }
2252     if (C4::Context->preference('marcflavour') and !$unimarc_and_100_exist) {
2253 #     warn "SETTING 100 for $auth_type";
2254         use POSIX qw(strftime);
2255         my $string = strftime( "%Y%m%d", localtime(time) );
2256         # set 50 to position 26 is biblios, 13 if authorities
2257         my $pos=26;
2258         $pos=13 if $auth_type eq 'UNIMARCAUTH';
2259         $string = sprintf( "%-*s", 35, $string );
2260         substr( $string, $pos , 6, "50" );
2261         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2262         $xml .= "<subfield code=\"a\">$string</subfield>\n";
2263         $xml .= "</datafield>\n";
2264     }
2265     $xml .= MARC::File::XML::footer();
2266     return $xml;
2267 }
2268
2269 =head2 TransformHtmlToMarc
2270
2271     L<$record> = TransformHtmlToMarc(L<$params>,L<$cgi>)
2272     L<$params> is a ref to an array as below:
2273     {
2274         'tag_010_indicator_531951' ,
2275         'tag_010_code_a_531951_145735' ,
2276         'tag_010_subfield_a_531951_145735' ,
2277         'tag_200_indicator_873510' ,
2278         'tag_200_code_a_873510_673465' ,
2279         'tag_200_subfield_a_873510_673465' ,
2280         'tag_200_code_b_873510_704318' ,
2281         'tag_200_subfield_b_873510_704318' ,
2282         'tag_200_code_e_873510_280822' ,
2283         'tag_200_subfield_e_873510_280822' ,
2284         'tag_200_code_f_873510_110730' ,
2285         'tag_200_subfield_f_873510_110730' ,
2286     }
2287     L<$cgi> is the CGI object which containts the value.
2288     L<$record> is the MARC::Record object.
2289
2290 =cut
2291
2292 sub TransformHtmlToMarc {
2293     my $params = shift;
2294     my $cgi    = shift;
2295
2296     # creating a new record
2297     my $record  = MARC::Record->new();
2298     my $i=0;
2299     my @fields;
2300     while ($params->[$i]){ # browse all CGI params
2301         my $param = $params->[$i];
2302         my $newfield=0;
2303         # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2304         if ($param eq 'biblionumber') {
2305             my ( $biblionumbertagfield, $biblionumbertagsubfield ) =
2306                 &GetMarcFromKohaField( "biblio.biblionumber", '' );
2307             if ($biblionumbertagfield < 10) {
2308                 $newfield = MARC::Field->new(
2309                     $biblionumbertagfield,
2310                     $cgi->param($param),
2311                 );
2312             } else {
2313                 $newfield = MARC::Field->new(
2314                     $biblionumbertagfield,
2315                     '',
2316                     '',
2317                     "$biblionumbertagsubfield" => $cgi->param($param),
2318                 );
2319             }
2320             push @fields,$newfield if($newfield);
2321         }
2322         elsif ($param =~ /^tag_(\d*)_indicator_/){ # new field start when having 'input name="..._indicator_..."
2323             my $tag  = $1;
2324
2325             my $ind1 = substr($cgi->param($param),0,1);
2326             my $ind2 = substr($cgi->param($param),1,1);
2327             $newfield=0;
2328             my $j=$i+1;
2329
2330             if($tag < 10){ # no code for theses fields
2331     # in MARC editor, 000 contains the leader.
2332                 if ($tag eq '000' ) {
2333                     $record->leader($cgi->param($params->[$j+1])) if length($cgi->param($params->[$j+1]))==24;
2334     # between 001 and 009 (included)
2335                 } else {
2336                     $newfield = MARC::Field->new(
2337                         $tag,
2338                         $cgi->param($params->[$j+1]),
2339                     );
2340                 }
2341     # > 009, deal with subfields
2342             } else {
2343                 while($params->[$j] =~ /_code_/){ # browse all it's subfield
2344                     my $inner_param = $params->[$j];
2345                     if ($newfield){
2346                         if($cgi->param($params->[$j+1])){  # only if there is a value (code => value)
2347                             $newfield->add_subfields(
2348                                 $cgi->param($inner_param) => $cgi->param($params->[$j+1])
2349                             );
2350                         }
2351                     } else {
2352                         if ( $cgi->param($params->[$j+1]) ) { # creating only if there is a value (code => value)
2353                             $newfield = MARC::Field->new(
2354                                 $tag,
2355                                 ''.$ind1,
2356                                 ''.$ind2,
2357                                 $cgi->param($inner_param) => $cgi->param($params->[$j+1]),
2358                             );
2359                         }
2360                     }
2361                     $j+=2;
2362                 }
2363             }
2364             push @fields,$newfield if($newfield);
2365         }
2366         $i++;
2367     }
2368
2369     $record->append_fields(@fields);
2370     return $record;
2371 }
2372
2373 =head2 TransformMarcToKoha
2374
2375 =over 4
2376
2377         $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
2378
2379 =back
2380
2381 =cut
2382
2383 sub TransformMarcToKoha {
2384     my ( $dbh, $record, $frameworkcode, $table ) = @_;
2385
2386     my $result;
2387
2388     # sometimes we only want to return the items data
2389     if ($table eq 'items') {
2390         my $sth = $dbh->prepare("SHOW COLUMNS FROM items");
2391         $sth->execute();
2392         while ( (my $field) = $sth->fetchrow ) {
2393             my $value = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2394             my $key = _disambiguate($table, $field);
2395             if ($result->{$key}) {
2396                 $result->{$key} .= " | " . $value;
2397             } else {
2398                 $result->{$key} = $value;
2399             }
2400         }
2401         return $result;
2402     } else {
2403         my @tables = ('biblio','biblioitems','items');
2404         foreach my $table (@tables){
2405             my $sth2 = $dbh->prepare("SHOW COLUMNS from $table");
2406             $sth2->execute;
2407             while (my ($field) = $sth2->fetchrow){
2408                 # FIXME use of _disambiguate is a temporary hack
2409                 # $result->{_disambiguate($table, $field)} = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2410                 my $value = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2411                 my $key = _disambiguate($table, $field);
2412                 if ($result->{$key}) {
2413                     # FIXME - hack to not bring in duplicates of the same value
2414                     unless (($key eq "biblionumber" or $key eq "biblioitemnumber") and ($value eq "")) {
2415                         $result->{$key} .= " | " . $value;
2416                     }
2417                 } else {
2418                     $result->{$key} = $value;
2419                 }
2420             }
2421             $sth2->finish();
2422         }
2423         # modify copyrightdate to keep only the 1st year found
2424         my $temp = $result->{'copyrightdate'};
2425         $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2426         if ( $1 > 0 ) {
2427             $result->{'copyrightdate'} = $1;
2428         }
2429         else {                      # if no cYYYY, get the 1st date.
2430             $temp =~ m/(\d\d\d\d)/;
2431             $result->{'copyrightdate'} = $1;
2432         }
2433
2434         # modify publicationyear to keep only the 1st year found
2435         $temp = $result->{'publicationyear'};
2436         $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2437         if ( $1 > 0 ) {
2438             $result->{'publicationyear'} = $1;
2439         }
2440         else {                      # if no cYYYY, get the 1st date.
2441             $temp =~ m/(\d\d\d\d)/;
2442             $result->{'publicationyear'} = $1;
2443         }
2444         return $result;
2445     }
2446 }
2447
2448
2449 =head2 _disambiguate
2450
2451 =over 4
2452
2453 $newkey = _disambiguate($table, $field);
2454
2455 This is a temporary hack to distinguish between the
2456 following sets of columns when using TransformMarcToKoha.
2457
2458 items.cn_source & biblioitems.cn_source
2459 items.cn_sort & biblioitems.cn_sort
2460
2461 Columns that are currently NOT distinguished (FIXME
2462 due to lack of time to fully test) are:
2463
2464 biblio.notes and biblioitems.notes
2465 biblionumber
2466 timestamp
2467 biblioitemnumber
2468
2469 FIXME - this is necessary because prefixing each column
2470 name with the table name would require changing lots
2471 of code and templates, and exposing more of the DB
2472 structure than is good to the UI templates, particularly
2473 since biblio and bibloitems may well merge in a future
2474 version.  In the future, it would also be good to
2475 separate DB access and UI presentation field names
2476 more.
2477
2478 =back
2479
2480 =cut
2481
2482 sub _disambiguate {
2483     my ($table, $column) = @_;
2484     if ($column eq "cn_sort" or $column eq "cn_source") {
2485         return $table . '.' . $column;
2486     } else {
2487         return $column;
2488     }
2489
2490 }
2491
2492 =head2 get_koha_field_from_marc
2493
2494 =over 4
2495
2496 $result->{_disambiguate($table, $field)} = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2497
2498 Internal function to map data from the MARC record to a specific non-MARC field.
2499 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2500
2501 =back
2502
2503 =cut
2504
2505 sub get_koha_field_from_marc {
2506     my ($koha_table,$koha_column,$record,$frameworkcode) = @_;
2507     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table.'.'.$koha_column, $frameworkcode );
2508     my $kohafield;
2509     foreach my $field ( $record->field($tagfield) ) {
2510         if ( $field->tag() < 10 ) {
2511             if ( $kohafield ) {
2512                 $kohafield .= " | " . $field->data();
2513             }
2514             else {
2515                 $kohafield = $field->data();
2516             }
2517         }
2518         else {
2519             if ( $field->subfields ) {
2520                 my @subfields = $field->subfields();
2521                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2522                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2523                         if ( $kohafield ) {
2524                             $kohafield .=
2525                               " | " . $subfields[$subfieldcount][1];
2526                         }
2527                         else {
2528                             $kohafield =
2529                               $subfields[$subfieldcount][1];
2530                         }
2531                     }
2532                 }
2533             }
2534         }
2535     }
2536     return $kohafield;
2537 }
2538
2539
2540 =head2 TransformMarcToKohaOneField
2541
2542 =over 4
2543
2544 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2545
2546 =back
2547
2548 =cut
2549
2550 sub TransformMarcToKohaOneField {
2551
2552     # FIXME ? if a field has a repeatable subfield that is used in old-db,
2553     # only the 1st will be retrieved...
2554     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2555     my $res = "";
2556     my ( $tagfield, $subfield ) =
2557       GetMarcFromKohaField( $kohatable . "." . $kohafield,
2558         $frameworkcode );
2559     foreach my $field ( $record->field($tagfield) ) {
2560         if ( $field->tag() < 10 ) {
2561             if ( $result->{$kohafield} ) {
2562                 $result->{$kohafield} .= " | " . $field->data();
2563             }
2564             else {
2565                 $result->{$kohafield} = $field->data();
2566             }
2567         }
2568         else {
2569             if ( $field->subfields ) {
2570                 my @subfields = $field->subfields();
2571                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2572                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2573                         if ( $result->{$kohafield} ) {
2574                             $result->{$kohafield} .=
2575                               " | " . $subfields[$subfieldcount][1];
2576                         }
2577                         else {
2578                             $result->{$kohafield} =
2579                               $subfields[$subfieldcount][1];
2580                         }
2581                     }
2582                 }
2583             }
2584         }
2585     }
2586     return $result;
2587 }
2588
2589 =head1  OTHER FUNCTIONS
2590
2591 =head2 char_decode
2592
2593 =over 4
2594
2595 my $string = char_decode( $string, $encoding );
2596
2597 converts ISO 5426 coded string to UTF-8
2598 sloppy code : should be improved in next issue
2599
2600 =back
2601
2602 =cut
2603
2604 sub char_decode {
2605     my ( $string, $encoding ) = @_;
2606     $_ = $string;
2607
2608     $encoding = C4::Context->preference("marcflavour") unless $encoding;
2609     if ( $encoding eq "UNIMARC" ) {
2610
2611         #         s/\xe1/Æ/gm;
2612         s/\xe2/Ğ/gm;
2613         s/\xe9/Ø/gm;
2614         s/\xec/ş/gm;
2615         s/\xf1/æ/gm;
2616         s/\xf3/ğ/gm;
2617         s/\xf9/ø/gm;
2618         s/\xfb/ß/gm;
2619         s/\xc1\x61/à/gm;
2620         s/\xc1\x65/è/gm;
2621         s/\xc1\x69/ì/gm;
2622         s/\xc1\x6f/ò/gm;
2623         s/\xc1\x75/ù/gm;
2624         s/\xc1\x41/À/gm;
2625         s/\xc1\x45/È/gm;
2626         s/\xc1\x49/Ì/gm;
2627         s/\xc1\x4f/Ò/gm;
2628         s/\xc1\x55/Ù/gm;
2629         s/\xc2\x41/Á/gm;
2630         s/\xc2\x45/É/gm;
2631         s/\xc2\x49/Í/gm;
2632         s/\xc2\x4f/Ó/gm;
2633         s/\xc2\x55/Ú/gm;
2634         s/\xc2\x59/İ/gm;
2635         s/\xc2\x61/á/gm;
2636         s/\xc2\x65/é/gm;
2637         s/\xc2\x69/í/gm;
2638         s/\xc2\x6f/ó/gm;
2639         s/\xc2\x75/ú/gm;
2640         s/\xc2\x79/ı/gm;
2641         s/\xc3\x41/Â/gm;
2642         s/\xc3\x45/Ê/gm;
2643         s/\xc3\x49/Î/gm;
2644         s/\xc3\x4f/Ô/gm;
2645         s/\xc3\x55/Û/gm;
2646         s/\xc3\x61/â/gm;
2647         s/\xc3\x65/ê/gm;
2648         s/\xc3\x69/î/gm;
2649         s/\xc3\x6f/ô/gm;
2650         s/\xc3\x75/û/gm;
2651         s/\xc4\x41/Ã/gm;
2652         s/\xc4\x4e/Ñ/gm;
2653         s/\xc4\x4f/Õ/gm;
2654         s/\xc4\x61/ã/gm;
2655         s/\xc4\x6e/ñ/gm;
2656         s/\xc4\x6f/õ/gm;
2657         s/\xc8\x41/Ä/gm;
2658         s/\xc8\x45/Ë/gm;
2659         s/\xc8\x49/Ï/gm;
2660         s/\xc8\x61/ä/gm;
2661         s/\xc8\x65/ë/gm;
2662         s/\xc8\x69/ï/gm;
2663         s/\xc8\x6F/ö/gm;
2664         s/\xc8\x75/ü/gm;
2665         s/\xc8\x76/ÿ/gm;
2666         s/\xc9\x41/Ä/gm;
2667         s/\xc9\x45/Ë/gm;
2668         s/\xc9\x49/Ï/gm;
2669         s/\xc9\x4f/Ö/gm;
2670         s/\xc9\x55/Ü/gm;
2671         s/\xc9\x61/ä/gm;
2672         s/\xc9\x6f/ö/gm;
2673         s/\xc9\x75/ü/gm;
2674         s/\xca\x41/Å/gm;
2675         s/\xca\x61/å/gm;
2676         s/\xd0\x43/Ç/gm;
2677         s/\xd0\x63/ç/gm;
2678
2679         # this handles non-sorting blocks (if implementation requires this)
2680         $string = nsb_clean($_);
2681     }
2682     elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2683         ##MARC-8 to UTF-8
2684
2685         s/\xe1\x61/à/gm;
2686         s/\xe1\x65/è/gm;
2687         s/\xe1\x69/ì/gm;
2688         s/\xe1\x6f/ò/gm;
2689         s/\xe1\x75/ù/gm;
2690         s/\xe1\x41/À/gm;
2691         s/\xe1\x45/È/gm;
2692         s/\xe1\x49/Ì/gm;
2693         s/\xe1\x4f/Ò/gm;
2694         s/\xe1\x55/Ù/gm;
2695         s/\xe2\x41/Á/gm;
2696         s/\xe2\x45/É/gm;
2697         s/\xe2\x49/Í/gm;
2698         s/\xe2\x4f/Ó/gm;
2699         s/\xe2\x55/Ú/gm;
2700         s/\xe2\x59/İ/gm;
2701         s/\xe2\x61/á/gm;
2702         s/\xe2\x65/é/gm;
2703         s/\xe2\x69/í/gm;
2704         s/\xe2\x6f/ó/gm;
2705         s/\xe2\x75/ú/gm;
2706         s/\xe2\x79/ı/gm;
2707         s/\xe3\x41/Â/gm;
2708         s/\xe3\x45/Ê/gm;
2709         s/\xe3\x49/Î/gm;
2710         s/\xe3\x4f/Ô/gm;
2711         s/\xe3\x55/Û/gm;
2712         s/\xe3\x61/â/gm;
2713         s/\xe3\x65/ê/gm;
2714         s/\xe3\x69/î/gm;
2715         s/\xe3\x6f/ô/gm;
2716         s/\xe3\x75/û/gm;
2717         s/\xe4\x41/Ã/gm;
2718         s/\xe4\x4e/Ñ/gm;
2719         s/\xe4\x4f/Õ/gm;
2720         s/\xe4\x61/ã/gm;
2721         s/\xe4\x6e/ñ/gm;
2722         s/\xe4\x6f/õ/gm;
2723         s/\xe6\x41/Ă/gm;
2724         s/\xe6\x45/Ĕ/gm;
2725         s/\xe6\x65/ĕ/gm;
2726         s/\xe6\x61/ă/gm;
2727         s/\xe8\x45/Ë/gm;
2728         s/\xe8\x49/Ï/gm;
2729         s/\xe8\x65/ë/gm;
2730         s/\xe8\x69/ï/gm;
2731         s/\xe8\x76/ÿ/gm;
2732         s/\xe9\x41/A/gm;
2733         s/\xe9\x4f/O/gm;
2734         s/\xe9\x55/U/gm;
2735         s/\xe9\x61/a/gm;
2736         s/\xe9\x6f/o/gm;
2737         s/\xe9\x75/u/gm;
2738         s/\xea\x41/A/gm;
2739         s/\xea\x61/a/gm;
2740
2741         #Additional Turkish characters
2742         s/\x1b//gm;
2743         s/\x1e//gm;
2744         s/(\xf0)s/\xc5\x9f/gm;
2745         s/(\xf0)S/\xc5\x9e/gm;
2746         s/(\xf0)c/ç/gm;
2747         s/(\xf0)C/Ç/gm;
2748         s/\xe7\x49/\\xc4\xb0/gm;
2749         s/(\xe6)G/\xc4\x9e/gm;
2750         s/(\xe6)g/ğ\xc4\x9f/gm;
2751         s/\xB8/ı/gm;
2752         s/\xB9/£/gm;
2753         s/(\xe8|\xc8)o/ö/gm;
2754         s/(\xe8|\xc8)O/Ö/gm;
2755         s/(\xe8|\xc8)u/ü/gm;
2756         s/(\xe8|\xc8)U/Ü/gm;
2757         s/\xc2\xb8/\xc4\xb1/gm;
2758         s/¸/\xc4\xb1/gm;
2759
2760         # this handles non-sorting blocks (if implementation requires this)
2761         $string = nsb_clean($_);
2762     }
2763     return ($string);
2764 }
2765
2766 =head2 nsb_clean
2767
2768 =over 4
2769
2770 my $string = nsb_clean( $string, $encoding );
2771
2772 =back
2773
2774 =cut
2775
2776 sub nsb_clean {
2777     my $NSB      = '\x88';    # NSB : begin Non Sorting Block
2778     my $NSE      = '\x89';    # NSE : Non Sorting Block end
2779                               # handles non sorting blocks
2780     my ($string) = @_;
2781     $_ = $string;
2782     s/$NSB/(/gm;
2783     s/[ ]{0,1}$NSE/) /gm;
2784     $string = $_;
2785     return ($string);
2786 }
2787
2788 =head2 PrepareItemrecordDisplay
2789
2790 =over 4
2791
2792 PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber);
2793
2794 Returns a hash with all the fields for Display a given item data in a template
2795
2796 =back
2797
2798 =cut
2799
2800 sub PrepareItemrecordDisplay {
2801
2802     my ( $bibnum, $itemnum ) = @_;
2803
2804     my $dbh = C4::Context->dbh;
2805     my $frameworkcode = &GetFrameworkCode( $bibnum );
2806     my ( $itemtagfield, $itemtagsubfield ) =
2807       &GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2808     my $tagslib = &GetMarcStructure( 1, $frameworkcode );
2809     my $itemrecord = GetMarcItem( $bibnum, $itemnum) if ($itemnum);
2810     my @loop_data;
2811     my $authorised_values_sth =
2812       $dbh->prepare(
2813 "SELECT authorised_value,lib FROM authorised_values WHERE category=? ORDER BY lib"
2814       );
2815     foreach my $tag ( sort keys %{$tagslib} ) {
2816         my $previous_tag = '';
2817         if ( $tag ne '' ) {
2818             # loop through each subfield
2819             my $cntsubf;
2820             foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
2821                 next if ( subfield_is_koha_internal_p($subfield) );
2822                 next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
2823                 my %subfield_data;
2824                 $subfield_data{tag}           = $tag;
2825                 $subfield_data{subfield}      = $subfield;
2826                 $subfield_data{countsubfield} = $cntsubf++;
2827                 $subfield_data{kohafield}     =
2828                   $tagslib->{$tag}->{$subfield}->{'kohafield'};
2829
2830          #        $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
2831                 $subfield_data{marc_lib} =
2832                     "<span id=\"error\" title=\""
2833                   . $tagslib->{$tag}->{$subfield}->{lib} . "\">"
2834                   . substr( $tagslib->{$tag}->{$subfield}->{lib}, 0, 12 )
2835                   . "</span>";
2836                 $subfield_data{mandatory} =
2837                   $tagslib->{$tag}->{$subfield}->{mandatory};
2838                 $subfield_data{repeatable} =
2839                   $tagslib->{$tag}->{$subfield}->{repeatable};
2840                 $subfield_data{hidden} = "display:none"
2841                   if $tagslib->{$tag}->{$subfield}->{hidden};
2842                 my ( $x, $value );
2843                 ( $x, $value ) = _find_value( $tag, $subfield, $itemrecord )
2844                   if ($itemrecord);
2845                 $value =~ s/"/&quot;/g;
2846
2847                 # search for itemcallnumber if applicable
2848                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
2849                     'items.itemcallnumber'
2850                     && C4::Context->preference('itemcallnumber') )
2851                 {
2852                     my $CNtag =
2853                       substr( C4::Context->preference('itemcallnumber'), 0, 3 );
2854                     my $CNsubfield =
2855                       substr( C4::Context->preference('itemcallnumber'), 3, 1 );
2856                     my $temp = $itemrecord->field($CNtag) if ($itemrecord);
2857                     if ($temp) {
2858                         $value = $temp->subfield($CNsubfield);
2859                     }
2860                 }
2861                 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
2862                     my @authorised_values;
2863                     my %authorised_lib;
2864
2865                     # builds list, depending on authorised value...
2866                     #---- branch
2867                     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq
2868                         "branches" )
2869                     {
2870                         if ( ( C4::Context->preference("IndependantBranches") )
2871                             && ( C4::Context->userenv->{flags} != 1 ) )
2872                         {
2873                             my $sth =
2874                               $dbh->prepare(
2875                                                                 "SELECT branchcode,branchname FROM branches WHERE branchcode = ? ORDER BY branchname"
2876                               );
2877                             $sth->execute( C4::Context->userenv->{branch} );
2878                             push @authorised_values, ""
2879                               unless (
2880                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
2881                             while ( my ( $branchcode, $branchname ) =
2882                                 $sth->fetchrow_array )
2883                             {
2884                                 push @authorised_values, $branchcode;
2885                                 $authorised_lib{$branchcode} = $branchname;
2886                             }
2887                         }
2888                         else {
2889                             my $sth =
2890                               $dbh->prepare(
2891                                                                 "SELECT branchcode,branchname FROM branches ORDER BY branchname"
2892                               );
2893                             $sth->execute;
2894                             push @authorised_values, ""
2895                               unless (
2896                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
2897                             while ( my ( $branchcode, $branchname ) =
2898                                 $sth->fetchrow_array )
2899                             {
2900                                 push @authorised_values, $branchcode;
2901                                 $authorised_lib{$branchcode} = $branchname;
2902                             }
2903                         }
2904
2905                         #----- itemtypes
2906                     }
2907                     elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq
2908                         "itemtypes" )
2909                     {
2910                         my $sth =
2911                           $dbh->prepare(
2912                                                         "SELECT itemtype,description FROM itemtypes ORDER BY description"
2913                           );
2914                         $sth->execute;
2915                         push @authorised_values, ""
2916                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2917                         while ( my ( $itemtype, $description ) =
2918                             $sth->fetchrow_array )
2919                         {
2920                             push @authorised_values, $itemtype;
2921                             $authorised_lib{$itemtype} = $description;
2922                         }
2923
2924                         #---- "true" authorised value
2925                     }
2926                     else {
2927                         $authorised_values_sth->execute(
2928                             $tagslib->{$tag}->{$subfield}->{authorised_value} );
2929                         push @authorised_values, ""
2930                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2931                         while ( my ( $value, $lib ) =
2932                             $authorised_values_sth->fetchrow_array )
2933                         {
2934                             push @authorised_values, $value;
2935                             $authorised_lib{$value} = $lib;
2936                         }
2937                     }
2938                     $subfield_data{marc_value} = CGI::scrolling_list(
2939                         -name     => 'field_value',
2940                         -values   => \@authorised_values,
2941                         -default  => "$value",
2942                         -labels   => \%authorised_lib,
2943                         -size     => 1,
2944                         -tabindex => '',
2945                         -multiple => 0,
2946                     );
2947                 }
2948                 elsif ( $tagslib->{$tag}->{$subfield}->{thesaurus_category} ) {
2949                     $subfield_data{marc_value} =
2950 "<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>";
2951
2952 #"
2953 # COMMENTED OUT because No $i is provided with this API.
2954 # And thus, no value_builder can be activated.
2955 # BUT could be thought over.
2956 #         } elsif ($tagslib->{$tag}->{$subfield}->{'value_builder'}) {
2957 #             my $plugin="value_builder/".$tagslib->{$tag}->{$subfield}->{'value_builder'};
2958 #             require $plugin;
2959 #             my $extended_param = plugin_parameters($dbh,$itemrecord,$tagslib,$i,0);
2960 #             my ($function_name,$javascript) = plugin_javascript($dbh,$record,$tagslib,$i,0);
2961 #             $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";
2962                 }
2963                 else {
2964                     $subfield_data{marc_value} =
2965 "<input type=\"text\" name=\"field_value\" value=\"$value\" size=50 maxlength=255>";
2966                 }
2967                 push( @loop_data, \%subfield_data );
2968             }
2969         }
2970     }
2971     my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
2972       if ( $itemrecord && $itemrecord->field($itemtagfield) );
2973     return {
2974         'itemtagfield'    => $itemtagfield,
2975         'itemtagsubfield' => $itemtagsubfield,
2976         'itemnumber'      => $itemnumber,
2977         'iteminformation' => \@loop_data
2978     };
2979 }
2980 #"
2981
2982 #
2983 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2984 # at the same time
2985 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2986 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2987 # =head2 ModZebrafiles
2988 #
2989 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2990 #
2991 # =cut
2992 #
2993 # sub ModZebrafiles {
2994 #
2995 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2996 #
2997 #     my $op;
2998 #     my $zebradir =
2999 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
3000 #     unless ( opendir( DIR, "$zebradir" ) ) {
3001 #         warn "$zebradir not found";
3002 #         return;
3003 #     }
3004 #     closedir DIR;
3005 #     my $filename = $zebradir . $biblionumber;
3006 #
3007 #     if ($record) {
3008 #         open( OUTPUT, ">", $filename . ".xml" );
3009 #         print OUTPUT $record;
3010 #         close OUTPUT;
3011 #     }
3012 # }
3013
3014 =head2 ModZebra
3015
3016 =over 4
3017
3018 ModZebra( $biblionumber, $op, $server, $newRecord );
3019
3020     $biblionumber is the biblionumber we want to index
3021     $op is specialUpdate or delete, and is used to know what we want to do
3022     $server is the server that we want to update
3023     $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.
3024
3025 =back
3026
3027 =cut
3028
3029 sub ModZebra {
3030 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
3031     my ( $biblionumber, $op, $server, $newRecord ) = @_;
3032     my $dbh=C4::Context->dbh;
3033
3034     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
3035     # at the same time
3036     # replaced by a zebraqueue table, that is filled with ModZebra to run.
3037     # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
3038
3039     if (C4::Context->preference("NoZebra")) {
3040         # lock the nozebra table : we will read index lines, update them in Perl process
3041         # and write everything in 1 transaction.
3042         # lock the table to avoid someone else overwriting what we are doing
3043         $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE');
3044         my %result; # the result hash that will be builded by deletion / add, and written on mySQL at the end, to improve speed
3045         my $record;
3046         if ($server eq 'biblioserver') {
3047             $record= GetMarcBiblio($biblionumber);
3048         } else {
3049             $record= C4::AuthoritiesMarc::GetAuthority($biblionumber);
3050         }
3051         if ($op eq 'specialUpdate') {
3052             # OK, we have to add or update the record
3053             # 1st delete (virtually, in indexes) ...
3054             %result = _DelBiblioNoZebra($biblionumber,$record,$server);
3055             # ... add the record
3056             %result=_AddBiblioNoZebra($biblionumber,$newRecord, $server, %result);
3057         } else {
3058             # it's a deletion, delete the record...
3059             # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
3060             %result=_DelBiblioNoZebra($biblionumber,$record,$server);
3061         }
3062         # ok, now update the database...
3063         my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
3064         foreach my $key (keys %result) {
3065             foreach my $index (keys %{$result{$key}}) {
3066                 $sth->execute($result{$key}->{$index}, $server, $key, $index);
3067             }
3068         }
3069         $dbh->do('UNLOCK TABLES');
3070
3071     } else {
3072         #
3073         # we use zebra, just fill zebraqueue table
3074         #
3075         my $sth=$dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
3076         $sth->execute($biblionumber,$server,$op);
3077         $sth->finish;
3078     }
3079 }
3080
3081 =head2 GetNoZebraIndexes
3082
3083     %indexes = GetNoZebraIndexes;
3084
3085     return the data from NoZebraIndexes syspref.
3086
3087 =cut
3088
3089 sub GetNoZebraIndexes {
3090     my $index = C4::Context->preference('NoZebraIndexes');
3091     my %indexes;
3092     foreach my $line (split /('|"),/,$index) {
3093         $line =~ /(.*)=>(.*)/;
3094 warn $line;
3095         my $index = substr($1,1); # get the index, don't forget to remove initial ' or "
3096         my $fields = $2;
3097         $index =~ s/'|"|\s//g;
3098
3099
3100         $fields =~ s/'|"|\s//g;
3101         $indexes{$index}=$fields;
3102     }
3103     return %indexes;
3104 }
3105
3106 =head1 INTERNAL FUNCTIONS
3107
3108 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
3109
3110     function to delete a biblio in NoZebra indexes
3111     This function does NOT delete anything in database : it reads all the indexes entries
3112     that have to be deleted & delete them in the hash
3113     The SQL part is done either :
3114     - after the Add if we are modifying a biblio (delete + add again)
3115     - immediatly after this sub if we are doing a true deletion.
3116     $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
3117
3118 =cut
3119
3120
3121 sub _DelBiblioNoZebra {
3122     my ($biblionumber, $record, $server)=@_;
3123
3124     # Get the indexes
3125     my $dbh = C4::Context->dbh;
3126     # Get the indexes
3127     my %index;
3128     my $title;
3129     if ($server eq 'biblioserver') {
3130         %index=GetNoZebraIndexes;
3131         # get title of the record (to store the 10 first letters with the index)
3132         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
3133         $title = lc($record->subfield($titletag,$titlesubfield));
3134     } else {
3135         # for authorities, the "title" is the $a mainentry
3136         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
3137         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
3138         $title = $record->subfield($authref->{auth_tag_to_report},'a');
3139         $index{'mainmainentry'}= $authref->{'auth_tag_to_report'}.'a';
3140         $index{'mainentry'}    = $authref->{'auth_tag_to_report'}.'*';
3141         $index{'auth_type'}    = '152b';
3142     }
3143
3144     my %result;
3145     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3146     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
3147     # limit to 10 char, should be enough, and limit the DB size
3148     $title = substr($title,0,10);
3149     #parse each field
3150     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3151     foreach my $field ($record->fields()) {
3152         #parse each subfield
3153         next if $field->tag <10;
3154         foreach my $subfield ($field->subfields()) {
3155             my $tag = $field->tag();
3156             my $subfieldcode = $subfield->[0];
3157             my $indexed=0;
3158             # check each index to see if the subfield is stored somewhere
3159             # otherwise, store it in __RAW__ index
3160             foreach my $key (keys %index) {
3161 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3162                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
3163                     $indexed=1;
3164                     my $line= lc $subfield->[1];
3165                     # remove meaningless value in the field...
3166                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3167                     # ... and split in words
3168                     foreach (split / /,$line) {
3169                         next unless $_; # skip  empty values (multiple spaces)
3170                         # if the entry is already here, do nothing, the biblionumber has already be removed
3171                         unless ($result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) {
3172                             # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
3173                             $sth2->execute($server,$key,$_);
3174                             my $existing_biblionumbers = $sth2->fetchrow;
3175                             # it exists
3176                             if ($existing_biblionumbers) {
3177 #                                 warn " existing for $key $_: $existing_biblionumbers";
3178                                 $result{$key}->{$_} =$existing_biblionumbers;
3179                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3180                             }
3181                         }
3182                     }
3183                 }
3184             }
3185             # the subfield is not indexed, store it in __RAW__ index anyway
3186             unless ($indexed) {
3187                 my $line= lc $subfield->[1];
3188                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3189                 # ... and split in words
3190                 foreach (split / /,$line) {
3191                     next unless $_; # skip  empty values (multiple spaces)
3192                     # if the entry is already here, do nothing, the biblionumber has already be removed
3193                     unless ($result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/) {
3194                         # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
3195                         $sth2->execute($server,'__RAW__',$_);
3196                         my $existing_biblionumbers = $sth2->fetchrow;
3197                         # it exists
3198                         if ($existing_biblionumbers) {
3199                             $result{'__RAW__'}->{$_} =$existing_biblionumbers;
3200                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3201                         }
3202                     }
3203                 }
3204             }
3205         }
3206     }
3207     return %result;
3208 }
3209
3210 =head2 _AddBiblioNoZebra($biblionumber, $record, $server, %result);
3211
3212     function to add a biblio in NoZebra indexes
3213
3214 =cut
3215
3216 sub _AddBiblioNoZebra {
3217     my ($biblionumber, $record, $server, %result)=@_;
3218     my $dbh = C4::Context->dbh;
3219     # Get the indexes
3220     my %index;
3221     my $title;
3222     if ($server eq 'biblioserver') {
3223         %index=GetNoZebraIndexes;
3224         # get title of the record (to store the 10 first letters with the index)
3225         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
3226         $title = lc($record->subfield($titletag,$titlesubfield));
3227     } else {
3228         # warn "server : $server";
3229         # for authorities, the "title" is the $a mainentry
3230         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
3231         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
3232         $title = $record->subfield($authref->{auth_tag_to_report},'a');
3233         $index{'mainmainentry'} = $authref->{auth_tag_to_report}.'a';
3234         $index{'mainentry'}     = $authref->{auth_tag_to_report}.'*';
3235         $index{'auth_type'}     = '152b';
3236     }
3237
3238     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3239     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
3240     # limit to 10 char, should be enough, and limit the DB size
3241     $title = substr($title,0,10);
3242     #parse each field
3243     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3244     foreach my $field ($record->fields()) {
3245         #parse each subfield
3246         next if $field->tag <10;
3247         foreach my $subfield ($field->subfields()) {
3248             my $tag = $field->tag();
3249             my $subfieldcode = $subfield->[0];
3250             my $indexed=0;
3251             # check each index to see if the subfield is stored somewhere
3252             # otherwise, store it in __RAW__ index
3253             foreach my $key (keys %index) {
3254 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3255                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
3256                     $indexed=1;
3257                     my $line= lc $subfield->[1];
3258                     # remove meaningless value in the field...
3259                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3260                     # ... and split in words
3261                     foreach (split / /,$line) {
3262                         next unless $_; # skip  empty values (multiple spaces)
3263                         # if the entry is already here, improve weight
3264 #                         warn "managing $_";
3265                         if ($result{$key}->{"$_"} =~ /$biblionumber,$title\-(\d);/) {
3266                             my $weight=$1+1;
3267                             $result{$key}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3268                             $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3269                         } else {
3270                             # get the value if it exist in the nozebra table, otherwise, create it
3271                             $sth2->execute($server,$key,$_);
3272                             my $existing_biblionumbers = $sth2->fetchrow;
3273                             # it exists
3274                             if ($existing_biblionumbers) {
3275                                 $result{$key}->{"$_"} =$existing_biblionumbers;
3276                                 my $weight=$1+1;
3277                                 $result{$key}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3278                                 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3279                             # create a new ligne for this entry
3280                             } else {
3281 #                             warn "INSERT : $server / $key / $_";
3282                                 $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).', indexname='.$dbh->quote($key).',value='.$dbh->quote($_));
3283                                 $result{$key}->{"$_"}.="$biblionumber,$title-1;";
3284                             }
3285                         }
3286                     }
3287                 }
3288             }
3289             # the subfield is not indexed, store it in __RAW__ index anyway
3290             unless ($indexed) {
3291                 my $line= lc $subfield->[1];
3292                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3293                 # ... and split in words
3294                 foreach (split / /,$line) {
3295                     next unless $_; # skip  empty values (multiple spaces)
3296                     # if the entry is already here, improve weight
3297                     if ($result{'__RAW__'}->{"$_"} =~ /$biblionumber,$title\-(\d);/) {
3298                         my $weight=$1+1;
3299                         $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3300                         $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3301                     } else {
3302                         # get the value if it exist in the nozebra table, otherwise, create it
3303                         $sth2->execute($server,'__RAW__',$_);
3304                         my $existing_biblionumbers = $sth2->fetchrow;
3305                         # it exists
3306                         if ($existing_biblionumbers) {
3307                             $result{'__RAW__'}->{"$_"} =$existing_biblionumbers;
3308                             my $weight=$1+1;
3309                             $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3310                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3311                         # create a new ligne for this entry
3312                         } else {
3313                             $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).',  indexname="__RAW__",value='.$dbh->quote($_));
3314                             $result{'__RAW__'}->{"$_"}.="$biblionumber,$title-1;";
3315                         }
3316                     }
3317                 }
3318             }
3319         }
3320     }
3321     return %result;
3322 }
3323
3324
3325 =head2 MARCitemchange
3326
3327 =over 4
3328
3329 &MARCitemchange( $record, $itemfield, $newvalue )
3330
3331 Function to update a single value in an item field.
3332 Used twice, could probably be replaced by something else, but works well...
3333
3334 =back
3335
3336 =back
3337
3338 =cut
3339
3340 sub MARCitemchange {
3341     my ( $record, $itemfield, $newvalue ) = @_;
3342     my $dbh = C4::Context->dbh;
3343
3344     my ( $tagfield, $tagsubfield ) =
3345       GetMarcFromKohaField( $itemfield, "" );
3346     if ( ($tagfield) && ($tagsubfield) ) {
3347         my $tag = $record->field($tagfield);
3348         if ($tag) {
3349             $tag->update( $tagsubfield => $newvalue );
3350             $record->delete_field($tag);
3351             $record->insert_fields_ordered($tag);
3352         }
3353     }
3354 }
3355 =head2 _find_value
3356
3357 =over 4
3358
3359 ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
3360
3361 Find the given $subfield in the given $tag in the given
3362 MARC::Record $record.  If the subfield is found, returns
3363 the (indicators, value) pair; otherwise, (undef, undef) is
3364 returned.
3365
3366 PROPOSITION :
3367 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
3368 I suggest we export it from this module.
3369
3370 =back
3371
3372 =cut
3373
3374 sub _find_value {
3375     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
3376     my @result;
3377     my $indicator;
3378     if ( $tagfield < 10 ) {
3379         if ( $record->field($tagfield) ) {
3380             push @result, $record->field($tagfield)->data();
3381         }
3382         else {
3383             push @result, "";
3384         }
3385     }
3386     else {
3387         foreach my $field ( $record->field($tagfield) ) {
3388             my @subfields = $field->subfields();
3389             foreach my $subfield (@subfields) {
3390                 if ( @$subfield[0] eq $insubfield ) {
3391                     push @result, @$subfield[1];
3392                     $indicator = $field->indicator(1) . $field->indicator(2);
3393                 }
3394             }
3395         }
3396     }
3397     return ( $indicator, @result );
3398 }
3399
3400 =head2 _koha_marc_update_bib_ids
3401
3402 =over 4
3403
3404 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
3405
3406 Internal function to add or update biblionumber and biblioitemnumber to
3407 the MARC XML.
3408
3409 =back
3410
3411 =cut
3412
3413 sub _koha_marc_update_bib_ids {
3414     my ($record, $frameworkcode, $biblionumber, $biblioitemnumber) = @_;
3415
3416     # we must add bibnum and bibitemnum in MARC::Record...
3417     # we build the new field with biblionumber and biblioitemnumber
3418     # we drop the original field
3419     # we add the new builded field.
3420     my ($biblio_tag, $biblio_subfield ) = GetMarcFromKohaField("biblio.biblionumber",$frameworkcode);
3421     my ($biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.biblioitemnumber",$frameworkcode);
3422
3423     if ($biblio_tag != $biblioitem_tag) {
3424         # biblionumber & biblioitemnumber are in different fields
3425
3426         # deal with biblionumber
3427         my ($new_field, $old_field);
3428         if ($biblio_tag < 10) {
3429             $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
3430         } else {
3431             $new_field =
3432               MARC::Field->new( $biblio_tag, '', '',
3433                 "$biblio_subfield" => $biblionumber );
3434         }
3435
3436         # drop old field and create new one...
3437         $old_field = $record->field($biblio_tag);
3438         $record->delete_field($old_field);
3439         $record->append_fields($new_field);
3440
3441         # deal with biblioitemnumber
3442         if ($biblioitem_tag < 10) {
3443             $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
3444         } else {
3445             $new_field =
3446               MARC::Field->new( $biblioitem_tag, '', '',
3447                 "$biblioitem_subfield" => $biblioitemnumber, );
3448         }
3449         # drop old field and create new one...
3450         $old_field = $record->field($biblioitem_tag);
3451         $record->delete_field($old_field);
3452         $record->insert_fields_ordered($new_field);
3453
3454     } else {
3455         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
3456         my $new_field = MARC::Field->new(
3457             $biblio_tag, '', '',
3458             "$biblio_subfield" => $biblionumber,
3459             "$biblioitem_subfield" => $biblioitemnumber
3460         );
3461
3462         # drop old field and create new one...
3463         my $old_field = $record->field($biblio_tag);
3464         $record->delete_field($old_field);
3465         $record->insert_fields_ordered($new_field);
3466     }
3467 }
3468
3469 =head2 _koha_add_biblio
3470
3471 =over 4
3472
3473 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3474
3475 Internal function to add a biblio ($biblio is a hash with the values)
3476
3477 =back
3478
3479 =cut
3480
3481 sub _koha_add_biblio {
3482     my ( $dbh, $biblio, $frameworkcode ) = @_;
3483
3484         my $error;
3485
3486         # set the series flag
3487     my $serial = 0;
3488     if ( $biblio->{'seriestitle'} ) { $serial = 1 };
3489
3490         my $query =
3491         "INSERT INTO biblio
3492                 SET frameworkcode = ?,
3493                         author = ?,
3494                         title = ?,
3495                         unititle =?,
3496                         notes = ?,
3497                         serial = ?,
3498                         seriestitle = ?,
3499                         copyrightdate = ?,
3500                         datecreated=NOW(),
3501                         abstract = ?
3502                 ";
3503     my $sth = $dbh->prepare($query);
3504     $sth->execute(
3505                 $frameworkcode,
3506         $biblio->{'author'},
3507         $biblio->{'title'},
3508                 $biblio->{'unititle'},
3509         $biblio->{'notes'},
3510                 $serial,
3511         $biblio->{'seriestitle'},
3512                 $biblio->{'copyrightdate'},
3513         $biblio->{'abstract'}
3514     );
3515
3516     my $biblionumber = $dbh->{'mysql_insertid'};
3517         if ( $dbh->errstr ) {
3518                 $error.="ERROR in _koha_add_biblio $query".$dbh->errstr;
3519         warn $error;
3520     }
3521
3522     $sth->finish();
3523         #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3524     return ($biblionumber,$error);
3525 }
3526
3527 =head2 _koha_modify_biblio
3528
3529 =over 4
3530
3531 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3532
3533 Internal function for updating the biblio table
3534
3535 =back
3536
3537 =cut
3538
3539 sub _koha_modify_biblio {
3540     my ( $dbh, $biblio, $frameworkcode ) = @_;
3541         my $error;
3542
3543     my $query = "
3544         UPDATE biblio
3545         SET    frameworkcode = ?,
3546                            author = ?,
3547                            title = ?,
3548                            unititle = ?,
3549                            notes = ?,
3550                            serial = ?,
3551                            seriestitle = ?,
3552                            copyrightdate = ?,
3553                abstract = ?
3554         WHERE  biblionumber = ?
3555                 "
3556         ;
3557     my $sth = $dbh->prepare($query);
3558
3559     $sth->execute(
3560                 $frameworkcode,
3561         $biblio->{'author'},
3562         $biblio->{'title'},
3563         $biblio->{'unititle'},
3564         $biblio->{'notes'},
3565         $biblio->{'serial'},
3566         $biblio->{'seriestitle'},
3567         $biblio->{'copyrightdate'},
3568                 $biblio->{'abstract'},
3569         $biblio->{'biblionumber'}
3570     ) if $biblio->{'biblionumber'};
3571
3572     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3573                 $error.="ERROR in _koha_modify_biblio $query".$dbh->errstr;
3574         warn $error;
3575     }
3576     return ( $biblio->{'biblionumber'},$error );
3577 }
3578
3579 =head2 _koha_modify_biblioitem_nonmarc
3580
3581 =over 4
3582
3583 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3584
3585 Updates biblioitems row except for marc and marcxml, which should be changed
3586 via ModBiblioMarc
3587
3588 =back
3589
3590 =cut
3591
3592 sub _koha_modify_biblioitem_nonmarc {
3593     my ( $dbh, $biblioitem ) = @_;
3594         my $error;
3595
3596         # re-calculate the cn_sort, it may have changed
3597         my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3598
3599         my $query =
3600         "UPDATE biblioitems
3601         SET biblionumber        = ?,
3602                 volume                  = ?,
3603                 number                  = ?,
3604         itemtype        = ?,
3605         isbn            = ?,
3606         issn            = ?,
3607                 publicationyear = ?,
3608         publishercode   = ?,
3609                 volumedate      = ?,
3610                 volumedesc      = ?,
3611                 collectiontitle = ?,
3612                 collectionissn  = ?,
3613                 collectionvolume= ?,
3614                 editionstatement= ?,
3615                 editionresponsibility = ?,
3616                 illus                   = ?,
3617                 pages                   = ?,
3618                 notes                   = ?,
3619                 size                    = ?,
3620                 place                   = ?,
3621                 lccn                    = ?,
3622                 url                     = ?,
3623         cn_source               = ?,
3624         cn_class        = ?,
3625         cn_item         = ?,
3626                 cn_suffix       = ?,
3627                 cn_sort         = ?,
3628                 totalissues     = ?
3629         where biblioitemnumber = ?
3630                 ";
3631         my $sth = $dbh->prepare($query);
3632         $sth->execute(
3633                 $biblioitem->{'biblionumber'},
3634                 $biblioitem->{'volume'},
3635                 $biblioitem->{'number'},
3636                 $biblioitem->{'itemtype'},
3637                 $biblioitem->{'isbn'},
3638                 $biblioitem->{'issn'},
3639                 $biblioitem->{'publicationyear'},
3640                 $biblioitem->{'publishercode'},
3641                 $biblioitem->{'volumedate'},
3642                 $biblioitem->{'volumedesc'},
3643                 $biblioitem->{'collectiontitle'},
3644                 $biblioitem->{'collectionissn'},
3645                 $biblioitem->{'collectionvolume'},
3646                 $biblioitem->{'editionstatement'},
3647                 $biblioitem->{'editionresponsibility'},
3648                 $biblioitem->{'illus'},
3649                 $biblioitem->{'pages'},
3650                 $biblioitem->{'bnotes'},
3651                 $biblioitem->{'size'},
3652                 $biblioitem->{'place'},
3653                 $biblioitem->{'lccn'},
3654                 $biblioitem->{'url'},
3655                 $biblioitem->{'biblioitems.cn_source'},
3656                 $biblioitem->{'cn_class'},
3657                 $biblioitem->{'cn_item'},
3658                 $biblioitem->{'cn_suffix'},
3659                 $cn_sort,
3660                 $biblioitem->{'totalissues'},
3661                 $biblioitem->{'biblioitemnumber'}
3662         );
3663     if ( $dbh->errstr ) {
3664                 $error.="ERROR in _koha_modify_biblioitem_nonmarc $query".$dbh->errstr;
3665         warn $error;
3666     }
3667         return ($biblioitem->{'biblioitemnumber'},$error);
3668 }
3669
3670 =head2 _koha_add_biblioitem
3671
3672 =over 4
3673
3674 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3675
3676 Internal function to add a biblioitem
3677
3678 =back
3679
3680 =cut
3681
3682 sub _koha_add_biblioitem {
3683     my ( $dbh, $biblioitem ) = @_;
3684         my $error;
3685
3686         my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3687     my $query =
3688     "INSERT INTO biblioitems SET
3689         biblionumber    = ?,
3690         volume          = ?,
3691         number          = ?,
3692         itemtype        = ?,
3693         isbn            = ?,
3694         issn            = ?,
3695         publicationyear = ?,
3696         publishercode   = ?,
3697         volumedate      = ?,
3698         volumedesc      = ?,
3699         collectiontitle = ?,
3700         collectionissn  = ?,
3701         collectionvolume= ?,
3702         editionstatement= ?,
3703         editionresponsibility = ?,
3704         illus           = ?,
3705         pages           = ?,
3706         notes           = ?,
3707         size            = ?,
3708         place           = ?,
3709         lccn            = ?,
3710         marc            = ?,
3711         url             = ?,
3712         cn_source       = ?,
3713         cn_class        = ?,
3714         cn_item         = ?,
3715         cn_suffix       = ?,
3716         cn_sort         = ?,
3717         totalissues     = ?
3718         ";
3719         my $sth = $dbh->prepare($query);
3720     $sth->execute(
3721         $biblioitem->{'biblionumber'},
3722         $biblioitem->{'volume'},
3723         $biblioitem->{'number'},
3724         $biblioitem->{'itemtype'},
3725         $biblioitem->{'isbn'},
3726         $biblioitem->{'issn'},
3727         $biblioitem->{'publicationyear'},
3728         $biblioitem->{'publishercode'},
3729         $biblioitem->{'volumedate'},
3730         $biblioitem->{'volumedesc'},
3731         $biblioitem->{'collectiontitle'},
3732         $biblioitem->{'collectionissn'},
3733         $biblioitem->{'collectionvolume'},
3734         $biblioitem->{'editionstatement'},
3735         $biblioitem->{'editionresponsibility'},
3736         $biblioitem->{'illus'},
3737         $biblioitem->{'pages'},
3738         $biblioitem->{'bnotes'},
3739         $biblioitem->{'size'},
3740         $biblioitem->{'place'},
3741         $biblioitem->{'lccn'},
3742         $biblioitem->{'marc'},
3743         $biblioitem->{'url'},
3744         $biblioitem->{'biblioitems.cn_source'},
3745         $biblioitem->{'cn_class'},
3746         $biblioitem->{'cn_item'},
3747         $biblioitem->{'cn_suffix'},
3748         $cn_sort,
3749         $biblioitem->{'totalissues'}
3750     );
3751     my $bibitemnum = $dbh->{'mysql_insertid'};
3752     if ( $dbh->errstr ) {
3753                 $error.="ERROR in _koha_add_biblioitem $query".$dbh->errstr;
3754                 warn $error;
3755     }
3756     $sth->finish();
3757     return ($bibitemnum,$error);
3758 }
3759
3760 =head2 _koha_new_items
3761
3762 =over 4
3763
3764 my ($itemnumber,$error) = _koha_new_items( $dbh, $item, $barcode );
3765
3766 =back
3767
3768 =cut
3769
3770 sub _koha_new_items {
3771     my ( $dbh, $item, $barcode ) = @_;
3772         my $error;
3773
3774     my ($items_cn_sort) = GetClassSort($item->{'items.cn_source'}, $item->{'itemcallnumber'}, "");
3775
3776     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
3777     if ( $item->{'dateaccessioned'} eq '' || !$item->{'dateaccessioned'} ) {
3778                 my $today = C4::Dates->new();
3779                 $item->{'dateaccessioned'} =  $today->output("iso"); #TODO: check time issues
3780         }
3781         my $query =
3782            "INSERT INTO items SET
3783                         biblionumber            = ?,
3784             biblioitemnumber    = ?,
3785                         barcode                 = ?,
3786                         dateaccessioned         = ?,
3787                         booksellerid        = ?,
3788             homebranch          = ?,
3789             price               = ?,
3790                         replacementprice        = ?,
3791             replacementpricedate = NOW(),
3792                         datelastborrowed        = ?,
3793                         datelastseen            = NOW(),
3794                         stack                   = ?,
3795                         notforloan                      = ?,
3796                         damaged                         = ?,
3797             itemlost            = ?,
3798                         wthdrawn                = ?,
3799                         itemcallnumber          = ?,
3800                         restricted                      = ?,
3801                         itemnotes                       = ?,
3802                         holdingbranch           = ?,
3803             paidfor             = ?,
3804                         location                        = ?,
3805                         onloan                          = ?,
3806                         cn_source                       = ?,
3807                         cn_sort                         = ?,
3808                         ccode                           = ?,
3809                         itype                           = ?,
3810                         materials                       = ?,
3811                         uri                             = ?
3812           ";
3813     my $sth = $dbh->prepare($query);
3814         $sth->execute(
3815                         $item->{'biblionumber'},
3816                         $item->{'biblioitemnumber'},
3817             $barcode,
3818                         $item->{'dateaccessioned'},
3819                         $item->{'booksellerid'},
3820             $item->{'homebranch'},
3821             $item->{'price'},
3822                         $item->{'replacementprice'},
3823                         $item->{datelastborrowed},
3824                         $item->{stack},
3825                         $item->{'notforloan'},
3826                         $item->{'damaged'},
3827             $item->{'itemlost'},
3828                         $item->{'wthdrawn'},
3829                         $item->{'itemcallnumber'},
3830             $item->{'restricted'},
3831                         $item->{'itemnotes'},
3832                         $item->{'holdingbranch'},
3833                         $item->{'paidfor'},
3834                         $item->{'location'},
3835                         $item->{'onloan'},
3836                         $item->{'items.cn_source'},
3837                         $items_cn_sort,
3838                         $item->{'ccode'},
3839                         $item->{'itype'},
3840                         $item->{'materials'},
3841                         $item->{'uri'},
3842     );
3843     my $itemnumber = $dbh->{'mysql_insertid'};
3844     if ( defined $sth->errstr ) {
3845         $error.="ERROR in _koha_new_items $query".$sth->errstr;
3846     }
3847         $sth->finish();
3848     return ( $itemnumber, $error );
3849 }
3850
3851 =head2 _koha_modify_item
3852
3853 =over 4
3854
3855 my ($itemnumber,$error) =_koha_modify_item( $dbh, $item, $op );
3856
3857 =back
3858
3859 =cut
3860
3861 sub _koha_modify_item {
3862     my ( $dbh, $item ) = @_;
3863         my $error;
3864
3865         # calculate items.cn_sort
3866     $item->{'cn_sort'} = GetClassSort($item->{'items.cn_source'}, $item->{'itemcallnumber'}, "");
3867
3868     my $query = "UPDATE items SET ";
3869         my @bind;
3870         for my $key ( keys %$item ) {
3871                 $query.="$key=?,";
3872                 push @bind, $item->{$key};
3873     }
3874         $query =~ s/,$//;
3875     $query .= " WHERE itemnumber=?";
3876     push @bind, $item->{'itemnumber'};
3877     my $sth = $dbh->prepare($query);
3878     $sth->execute(@bind);
3879     if ( $dbh->errstr ) {
3880         $error.="ERROR in _koha_modify_item $query".$dbh->errstr;
3881         warn $error;
3882     }
3883     $sth->finish();
3884         return ($item->{'itemnumber'},$error);
3885 }
3886
3887 =head2 _koha_delete_biblio
3888
3889 =over 4
3890
3891 $error = _koha_delete_biblio($dbh,$biblionumber);
3892
3893 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3894
3895 C<$dbh> - the database handle
3896 C<$biblionumber> - the biblionumber of the biblio to be deleted
3897
3898 =back
3899
3900 =cut
3901
3902 # FIXME: add error handling
3903
3904 sub _koha_delete_biblio {
3905     my ( $dbh, $biblionumber ) = @_;
3906
3907     # get all the data for this biblio
3908     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3909     $sth->execute($biblionumber);
3910
3911     if ( my $data = $sth->fetchrow_hashref ) {
3912
3913         # save the record in deletedbiblio
3914         # find the fields to save
3915         my $query = "INSERT INTO deletedbiblio SET ";
3916         my @bind  = ();
3917         foreach my $temp ( keys %$data ) {
3918             $query .= "$temp = ?,";
3919             push( @bind, $data->{$temp} );
3920         }
3921
3922         # replace the last , by ",?)"
3923         $query =~ s/\,$//;
3924         my $bkup_sth = $dbh->prepare($query);
3925         $bkup_sth->execute(@bind);
3926         $bkup_sth->finish;
3927
3928         # delete the biblio
3929         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3930         $del_sth->execute($biblionumber);
3931         $del_sth->finish;
3932     }
3933     $sth->finish;
3934     return undef;
3935 }
3936
3937 =head2 _koha_delete_biblioitems
3938
3939 =over 4
3940
3941 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3942
3943 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3944
3945 C<$dbh> - the database handle
3946 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3947
3948 =back
3949
3950 =cut
3951
3952 # FIXME: add error handling
3953
3954 sub _koha_delete_biblioitems {
3955     my ( $dbh, $biblioitemnumber ) = @_;
3956
3957     # get all the data for this biblioitem
3958     my $sth =
3959       $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3960     $sth->execute($biblioitemnumber);
3961
3962     if ( my $data = $sth->fetchrow_hashref ) {
3963
3964         # save the record in deletedbiblioitems
3965         # find the fields to save
3966         my $query = "INSERT INTO deletedbiblioitems SET ";
3967         my @bind  = ();
3968         foreach my $temp ( keys %$data ) {
3969             $query .= "$temp = ?,";
3970             push( @bind, $data->{$temp} );
3971         }
3972
3973         # replace the last , by ",?)"
3974         $query =~ s/\,$//;
3975         my $bkup_sth = $dbh->prepare($query);
3976         $bkup_sth->execute(@bind);
3977         $bkup_sth->finish;
3978
3979         # delete the biblioitem
3980         my $del_sth =
3981           $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3982         $del_sth->execute($biblioitemnumber);
3983         $del_sth->finish;
3984     }
3985     $sth->finish;
3986     return undef;
3987 }
3988
3989 =head2 _koha_delete_item
3990
3991 =over 4
3992
3993 _koha_delete_item( $dbh, $itemnum );
3994
3995 Internal function to delete an item record from the koha tables
3996
3997 =back
3998
3999 =cut
4000
4001 sub _koha_delete_item {
4002     my ( $dbh, $itemnum ) = @_;
4003
4004         # save the deleted item to deleteditems table
4005     my $sth = $dbh->prepare("SELECT * FROM items WHERE itemnumber=?");
4006     $sth->execute($itemnum);
4007     my $data = $sth->fetchrow_hashref();
4008     $sth->finish();
4009     my $query = "INSERT INTO deleteditems SET ";
4010     my @bind  = ();
4011     foreach my $key ( keys %$data ) {
4012         $query .= "$key = ?,";
4013         push( @bind, $data->{$key} );
4014     }
4015     $query =~ s/\,$//;
4016     $sth = $dbh->prepare($query);
4017     $sth->execute(@bind);
4018     $sth->finish();
4019
4020         # delete from items table
4021     $sth = $dbh->prepare("DELETE FROM items WHERE itemnumber=?");
4022     $sth->execute($itemnum);
4023     $sth->finish();
4024         return undef;
4025 }
4026
4027 =head1 UNEXPORTED FUNCTIONS
4028
4029 =head2 ModBiblioMarc
4030
4031     &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
4032
4033     Add MARC data for a biblio to koha
4034
4035     Function exported, but should NOT be used, unless you really know what you're doing
4036
4037 =cut
4038
4039 sub ModBiblioMarc {
4040
4041 # pass the MARC::Record to this function, and it will create the records in the marc field
4042     my ( $record, $biblionumber, $frameworkcode ) = @_;
4043     my $dbh = C4::Context->dbh;
4044     my @fields = $record->fields();
4045     if ( !$frameworkcode ) {
4046         $frameworkcode = "";
4047     }
4048     my $sth =
4049       $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
4050     $sth->execute( $frameworkcode, $biblionumber );
4051     $sth->finish;
4052     my $encoding = C4::Context->preference("marcflavour");
4053
4054     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
4055     if ( $encoding eq "UNIMARC" ) {
4056         my $string;
4057         if ( length($record->subfield( 100, "a" )) == 35 ) {
4058             $string = $record->subfield( 100, "a" );
4059             my $f100 = $record->field(100);
4060             $record->delete_field($f100);
4061         }
4062         else {
4063             $string = POSIX::strftime( "%Y%m%d", localtime );
4064             $string =~ s/\-//g;
4065             $string = sprintf( "%-*s", 35, $string );
4066         }
4067         substr( $string, 22, 6, "frey50" );
4068         unless ( $record->subfield( 100, "a" ) ) {
4069             $record->insert_grouped_field(
4070                 MARC::Field->new( 100, "", "", "a" => $string ) );
4071         }
4072     }
4073     ModZebra($biblionumber,"specialUpdate","biblioserver",$record);
4074     $sth =
4075       $dbh->prepare(
4076         "UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
4077     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding),
4078         $biblionumber );
4079     $sth->finish;
4080     return $biblionumber;
4081 }
4082
4083 =head2 AddItemInMarc
4084
4085 =over 4
4086
4087 $newbiblionumber = AddItemInMarc( $record, $biblionumber, $frameworkcode );
4088
4089 Add an item in a MARC record and save the MARC record
4090
4091 Function exported, but should NOT be used, unless you really know what you're doing
4092
4093 =back
4094
4095 =cut
4096
4097 sub AddItemInMarc {
4098
4099     # pass the MARC::Record to this function, and it will create the records in the marc tables
4100     my ( $record, $biblionumber, $frameworkcode ) = @_;
4101     my $newrec = &GetMarcBiblio($biblionumber);
4102
4103     # create it
4104     my @fields = $record->fields();
4105     foreach my $field (@fields) {
4106         $newrec->append_fields($field);
4107     }
4108
4109     # FIXME: should we be making sure the biblionumbers are the same?
4110     my $newbiblionumber =
4111       &ModBiblioMarc( $newrec, $biblionumber, $frameworkcode );
4112     return $newbiblionumber;
4113 }
4114
4115 =head2 z3950_extended_services
4116
4117 z3950_extended_services($serviceType,$serviceOptions,$record);
4118
4119     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.
4120
4121 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
4122
4123 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
4124
4125     action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
4126
4127 and maybe
4128
4129     recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
4130     syntax => the record syntax (transfer syntax)
4131     databaseName = Database from connection object
4132
4133     To set serviceOptions, call set_service_options($serviceType)
4134
4135 C<$record> the record, if one is needed for the service type
4136
4137     A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
4138
4139 =cut
4140
4141 sub z3950_extended_services {
4142     my ( $server, $serviceType, $action, $serviceOptions ) = @_;
4143
4144     # get our connection object
4145     my $Zconn = C4::Context->Zconn( $server, 0, 1 );
4146
4147     # create a new package object
4148     my $Zpackage = $Zconn->package();
4149
4150     # set our options
4151     $Zpackage->option( action => $action );
4152
4153     if ( $serviceOptions->{'databaseName'} ) {
4154         $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
4155     }
4156     if ( $serviceOptions->{'recordIdNumber'} ) {
4157         $Zpackage->option(
4158             recordIdNumber => $serviceOptions->{'recordIdNumber'} );
4159     }
4160     if ( $serviceOptions->{'recordIdOpaque'} ) {
4161         $Zpackage->option(
4162             recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
4163     }
4164
4165  # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
4166  #if ($serviceType eq 'itemorder') {
4167  #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
4168  #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
4169  #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
4170  #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
4171  #}
4172
4173     if ( $serviceOptions->{record} ) {
4174         $Zpackage->option( record => $serviceOptions->{record} );
4175
4176         # can be xml or marc
4177         if ( $serviceOptions->{'syntax'} ) {
4178             $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
4179         }
4180     }
4181
4182     # send the request, handle any exception encountered
4183     eval { $Zpackage->send($serviceType) };
4184     if ( $@ && $@->isa("ZOOM::Exception") ) {
4185         return "error:  " . $@->code() . " " . $@->message() . "\n";
4186     }
4187
4188     # free up package resources
4189     $Zpackage->destroy();
4190 }
4191
4192 =head2 set_service_options
4193
4194 my $serviceOptions = set_service_options($serviceType);
4195
4196 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
4197
4198 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
4199
4200 =cut
4201
4202 sub set_service_options {
4203     my ($serviceType) = @_;
4204     my $serviceOptions;
4205
4206 # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
4207 #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
4208
4209     if ( $serviceType eq 'commit' ) {
4210
4211         # nothing to do
4212     }
4213     if ( $serviceType eq 'create' ) {
4214
4215         # nothing to do
4216     }
4217     if ( $serviceType eq 'drop' ) {
4218         die "ERROR: 'drop' not currently supported (by Zebra)";
4219     }
4220     return $serviceOptions;
4221 }
4222
4223 =head2 GetItemsCount
4224
4225 $count = &GetItemsCount( $biblionumber);
4226 this function return count of item with $biblionumber
4227 =cut
4228
4229 sub GetItemsCount {
4230     my ( $biblionumber ) = @_;
4231     my $dbh = C4::Context->dbh;
4232     my $query = "SELECT count(*)
4233                   FROM  items
4234                   WHERE biblionumber=?";
4235     my $sth = $dbh->prepare($query);
4236     $sth->execute($biblionumber);
4237     my $count = $sth->fetchrow;
4238     $sth->finish;
4239     return ($count);
4240 }
4241
4242 END { }    # module clean-up code here (global destructor)
4243
4244 1;
4245
4246 __END__
4247
4248 =head1 AUTHOR
4249
4250 Koha Developement team <info@koha.org>
4251
4252 Paul POULAIN paul.poulain@free.fr
4253
4254 Joshua Ferraro jmf@liblime.com
4255
4256 =cut