C4/Biblio.pm

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