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