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