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

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