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) ...
3088             %result = _DelBiblioNoZebra($biblionumber,$record,$server);
3089             # ... add the record
3090             %result=_AddBiblioNoZebra($biblionumber,$newRecord, $server, %result);
3091         } else {
3092             # it's a deletion, delete the record...
3093             # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
3094             %result=_DelBiblioNoZebra($biblionumber,$record,$server);
3095         }
3096         # ok, now update the database...
3097         my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
3098         foreach my $key (keys %result) {
3099             foreach my $index (keys %{$result{$key}}) {
3100                 $sth->execute($result{$key}->{$index}, $server, $key, $index);
3101             }
3102         }
3103         $dbh->do('UNLOCK TABLES');
3104
3105     } else {
3106         #
3107         # we use zebra, just fill zebraqueue table
3108         #
3109         my $sth=$dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
3110         $sth->execute($biblionumber,$server,$op);
3111         $sth->finish;
3112     }
3113 }
3114
3115 =head2 GetNoZebraIndexes
3116
3117     %indexes = GetNoZebraIndexes;
3118
3119     return the data from NoZebraIndexes syspref.
3120
3121 =cut
3122
3123 sub GetNoZebraIndexes {
3124     my $index = C4::Context->preference('NoZebraIndexes');
3125     my %indexes;
3126     foreach my $line (split /('|"),/,$index) {
3127         $line =~ /(.*)=>(.*)/;
3128 warn $line;
3129         my $index = substr($1,1); # get the index, don't forget to remove initial ' or "
3130         my $fields = $2;
3131         $index =~ s/'|"|\s//g;
3132
3133
3134         $fields =~ s/'|"|\s//g;
3135         $indexes{$index}=$fields;
3136     }
3137     return %indexes;
3138 }
3139
3140 =head1 INTERNAL FUNCTIONS
3141
3142 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
3143
3144     function to delete a biblio in NoZebra indexes
3145     This function does NOT delete anything in database : it reads all the indexes entries
3146     that have to be deleted & delete them in the hash
3147     The SQL part is done either :
3148     - after the Add if we are modifying a biblio (delete + add again)
3149     - immediatly after this sub if we are doing a true deletion.
3150     $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
3151
3152 =cut
3153
3154
3155 sub _DelBiblioNoZebra {
3156     my ($biblionumber, $record, $server)=@_;
3157
3158     # Get the indexes
3159     my $dbh = C4::Context->dbh;
3160     # Get the indexes
3161     my %index;
3162     my $title;
3163     if ($server eq 'biblioserver') {
3164         %index=GetNoZebraIndexes;
3165         # get title of the record (to store the 10 first letters with the index)
3166         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
3167         $title = lc($record->subfield($titletag,$titlesubfield));
3168     } else {
3169         # for authorities, the "title" is the $a mainentry
3170         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
3171         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
3172         $title = $record->subfield($authref->{auth_tag_to_report},'a');
3173         $index{'mainmainentry'}= $authref->{'auth_tag_to_report'}.'a';
3174         $index{'mainentry'}    = $authref->{'auth_tag_to_report'}.'*';
3175         $index{'auth_type'}    = '152b';
3176     }
3177
3178     my %result;
3179     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3180     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
3181     # limit to 10 char, should be enough, and limit the DB size
3182     $title = substr($title,0,10);
3183     #parse each field
3184     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3185     foreach my $field ($record->fields()) {
3186         #parse each subfield
3187         next if $field->tag <10;
3188         foreach my $subfield ($field->subfields()) {
3189             my $tag = $field->tag();
3190             my $subfieldcode = $subfield->[0];
3191             my $indexed=0;
3192             # check each index to see if the subfield is stored somewhere
3193             # otherwise, store it in __RAW__ index
3194             foreach my $key (keys %index) {
3195 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3196                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
3197                     $indexed=1;
3198                     my $line= lc $subfield->[1];
3199                     # remove meaningless value in the field...
3200                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3201                     # ... and split in words
3202                     foreach (split / /,$line) {
3203                         next unless $_; # skip  empty values (multiple spaces)
3204                         # if the entry is already here, do nothing, the biblionumber has already be removed
3205                         unless ($result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) {
3206                             # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
3207                             $sth2->execute($server,$key,$_);
3208                             my $existing_biblionumbers = $sth2->fetchrow;
3209                             # it exists
3210                             if ($existing_biblionumbers) {
3211 #                                 warn " existing for $key $_: $existing_biblionumbers";
3212                                 $result{$key}->{$_} =$existing_biblionumbers;
3213                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3214                             }
3215                         }
3216                     }
3217                 }
3218             }
3219             # the subfield is not indexed, store it in __RAW__ index anyway
3220             unless ($indexed) {
3221                 my $line= lc $subfield->[1];
3222                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3223                 # ... and split in words
3224                 foreach (split / /,$line) {
3225                     next unless $_; # skip  empty values (multiple spaces)
3226                     # if the entry is already here, do nothing, the biblionumber has already be removed
3227                     unless ($result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/) {
3228                         # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
3229                         $sth2->execute($server,'__RAW__',$_);
3230                         my $existing_biblionumbers = $sth2->fetchrow;
3231                         # it exists
3232                         if ($existing_biblionumbers) {
3233                             $result{'__RAW__'}->{$_} =$existing_biblionumbers;
3234                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3235                         }
3236                     }
3237                 }
3238             }
3239         }
3240     }
3241     return %result;
3242 }
3243
3244 =head2 _AddBiblioNoZebra($biblionumber, $record, $server, %result);
3245
3246     function to add a biblio in NoZebra indexes
3247
3248 =cut
3249
3250 sub _AddBiblioNoZebra {
3251     my ($biblionumber, $record, $server, %result)=@_;
3252     my $dbh = C4::Context->dbh;
3253     # Get the indexes
3254     my %index;
3255     my $title;
3256     if ($server eq 'biblioserver') {
3257         %index=GetNoZebraIndexes;
3258         # get title of the record (to store the 10 first letters with the index)
3259         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
3260         $title = lc($record->subfield($titletag,$titlesubfield));
3261     } else {
3262         # warn "server : $server";
3263         # for authorities, the "title" is the $a mainentry
3264         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
3265         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
3266         $title = $record->subfield($authref->{auth_tag_to_report},'a');
3267         $index{'mainmainentry'} = $authref->{auth_tag_to_report}.'a';
3268         $index{'mainentry'}     = $authref->{auth_tag_to_report}.'*';
3269         $index{'auth_type'}     = '152b';
3270     }
3271
3272     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3273     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
3274     # limit to 10 char, should be enough, and limit the DB size
3275     $title = substr($title,0,10);
3276     #parse each field
3277     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3278     foreach my $field ($record->fields()) {
3279         #parse each subfield
3280         next if $field->tag <10;
3281         foreach my $subfield ($field->subfields()) {
3282             my $tag = $field->tag();
3283             my $subfieldcode = $subfield->[0];
3284             my $indexed=0;
3285             # check each index to see if the subfield is stored somewhere
3286             # otherwise, store it in __RAW__ index
3287             foreach my $key (keys %index) {
3288 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3289                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
3290                     $indexed=1;
3291                     my $line= lc $subfield->[1];
3292                     # remove meaningless value in the field...
3293                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3294                     # ... and split in words
3295                     foreach (split / /,$line) {
3296                         next unless $_; # skip  empty values (multiple spaces)
3297                         # if the entry is already here, improve weight
3298 #                         warn "managing $_";
3299                         if ($result{$key}->{"$_"} =~ /$biblionumber,$title\-(\d);/) {
3300                             my $weight=$1+1;
3301                             $result{$key}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3302                             $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3303                         } else {
3304                             # get the value if it exist in the nozebra table, otherwise, create it
3305                             $sth2->execute($server,$key,$_);
3306                             my $existing_biblionumbers = $sth2->fetchrow;
3307                             # it exists
3308                             if ($existing_biblionumbers) {
3309                                 $result{$key}->{"$_"} =$existing_biblionumbers;
3310                                 my $weight=$1+1;
3311                                 $result{$key}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3312                                 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3313                             # create a new ligne for this entry
3314                             } else {
3315 #                             warn "INSERT : $server / $key / $_";
3316                                 $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).', indexname='.$dbh->quote($key).',value='.$dbh->quote($_));
3317                                 $result{$key}->{"$_"}.="$biblionumber,$title-1;";
3318                             }
3319                         }
3320                     }
3321                 }
3322             }
3323             # the subfield is not indexed, store it in __RAW__ index anyway
3324             unless ($indexed) {
3325                 my $line= lc $subfield->[1];
3326                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3327                 # ... and split in words
3328                 foreach (split / /,$line) {
3329                     next unless $_; # skip  empty values (multiple spaces)
3330                     # if the entry is already here, improve weight
3331                     if ($result{'__RAW__'}->{"$_"} =~ /$biblionumber,$title\-(\d);/) {
3332                         my $weight=$1+1;
3333                         $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3334                         $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3335                     } else {
3336                         # get the value if it exist in the nozebra table, otherwise, create it
3337                         $sth2->execute($server,'__RAW__',$_);
3338                         my $existing_biblionumbers = $sth2->fetchrow;
3339                         # it exists
3340                         if ($existing_biblionumbers) {
3341                             $result{'__RAW__'}->{"$_"} =$existing_biblionumbers;
3342                             my $weight=$1+1;
3343                             $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3344                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3345                         # create a new ligne for this entry
3346                         } else {
3347                             $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).',  indexname="__RAW__",value='.$dbh->quote($_));
3348                             $result{'__RAW__'}->{"$_"}.="$biblionumber,$title-1;";
3349                         }
3350                     }
3351                 }
3352             }
3353         }
3354     }
3355     return %result;
3356 }
3357
3358
3359 =head2 MARCitemchange
3360
3361 =over 4
3362
3363 &MARCitemchange( $record, $itemfield, $newvalue )
3364
3365 Function to update a single value in an item field.
3366 Used twice, could probably be replaced by something else, but works well...
3367
3368 =back
3369
3370 =back
3371
3372 =cut
3373
3374 sub MARCitemchange {
3375     my ( $record, $itemfield, $newvalue ) = @_;
3376     my $dbh = C4::Context->dbh;
3377
3378     my ( $tagfield, $tagsubfield ) =
3379       GetMarcFromKohaField( $itemfield, "" );
3380     if ( ($tagfield) && ($tagsubfield) ) {
3381         my $tag = $record->field($tagfield);
3382         if ($tag) {
3383             $tag->update( $tagsubfield => $newvalue );
3384             $record->delete_field($tag);
3385             $record->insert_fields_ordered($tag);
3386         }
3387     }
3388 }
3389 =head2 _find_value
3390
3391 =over 4
3392
3393 ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
3394
3395 Find the given $subfield in the given $tag in the given
3396 MARC::Record $record.  If the subfield is found, returns
3397 the (indicators, value) pair; otherwise, (undef, undef) is
3398 returned.
3399
3400 PROPOSITION :
3401 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
3402 I suggest we export it from this module.
3403
3404 =back
3405
3406 =cut
3407
3408 sub _find_value {
3409     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
3410     my @result;
3411     my $indicator;
3412     if ( $tagfield < 10 ) {
3413         if ( $record->field($tagfield) ) {
3414             push @result, $record->field($tagfield)->data();
3415         }
3416         else {
3417             push @result, "";
3418         }
3419     }
3420     else {
3421         foreach my $field ( $record->field($tagfield) ) {
3422             my @subfields = $field->subfields();
3423             foreach my $subfield (@subfields) {
3424                 if ( @$subfield[0] eq $insubfield ) {
3425                     push @result, @$subfield[1];
3426                     $indicator = $field->indicator(1) . $field->indicator(2);
3427                 }
3428             }
3429         }
3430     }
3431     return ( $indicator, @result );
3432 }
3433
3434 =head2 _koha_marc_update_bib_ids
3435
3436 =over 4
3437
3438 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
3439
3440 Internal function to add or update biblionumber and biblioitemnumber to
3441 the MARC XML.
3442
3443 =back
3444
3445 =cut
3446
3447 sub _koha_marc_update_bib_ids {
3448     my ($record, $frameworkcode, $biblionumber, $biblioitemnumber) = @_;
3449
3450     # we must add bibnum and bibitemnum in MARC::Record...
3451     # we build the new field with biblionumber and biblioitemnumber
3452     # we drop the original field
3453     # we add the new builded field.
3454     my ($biblio_tag, $biblio_subfield ) = GetMarcFromKohaField("biblio.biblionumber",$frameworkcode);
3455     my ($biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.biblioitemnumber",$frameworkcode);
3456
3457     if ($biblio_tag != $biblioitem_tag) {
3458         # biblionumber & biblioitemnumber are in different fields
3459
3460         # deal with biblionumber
3461         my ($new_field, $old_field);
3462         if ($biblio_tag < 10) {
3463             $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
3464         } else {
3465             $new_field =
3466               MARC::Field->new( $biblio_tag, '', '',
3467                 "$biblio_subfield" => $biblionumber );
3468         }
3469
3470         # drop old field and create new one...
3471         $old_field = $record->field($biblio_tag);
3472         $record->delete_field($old_field);
3473         $record->append_fields($new_field);
3474
3475         # deal with biblioitemnumber
3476         if ($biblioitem_tag < 10) {
3477             $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
3478         } else {
3479             $new_field =
3480               MARC::Field->new( $biblioitem_tag, '', '',
3481                 "$biblioitem_subfield" => $biblioitemnumber, );
3482         }
3483         # drop old field and create new one...
3484         $old_field = $record->field($biblioitem_tag);
3485         $record->delete_field($old_field);
3486         $record->insert_fields_ordered($new_field);
3487
3488     } else {
3489         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
3490         my $new_field = MARC::Field->new(
3491             $biblio_tag, '', '',
3492             "$biblio_subfield" => $biblionumber,
3493             "$biblioitem_subfield" => $biblioitemnumber
3494         );
3495
3496         # drop old field and create new one...
3497         my $old_field = $record->field($biblio_tag);
3498         $record->delete_field($old_field);
3499         $record->insert_fields_ordered($new_field);
3500     }
3501 }
3502
3503 =head2 _koha_add_biblio
3504
3505 =over 4
3506
3507 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3508
3509 Internal function to add a biblio ($biblio is a hash with the values)
3510
3511 =back
3512
3513 =cut
3514
3515 sub _koha_add_biblio {
3516     my ( $dbh, $biblio, $frameworkcode ) = @_;
3517
3518         my $error;
3519
3520         # set the series flag
3521     my $serial = 0;
3522     if ( $biblio->{'seriestitle'} ) { $serial = 1 };
3523
3524         my $query =
3525         "INSERT INTO biblio
3526                 SET frameworkcode = ?,
3527                         author = ?,
3528                         title = ?,
3529                         unititle =?,
3530                         notes = ?,
3531                         serial = ?,
3532                         seriestitle = ?,
3533                         copyrightdate = ?,
3534                         datecreated=NOW(),
3535                         abstract = ?
3536                 ";
3537     my $sth = $dbh->prepare($query);
3538     $sth->execute(
3539                 $frameworkcode,
3540         $biblio->{'author'},
3541         $biblio->{'title'},
3542                 $biblio->{'unititle'},
3543         $biblio->{'notes'},
3544                 $serial,
3545         $biblio->{'seriestitle'},
3546                 $biblio->{'copyrightdate'},
3547         $biblio->{'abstract'}
3548     );
3549
3550     my $biblionumber = $dbh->{'mysql_insertid'};
3551         if ( $dbh->errstr ) {
3552                 $error.="ERROR in _koha_add_biblio $query".$dbh->errstr;
3553         warn $error;
3554     }
3555
3556     $sth->finish();
3557         #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3558     return ($biblionumber,$error);
3559 }
3560
3561 =head2 _koha_modify_biblio
3562
3563 =over 4
3564
3565 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3566
3567 Internal function for updating the biblio table
3568
3569 =back
3570
3571 =cut
3572
3573 sub _koha_modify_biblio {
3574     my ( $dbh, $biblio, $frameworkcode ) = @_;
3575         my $error;
3576
3577     my $query = "
3578         UPDATE biblio
3579         SET    frameworkcode = ?,
3580                            author = ?,
3581                            title = ?,
3582                            unititle = ?,
3583                            notes = ?,
3584                            serial = ?,
3585                            seriestitle = ?,
3586                            copyrightdate = ?,
3587                abstract = ?
3588         WHERE  biblionumber = ?
3589                 "
3590         ;
3591     my $sth = $dbh->prepare($query);
3592
3593     $sth->execute(
3594                 $frameworkcode,
3595         $biblio->{'author'},
3596         $biblio->{'title'},
3597         $biblio->{'unititle'},
3598         $biblio->{'notes'},
3599         $biblio->{'serial'},
3600         $biblio->{'seriestitle'},
3601         $biblio->{'copyrightdate'},
3602                 $biblio->{'abstract'},
3603         $biblio->{'biblionumber'}
3604     ) if $biblio->{'biblionumber'};
3605
3606     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3607                 $error.="ERROR in _koha_modify_biblio $query".$dbh->errstr;
3608         warn $error;
3609     }
3610     return ( $biblio->{'biblionumber'},$error );
3611 }
3612
3613 =head2 _koha_modify_biblioitem_nonmarc
3614
3615 =over 4
3616
3617 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3618
3619 Updates biblioitems row except for marc and marcxml, which should be changed
3620 via ModBiblioMarc
3621
3622 =back
3623
3624 =cut
3625
3626 sub _koha_modify_biblioitem_nonmarc {
3627     my ( $dbh, $biblioitem ) = @_;
3628         my $error;
3629
3630         # re-calculate the cn_sort, it may have changed
3631         my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3632
3633         my $query =
3634         "UPDATE biblioitems
3635         SET biblionumber        = ?,
3636                 volume                  = ?,
3637                 number                  = ?,
3638         itemtype        = ?,
3639         isbn            = ?,
3640         issn            = ?,
3641                 publicationyear = ?,
3642         publishercode   = ?,
3643                 volumedate      = ?,
3644                 volumedesc      = ?,
3645                 collectiontitle = ?,
3646                 collectionissn  = ?,
3647                 collectionvolume= ?,
3648                 editionstatement= ?,
3649                 editionresponsibility = ?,
3650                 illus                   = ?,
3651                 pages                   = ?,
3652                 notes                   = ?,
3653                 size                    = ?,
3654                 place                   = ?,
3655                 lccn                    = ?,
3656                 url                     = ?,
3657         cn_source               = ?,
3658         cn_class        = ?,
3659         cn_item         = ?,
3660                 cn_suffix       = ?,
3661                 cn_sort         = ?,
3662                 totalissues     = ?
3663         where biblioitemnumber = ?
3664                 ";
3665         my $sth = $dbh->prepare($query);
3666         $sth->execute(
3667                 $biblioitem->{'biblionumber'},
3668                 $biblioitem->{'volume'},
3669                 $biblioitem->{'number'},
3670                 $biblioitem->{'itemtype'},
3671                 $biblioitem->{'isbn'},
3672                 $biblioitem->{'issn'},
3673                 $biblioitem->{'publicationyear'},
3674                 $biblioitem->{'publishercode'},
3675                 $biblioitem->{'volumedate'},
3676                 $biblioitem->{'volumedesc'},
3677                 $biblioitem->{'collectiontitle'},
3678                 $biblioitem->{'collectionissn'},
3679                 $biblioitem->{'collectionvolume'},
3680                 $biblioitem->{'editionstatement'},
3681                 $biblioitem->{'editionresponsibility'},
3682                 $biblioitem->{'illus'},
3683                 $biblioitem->{'pages'},
3684                 $biblioitem->{'bnotes'},
3685                 $biblioitem->{'size'},
3686                 $biblioitem->{'place'},
3687                 $biblioitem->{'lccn'},
3688                 $biblioitem->{'url'},
3689                 $biblioitem->{'biblioitems.cn_source'},
3690                 $biblioitem->{'cn_class'},
3691                 $biblioitem->{'cn_item'},
3692                 $biblioitem->{'cn_suffix'},
3693                 $cn_sort,
3694                 $biblioitem->{'totalissues'},
3695                 $biblioitem->{'biblioitemnumber'}
3696         );
3697     if ( $dbh->errstr ) {
3698                 $error.="ERROR in _koha_modify_biblioitem_nonmarc $query".$dbh->errstr;
3699         warn $error;
3700     }
3701         return ($biblioitem->{'biblioitemnumber'},$error);
3702 }
3703
3704 =head2 _koha_add_biblioitem
3705
3706 =over 4
3707
3708 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3709
3710 Internal function to add a biblioitem
3711
3712 =back
3713
3714 =cut
3715
3716 sub _koha_add_biblioitem {
3717     my ( $dbh, $biblioitem ) = @_;
3718         my $error;
3719
3720         my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3721     my $query =
3722     "INSERT INTO biblioitems SET
3723         biblionumber    = ?,
3724         volume          = ?,
3725         number          = ?,
3726         itemtype        = ?,
3727         isbn            = ?,
3728         issn            = ?,
3729         publicationyear = ?,
3730         publishercode   = ?,
3731         volumedate      = ?,
3732         volumedesc      = ?,
3733         collectiontitle = ?,
3734         collectionissn  = ?,
3735         collectionvolume= ?,
3736         editionstatement= ?,
3737         editionresponsibility = ?,
3738         illus           = ?,
3739         pages           = ?,
3740         notes           = ?,
3741         size            = ?,
3742         place           = ?,
3743         lccn            = ?,
3744         marc            = ?,
3745         url             = ?,
3746         cn_source       = ?,
3747         cn_class        = ?,
3748         cn_item         = ?,
3749         cn_suffix       = ?,
3750         cn_sort         = ?,
3751         totalissues     = ?
3752         ";
3753         my $sth = $dbh->prepare($query);
3754     $sth->execute(
3755         $biblioitem->{'biblionumber'},
3756         $biblioitem->{'volume'},
3757         $biblioitem->{'number'},
3758         $biblioitem->{'itemtype'},
3759         $biblioitem->{'isbn'},
3760         $biblioitem->{'issn'},
3761         $biblioitem->{'publicationyear'},
3762         $biblioitem->{'publishercode'},
3763         $biblioitem->{'volumedate'},
3764         $biblioitem->{'volumedesc'},
3765         $biblioitem->{'collectiontitle'},
3766         $biblioitem->{'collectionissn'},
3767         $biblioitem->{'collectionvolume'},
3768         $biblioitem->{'editionstatement'},
3769         $biblioitem->{'editionresponsibility'},
3770         $biblioitem->{'illus'},
3771         $biblioitem->{'pages'},
3772         $biblioitem->{'bnotes'},
3773         $biblioitem->{'size'},
3774         $biblioitem->{'place'},
3775         $biblioitem->{'lccn'},
3776         $biblioitem->{'marc'},
3777         $biblioitem->{'url'},
3778         $biblioitem->{'biblioitems.cn_source'},
3779         $biblioitem->{'cn_class'},
3780         $biblioitem->{'cn_item'},
3781         $biblioitem->{'cn_suffix'},
3782         $cn_sort,
3783         $biblioitem->{'totalissues'}
3784     );
3785     my $bibitemnum = $dbh->{'mysql_insertid'};
3786     if ( $dbh->errstr ) {
3787                 $error.="ERROR in _koha_add_biblioitem $query".$dbh->errstr;
3788                 warn $error;
3789     }
3790     $sth->finish();
3791     return ($bibitemnum,$error);
3792 }
3793
3794 =head2 _koha_new_items
3795
3796 =over 4
3797
3798 my ($itemnumber,$error) = _koha_new_items( $dbh, $item, $barcode );
3799
3800 =back
3801
3802 =cut
3803
3804 sub _koha_new_items {
3805     my ( $dbh, $item, $barcode ) = @_;
3806         my $error;
3807
3808     my ($items_cn_sort) = GetClassSort($item->{'items.cn_source'}, $item->{'itemcallnumber'}, "");
3809
3810     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
3811     if ( $item->{'dateaccessioned'} eq '' || !$item->{'dateaccessioned'} ) {
3812                 my $today = C4::Dates->new();
3813                 $item->{'dateaccessioned'} =  $today->output("iso"); #TODO: check time issues
3814         }
3815         my $query =
3816            "INSERT INTO items SET
3817                         biblionumber            = ?,
3818             biblioitemnumber    = ?,
3819                         barcode                 = ?,
3820                         dateaccessioned         = ?,
3821                         booksellerid        = ?,
3822             homebranch          = ?,
3823             price               = ?,
3824                         replacementprice        = ?,
3825             replacementpricedate = NOW(),
3826                         datelastborrowed        = ?,
3827                         datelastseen            = NOW(),
3828                         stack                   = ?,
3829                         notforloan                      = ?,
3830                         damaged                         = ?,
3831             itemlost            = ?,
3832                         wthdrawn                = ?,
3833                         itemcallnumber          = ?,
3834                         restricted                      = ?,
3835                         itemnotes                       = ?,
3836                         holdingbranch           = ?,
3837             paidfor             = ?,
3838                         location                        = ?,
3839                         onloan                          = ?,
3840                         cn_source                       = ?,
3841                         cn_sort                         = ?,
3842                         ccode                           = ?,
3843                         itype                           = ?,
3844                         materials                       = ?,
3845                         uri                             = ?
3846           ";
3847     my $sth = $dbh->prepare($query);
3848         $sth->execute(
3849                         $item->{'biblionumber'},
3850                         $item->{'biblioitemnumber'},
3851             $barcode,
3852                         $item->{'dateaccessioned'},
3853                         $item->{'booksellerid'},
3854             $item->{'homebranch'},
3855             $item->{'price'},
3856                         $item->{'replacementprice'},
3857                         $item->{datelastborrowed},
3858                         $item->{stack},
3859                         $item->{'notforloan'},
3860                         $item->{'damaged'},
3861             $item->{'itemlost'},
3862                         $item->{'wthdrawn'},
3863                         $item->{'itemcallnumber'},
3864             $item->{'restricted'},
3865                         $item->{'itemnotes'},
3866                         $item->{'holdingbranch'},
3867                         $item->{'paidfor'},
3868                         $item->{'location'},
3869                         $item->{'onloan'},
3870                         $item->{'items.cn_source'},
3871                         $items_cn_sort,
3872                         $item->{'ccode'},
3873                         $item->{'itype'},
3874                         $item->{'materials'},
3875                         $item->{'uri'},
3876     );
3877     my $itemnumber = $dbh->{'mysql_insertid'};
3878     if ( defined $sth->errstr ) {
3879         $error.="ERROR in _koha_new_items $query".$sth->errstr;
3880     }
3881         $sth->finish();
3882     return ( $itemnumber, $error );
3883 }
3884
3885 =head2 _koha_modify_item
3886
3887 =over 4
3888
3889 my ($itemnumber,$error) =_koha_modify_item( $dbh, $item, $op );
3890
3891 =back
3892
3893 =cut
3894
3895 sub _koha_modify_item {
3896     my ( $dbh, $item ) = @_;
3897         my $error;
3898
3899         # calculate items.cn_sort
3900     $item->{'cn_sort'} = GetClassSort($item->{'items.cn_source'}, $item->{'itemcallnumber'}, "");
3901
3902     my $query = "UPDATE items SET ";
3903         my @bind;
3904         for my $key ( keys %$item ) {
3905                 $query.="$key=?,";
3906                 push @bind, $item->{$key};
3907     }
3908         $query =~ s/,$//;
3909     $query .= " WHERE itemnumber=?";
3910     push @bind, $item->{'itemnumber'};
3911     my $sth = $dbh->prepare($query);
3912     $sth->execute(@bind);
3913     if ( $dbh->errstr ) {
3914         $error.="ERROR in _koha_modify_item $query".$dbh->errstr;
3915         warn $error;
3916     }
3917     $sth->finish();
3918         return ($item->{'itemnumber'},$error);
3919 }
3920
3921 =head2 _koha_delete_biblio
3922
3923 =over 4
3924
3925 $error = _koha_delete_biblio($dbh,$biblionumber);
3926
3927 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3928
3929 C<$dbh> - the database handle
3930 C<$biblionumber> - the biblionumber of the biblio to be deleted
3931
3932 =back
3933
3934 =cut
3935
3936 # FIXME: add error handling
3937
3938 sub _koha_delete_biblio {
3939     my ( $dbh, $biblionumber ) = @_;
3940
3941     # get all the data for this biblio
3942     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3943     $sth->execute($biblionumber);
3944
3945     if ( my $data = $sth->fetchrow_hashref ) {
3946
3947         # save the record in deletedbiblio
3948         # find the fields to save
3949         my $query = "INSERT INTO deletedbiblio SET ";
3950         my @bind  = ();
3951         foreach my $temp ( keys %$data ) {
3952             $query .= "$temp = ?,";
3953             push( @bind, $data->{$temp} );
3954         }
3955
3956         # replace the last , by ",?)"
3957         $query =~ s/\,$//;
3958         my $bkup_sth = $dbh->prepare($query);
3959         $bkup_sth->execute(@bind);
3960         $bkup_sth->finish;
3961
3962         # delete the biblio
3963         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3964         $del_sth->execute($biblionumber);
3965         $del_sth->finish;
3966     }
3967     $sth->finish;
3968     return undef;
3969 }
3970
3971 =head2 _koha_delete_biblioitems
3972
3973 =over 4
3974
3975 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3976
3977 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3978
3979 C<$dbh> - the database handle
3980 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3981
3982 =back
3983
3984 =cut
3985
3986 # FIXME: add error handling
3987
3988 sub _koha_delete_biblioitems {
3989     my ( $dbh, $biblioitemnumber ) = @_;
3990
3991     # get all the data for this biblioitem
3992     my $sth =
3993       $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3994     $sth->execute($biblioitemnumber);
3995
3996     if ( my $data = $sth->fetchrow_hashref ) {
3997
3998         # save the record in deletedbiblioitems
3999         # find the fields to save
4000         my $query = "INSERT INTO deletedbiblioitems SET ";
4001         my @bind  = ();
4002         foreach my $temp ( keys %$data ) {
4003             $query .= "$temp = ?,";
4004             push( @bind, $data->{$temp} );
4005         }
4006
4007         # replace the last , by ",?)"
4008         $query =~ s/\,$//;
4009         my $bkup_sth = $dbh->prepare($query);
4010         $bkup_sth->execute(@bind);
4011         $bkup_sth->finish;
4012
4013         # delete the biblioitem
4014         my $del_sth =
4015           $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
4016         $del_sth->execute($biblioitemnumber);
4017         $del_sth->finish;
4018     }
4019     $sth->finish;
4020     return undef;
4021 }
4022
4023 =head2 _koha_delete_item
4024
4025 =over 4
4026
4027 _koha_delete_item( $dbh, $itemnum );
4028
4029 Internal function to delete an item record from the koha tables
4030
4031 =back
4032
4033 =cut
4034
4035 sub _koha_delete_item {
4036     my ( $dbh, $itemnum ) = @_;
4037
4038         # save the deleted item to deleteditems table
4039     my $sth = $dbh->prepare("SELECT * FROM items WHERE itemnumber=?");
4040     $sth->execute($itemnum);
4041     my $data = $sth->fetchrow_hashref();
4042     $sth->finish();
4043     my $query = "INSERT INTO deleteditems SET ";
4044     my @bind  = ();
4045     foreach my $key ( keys %$data ) {
4046         $query .= "$key = ?,";
4047         push( @bind, $data->{$key} );
4048     }
4049     $query =~ s/\,$//;
4050     $sth = $dbh->prepare($query);
4051     $sth->execute(@bind);
4052     $sth->finish();
4053
4054         # delete from items table
4055     $sth = $dbh->prepare("DELETE FROM items WHERE itemnumber=?");
4056     $sth->execute($itemnum);
4057     $sth->finish();
4058         return undef;
4059 }
4060
4061 =head1 UNEXPORTED FUNCTIONS
4062
4063 =head2 ModBiblioMarc
4064
4065     &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
4066
4067     Add MARC data for a biblio to koha
4068
4069     Function exported, but should NOT be used, unless you really know what you're doing
4070
4071 =cut
4072
4073 sub ModBiblioMarc {
4074
4075 # pass the MARC::Record to this function, and it will create the records in the marc field
4076     my ( $record, $biblionumber, $frameworkcode ) = @_;
4077     my $dbh = C4::Context->dbh;
4078     my @fields = $record->fields();
4079     if ( !$frameworkcode ) {
4080         $frameworkcode = "";
4081     }
4082     my $sth =
4083       $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
4084     $sth->execute( $frameworkcode, $biblionumber );
4085     $sth->finish;
4086     my $encoding = C4::Context->preference("marcflavour");
4087
4088     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
4089     if ( $encoding eq "UNIMARC" ) {
4090         my $string;
4091         if ( length($record->subfield( 100, "a" )) == 35 ) {
4092             $string = $record->subfield( 100, "a" );
4093             my $f100 = $record->field(100);
4094             $record->delete_field($f100);
4095         }
4096         else {
4097             $string = POSIX::strftime( "%Y%m%d", localtime );
4098             $string =~ s/\-//g;
4099             $string = sprintf( "%-*s", 35, $string );
4100         }
4101         substr( $string, 22, 6, "frey50" );
4102         unless ( $record->subfield( 100, "a" ) ) {
4103             $record->insert_grouped_field(
4104                 MARC::Field->new( 100, "", "", "a" => $string ) );
4105         }
4106     }
4107     ModZebra($biblionumber,"specialUpdate","biblioserver",$record);
4108     $sth =
4109       $dbh->prepare(
4110         "UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
4111     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding),
4112         $biblionumber );
4113     $sth->finish;
4114     return $biblionumber;
4115 }
4116
4117 =head2 AddItemInMarc
4118
4119 =over 4
4120
4121 $newbiblionumber = AddItemInMarc( $record, $biblionumber, $frameworkcode );
4122
4123 Add an item in a MARC record and save the MARC record
4124
4125 Function exported, but should NOT be used, unless you really know what you're doing
4126
4127 =back
4128
4129 =cut
4130
4131 sub AddItemInMarc {
4132
4133     # pass the MARC::Record to this function, and it will create the records in the marc tables
4134     my ( $record, $biblionumber, $frameworkcode ) = @_;
4135     my $newrec = &GetMarcBiblio($biblionumber);
4136
4137     # create it
4138     my @fields = $record->fields();
4139     foreach my $field (@fields) {
4140         $newrec->append_fields($field);
4141     }
4142
4143     # FIXME: should we be making sure the biblionumbers are the same?
4144     my $newbiblionumber =
4145       &ModBiblioMarc( $newrec, $biblionumber, $frameworkcode );
4146     return $newbiblionumber;
4147 }
4148
4149 =head2 z3950_extended_services
4150
4151 z3950_extended_services($serviceType,$serviceOptions,$record);
4152
4153     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.
4154
4155 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
4156
4157 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
4158
4159     action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
4160
4161 and maybe
4162
4163     recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
4164     syntax => the record syntax (transfer syntax)
4165     databaseName = Database from connection object
4166
4167     To set serviceOptions, call set_service_options($serviceType)
4168
4169 C<$record> the record, if one is needed for the service type
4170
4171     A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
4172
4173 =cut
4174
4175 sub z3950_extended_services {
4176     my ( $server, $serviceType, $action, $serviceOptions ) = @_;
4177
4178     # get our connection object
4179     my $Zconn = C4::Context->Zconn( $server, 0, 1 );
4180
4181     # create a new package object
4182     my $Zpackage = $Zconn->package();
4183
4184     # set our options
4185     $Zpackage->option( action => $action );
4186
4187     if ( $serviceOptions->{'databaseName'} ) {
4188         $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
4189     }
4190     if ( $serviceOptions->{'recordIdNumber'} ) {
4191         $Zpackage->option(
4192             recordIdNumber => $serviceOptions->{'recordIdNumber'} );
4193     }
4194     if ( $serviceOptions->{'recordIdOpaque'} ) {
4195         $Zpackage->option(
4196             recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
4197     }
4198
4199  # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
4200  #if ($serviceType eq 'itemorder') {
4201  #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
4202  #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
4203  #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
4204  #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
4205  #}
4206
4207     if ( $serviceOptions->{record} ) {
4208         $Zpackage->option( record => $serviceOptions->{record} );
4209
4210         # can be xml or marc
4211         if ( $serviceOptions->{'syntax'} ) {
4212             $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
4213         }
4214     }
4215
4216     # send the request, handle any exception encountered
4217     eval { $Zpackage->send($serviceType) };
4218     if ( $@ && $@->isa("ZOOM::Exception") ) {
4219         return "error:  " . $@->code() . " " . $@->message() . "\n";
4220     }
4221
4222     # free up package resources
4223     $Zpackage->destroy();
4224 }
4225
4226 =head2 set_service_options
4227
4228 my $serviceOptions = set_service_options($serviceType);
4229
4230 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
4231
4232 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
4233
4234 =cut
4235
4236 sub set_service_options {
4237     my ($serviceType) = @_;
4238     my $serviceOptions;
4239
4240 # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
4241 #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
4242
4243     if ( $serviceType eq 'commit' ) {
4244
4245         # nothing to do
4246     }
4247     if ( $serviceType eq 'create' ) {
4248
4249         # nothing to do
4250     }
4251     if ( $serviceType eq 'drop' ) {
4252         die "ERROR: 'drop' not currently supported (by Zebra)";
4253     }
4254     return $serviceOptions;
4255 }
4256
4257 =head2 GetItemsCount
4258
4259 $count = &GetItemsCount( $biblionumber);
4260 this function return count of item with $biblionumber
4261 =cut
4262
4263 sub GetItemsCount {
4264     my ( $biblionumber ) = @_;
4265     my $dbh = C4::Context->dbh;
4266     my $query = "SELECT count(*)
4267                   FROM  items
4268                   WHERE biblionumber=?";
4269     my $sth = $dbh->prepare($query);
4270     $sth->execute($biblionumber);
4271     my $count = $sth->fetchrow;
4272     $sth->finish;
4273     return ($count);
4274 }
4275
4276 END { }    # module clean-up code here (global destructor)
4277
4278 1;
4279
4280 __END__
4281
4282 =head1 AUTHOR
4283
4284 Koha Developement team <info@koha.org>
4285
4286 Paul POULAIN paul.poulain@free.fr
4287
4288 Joshua Ferraro jmf@liblime.com
4289
4290 =cut