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