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