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