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 = "701";
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         my $index = substr($1,1); # get the index, don't forget to remove initial ' or "
3095         my $fields = $2;
3096         $index =~ s/'|"| //g;
3097         $fields =~ s/'|"| //g;
3098         $indexes{$index}=$fields;
3099     }
3100     return %indexes;
3101 }
3102
3103 =head1 INTERNAL FUNCTIONS
3104
3105 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
3106
3107     function to delete a biblio in NoZebra indexes
3108     This function does NOT delete anything in database : it reads all the indexes entries
3109     that have to be deleted & delete them in the hash
3110     The SQL part is done either :
3111     - after the Add if we are modifying a biblio (delete + add again)
3112     - immediatly after this sub if we are doing a true deletion.
3113     $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
3114
3115 =cut
3116
3117
3118 sub _DelBiblioNoZebra {
3119     my ($biblionumber, $record, $server)=@_;
3120
3121     # Get the indexes
3122     my $dbh = C4::Context->dbh;
3123     # Get the indexes
3124     my %index;
3125     my $title;
3126     if ($server eq 'biblioserver') {
3127         %index=GetNoZebraIndexes;
3128         # get title of the record (to store the 10 first letters with the index)
3129         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
3130         $title = lc($record->subfield($titletag,$titlesubfield));
3131     } else {
3132         # for authorities, the "title" is the $a mainentry
3133         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
3134         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
3135         $title = $record->subfield($authref->{auth_tag_to_report},'a');
3136         $index{'mainmainentry'}= $authref->{'auth_tag_to_report'}.'a';
3137         $index{'mainentry'}    = $authref->{'auth_tag_to_report'}.'*';
3138         $index{'auth_type'}    = '152b';
3139     }
3140
3141     my %result;
3142     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3143     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
3144     # limit to 10 char, should be enough, and limit the DB size
3145     $title = substr($title,0,10);
3146     #parse each field
3147     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3148     foreach my $field ($record->fields()) {
3149         #parse each subfield
3150         next if $field->tag <10;
3151         foreach my $subfield ($field->subfields()) {
3152             my $tag = $field->tag();
3153             my $subfieldcode = $subfield->[0];
3154             my $indexed=0;
3155             # check each index to see if the subfield is stored somewhere
3156             # otherwise, store it in __RAW__ index
3157             foreach my $key (keys %index) {
3158 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3159                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
3160                     $indexed=1;
3161                     my $line= lc $subfield->[1];
3162                     # remove meaningless value in the field...
3163                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3164                     # ... and split in words
3165                     foreach (split / /,$line) {
3166                         next unless $_; # skip  empty values (multiple spaces)
3167                         # if the entry is already here, do nothing, the biblionumber has already be removed
3168                         unless ($result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) {
3169                             # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
3170                             $sth2->execute($server,$key,$_);
3171                             my $existing_biblionumbers = $sth2->fetchrow;
3172                             # it exists
3173                             if ($existing_biblionumbers) {
3174 #                                 warn " existing for $key $_: $existing_biblionumbers";
3175                                 $result{$key}->{$_} =$existing_biblionumbers;
3176                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3177                             }
3178                         }
3179                     }
3180                 }
3181             }
3182             # the subfield is not indexed, store it in __RAW__ index anyway
3183             unless ($indexed) {
3184                 my $line= lc $subfield->[1];
3185                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3186                 # ... and split in words
3187                 foreach (split / /,$line) {
3188                     next unless $_; # skip  empty values (multiple spaces)
3189                     # if the entry is already here, do nothing, the biblionumber has already be removed
3190                     unless ($result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/) {
3191                         # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
3192                         $sth2->execute($server,'__RAW__',$_);
3193                         my $existing_biblionumbers = $sth2->fetchrow;
3194                         # it exists
3195                         if ($existing_biblionumbers) {
3196                             $result{'__RAW__'}->{$_} =$existing_biblionumbers;
3197                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3198                         }
3199                     }
3200                 }
3201             }
3202         }
3203     }
3204     return %result;
3205 }
3206
3207 =head2 _AddBiblioNoZebra($biblionumber, $record, $server, %result);
3208
3209     function to add a biblio in NoZebra indexes
3210
3211 =cut
3212
3213 sub _AddBiblioNoZebra {
3214     my ($biblionumber, $record, $server, %result)=@_;
3215     my $dbh = C4::Context->dbh;
3216     # Get the indexes
3217     my %index;
3218     my $title;
3219     if ($server eq 'biblioserver') {
3220         %index=GetNoZebraIndexes;
3221         # get title of the record (to store the 10 first letters with the index)
3222         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
3223         $title = lc($record->subfield($titletag,$titlesubfield));
3224     } else {
3225         # warn "server : $server";
3226         # for authorities, the "title" is the $a mainentry
3227         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
3228         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
3229         $title = $record->subfield($authref->{auth_tag_to_report},'a');
3230         $index{'mainmainentry'} = $authref->{auth_tag_to_report}.'a';
3231         $index{'mainentry'}     = $authref->{auth_tag_to_report}.'*';
3232         $index{'auth_type'}     = '152b';
3233     }
3234
3235     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3236     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
3237     # limit to 10 char, should be enough, and limit the DB size
3238     $title = substr($title,0,10);
3239     #parse each field
3240     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3241     foreach my $field ($record->fields()) {
3242         #parse each subfield
3243         next if $field->tag <10;
3244         foreach my $subfield ($field->subfields()) {
3245             my $tag = $field->tag();
3246             my $subfieldcode = $subfield->[0];
3247             my $indexed=0;
3248             # check each index to see if the subfield is stored somewhere
3249             # otherwise, store it in __RAW__ index
3250             foreach my $key (keys %index) {
3251 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3252                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
3253                     $indexed=1;
3254                     my $line= lc $subfield->[1];
3255                     # remove meaningless value in the field...
3256                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3257                     # ... and split in words
3258                     foreach (split / /,$line) {
3259                         next unless $_; # skip  empty values (multiple spaces)
3260                         # if the entry is already here, improve weight
3261 #                         warn "managing $_";
3262                         if ($result{$key}->{"$_"} =~ /$biblionumber,$title\-(\d);/) {
3263                             my $weight=$1+1;
3264                             $result{$key}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3265                             $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3266                         } else {
3267                             # get the value if it exist in the nozebra table, otherwise, create it
3268                             $sth2->execute($server,$key,$_);
3269                             my $existing_biblionumbers = $sth2->fetchrow;
3270                             # it exists
3271                             if ($existing_biblionumbers) {
3272                                 $result{$key}->{"$_"} =$existing_biblionumbers;
3273                                 my $weight=$1+1;
3274                                 $result{$key}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3275                                 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3276                             # create a new ligne for this entry
3277                             } else {
3278 #                             warn "INSERT : $server / $key / $_";
3279                                 $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).', indexname='.$dbh->quote($key).',value='.$dbh->quote($_));
3280                                 $result{$key}->{"$_"}.="$biblionumber,$title-1;";
3281                             }
3282                         }
3283                     }
3284                 }
3285             }
3286             # the subfield is not indexed, store it in __RAW__ index anyway
3287             unless ($indexed) {
3288                 my $line= lc $subfield->[1];
3289                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3290                 # ... and split in words
3291                 foreach (split / /,$line) {
3292                     next unless $_; # skip  empty values (multiple spaces)
3293                     # if the entry is already here, improve weight
3294                     if ($result{'__RAW__'}->{"$_"} =~ /$biblionumber,$title\-(\d);/) {
3295                         my $weight=$1+1;
3296                         $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3297                         $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3298                     } else {
3299                         # get the value if it exist in the nozebra table, otherwise, create it
3300                         $sth2->execute($server,'__RAW__',$_);
3301                         my $existing_biblionumbers = $sth2->fetchrow;
3302                         # it exists
3303                         if ($existing_biblionumbers) {
3304                             $result{'__RAW__'}->{"$_"} =$existing_biblionumbers;
3305                             my $weight=$1+1;
3306                             $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3307                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3308                         # create a new ligne for this entry
3309                         } else {
3310                             $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).',  indexname="__RAW__",value='.$dbh->quote($_));
3311                             $result{'__RAW__'}->{"$_"}.="$biblionumber,$title-1;";
3312                         }
3313                     }
3314                 }
3315             }
3316         }
3317     }
3318     return %result;
3319 }
3320
3321
3322 =head2 MARCitemchange
3323
3324 =over 4
3325
3326 &MARCitemchange( $record, $itemfield, $newvalue )
3327
3328 Function to update a single value in an item field.
3329 Used twice, could probably be replaced by something else, but works well...
3330
3331 =back
3332
3333 =back
3334
3335 =cut
3336
3337 sub MARCitemchange {
3338     my ( $record, $itemfield, $newvalue ) = @_;
3339     my $dbh = C4::Context->dbh;
3340
3341     my ( $tagfield, $tagsubfield ) =
3342       GetMarcFromKohaField( $itemfield, "" );
3343     if ( ($tagfield) && ($tagsubfield) ) {
3344         my $tag = $record->field($tagfield);
3345         if ($tag) {
3346             $tag->update( $tagsubfield => $newvalue );
3347             $record->delete_field($tag);
3348             $record->insert_fields_ordered($tag);
3349         }
3350     }
3351 }
3352 =head2 _find_value
3353
3354 =over 4
3355
3356 ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
3357
3358 Find the given $subfield in the given $tag in the given
3359 MARC::Record $record.  If the subfield is found, returns
3360 the (indicators, value) pair; otherwise, (undef, undef) is
3361 returned.
3362
3363 PROPOSITION :
3364 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
3365 I suggest we export it from this module.
3366
3367 =back
3368
3369 =cut
3370
3371 sub _find_value {
3372     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
3373     my @result;
3374     my $indicator;
3375     if ( $tagfield < 10 ) {
3376         if ( $record->field($tagfield) ) {
3377             push @result, $record->field($tagfield)->data();
3378         }
3379         else {
3380             push @result, "";
3381         }
3382     }
3383     else {
3384         foreach my $field ( $record->field($tagfield) ) {
3385             my @subfields = $field->subfields();
3386             foreach my $subfield (@subfields) {
3387                 if ( @$subfield[0] eq $insubfield ) {
3388                     push @result, @$subfield[1];
3389                     $indicator = $field->indicator(1) . $field->indicator(2);
3390                 }
3391             }
3392         }
3393     }
3394     return ( $indicator, @result );
3395 }
3396
3397 =head2 _koha_marc_update_bib_ids
3398
3399 =over 4
3400
3401 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
3402
3403 Internal function to add or update biblionumber and biblioitemnumber to
3404 the MARC XML.
3405
3406 =back
3407
3408 =cut
3409
3410 sub _koha_marc_update_bib_ids {
3411     my ($record, $frameworkcode, $biblionumber, $biblioitemnumber) = @_;
3412
3413     # we must add bibnum and bibitemnum in MARC::Record...
3414     # we build the new field with biblionumber and biblioitemnumber
3415     # we drop the original field
3416     # we add the new builded field.
3417     my ($biblio_tag, $biblio_subfield ) = GetMarcFromKohaField("biblio.biblionumber",$frameworkcode);
3418     my ($biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.biblioitemnumber",$frameworkcode);
3419
3420     if ($biblio_tag != $biblioitem_tag) {
3421         # biblionumber & biblioitemnumber are in different fields
3422
3423         # deal with biblionumber
3424         my ($new_field, $old_field);
3425         if ($biblio_tag < 10) {
3426             $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
3427         } else {
3428             $new_field =
3429               MARC::Field->new( $biblio_tag, '', '',
3430                 "$biblio_subfield" => $biblionumber );
3431         }
3432
3433         # drop old field and create new one...
3434         $old_field = $record->field($biblio_tag);
3435         $record->delete_field($old_field);
3436         $record->append_fields($new_field);
3437
3438         # deal with biblioitemnumber
3439         if ($biblioitem_tag < 10) {
3440             $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
3441         } else {
3442             $new_field =
3443               MARC::Field->new( $biblioitem_tag, '', '',
3444                 "$biblioitem_subfield" => $biblioitemnumber, );
3445         }
3446         # drop old field and create new one...
3447         $old_field = $record->field($biblioitem_tag);
3448         $record->delete_field($old_field);
3449         $record->insert_fields_ordered($new_field);
3450
3451     } else {
3452         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
3453         my $new_field = MARC::Field->new(
3454             $biblio_tag, '', '',
3455             "$biblio_subfield" => $biblionumber,
3456             "$biblioitem_subfield" => $biblioitemnumber
3457         );
3458
3459         # drop old field and create new one...
3460         my $old_field = $record->field($biblio_tag);
3461         $record->delete_field($old_field);
3462         $record->insert_fields_ordered($new_field);
3463     }
3464 }
3465
3466 =head2 _koha_add_biblio
3467
3468 =over 4
3469
3470 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3471
3472 Internal function to add a biblio ($biblio is a hash with the values)
3473
3474 =back
3475
3476 =cut
3477
3478 sub _koha_add_biblio {
3479     my ( $dbh, $biblio, $frameworkcode ) = @_;
3480
3481         my $error;
3482
3483         # set the series flag
3484     my $serial = 0;
3485     if ( $biblio->{'seriestitle'} ) { $serial = 1 };
3486
3487         my $query =
3488         "INSERT INTO biblio
3489                 SET frameworkcode = ?,
3490                         author = ?,
3491                         title = ?,
3492                         unititle =?,
3493                         notes = ?,
3494                         serial = ?,
3495                         seriestitle = ?,
3496                         copyrightdate = ?,
3497                         datecreated=NOW(),
3498                         abstract = ?
3499                 ";
3500     my $sth = $dbh->prepare($query);
3501     $sth->execute(
3502                 $frameworkcode,
3503         $biblio->{'author'},
3504         $biblio->{'title'},
3505                 $biblio->{'unititle'},
3506         $biblio->{'notes'},
3507                 $serial,
3508         $biblio->{'seriestitle'},
3509                 $biblio->{'copyrightdate'},
3510         $biblio->{'abstract'}
3511     );
3512
3513     my $biblionumber = $dbh->{'mysql_insertid'};
3514         if ( $dbh->errstr ) {
3515                 $error.="ERROR in _koha_add_biblio $query".$dbh->errstr;
3516         warn $error;
3517     }
3518
3519     $sth->finish();
3520         #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3521     return ($biblionumber,$error);
3522 }
3523
3524 =head2 _koha_modify_biblio
3525
3526 =over 4
3527
3528 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3529
3530 Internal function for updating the biblio table
3531
3532 =back
3533
3534 =cut
3535
3536 sub _koha_modify_biblio {
3537     my ( $dbh, $biblio, $frameworkcode ) = @_;
3538         my $error;
3539
3540     my $query = "
3541         UPDATE biblio
3542         SET    frameworkcode = ?,
3543                            author = ?,
3544                            title = ?,
3545                            unititle = ?,
3546                            notes = ?,
3547                            serial = ?,
3548                            seriestitle = ?,
3549                            copyrightdate = ?,
3550                abstract = ?
3551         WHERE  biblionumber = ?
3552                 "
3553         ;
3554     my $sth = $dbh->prepare($query);
3555
3556     $sth->execute(
3557                 $frameworkcode,
3558         $biblio->{'author'},
3559         $biblio->{'title'},
3560         $biblio->{'unititle'},
3561         $biblio->{'notes'},
3562         $biblio->{'serial'},
3563         $biblio->{'seriestitle'},
3564         $biblio->{'copyrightdate'},
3565                 $biblio->{'abstract'},
3566         $biblio->{'biblionumber'}
3567     ) if $biblio->{'biblionumber'};
3568
3569     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3570                 $error.="ERROR in _koha_modify_biblio $query".$dbh->errstr;
3571         warn $error;
3572     }
3573     return ( $biblio->{'biblionumber'},$error );
3574 }
3575
3576 =head2 _koha_modify_biblioitem_nonmarc
3577
3578 =over 4
3579
3580 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3581
3582 Updates biblioitems row except for marc and marcxml, which should be changed
3583 via ModBiblioMarc
3584
3585 =back
3586
3587 =cut
3588
3589 sub _koha_modify_biblioitem_nonmarc {
3590     my ( $dbh, $biblioitem ) = @_;
3591         my $error;
3592
3593         # re-calculate the cn_sort, it may have changed
3594         my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3595
3596         my $query =
3597         "UPDATE biblioitems
3598         SET biblionumber        = ?,
3599                 volume                  = ?,
3600                 number                  = ?,
3601         itemtype        = ?,
3602         isbn            = ?,
3603         issn            = ?,
3604                 publicationyear = ?,
3605         publishercode   = ?,
3606                 volumedate      = ?,
3607                 volumedesc      = ?,
3608                 collectiontitle = ?,
3609                 collectionissn  = ?,
3610                 collectionvolume= ?,
3611                 editionstatement= ?,
3612                 editionresponsibility = ?,
3613                 illus                   = ?,
3614                 pages                   = ?,
3615                 notes                   = ?,
3616                 size                    = ?,
3617                 place                   = ?,
3618                 lccn                    = ?,
3619                 url                     = ?,
3620         cn_source               = ?,
3621         cn_class        = ?,
3622         cn_item         = ?,
3623                 cn_suffix       = ?,
3624                 cn_sort         = ?,
3625                 totalissues     = ?
3626         where biblioitemnumber = ?
3627                 ";
3628         my $sth = $dbh->prepare($query);
3629         $sth->execute(
3630                 $biblioitem->{'biblionumber'},
3631                 $biblioitem->{'volume'},
3632                 $biblioitem->{'number'},
3633                 $biblioitem->{'itemtype'},
3634                 $biblioitem->{'isbn'},
3635                 $biblioitem->{'issn'},
3636                 $biblioitem->{'publicationyear'},
3637                 $biblioitem->{'publishercode'},
3638                 $biblioitem->{'volumedate'},
3639                 $biblioitem->{'volumedesc'},
3640                 $biblioitem->{'collectiontitle'},
3641                 $biblioitem->{'collectionissn'},
3642                 $biblioitem->{'collectionvolume'},
3643                 $biblioitem->{'editionstatement'},
3644                 $biblioitem->{'editionresponsibility'},
3645                 $biblioitem->{'illus'},
3646                 $biblioitem->{'pages'},
3647                 $biblioitem->{'bnotes'},
3648                 $biblioitem->{'size'},
3649                 $biblioitem->{'place'},
3650                 $biblioitem->{'lccn'},
3651                 $biblioitem->{'url'},
3652                 $biblioitem->{'biblioitems.cn_source'},
3653                 $biblioitem->{'cn_class'},
3654                 $biblioitem->{'cn_item'},
3655                 $biblioitem->{'cn_suffix'},
3656                 $cn_sort,
3657                 $biblioitem->{'totalissues'},
3658                 $biblioitem->{'biblioitemnumber'}
3659         );
3660     if ( $dbh->errstr ) {
3661                 $error.="ERROR in _koha_modify_biblioitem_nonmarc $query".$dbh->errstr;
3662         warn $error;
3663     }
3664         return ($biblioitem->{'biblioitemnumber'},$error);
3665 }
3666
3667 =head2 _koha_add_biblioitem
3668
3669 =over 4
3670
3671 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3672
3673 Internal function to add a biblioitem
3674
3675 =back
3676
3677 =cut
3678
3679 sub _koha_add_biblioitem {
3680     my ( $dbh, $biblioitem ) = @_;
3681         my $error;
3682
3683         my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3684     my $query =
3685     "INSERT INTO biblioitems SET
3686         biblionumber    = ?,
3687         volume          = ?,
3688         number          = ?,
3689         itemtype        = ?,
3690         isbn            = ?,
3691         issn            = ?,
3692         publicationyear = ?,
3693         publishercode   = ?,
3694         volumedate      = ?,
3695         volumedesc      = ?,
3696         collectiontitle = ?,
3697         collectionissn  = ?,
3698         collectionvolume= ?,
3699         editionstatement= ?,
3700         editionresponsibility = ?,
3701         illus           = ?,
3702         pages           = ?,
3703         notes           = ?,
3704         size            = ?,
3705         place           = ?,
3706         lccn            = ?,
3707         marc            = ?,
3708         url             = ?,
3709         cn_source       = ?,
3710         cn_class        = ?,
3711         cn_item         = ?,
3712         cn_suffix       = ?,
3713         cn_sort         = ?,
3714         totalissues     = ?
3715         ";
3716         my $sth = $dbh->prepare($query);
3717     $sth->execute(
3718         $biblioitem->{'biblionumber'},
3719         $biblioitem->{'volume'},
3720         $biblioitem->{'number'},
3721         $biblioitem->{'itemtype'},
3722         $biblioitem->{'isbn'},
3723         $biblioitem->{'issn'},
3724         $biblioitem->{'publicationyear'},
3725         $biblioitem->{'publishercode'},
3726         $biblioitem->{'volumedate'},
3727         $biblioitem->{'volumedesc'},
3728         $biblioitem->{'collectiontitle'},
3729         $biblioitem->{'collectionissn'},
3730         $biblioitem->{'collectionvolume'},
3731         $biblioitem->{'editionstatement'},
3732         $biblioitem->{'editionresponsibility'},
3733         $biblioitem->{'illus'},
3734         $biblioitem->{'pages'},
3735         $biblioitem->{'bnotes'},
3736         $biblioitem->{'size'},
3737         $biblioitem->{'place'},
3738         $biblioitem->{'lccn'},
3739         $biblioitem->{'marc'},
3740         $biblioitem->{'url'},
3741         $biblioitem->{'biblioitems.cn_source'},
3742         $biblioitem->{'cn_class'},
3743         $biblioitem->{'cn_item'},
3744         $biblioitem->{'cn_suffix'},
3745         $cn_sort,
3746         $biblioitem->{'totalissues'}
3747     );
3748     my $bibitemnum = $dbh->{'mysql_insertid'};
3749     if ( $dbh->errstr ) {
3750                 $error.="ERROR in _koha_add_biblioitem $query".$dbh->errstr;
3751                 warn $error;
3752     }
3753     $sth->finish();
3754     return ($bibitemnum,$error);
3755 }
3756
3757 =head2 _koha_new_items
3758
3759 =over 4
3760
3761 my ($itemnumber,$error) = _koha_new_items( $dbh, $item, $barcode );
3762
3763 =back
3764
3765 =cut
3766
3767 sub _koha_new_items {
3768     my ( $dbh, $item, $barcode ) = @_;
3769         my $error;
3770
3771     my ($items_cn_sort) = GetClassSort($item->{'items.cn_source'}, $item->{'itemcallnumber'}, "");
3772
3773     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
3774     if ( $item->{'dateaccessioned'} eq '' || !$item->{'dateaccessioned'} ) {
3775                 my $today = C4::Dates->new();
3776                 $item->{'dateaccessioned'} =  $today->output("iso"); #TODO: check time issues
3777         }
3778         my $query =
3779            "INSERT INTO items SET
3780                         biblionumber            = ?,
3781             biblioitemnumber    = ?,
3782                         barcode                 = ?,
3783                         dateaccessioned         = ?,
3784                         booksellerid        = ?,
3785             homebranch          = ?,
3786             price               = ?,
3787                         replacementprice        = ?,
3788             replacementpricedate = NOW(),
3789                         datelastborrowed        = ?,
3790                         datelastseen            = NOW(),
3791                         stack                   = ?,
3792                         notforloan                      = ?,
3793                         damaged                         = ?,
3794             itemlost            = ?,
3795                         wthdrawn                = ?,
3796                         itemcallnumber          = ?,
3797                         restricted                      = ?,
3798                         itemnotes                       = ?,
3799                         holdingbranch           = ?,
3800             paidfor             = ?,
3801                         location                        = ?,
3802                         onloan                          = ?,
3803                         cn_source                       = ?,
3804                         cn_sort                         = ?,
3805                         ccode                           = ?,
3806                         itype                           = ?,
3807                         materials                       = ?,
3808                         uri                             = ?
3809           ";
3810     my $sth = $dbh->prepare($query);
3811         $sth->execute(
3812                         $item->{'biblionumber'},
3813                         $item->{'biblioitemnumber'},
3814             $barcode,
3815                         $item->{'dateaccessioned'},
3816                         $item->{'booksellerid'},
3817             $item->{'homebranch'},
3818             $item->{'price'},
3819                         $item->{'replacementprice'},
3820                         $item->{datelastborrowed},
3821                         $item->{stack},
3822                         $item->{'notforloan'},
3823                         $item->{'damaged'},
3824             $item->{'itemlost'},
3825                         $item->{'wthdrawn'},
3826                         $item->{'itemcallnumber'},
3827             $item->{'restricted'},
3828                         $item->{'itemnotes'},
3829                         $item->{'holdingbranch'},
3830                         $item->{'paidfor'},
3831                         $item->{'location'},
3832                         $item->{'onloan'},
3833                         $item->{'items.cn_source'},
3834                         $items_cn_sort,
3835                         $item->{'ccode'},
3836                         $item->{'itype'},
3837                         $item->{'materials'},
3838                         $item->{'uri'},
3839     );
3840     my $itemnumber = $dbh->{'mysql_insertid'};
3841     if ( defined $sth->errstr ) {
3842         $error.="ERROR in _koha_new_items $query".$sth->errstr;
3843     }
3844         $sth->finish();
3845     return ( $itemnumber, $error );
3846 }
3847
3848 =head2 _koha_modify_item
3849
3850 =over 4
3851
3852 my ($itemnumber,$error) =_koha_modify_item( $dbh, $item, $op );
3853
3854 =back
3855
3856 =cut
3857
3858 sub _koha_modify_item {
3859     my ( $dbh, $item ) = @_;
3860         my $error;
3861
3862         # calculate items.cn_sort
3863     $item->{'cn_sort'} = GetClassSort($item->{'items.cn_source'}, $item->{'itemcallnumber'}, "");
3864
3865     my $query = "UPDATE items SET ";
3866         my @bind;
3867         for my $key ( keys %$item ) {
3868                 $query.="$key=?,";
3869                 push @bind, $item->{$key};
3870     }
3871         $query =~ s/,$//;
3872     $query .= " WHERE itemnumber=?";
3873     push @bind, $item->{'itemnumber'};
3874     my $sth = $dbh->prepare($query);
3875     $sth->execute(@bind);
3876     if ( $dbh->errstr ) {
3877         $error.="ERROR in _koha_modify_item $query".$dbh->errstr;
3878         warn $error;
3879     }
3880     $sth->finish();
3881         return ($item->{'itemnumber'},$error);
3882 }
3883
3884 =head2 _koha_delete_biblio
3885
3886 =over 4
3887
3888 $error = _koha_delete_biblio($dbh,$biblionumber);
3889
3890 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3891
3892 C<$dbh> - the database handle
3893 C<$biblionumber> - the biblionumber of the biblio to be deleted
3894
3895 =back
3896
3897 =cut
3898
3899 # FIXME: add error handling
3900
3901 sub _koha_delete_biblio {
3902     my ( $dbh, $biblionumber ) = @_;
3903
3904     # get all the data for this biblio
3905     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3906     $sth->execute($biblionumber);
3907
3908     if ( my $data = $sth->fetchrow_hashref ) {
3909
3910         # save the record in deletedbiblio
3911         # find the fields to save
3912         my $query = "INSERT INTO deletedbiblio SET ";
3913         my @bind  = ();
3914         foreach my $temp ( keys %$data ) {
3915             $query .= "$temp = ?,";
3916             push( @bind, $data->{$temp} );
3917         }
3918
3919         # replace the last , by ",?)"
3920         $query =~ s/\,$//;
3921         my $bkup_sth = $dbh->prepare($query);
3922         $bkup_sth->execute(@bind);
3923         $bkup_sth->finish;
3924
3925         # delete the biblio
3926         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3927         $del_sth->execute($biblionumber);
3928         $del_sth->finish;
3929     }
3930     $sth->finish;
3931     return undef;
3932 }
3933
3934 =head2 _koha_delete_biblioitems
3935
3936 =over 4
3937
3938 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3939
3940 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3941
3942 C<$dbh> - the database handle
3943 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3944
3945 =back
3946
3947 =cut
3948
3949 # FIXME: add error handling
3950
3951 sub _koha_delete_biblioitems {
3952     my ( $dbh, $biblioitemnumber ) = @_;
3953
3954     # get all the data for this biblioitem
3955     my $sth =
3956       $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3957     $sth->execute($biblioitemnumber);
3958
3959     if ( my $data = $sth->fetchrow_hashref ) {
3960
3961         # save the record in deletedbiblioitems
3962         # find the fields to save
3963         my $query = "INSERT INTO deletedbiblioitems SET ";
3964         my @bind  = ();
3965         foreach my $temp ( keys %$data ) {
3966             $query .= "$temp = ?,";
3967             push( @bind, $data->{$temp} );
3968         }
3969
3970         # replace the last , by ",?)"
3971         $query =~ s/\,$//;
3972         my $bkup_sth = $dbh->prepare($query);
3973         $bkup_sth->execute(@bind);
3974         $bkup_sth->finish;
3975
3976         # delete the biblioitem
3977         my $del_sth =
3978           $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3979         $del_sth->execute($biblioitemnumber);
3980         $del_sth->finish;
3981     }
3982     $sth->finish;
3983     return undef;
3984 }
3985
3986 =head2 _koha_delete_item
3987
3988 =over 4
3989
3990 _koha_delete_item( $dbh, $itemnum );
3991
3992 Internal function to delete an item record from the koha tables
3993
3994 =back
3995
3996 =cut
3997
3998 sub _koha_delete_item {
3999     my ( $dbh, $itemnum ) = @_;
4000
4001         # save the deleted item to deleteditems table
4002     my $sth = $dbh->prepare("SELECT * FROM items WHERE itemnumber=?");
4003     $sth->execute($itemnum);
4004     my $data = $sth->fetchrow_hashref();
4005     $sth->finish();
4006     my $query = "INSERT INTO deleteditems SET ";
4007     my @bind  = ();
4008     foreach my $key ( keys %$data ) {
4009         $query .= "$key = ?,";
4010         push( @bind, $data->{$key} );
4011     }
4012     $query =~ s/\,$//;
4013     $sth = $dbh->prepare($query);
4014     $sth->execute(@bind);
4015     $sth->finish();
4016
4017         # delete from items table
4018     $sth = $dbh->prepare("DELETE FROM items WHERE itemnumber=?");
4019     $sth->execute($itemnum);
4020     $sth->finish();
4021         return undef;
4022 }
4023
4024 =head1 UNEXPORTED FUNCTIONS
4025
4026 =head2 ModBiblioMarc
4027
4028     &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
4029
4030     Add MARC data for a biblio to koha
4031
4032     Function exported, but should NOT be used, unless you really know what you're doing
4033
4034 =cut
4035
4036 sub ModBiblioMarc {
4037
4038 # pass the MARC::Record to this function, and it will create the records in the marc field
4039     my ( $record, $biblionumber, $frameworkcode ) = @_;
4040     my $dbh = C4::Context->dbh;
4041     my @fields = $record->fields();
4042     if ( !$frameworkcode ) {
4043         $frameworkcode = "";
4044     }
4045     my $sth =
4046       $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
4047     $sth->execute( $frameworkcode, $biblionumber );
4048     $sth->finish;
4049     my $encoding = C4::Context->preference("marcflavour");
4050
4051     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
4052     if ( $encoding eq "UNIMARC" ) {
4053         my $string;
4054         if ( length($record->subfield( 100, "a" )) == 35 ) {
4055             $string = $record->subfield( 100, "a" );
4056             my $f100 = $record->field(100);
4057             $record->delete_field($f100);
4058         }
4059         else {
4060             $string = POSIX::strftime( "%Y%m%d", localtime );
4061             $string =~ s/\-//g;
4062             $string = sprintf( "%-*s", 35, $string );
4063         }
4064         substr( $string, 22, 6, "frey50" );
4065         unless ( $record->subfield( 100, "a" ) ) {
4066             $record->insert_grouped_field(
4067                 MARC::Field->new( 100, "", "", "a" => $string ) );
4068         }
4069     }
4070     ModZebra($biblionumber,"specialUpdate","biblioserver",$record);
4071     $sth =
4072       $dbh->prepare(
4073         "UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
4074     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding),
4075         $biblionumber );
4076     $sth->finish;
4077     return $biblionumber;
4078 }
4079
4080 =head2 AddItemInMarc
4081
4082 =over 4
4083
4084 $newbiblionumber = AddItemInMarc( $record, $biblionumber, $frameworkcode );
4085
4086 Add an item in a MARC record and save the MARC record
4087
4088 Function exported, but should NOT be used, unless you really know what you're doing
4089
4090 =back
4091
4092 =cut
4093
4094 sub AddItemInMarc {
4095
4096     # pass the MARC::Record to this function, and it will create the records in the marc tables
4097     my ( $record, $biblionumber, $frameworkcode ) = @_;
4098     my $newrec = &GetMarcBiblio($biblionumber);
4099
4100     # create it
4101     my @fields = $record->fields();
4102     foreach my $field (@fields) {
4103         $newrec->append_fields($field);
4104     }
4105
4106     # FIXME: should we be making sure the biblionumbers are the same?
4107     my $newbiblionumber =
4108       &ModBiblioMarc( $newrec, $biblionumber, $frameworkcode );
4109     return $newbiblionumber;
4110 }
4111
4112 =head2 z3950_extended_services
4113
4114 z3950_extended_services($serviceType,$serviceOptions,$record);
4115
4116     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.
4117
4118 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
4119
4120 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
4121
4122     action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
4123
4124 and maybe
4125
4126     recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
4127     syntax => the record syntax (transfer syntax)
4128     databaseName = Database from connection object
4129
4130     To set serviceOptions, call set_service_options($serviceType)
4131
4132 C<$record> the record, if one is needed for the service type
4133
4134     A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
4135
4136 =cut
4137
4138 sub z3950_extended_services {
4139     my ( $server, $serviceType, $action, $serviceOptions ) = @_;
4140
4141     # get our connection object
4142     my $Zconn = C4::Context->Zconn( $server, 0, 1 );
4143
4144     # create a new package object
4145     my $Zpackage = $Zconn->package();
4146
4147     # set our options
4148     $Zpackage->option( action => $action );
4149
4150     if ( $serviceOptions->{'databaseName'} ) {
4151         $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
4152     }
4153     if ( $serviceOptions->{'recordIdNumber'} ) {
4154         $Zpackage->option(
4155             recordIdNumber => $serviceOptions->{'recordIdNumber'} );
4156     }
4157     if ( $serviceOptions->{'recordIdOpaque'} ) {
4158         $Zpackage->option(
4159             recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
4160     }
4161
4162  # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
4163  #if ($serviceType eq 'itemorder') {
4164  #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
4165  #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
4166  #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
4167  #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
4168  #}
4169
4170     if ( $serviceOptions->{record} ) {
4171         $Zpackage->option( record => $serviceOptions->{record} );
4172
4173         # can be xml or marc
4174         if ( $serviceOptions->{'syntax'} ) {
4175             $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
4176         }
4177     }
4178
4179     # send the request, handle any exception encountered
4180     eval { $Zpackage->send($serviceType) };
4181     if ( $@ && $@->isa("ZOOM::Exception") ) {
4182         return "error:  " . $@->code() . " " . $@->message() . "\n";
4183     }
4184
4185     # free up package resources
4186     $Zpackage->destroy();
4187 }
4188
4189 =head2 set_service_options
4190
4191 my $serviceOptions = set_service_options($serviceType);
4192
4193 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
4194
4195 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
4196
4197 =cut
4198
4199 sub set_service_options {
4200     my ($serviceType) = @_;
4201     my $serviceOptions;
4202
4203 # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
4204 #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
4205
4206     if ( $serviceType eq 'commit' ) {
4207
4208         # nothing to do
4209     }
4210     if ( $serviceType eq 'create' ) {
4211
4212         # nothing to do
4213     }
4214     if ( $serviceType eq 'drop' ) {
4215         die "ERROR: 'drop' not currently supported (by Zebra)";
4216     }
4217     return $serviceOptions;
4218 }
4219
4220 =head2 GetItemsCount
4221
4222 $count = &GetItemsCount( $biblionumber);
4223 this function return count of item with $biblionumber
4224 =cut
4225
4226 sub GetItemsCount {
4227     my ( $biblionumber ) = @_;
4228     my $dbh = C4::Context->dbh;
4229     my $query = "SELECT count(*)
4230                   FROM  items
4231                   WHERE biblionumber=?";
4232     my $sth = $dbh->prepare($query);
4233     $sth->execute($biblionumber);
4234     my $count = $sth->fetchrow;
4235     $sth->finish;
4236     return ($count);
4237 }
4238
4239 END { }    # module clean-up code here (global destructor)
4240
4241 1;
4242
4243 __END__
4244
4245 =head1 AUTHOR
4246
4247 Koha Developement team <info@koha.org>
4248
4249 Paul POULAIN paul.poulain@free.fr
4250
4251 Joshua Ferraro jmf@liblime.com
4252
4253 =cut