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($dbh,$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 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
1295     while (
1296         (
1297             $tag,          $subfield,      $liblibrarian,
1298             ,              $libopac,       $tab,
1299             $mandatory,    $repeatable,    $authorised_value,
1300             $authtypecode, $value_builder, $kohafield,
1301             $seealso,      $hidden,        $isurl,
1302             $link
1303         )
1304         = $sth->fetchrow
1305       )
1306     {
1307         $res->{$tag}->{$subfield}->{lib} =
1308           ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1309         $res->{$tag}->{$subfield}->{tab}              = $tab;
1310         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
1311         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
1312         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
1313         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
1314         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
1315         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
1316         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
1317         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
1318         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
1319         $res->{$tag}->{$subfield}->{link}             = $link;
1320     }
1321     return $res;
1322 }
1323
1324 =head2 MARCfind_marc_from_kohafield
1325
1326 =cut
1327
1328 sub MARCfind_marc_from_kohafield {
1329     my ( $dbh, $kohafield, $frameworkcode ) = @_;
1330     return 0, 0 unless $kohafield;
1331     my $relations = C4::Context->marcfromkohafield;
1332     return (
1333         $relations->{$frameworkcode}->{$kohafield}->[0],
1334         $relations->{$frameworkcode}->{$kohafield}->[1]
1335     );
1336 }
1337
1338 =head2 MARCaddbiblio
1339
1340 &MARCaddbiblio($newrec,$biblionumber,$frameworkcode);
1341
1342 Add MARC data for a biblio to koha
1343
1344 =cut
1345
1346 sub MARCaddbiblio {
1347
1348 # pass the MARC::Record to this function, and it will create the records in the marc tables
1349     my ( $record, $biblionumber, $frameworkcode ) = @_;
1350     my $dbh = C4::Context->dbh;
1351     my @fields = $record->fields();
1352     if ( !$frameworkcode ) {
1353         $frameworkcode = "";
1354     }
1355     my $sth =
1356       $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
1357     $sth->execute( $frameworkcode, $biblionumber );
1358     $sth->finish;
1359     my $encoding = C4::Context->preference("marcflavour");
1360
1361 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
1362     if ( $encoding eq "UNIMARC" ) {
1363         my $string;
1364         if ( $record->subfield( 100, "a" ) ) {
1365             $string = $record->subfield( 100, "a" );
1366             my $f100 = $record->field(100);
1367             $record->delete_field($f100);
1368         }
1369         else {
1370             $string = POSIX::strftime( "%Y%m%d", localtime );
1371             $string =~ s/\-//g;
1372             $string = sprintf( "%-*s", 35, $string );
1373         }
1374         substr( $string, 22, 6, "frey50" );
1375         unless ( $record->subfield( 100, "a" ) ) {
1376             $record->insert_grouped_field(
1377                 MARC::Field->new( 100, "", "", "a" => $string ) );
1378         }
1379     }
1380 #     warn "biblionumber : ".$biblionumber;
1381     $sth =
1382       $dbh->prepare(
1383         "update biblioitems set marc=?,marcxml=?  where biblionumber=?");
1384     $sth->execute( $record->as_usmarc(), $record->as_xml_record(),
1385         $biblionumber );
1386 #     warn $record->as_xml_record();
1387     $sth->finish;
1388     zebraop($dbh,$biblionumber,"specialUpdate","biblioserver");
1389     return $biblionumber;
1390 }
1391
1392 =head2 MARCadditem
1393
1394 $newbiblionumber = MARCadditem( $record, $biblionumber, $frameworkcode );
1395
1396 =cut
1397
1398 sub MARCadditem {
1399
1400 # pass the MARC::Record to this function, and it will create the records in the marc tables
1401     my ( $record, $biblionumber, $frameworkcode ) = @_;
1402     my $newrec = &GetMarcBiblio($biblionumber);
1403
1404     # 2nd recreate it
1405     my @fields = $record->fields();
1406     foreach my $field (@fields) {
1407         $newrec->append_fields($field);
1408     }
1409
1410     # FIXME: should we be making sure the biblionumbers are the same?
1411     my $newbiblionumber =
1412       &MARCaddbiblio( $newrec, $biblionumber, $frameworkcode );
1413     return $newbiblionumber;
1414 }
1415
1416 =head2 GetMarcBiblio
1417
1418 Returns MARC::Record of the biblionumber passed in parameter.
1419
1420 =cut
1421
1422 sub GetMarcBiblio {
1423     my $biblionumber = shift;
1424     my $dbh          = C4::Context->dbh;
1425     my $sth          =
1426       $dbh->prepare("select marcxml from biblioitems where biblionumber=? ");
1427     $sth->execute($biblionumber);
1428     my ($marcxml) = $sth->fetchrow;
1429 #     warn "marcxml : $marcxml";
1430         MARC::File::XML->default_record_format(C4::Context->preference('marcflavour'));
1431     $marcxml =~ s/\x1e//g;
1432     $marcxml =~ s/\x1f//g;
1433     $marcxml =~ s/\x1d//g;
1434     $marcxml =~ s/\x0f//g;
1435     $marcxml =~ s/\x0c//g;
1436     my $record = MARC::Record->new();
1437     $record = MARC::Record::new_from_xml( $marcxml, "utf8",C4::Context->preference('marcflavour')) if $marcxml;
1438     return $record;
1439 }
1440
1441 =head2 GetXmlBiblio
1442
1443 my $marcxml = GetXmlBiblio($biblionumber);
1444
1445 Returns biblioitems.marcxml of the biblionumber passed in parameter.
1446
1447 =cut
1448
1449 sub GetXmlBiblio {
1450     my ( $biblionumber ) = @_;
1451     my $dbh = C4::Context->dbh;
1452     my $sth =
1453       $dbh->prepare("select marcxml from biblioitems where biblionumber=? ");
1454     $sth->execute($biblionumber);
1455     my ($marcxml) = $sth->fetchrow;
1456     return $marcxml;
1457 }
1458
1459 =head2 GetAuthorisedValueDesc
1460
1461 my $subfieldvalue =get_authorised_value_desc(
1462     $tag, $subf[$i][0],$subf[$i][1], '', $taglib);
1463
1464 =cut
1465
1466 sub GetAuthorisedValueDesc {
1467     my ( $tag, $subfield, $value, $framework, $tagslib ) = @_;
1468     my $dbh = C4::Context->dbh;
1469
1470     #---- branch
1471     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1472         return C4::Branch::GetBranchName($value);
1473     }
1474
1475     #---- itemtypes
1476     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1477         return getitemtypeinfo($value);
1478     }
1479
1480     #---- "true" authorized value
1481     my $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1482
1483     if ( $category ne "" ) {
1484         my $sth =
1485           $dbh->prepare(
1486             "select lib from authorised_values where category = ? and authorised_value = ?"
1487           );
1488         $sth->execute( $category, $value );
1489         my $data = $sth->fetchrow_hashref;
1490         return $data->{'lib'};
1491     }
1492     else {
1493         return $value;    # if nothing is found return the original value
1494     }
1495 }
1496
1497 =head2 MARCgetitem
1498
1499 Returns MARC::Record of the item passed in parameter.
1500
1501 =cut
1502
1503 sub MARCgetitem {
1504     my ( $biblionumber, $itemnumber ) = @_;
1505     my $dbh = C4::Context->dbh;
1506     my $newrecord = MARC::Record->new();
1507     my $marcflavour = C4::Context->preference('marcflavour');
1508
1509     my $marcxml = GetXmlBiblio($biblionumber);
1510     my $record = MARC::Record->new();
1511 #     warn "marcxml :$marcxml";
1512     $record = MARC::Record::new_from_xml( $marcxml, "utf8", $marcflavour );
1513 #     warn "record :".$record->as_formatted;
1514     # now, find where the itemnumber is stored & extract only the item
1515     my ( $itemnumberfield, $itemnumbersubfield ) =
1516       MARCfind_marc_from_kohafield( $dbh, 'items.itemnumber', '' );
1517     my @fields = $record->field($itemnumberfield);
1518     foreach my $field (@fields) {
1519         if ( $field->subfield($itemnumbersubfield) eq $itemnumber ) {
1520             $newrecord->insert_fields_ordered($field);
1521         }
1522     }
1523     return $newrecord;
1524 }
1525
1526 =head2 GetMarcNotes
1527
1528 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1529
1530 get a single record in piggyback mode from Zebra and return it in the requested record syntax
1531
1532 default record syntax is XML
1533
1534 =cut
1535
1536 sub GetMarcNotes {
1537     my ( $record, $marcflavour ) = @_;
1538     my $scope;
1539     if ( $marcflavour eq "MARC21" ) {
1540         $scope = '5..';
1541     }
1542     else {    # assume unimarc if not marc21
1543         $scope = '3..';
1544     }
1545     my @marcnotes;
1546     my $note = "";
1547     my $tag  = "";
1548     my $marcnote;
1549     foreach my $field ( $record->field($scope) ) {
1550         my $value = $field->as_string();
1551         if ( $note ne "" ) {
1552             $marcnote = { marcnote => $note, };
1553             push @marcnotes, $marcnote;
1554             $note = $value;
1555         }
1556         if ( $note ne $value ) {
1557             $note = $note . " " . $value;
1558         }
1559     }
1560
1561     if ( $note ) {
1562         $marcnote = { marcnote => $note };
1563         push @marcnotes, $marcnote;    #load last tag into array
1564     }
1565     return \@marcnotes;
1566 }    # end GetMarcNotes
1567
1568 =head2 GetMarcSubjects
1569
1570 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1571
1572 =cut
1573
1574 sub GetMarcSubjects {
1575     my ( $record, $marcflavour ) = @_;
1576     my ( $mintag, $maxtag );
1577     if ( $marcflavour eq "MARC21" ) {
1578         $mintag = "600";
1579         $maxtag = "699";
1580     }
1581     else {    # assume unimarc if not marc21
1582         $mintag = "600";
1583         $maxtag = "611";
1584     }
1585
1586     my @marcsubjcts;
1587
1588     foreach my $field ( $record->fields ) {
1589         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1590         my @subfields = $field->subfields();
1591         my $link;
1592         my $label = "su:";
1593         my $flag = 0;
1594         for my $subject_subfield ( @subfields ) {
1595             my $code = $subject_subfield->[0];
1596             $label .= $subject_subfield->[1] . " and su-to:" unless ( $code == 9 );
1597             if ( $code == 9 ) {
1598                 $link = "Koha-Auth-Number:".$subject_subfield->[1];
1599                 $flag = 1;
1600             }
1601             elsif ( ! $flag ) {
1602                 $link = $label;
1603                 $link =~ s/ and\ssu-to:$//;
1604             }
1605         }
1606         $label =~ s/su/ /g;
1607         $label =~ s/://g;
1608         $label =~ s/-to//g;
1609         $label =~ s/and//g;
1610         push @marcsubjcts,
1611           {
1612             label => $label,
1613             link  => $link
1614           }
1615     }
1616     return \@marcsubjcts;
1617 }    #end GetMarcSubjects
1618
1619 =head2 GetMarcAuthors
1620
1621 authors = GetMarcAuthors($record,$marcflavour);
1622
1623 =cut
1624
1625 sub GetMarcAuthors {
1626     my ( $record, $marcflavour ) = @_;
1627     my ( $mintag, $maxtag );
1628     if ( $marcflavour eq "MARC21" ) {
1629         $mintag = "100";
1630         $maxtag = "111";
1631     }
1632     else {    # assume unimarc if not marc21
1633         $mintag = "701";
1634         $maxtag = "712";
1635     }
1636
1637     my @marcauthors;
1638
1639     foreach my $field ( $record->fields ) {
1640         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1641         my %hash;
1642         my @subfields = $field->subfields();
1643         my $count_auth = 0;
1644         my $and ;
1645         for my $authors_subfield (@subfields) {
1646                 if ($count_auth ne '0'){
1647                 $and = " and au:";
1648                 }
1649             $count_auth++;
1650             my $subfieldcode     = $authors_subfield->[0];
1651             my $value            = $authors_subfield->[1];
1652             $hash{'tag'}         = $field->tag;
1653             $hash{value}        .= $value . " " if ($subfieldcode != 9) ;
1654             $hash{link}        .= $value if ($subfieldcode eq 9);
1655         }
1656         push @marcauthors, \%hash;
1657     }
1658     return \@marcauthors;
1659 }
1660
1661 =head2 GetMarcSeries
1662
1663 $marcseriessarray = GetMarcSeries($record,$marcflavour);
1664
1665 =cut
1666
1667 sub GetMarcSeries {
1668     my ($record, $marcflavour) = @_;
1669     my ($mintag, $maxtag);
1670     if ($marcflavour eq "MARC21") {
1671         $mintag = "440";
1672         $maxtag = "490";
1673     } else {           # assume unimarc if not marc21
1674         $mintag = "600";
1675         $maxtag = "619";
1676     }
1677
1678     my @marcseries;
1679     my $subjct = "";
1680     my $subfield = "";
1681     my $marcsubjct;
1682
1683     foreach my $field ($record->field('440'), $record->field('490')) {
1684         my @subfields_loop;
1685         #my $value = $field->subfield('a');
1686         #$marcsubjct = {MARCSUBJCT => $value,};
1687         my @subfields = $field->subfields();
1688         #warn "subfields:".join " ", @$subfields;
1689         my $counter = 0;
1690         my @link_loop;
1691         for my $series_subfield (@subfields) {
1692                         my $volume_number;
1693                         undef $volume_number;
1694                         # see if this is an instance of a volume
1695                         if ($series_subfield->[0] eq 'v') {
1696                                 $volume_number=1;
1697                         }
1698
1699             my $code = $series_subfield->[0];
1700             my $value = $series_subfield->[1];
1701             my $linkvalue = $value;
1702             $linkvalue =~ s/(\(|\))//g;
1703             my $operator = " and " unless $counter==0;
1704             push @link_loop, {link => $linkvalue, operator => $operator };
1705             my $separator = C4::Context->preference("authoritysep") unless $counter==0;
1706                         if ($volume_number) {
1707                         push @subfields_loop, {volumenum => $value};
1708                         }
1709                         else {
1710             push @subfields_loop, {code => $code, value => $value, link_loop => \@link_loop, separator => $separator, volumenum => $volume_number};
1711                         }
1712             $counter++;
1713         }
1714         push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1715         #$marcsubjct = {MARCSUBJCT => $field->as_string(),};
1716         #push @marcsubjcts, $marcsubjct;
1717         #$subjct = $value;
1718
1719     }
1720     my $marcseriessarray=\@marcseries;
1721     return $marcseriessarray;
1722 }  #end getMARCseriess
1723
1724 =head2 MARCmodbiblio
1725
1726 MARCmodbibio($dbh,$biblionumber,$record,$frameworkcode,1);
1727
1728 Modify a biblio record with the option to save items data
1729
1730 =cut
1731
1732 sub MARCmodbiblio {
1733     my ( $dbh, $biblionumber, $record, $frameworkcode, $keep_items ) = @_;
1734
1735     # delete original record but save the items
1736     my $newrec = &MARCdelbiblio( $biblionumber, $keep_items );
1737
1738     # recreate it and add the new fields
1739     my @fields = $record->fields();
1740     foreach my $field (@fields) {
1741
1742         # this requires a more recent version of MARC::Record
1743         # but ensures the fields are in order
1744         $newrec->insert_fields_ordered($field);
1745     }
1746
1747     # give back our old leader
1748     $newrec->leader( $record->leader() );
1749
1750     # add the record back with the items info preserved
1751     &MARCaddbiblio( $newrec, $biblionumber, $frameworkcode );
1752 }
1753
1754 =head2 MARCdelbiblio
1755
1756 &MARCdelbiblio( $biblionumber, $keep_items )
1757
1758 if the keep_item is set to 1, then all items are preserved.
1759 This flag is set when the delbiblio is called by modbiblio
1760 due to a too complex structure of MARC (repeatable fields and subfields),
1761 the best solution for a modif is to delete / recreate the record.
1762
1763 1st of all, copy the MARC::Record to deletedbiblio table => if a true deletion, MARC data will be kept.
1764 if deletion called before MARCmodbiblio => won't do anything, as the oldbiblionumber doesn't
1765 exist in deletedbiblio table
1766
1767 =cut
1768
1769 sub MARCdelbiblio {
1770     my ( $biblionumber, $keep_items ) = @_;
1771     my $dbh = C4::Context->dbh;
1772
1773     my $record          = GetMarcBiblio($biblionumber);
1774     my $oldbiblionumber = $biblionumber;
1775     my $copy2deleted    =
1776       $dbh->prepare("update deletedbiblio set marc=? where biblionumber=?");
1777     $copy2deleted->execute( $record->as_usmarc(), $oldbiblionumber );
1778     my @fields = $record->fields();
1779
1780     # now, delete in MARC tables.
1781     if ( $keep_items eq 1 ) {
1782         #search item field code
1783         my $sth =
1784           $dbh->prepare(
1785 "select tagfield from marc_subfield_structure where kohafield like 'items.%'"
1786           );
1787         $sth->execute;
1788         my $itemtag = $sth->fetchrow_hashref->{tagfield};
1789
1790         foreach my $field (@fields) {
1791
1792             if ( $field->tag() ne $itemtag ) {
1793                 $record->delete_field($field);
1794             }    #if
1795         }    #foreach
1796     }
1797     else {
1798         foreach my $field (@fields) {
1799
1800             $record->delete_field($field);
1801         }    #foreach
1802     }
1803     return $record;
1804 }
1805
1806 =head2 MARCdelitem
1807
1808 MARCdelitem( $biblionumber, $itemnumber )
1809
1810 delete the item field from the MARC record for the itemnumber specified
1811
1812 =cut
1813
1814 sub MARCdelitem {
1815     my ( $biblionumber, $itemnumber ) = @_;
1816     my $dbh = C4::Context->dbh;
1817
1818     # get the MARC record
1819     my $record = GetMarcBiblio($biblionumber);
1820
1821     # backup the record
1822     my $copy2deleted =
1823       $dbh->prepare("UPDATE deleteditems SET marc=? WHERE itemnumber=?");
1824     $copy2deleted->execute( $record->as_usmarc(), $itemnumber );
1825
1826     #search item field code
1827     my $sth =
1828       $dbh->prepare(
1829 "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE kohafield LIKE 'items.itemnumber'"
1830       );
1831     $sth->execute;
1832     my ( $itemtag, $itemsubfield ) = $sth->fetchrow;
1833     my @fields = $record->field($itemtag);
1834     # delete the item specified
1835     foreach my $field (@fields) {
1836         if ( $field->subfield($itemsubfield) eq $itemnumber ) {
1837             $record->delete_field($field);
1838         }
1839     }
1840     return $record;
1841 }
1842
1843 =head2 MARCmoditemonefield
1844
1845 &MARCmoditemonefield( $biblionumber, $itemnumber, $itemfield, $newvalue )
1846
1847 =cut
1848
1849 sub MARCmoditemonefield {
1850     my ( $biblionumber, $itemnumber, $itemfield, $newvalue ) = @_;
1851     my $dbh = C4::Context->dbh;
1852     if ( !defined $newvalue ) {
1853         $newvalue = "";
1854     }
1855
1856     my $record = MARCgetitem( $biblionumber, $itemnumber );
1857
1858     my $sth =
1859       $dbh->prepare(
1860 "select tagfield,tagsubfield from marc_subfield_structure where kohafield=?"
1861       );
1862     my $tagfield;
1863     my $tagsubfield;
1864     $sth->execute($itemfield);
1865     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
1866         my $tag = $record->field($tagfield);
1867         if ($tag) {
1868             my $tagsubs = $record->field($tagfield)->subfield($tagsubfield);
1869             $tag->update( $tagsubfield => $newvalue );
1870             $record->delete_field($tag);
1871             $record->insert_fields_ordered($tag);
1872             &MARCmoditem( $record, $biblionumber, $itemnumber, 0 );
1873         }
1874     }
1875 }
1876
1877 =head2 MARCmoditem
1878
1879 &MARCmoditem( $record, $biblionumber, $itemnumber, $frameworkcode, $delete )
1880
1881 =cut
1882
1883 sub MARCmoditem {
1884     my ( $record, $biblionumber, $itemnumber, $frameworkcode, $delete ) = @_;
1885     my $dbh = C4::Context->dbh;
1886
1887     # delete this item from MARC
1888     my $newrec = &MARCdelitem( $biblionumber, $itemnumber );
1889
1890     # 2nd recreate it
1891     my @fields = $record->fields();
1892     ###NEU specific add cataloguers cardnumber as well
1893     my $cardtag = C4::Context->preference('itemcataloguersubfield');
1894
1895     foreach my $field (@fields) {
1896         if ($cardtag) {
1897             my $me = C4::Context->userenv;
1898             my $cataloguer = $me->{'cardnumber'} if ($me);
1899             $field->update( $cardtag => $cataloguer ) if ($me);
1900         }
1901         $newrec->append_fields($field);
1902     }
1903     &MARCaddbiblio( $newrec, $biblionumber, $frameworkcode );
1904 }
1905
1906 =head2 MARCfind_frameworkcode
1907
1908 $frameworkcode = MARCfind_frameworkcode( $biblionumber )
1909
1910 =cut
1911
1912 sub MARCfind_frameworkcode {
1913     my ( $biblionumber ) = @_;
1914     my $dbh = C4::Context->dbh;
1915     my $sth =
1916       $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
1917     $sth->execute($biblionumber);
1918     my ($frameworkcode) = $sth->fetchrow;
1919     return $frameworkcode;
1920 }
1921
1922 =head2 Koha2Marc
1923
1924 $record = Koha2Marc( $hash )
1925
1926 This function builds partial MARC::Record from a hash
1927
1928 Hash entries can be from biblio or biblioitems.
1929
1930 This function is called in acquisition module, to create a basic catalogue entry from user entry
1931
1932 =cut
1933
1934 sub Koha2Marc {
1935
1936     my ( $hash ) = @_;
1937     my $dbh = C4::Context->dbh;
1938     my $sth =
1939     $dbh->prepare(
1940         "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
1941     );
1942     my $record = MARC::Record->new();
1943     foreach (keys %{$hash}) {
1944         &MARCkoha2marcOnefield( $sth, $record, $_,
1945             $hash->{$_}, '' );
1946         }
1947     return $record;
1948 }
1949
1950 =head2 MARCkoha2marcBiblio
1951
1952 $record = MARCkoha2marcBiblio( $biblionumber, $biblioitemnumber )
1953
1954 this function builds partial MARC::Record from the old koha-DB fields
1955
1956 =cut
1957
1958 sub MARCkoha2marcBiblio {
1959
1960     my ( $biblionumber, $biblioitemnumber ) = @_;
1961     my $dbh = C4::Context->dbh;
1962     my $sth =
1963       $dbh->prepare(
1964 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
1965       );
1966     my $record = MARC::Record->new();
1967
1968     #--- if biblionumber, then retrieve old-style koha data
1969     if ( $biblionumber > 0 ) {
1970         my $sth2 = $dbh->prepare(
1971 "select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp
1972         from biblio where biblionumber=?"
1973         );
1974         $sth2->execute($biblionumber);
1975         my $row = $sth2->fetchrow_hashref;
1976         my $code;
1977         foreach $code ( keys %$row ) {
1978             if ( $row->{$code} ) {
1979                 &MARCkoha2marcOnefield( $sth, $record, "biblio." . $code,
1980                     $row->{$code}, '' );
1981             }
1982         }
1983     }
1984
1985     #--- if biblioitem, then retrieve old-style koha data
1986     if ( $biblioitemnumber > 0 ) {
1987         my $sth2 = $dbh->prepare(
1988             " SELECT biblioitemnumber,biblionumber,volume,number,classification,
1989                         itemtype,url,isbn,issn,dewey,subclass,publicationyear,publishercode,
1990                         volumedate,volumeddesc,timestamp,illus,pages,notes AS bnotes,size,place
1991                     FROM biblioitems
1992                     WHERE biblioitemnumber=?
1993                     "
1994         );
1995         $sth2->execute($biblioitemnumber);
1996         my $row = $sth2->fetchrow_hashref;
1997         my $code;
1998         foreach $code ( keys %$row ) {
1999             if ( $row->{$code} ) {
2000                 &MARCkoha2marcOnefield( $sth, $record, "biblioitems." . $code,
2001                     $row->{$code}, '' );
2002             }
2003         }
2004     }
2005     return $record;
2006 }
2007
2008 =head2 MARCkoha2marcItem
2009
2010 $record = MARCkoha2marcItem( $dbh, $biblionumber, $itemnumber );
2011
2012 =cut
2013
2014 sub MARCkoha2marcItem {
2015
2016     # this function builds partial MARC::Record from the old koha-DB fields
2017     my ( $dbh, $biblionumber, $itemnumber ) = @_;
2018
2019     #    my $dbh=&C4Connect;
2020     my $sth =
2021       $dbh->prepare(
2022 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
2023       );
2024     my $record = MARC::Record->new();
2025
2026     #--- if item, then retrieve old-style koha data
2027     if ( $itemnumber > 0 ) {
2028
2029         #    print STDERR "prepare $biblionumber,$itemnumber\n";
2030         my $sth2 = $dbh->prepare(
2031 "SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned,
2032                         booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
2033                         datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,itemcallnumber,issues,renewals,
2034                     reserves,restricted,binding,itemnotes,holdingbranch,timestamp,onloan,Cutterextra
2035                     FROM items
2036                     WHERE itemnumber=?"
2037         );
2038         $sth2->execute($itemnumber);
2039         my $row = $sth2->fetchrow_hashref;
2040         my $code;
2041         foreach $code ( keys %$row ) {
2042             if ( $row->{$code} ) {
2043                 &MARCkoha2marcOnefield( $sth, $record, "items." . $code,
2044                     $row->{$code}, '' );
2045             }
2046         }
2047     }
2048     return $record;
2049 }
2050
2051 =head2 MARCkoha2marcOnefield
2052
2053 $record = MARCkoha2marcOnefield( $sth, $record, $kohafieldname, $value, $frameworkcode );
2054
2055 =cut
2056
2057 sub MARCkoha2marcOnefield {
2058     my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_;
2059     $frameworkcode='' unless $frameworkcode;
2060     my $tagfield;
2061     my $tagsubfield;
2062
2063     if ( !defined $sth ) {
2064         my $dbh = C4::Context->dbh;
2065         $sth =
2066           $dbh->prepare(
2067 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
2068           );
2069     }
2070     $sth->execute( $frameworkcode, $kohafieldname );
2071     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
2072         my $tag = $record->field($tagfield);
2073         if ($tag) {
2074             $tag->update( $tagsubfield => $value );
2075             $record->delete_field($tag);
2076             $record->insert_fields_ordered($tag);
2077         }
2078         else {
2079             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
2080         }
2081     }
2082     return $record;
2083 }
2084
2085 =head2 MARChtml2xml
2086
2087 $xml = MARChtml2xml( $tags, $subfields, $values, $indicator, $ind_tag )
2088
2089 =cut
2090
2091 sub MARChtml2xml {
2092     my ( $tags, $subfields, $values, $indicator, $ind_tag ) = @_;
2093     my $xml = MARC::File::XML::header('UTF-8');
2094     if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
2095         MARC::File::XML->default_record_format('UNIMARC');
2096         use POSIX qw(strftime);
2097         my $string = strftime( "%Y%m%d", localtime(time) );
2098         $string = sprintf( "%-*s", 35, $string );
2099         substr( $string, 22, 6, "frey50" );
2100         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2101         $xml .= "<subfield code=\"a\">$string</subfield>\n";
2102         $xml .= "</datafield>\n";
2103     }
2104     my $prevvalue;
2105     my $prevtag = -1;
2106     my $first   = 1;
2107     my $j       = -1;
2108     for ( my $i = 0 ; $i <= @$tags ; $i++ ) {
2109         @$values[$i] =~ s/&/&amp;/g;
2110         @$values[$i] =~ s/</&lt;/g;
2111         @$values[$i] =~ s/>/&gt;/g;
2112         @$values[$i] =~ s/"/&quot;/g;
2113         @$values[$i] =~ s/'/&apos;/g;
2114         if ( !utf8::is_utf8( @$values[$i] ) ) {
2115             utf8::decode( @$values[$i] );
2116         }
2117         if ( ( @$tags[$i] ne $prevtag ) ) {
2118             $j++ unless ( @$tags[$i] eq "" );
2119             if ( !$first ) {
2120                 $xml .= "</datafield>\n";
2121                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
2122                     && ( @$values[$i] ne "" ) )
2123                 {
2124                     my $ind1 = substr( @$indicator[$j], 0, 1 );
2125                     my $ind2;
2126                     if ( @$indicator[$j] ) {
2127                         $ind2 = substr( @$indicator[$j], 1, 1 );
2128                     }
2129                     else {
2130                         warn "Indicator in @$tags[$i] is empty";
2131                         $ind2 = " ";
2132                     }
2133                     $xml .=
2134 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2135                     $xml .=
2136 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2137                     $first = 0;
2138                 }
2139                 else {
2140                     $first = 1;
2141                 }
2142             }
2143             else {
2144                 if ( @$values[$i] ne "" ) {
2145
2146                     # leader
2147                     if ( @$tags[$i] eq "000" ) {
2148                         $xml .= "<leader>@$values[$i]</leader>\n";
2149                         $first = 1;
2150
2151                         # rest of the fixed fields
2152                     }
2153                     elsif ( @$tags[$i] < 10 ) {
2154                         $xml .=
2155 "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2156                         $first = 1;
2157                     }
2158                     else {
2159                         my $ind1 = substr( @$indicator[$j], 0, 1 );
2160                         my $ind2 = substr( @$indicator[$j], 1, 1 );
2161                         $xml .=
2162 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2163                         $xml .=
2164 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2165                         $first = 0;
2166                     }
2167                 }
2168             }
2169         }
2170         else {    # @$tags[$i] eq $prevtag
2171             if ( @$values[$i] eq "" ) {
2172             }
2173             else {
2174                 if ($first) {
2175                     my $ind1 = substr( @$indicator[$j], 0, 1 );
2176                     my $ind2 = substr( @$indicator[$j], 1, 1 );
2177                     $xml .=
2178 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2179                     $first = 0;
2180                 }
2181                 $xml .=
2182 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2183             }
2184         }
2185         $prevtag = @$tags[$i];
2186     }
2187     $xml .= MARC::File::XML::footer();
2188
2189     return $xml;
2190 }
2191
2192 =head2 MARChtml2marc
2193
2194 $record = MARChtml2marc( $dbh, $rtags, $rsubfields, $rvalues, %indicators )
2195
2196 =cut
2197
2198 sub MARChtml2marc {
2199     my ( $dbh, $rtags, $rsubfields, $rvalues, %indicators ) = @_;
2200     my $prevtag = -1;
2201     my $record  = MARC::Record->new();
2202
2203     #     my %subfieldlist=();
2204     my $prevvalue;    # if tag <10
2205     my $field;        # if tag >=10
2206     for ( my $i = 0 ; $i < @$rtags ; $i++ ) {
2207         next unless @$rvalues[$i];
2208
2209  # rebuild MARC::Record
2210  #             warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
2211         if ( @$rtags[$i] ne $prevtag ) {
2212             if ( $prevtag < 10 ) {
2213                 if ($prevvalue) {
2214
2215                     if ( $prevtag ne '000' ) {
2216                         $record->insert_fields_ordered(
2217                             ( sprintf "%03s", $prevtag ), $prevvalue );
2218                     }
2219                     else {
2220
2221                         $record->leader($prevvalue);
2222
2223                     }
2224                 }
2225             }
2226             else {
2227                 if ($field) {
2228                     $record->insert_fields_ordered($field);
2229                 }
2230             }
2231             $indicators{ @$rtags[$i] } .= '  ';
2232             if ( @$rtags[$i] < 10 ) {
2233                 $prevvalue = @$rvalues[$i];
2234                 undef $field;
2235             }
2236             else {
2237                 undef $prevvalue;
2238                 $field = MARC::Field->new(
2239                     ( sprintf "%03s", @$rtags[$i] ),
2240                     substr( $indicators{ @$rtags[$i] }, 0, 1 ),
2241                     substr( $indicators{ @$rtags[$i] }, 1, 1 ),
2242                     @$rsubfields[$i] => @$rvalues[$i]
2243                 );
2244             }
2245             $prevtag = @$rtags[$i];
2246         }
2247         else {
2248             if ( @$rtags[$i] < 10 ) {
2249                 $prevvalue = @$rvalues[$i];
2250             }
2251             else {
2252                 if ( length( @$rvalues[$i] ) > 0 ) {
2253                     $field->add_subfields( @$rsubfields[$i] => @$rvalues[$i] );
2254                 }
2255             }
2256             $prevtag = @$rtags[$i];
2257         }
2258     }
2259
2260     # the last has not been included inside the loop... do it now !
2261     $record->insert_fields_ordered($field) if $field;
2262
2263     #     warn "HTML2MARC=".$record->as_formatted;
2264     $record->encoding('UTF-8');
2265
2266     #    $record->MARC::File::USMARC::update_leader();
2267     return $record;
2268 }
2269
2270 =head2 MARCmarc2koha
2271
2272 $result = MARCmarc2koha( $dbh, $record, $frameworkcode )
2273
2274 =cut
2275
2276 sub MARCmarc2koha {
2277     my ( $dbh, $record, $frameworkcode ) = @_;
2278     my $sth =
2279       $dbh->prepare(
2280 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
2281       );
2282     my $result;
2283     my $sth2 = $dbh->prepare("SHOW COLUMNS from biblio");
2284     $sth2->execute;
2285     my $field;
2286     while ( ($field) = $sth2->fetchrow ) {
2287         $result =
2288           &MARCmarc2kohaOneField( "biblio", $field, $record, $result,
2289             $frameworkcode );
2290     }
2291     $sth2 = $dbh->prepare("SHOW COLUMNS from biblioitems");
2292     $sth2->execute;
2293     while ( ($field) = $sth2->fetchrow ) {
2294         if ( $field eq 'notes' ) { $field = 'bnotes'; }
2295         $result =
2296           &MARCmarc2kohaOneField( "biblioitems", $field, $record, $result,
2297             $frameworkcode );
2298     }
2299     $sth2 = $dbh->prepare("SHOW COLUMNS from items");
2300     $sth2->execute;
2301     while ( ($field) = $sth2->fetchrow ) {
2302         $result =
2303           &MARCmarc2kohaOneField( "items", $field, $record, $result,
2304             $frameworkcode );
2305     }
2306
2307     #
2308     # modify copyrightdate to keep only the 1st year found
2309     my $temp = $result->{'copyrightdate'};
2310     $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2311     if ( $1 > 0 ) {
2312         $result->{'copyrightdate'} = $1;
2313     }
2314     else {                      # if no cYYYY, get the 1st date.
2315         $temp =~ m/(\d\d\d\d)/;
2316         $result->{'copyrightdate'} = $1;
2317     }
2318
2319     # modify publicationyear to keep only the 1st year found
2320     $temp = $result->{'publicationyear'};
2321     $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2322     if ( $1 > 0 ) {
2323         $result->{'publicationyear'} = $1;
2324     }
2325     else {                      # if no cYYYY, get the 1st date.
2326         $temp =~ m/(\d\d\d\d)/;
2327         $result->{'publicationyear'} = $1;
2328     }
2329     return $result;
2330 }
2331
2332 =head2 MARCmarc2kohaOneField
2333
2334 $result = MARCmarc2kohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2335
2336 =cut
2337
2338 sub MARCmarc2kohaOneField {
2339
2340 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
2341     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2342
2343     my $res = "";
2344     my ( $tagfield, $subfield ) =
2345       MARCfind_marc_from_kohafield( "", $kohatable . "." . $kohafield,
2346         $frameworkcode );
2347     foreach my $field ( $record->field($tagfield) ) {
2348         if ( $field->tag() < 10 ) {
2349             if ( $result->{$kohafield} ) {
2350                 $result->{$kohafield} .= " | " . $field->data();
2351             }
2352             else {
2353                 $result->{$kohafield} = $field->data();
2354             }
2355         }
2356         else {
2357             if ( $field->subfields ) {
2358                 my @subfields = $field->subfields();
2359                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2360                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2361                         if ( $result->{$kohafield} ) {
2362                             $result->{$kohafield} .=
2363                               " | " . $subfields[$subfieldcount][1];
2364                         }
2365                         else {
2366                             $result->{$kohafield} =
2367                               $subfields[$subfieldcount][1];
2368                         }
2369                     }
2370                 }
2371             }
2372         }
2373     }
2374     return $result;
2375 }
2376
2377 =head2 MARCitemchange
2378
2379 &MARCitemchange( $record, $itemfield, $newvalue )
2380
2381 =cut
2382
2383 sub MARCitemchange {
2384     my ( $record, $itemfield, $newvalue ) = @_;
2385     my $dbh = C4::Context->dbh;
2386
2387     my ( $tagfield, $tagsubfield ) =
2388       MARCfind_marc_from_kohafield( $dbh, $itemfield, "" );
2389     if ( ($tagfield) && ($tagsubfield) ) {
2390         my $tag = $record->field($tagfield);
2391         if ($tag) {
2392             $tag->update( $tagsubfield => $newvalue );
2393             $record->delete_field($tag);
2394             $record->insert_fields_ordered($tag);
2395         }
2396     }
2397 }
2398
2399 =head1 INTERNAL FUNCTIONS
2400
2401 =head2 _koha_add_biblio
2402
2403 _koha_add_biblio($dbh,$biblioitem);
2404
2405 Internal function to add a biblio ($biblio is a hash with the values)
2406
2407 =cut
2408
2409 sub _koha_add_biblio {
2410     my ( $dbh, $biblio, $frameworkcode ) = @_;
2411     my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
2412     $sth->execute;
2413     my $data         = $sth->fetchrow_arrayref;
2414     my $biblionumber = $$data[0] + 1;
2415     my $series       = 0;
2416
2417     if ( $biblio->{'seriestitle'} ) { $series = 1 }
2418     $sth->finish;
2419     $sth = $dbh->prepare(
2420         "INSERT INTO biblio
2421     SET biblionumber  = ?, title = ?, author = ?, copyrightdate = ?, serial = ?, seriestitle = ?, notes = ?, abstract = ?, unititle = ?, frameworkcode = ? "
2422     );
2423     $sth->execute(
2424         $biblionumber,         $biblio->{'title'},
2425         $biblio->{'author'},   $biblio->{'copyrightdate'},
2426         $biblio->{'serial'},   $biblio->{'seriestitle'},
2427         $biblio->{'notes'},    $biblio->{'abstract'},
2428         $biblio->{'unititle'}, $frameworkcode
2429     );
2430
2431     $sth->finish;
2432     return ($biblionumber);
2433 }
2434
2435 =head2 _find_value
2436
2437     ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
2438
2439 Find the given $subfield in the given $tag in the given
2440 MARC::Record $record.  If the subfield is found, returns
2441 the (indicators, value) pair; otherwise, (undef, undef) is
2442 returned.
2443
2444 PROPOSITION :
2445 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
2446 I suggest we export it from this module.
2447
2448 =cut
2449
2450 sub _find_value {
2451     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
2452     my @result;
2453     my $indicator;
2454     if ( $tagfield < 10 ) {
2455         if ( $record->field($tagfield) ) {
2456             push @result, $record->field($tagfield)->data();
2457         }
2458         else {
2459             push @result, "";
2460         }
2461     }
2462     else {
2463         foreach my $field ( $record->field($tagfield) ) {
2464             my @subfields = $field->subfields();
2465             foreach my $subfield (@subfields) {
2466                 if ( @$subfield[0] eq $insubfield ) {
2467                     push @result, @$subfield[1];
2468                     $indicator = $field->indicator(1) . $field->indicator(2);
2469                 }
2470             }
2471         }
2472     }
2473     return ( $indicator, @result );
2474 }
2475
2476 =head2 _koha_modify_biblio
2477
2478 Internal function for updating the biblio table
2479
2480 =cut
2481
2482 sub _koha_modify_biblio {
2483     my ( $dbh, $biblio ) = @_;
2484
2485 # FIXME: this code could be made more portable by not hard-coding the values that are supposed to be in biblio table
2486     my $sth =
2487       $dbh->prepare(
2488 "Update biblio set title = ?, author = ?, abstract = ?, copyrightdate = ?, seriestitle = ?, serial = ?, unititle = ?, notes = ? where biblionumber = ?"
2489       );
2490     $sth->execute(
2491         $biblio->{'title'},       $biblio->{'author'},
2492         $biblio->{'abstract'},    $biblio->{'copyrightdate'},
2493         $biblio->{'seriestitle'}, $biblio->{'serial'},
2494         $biblio->{'unititle'},    $biblio->{'notes'},
2495         $biblio->{'biblionumber'}
2496     );
2497     $sth->finish;
2498     return ( $biblio->{'biblionumber'} );
2499 }
2500
2501 =head2 _koha_modify_biblioitem
2502
2503 _koha_modify_biblioitem( $dbh, $biblioitem );
2504
2505 =cut
2506
2507 sub _koha_modify_biblioitem {
2508     my ( $dbh, $biblioitem ) = @_;
2509     my $query;
2510 ##Recalculate LC in case it changed --TG
2511
2512     $biblioitem->{'itemtype'}      = $dbh->quote( $biblioitem->{'itemtype'} );
2513     $biblioitem->{'url'}           = $dbh->quote( $biblioitem->{'url'} );
2514     $biblioitem->{'isbn'}          = $dbh->quote( $biblioitem->{'isbn'} );
2515     $biblioitem->{'issn'}          = $dbh->quote( $biblioitem->{'issn'} );
2516     $biblioitem->{'publishercode'} =
2517       $dbh->quote( $biblioitem->{'publishercode'} );
2518     $biblioitem->{'publicationyear'} =
2519       $dbh->quote( $biblioitem->{'publicationyear'} );
2520     $biblioitem->{'classification'} =
2521       $dbh->quote( $biblioitem->{'classification'} );
2522     $biblioitem->{'dewey'}        = $dbh->quote( $biblioitem->{'dewey'} );
2523     $biblioitem->{'subclass'}     = $dbh->quote( $biblioitem->{'subclass'} );
2524     $biblioitem->{'illus'}        = $dbh->quote( $biblioitem->{'illus'} );
2525     $biblioitem->{'pages'}        = $dbh->quote( $biblioitem->{'pages'} );
2526     $biblioitem->{'volumeddesc'}  = $dbh->quote( $biblioitem->{'volumeddesc'} );
2527     $biblioitem->{'bnotes'}       = $dbh->quote( $biblioitem->{'bnotes'} );
2528     $biblioitem->{'size'}         = $dbh->quote( $biblioitem->{'size'} );
2529     $biblioitem->{'place'}        = $dbh->quote( $biblioitem->{'place'} );
2530     $biblioitem->{'ccode'}        = $dbh->quote( $biblioitem->{'ccode'} );
2531     $biblioitem->{'biblionumber'} =
2532       $dbh->quote( $biblioitem->{'biblionumber'} );
2533
2534     $query = "Update biblioitems set
2535         itemtype        = $biblioitem->{'itemtype'},
2536         url             = $biblioitem->{'url'},
2537         isbn            = $biblioitem->{'isbn'},
2538         issn            = $biblioitem->{'issn'},
2539         publishercode   = $biblioitem->{'publishercode'},
2540         publicationyear = $biblioitem->{'publicationyear'},
2541         classification  = $biblioitem->{'classification'},
2542         dewey           = $biblioitem->{'dewey'},
2543         subclass        = $biblioitem->{'subclass'},
2544         illus           = $biblioitem->{'illus'},
2545         pages           = $biblioitem->{'pages'},
2546         volumeddesc     = $biblioitem->{'volumeddesc'},
2547         notes           = $biblioitem->{'bnotes'},
2548         size            = $biblioitem->{'size'},
2549         place           = $biblioitem->{'place'},
2550         ccode           = $biblioitem->{'ccode'}
2551         where biblionumber = $biblioitem->{'biblionumber'}";
2552
2553     $dbh->do($query);
2554     if ( $dbh->errstr ) {
2555         warn "$query";
2556     }
2557 }
2558
2559 =head2 _koha_modify_note
2560
2561 _koha_modify_note( $dbh, $bibitemnum, $note );
2562
2563 =cut
2564
2565 sub _koha_modify_note {
2566     my ( $dbh, $bibitemnum, $note ) = @_;
2567
2568     #  my $dbh=C4Connect;
2569     my $query = "update biblioitems set notes='$note' where
2570   biblioitemnumber='$bibitemnum'";
2571     my $sth = $dbh->prepare($query);
2572     $sth->execute;
2573     $sth->finish;
2574 }
2575
2576 =head2 _koha_add_biblioitem
2577
2578 _koha_add_biblioitem( $dbh, $biblioitem );
2579
2580 Internal function to add a biblioitem
2581
2582 =cut
2583
2584 sub _koha_add_biblioitem {
2585     my ( $dbh, $biblioitem ) = @_;
2586
2587     #  my $dbh   = C4Connect;
2588     my $sth = $dbh->prepare("SELECT max(biblioitemnumber) FROM biblioitems");
2589     my $data;
2590     my $bibitemnum;
2591
2592     $sth->execute;
2593     $data       = $sth->fetchrow_arrayref;
2594     $bibitemnum = $$data[0] + 1;
2595
2596     $sth->finish;
2597
2598     $sth = $dbh->prepare(
2599         "INSERT INTO biblioitems SET
2600             biblioitemnumber = ?, biblionumber    = ?,
2601             volume           = ?, number          = ?,
2602             classification   = ?, itemtype        = ?,
2603             url              = ?, isbn            = ?,
2604             issn             = ?, dewey           = ?,
2605             subclass         = ?, publicationyear = ?,
2606             publishercode    = ?, volumedate      = ?,
2607             volumeddesc      = ?, illus           = ?,
2608             pages            = ?, notes           = ?,
2609             size             = ?, lccn            = ?,
2610             marc             = ?, lcsort          =?,
2611             place            = ?, ccode           = ?
2612           "
2613     );
2614     my ($lcsort) =
2615       calculatelc( $biblioitem->{'classification'} )
2616       . $biblioitem->{'subclass'};
2617     $sth->execute(
2618         $bibitemnum,                     $biblioitem->{'biblionumber'},
2619         $biblioitem->{'volume'},         $biblioitem->{'number'},
2620         $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
2621         $biblioitem->{'url'},            $biblioitem->{'isbn'},
2622         $biblioitem->{'issn'},           $biblioitem->{'dewey'},
2623         $biblioitem->{'subclass'},       $biblioitem->{'publicationyear'},
2624         $biblioitem->{'publishercode'},  $biblioitem->{'volumedate'},
2625         $biblioitem->{'volumeddesc'},    $biblioitem->{'illus'},
2626         $biblioitem->{'pages'},          $biblioitem->{'bnotes'},
2627         $biblioitem->{'size'},           $biblioitem->{'lccn'},
2628         $biblioitem->{'marc'},           $biblioitem->{'place'},
2629         $lcsort,                         $biblioitem->{'ccode'}
2630     );
2631     $sth->finish;
2632     return ($bibitemnum);
2633 }
2634
2635 =head2 _koha_new_items
2636
2637 _koha_new_items( $dbh, $item, $barcode );
2638
2639 =cut
2640
2641 sub _koha_new_items {
2642     my ( $dbh, $item, $barcode ) = @_;
2643
2644     #  my $dbh   = C4Connect;
2645     my $sth = $dbh->prepare("Select max(itemnumber) from items");
2646     my $data;
2647     my $itemnumber;
2648     my $error = "";
2649
2650     $sth->execute;
2651     $data       = $sth->fetchrow_hashref;
2652     $itemnumber = $data->{'max(itemnumber)'} + 1;
2653     $sth->finish;
2654 ## Now calculate lccalnumber
2655     my ($cutterextra) = itemcalculator(
2656         $dbh,
2657         $item->{'biblioitemnumber'},
2658         $item->{'itemcallnumber'}
2659     );
2660
2661 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
2662     if ( $item->{'loan'} ) {
2663         $item->{'notforloan'} = $item->{'loan'};
2664     }
2665
2666     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
2667     if ( $item->{'dateaccessioned'} eq '' || !$item->{'dateaccessioned'} ) {
2668
2669         $sth = $dbh->prepare(
2670             "Insert into items set
2671             itemnumber           = ?,     biblionumber     = ?,
2672             multivolumepart      = ?,
2673             biblioitemnumber     = ?,     barcode          = ?,
2674             booksellerid         = ?,     dateaccessioned  = NOW(),
2675             homebranch           = ?,     holdingbranch    = ?,
2676             price                = ?,     replacementprice = ?,
2677             replacementpricedate = NOW(), datelastseen     = NOW(),
2678             multivolume          = ?,     stack            = ?,
2679             itemlost             = ?,     wthdrawn         = ?,
2680             paidfor              = ?,     itemnotes        = ?,
2681             itemcallnumber       =?,      notforloan       = ?,
2682             location             = ?,     Cutterextra      = ?
2683           "
2684         );
2685         $sth->execute(
2686             $itemnumber,                $item->{'biblionumber'},
2687             $item->{'multivolumepart'}, $item->{'biblioitemnumber'},
2688             $barcode,                   $item->{'booksellerid'},
2689             $item->{'homebranch'},      $item->{'holdingbranch'},
2690             $item->{'price'},           $item->{'replacementprice'},
2691             $item->{multivolume},       $item->{stack},
2692             $item->{itemlost},          $item->{wthdrawn},
2693             $item->{paidfor},           $item->{'itemnotes'},
2694             $item->{'itemcallnumber'},  $item->{'notforloan'},
2695             $item->{'location'},        $cutterextra
2696         );
2697     }
2698     else {
2699         $sth = $dbh->prepare(
2700             "INSERT INTO items SET
2701             itemnumber           = ?,     biblionumber     = ?,
2702             multivolumepart      = ?,
2703             biblioitemnumber     = ?,     barcode          = ?,
2704             booksellerid         = ?,     dateaccessioned  = ?,
2705             homebranch           = ?,     holdingbranch    = ?,
2706             price                = ?,     replacementprice = ?,
2707             replacementpricedate = NOW(), datelastseen     = NOW(),
2708             multivolume          = ?,     stack            = ?,
2709             itemlost             = ?,     wthdrawn         = ?,
2710             paidfor              = ?,     itemnotes        = ?,
2711             itemcallnumber       = ?,     notforloan       = ?,
2712             location             = ?,
2713             Cutterextra          = ?
2714                             "
2715         );
2716         $sth->execute(
2717             $itemnumber,                 $item->{'biblionumber'},
2718             $item->{'multivolumepart'},  $item->{'biblioitemnumber'},
2719             $barcode,                    $item->{'booksellerid'},
2720             $item->{'dateaccessioned'},  $item->{'homebranch'},
2721             $item->{'holdingbranch'},    $item->{'price'},
2722             $item->{'replacementprice'}, $item->{multivolume},
2723             $item->{stack},              $item->{itemlost},
2724             $item->{wthdrawn},           $item->{paidfor},
2725             $item->{'itemnotes'},        $item->{'itemcallnumber'},
2726             $item->{'notforloan'},       $item->{'location'},
2727             $cutterextra
2728         );
2729     }
2730     if ( defined $sth->errstr ) {
2731         $error .= $sth->errstr;
2732     }
2733     return ( $itemnumber, $error );
2734 }
2735
2736 =head2 _koha_modify_item
2737
2738 _koha_modify_item( $dbh, $item, $op );
2739
2740 =cut
2741
2742 sub _koha_modify_item {
2743     my ( $dbh, $item, $op ) = @_;
2744     $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
2745
2746     # if all we're doing is setting statuses, just update those and get out
2747     if ( $op eq "setstatus" ) {
2748         my $query =
2749           "UPDATE items SET itemlost=?,wthdrawn=?,binding=? WHERE itemnumber=?";
2750         my @bind = (
2751             $item->{'itemlost'}, $item->{'wthdrawn'},
2752             $item->{'binding'},  $item->{'itemnumber'}
2753         );
2754         my $sth = $dbh->prepare($query);
2755         $sth->execute(@bind);
2756         $sth->finish;
2757         return undef;
2758     }
2759 ## Now calculate lccalnumber
2760     my ($cutterextra) =
2761       itemcalculator( $dbh, $item->{'bibitemnum'}, $item->{'itemcallnumber'} );
2762
2763     my $query = "UPDATE items SET
2764 barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,homebranch=?,cutterextra=?, onloan=?, binding=?";
2765
2766     my @bind = (
2767         $item->{'barcode'},        $item->{'notes'},
2768         $item->{'itemcallnumber'}, $item->{'notforloan'},
2769         $item->{'location'},       $item->{multivolumepart},
2770         $item->{multivolume},      $item->{stack},
2771         $item->{wthdrawn},         $item->{holdingbranch},
2772         $item->{homebranch},       $cutterextra,
2773         $item->{onloan},           $item->{binding}
2774     );
2775     if ( $item->{'lost'} ne '' ) {
2776         $query =
2777 "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
2778                             itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
2779                              location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,cutterextra=?,onloan=?, binding=?";
2780         @bind = (
2781             $item->{'bibitemnum'},     $item->{'barcode'},
2782             $item->{'notes'},          $item->{'homebranch'},
2783             $item->{'lost'},           $item->{'wthdrawn'},
2784             $item->{'itemcallnumber'}, $item->{'notforloan'},
2785             $item->{'location'},       $item->{multivolumepart},
2786             $item->{multivolume},      $item->{stack},
2787             $item->{wthdrawn},         $item->{holdingbranch},
2788             $cutterextra,              $item->{onloan},
2789             $item->{binding}
2790         );
2791         if ( $item->{homebranch} ) {
2792             $query .= ",homebranch=?";
2793             push @bind, $item->{homebranch};
2794         }
2795         if ( $item->{holdingbranch} ) {
2796             $query .= ",holdingbranch=?";
2797             push @bind, $item->{holdingbranch};
2798         }
2799     }
2800     $query .= " where itemnumber=?";
2801     push @bind, $item->{'itemnum'};
2802     if ( $item->{'replacement'} ne '' ) {
2803         $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
2804     }
2805     my $sth = $dbh->prepare($query);
2806     $sth->execute(@bind);
2807     $sth->finish;
2808 }
2809
2810 =head2 _koha_delete_item
2811
2812 _koha_delete_item( $dbh, $itemnum );
2813
2814 Internal function to delete an item record from the koha tables
2815
2816 =cut
2817
2818 sub _koha_delete_item {
2819     my ( $dbh, $itemnum ) = @_;
2820
2821     my $sth = $dbh->prepare("select * from items where itemnumber=?");
2822     $sth->execute($itemnum);
2823     my $data = $sth->fetchrow_hashref;
2824     $sth->finish;
2825     my $query = "Insert into deleteditems set ";
2826     my @bind  = ();
2827     foreach my $temp ( keys %$data ) {
2828         $query .= "$temp = ?,";
2829         push( @bind, $data->{$temp} );
2830     }
2831     $query =~ s/\,$//;
2832
2833     #  print $query;
2834     $sth = $dbh->prepare($query);
2835     $sth->execute(@bind);
2836     $sth->finish;
2837     $sth = $dbh->prepare("Delete from items where itemnumber=?");
2838     $sth->execute($itemnum);
2839     $sth->finish;
2840 }
2841
2842 =head2 _koha_delete_biblio
2843
2844 $error = _koha_delete_biblio($dbh,$biblionumber);
2845
2846 Internal sub for deleting from biblio table -- also saves to deletedbiblio
2847
2848 C<$dbh> - the database handle
2849 C<$biblionumber> - the biblionumber of the biblio to be deleted
2850
2851 =cut
2852
2853 # FIXME: add error handling
2854
2855 sub _koha_delete_biblio {
2856     my ( $dbh, $biblionumber ) = @_;
2857
2858     # get all the data for this biblio
2859     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
2860     $sth->execute($biblionumber);
2861
2862     if ( my $data = $sth->fetchrow_hashref ) {
2863
2864         # save the record in deletedbiblio
2865         # find the fields to save
2866         my $query = "INSERT INTO deletedbiblio SET ";
2867         my @bind  = ();
2868         foreach my $temp ( keys %$data ) {
2869             $query .= "$temp = ?,";
2870             push( @bind, $data->{$temp} );
2871         }
2872
2873         # replace the last , by ",?)"
2874         $query =~ s/\,$//;
2875         my $bkup_sth = $dbh->prepare($query);
2876         $bkup_sth->execute(@bind);
2877         $bkup_sth->finish;
2878
2879         # delete the biblio
2880         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
2881         $del_sth->execute($biblionumber);
2882         $del_sth->finish;
2883     }
2884     $sth->finish;
2885     return undef;
2886 }
2887
2888 =head2 _koha_delete_biblioitems
2889
2890 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
2891
2892 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
2893
2894 C<$dbh> - the database handle
2895 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
2896
2897 =cut
2898
2899 # FIXME: add error handling
2900
2901 sub _koha_delete_biblioitems {
2902     my ( $dbh, $biblioitemnumber ) = @_;
2903
2904     # get all the data for this biblioitem
2905     my $sth =
2906       $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
2907     $sth->execute($biblioitemnumber);
2908
2909     if ( my $data = $sth->fetchrow_hashref ) {
2910
2911         # save the record in deletedbiblioitems
2912         # find the fields to save
2913         my $query = "INSERT INTO deletedbiblioitems SET ";
2914         my @bind  = ();
2915         foreach my $temp ( keys %$data ) {
2916             $query .= "$temp = ?,";
2917             push( @bind, $data->{$temp} );
2918         }
2919
2920         # replace the last , by ",?)"
2921         $query =~ s/\,$//;
2922         my $bkup_sth = $dbh->prepare($query);
2923         $bkup_sth->execute(@bind);
2924         $bkup_sth->finish;
2925
2926         # delete the biblioitem
2927         my $del_sth =
2928           $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
2929         $del_sth->execute($biblioitemnumber);
2930         $del_sth->finish;
2931     }
2932     $sth->finish;
2933     return undef;
2934 }
2935
2936 =head2 _koha_delete_items
2937
2938 $error = _koha_delete_items($dbh,$itemnumber);
2939
2940 Internal sub for deleting from items table -- also saves to deleteditems
2941
2942 C<$dbh> - the database handle
2943 C<$itemnumber> - the itemnumber of the item to be deleted
2944
2945 =cut
2946
2947 # FIXME: add error handling
2948
2949 sub _koha_delete_items {
2950     my ( $dbh, $itemnumber ) = @_;
2951
2952     # get all the data for this item
2953     my $sth = $dbh->prepare("SELECT * FROM items WHERE itemnumber=?");
2954     $sth->execute($itemnumber);
2955
2956     if ( my $data = $sth->fetchrow_hashref ) {
2957
2958         # save the record in deleteditems
2959         # find the fields to save
2960         my $query = "INSERT INTO deleteditems SET ";
2961         my @bind  = ();
2962         foreach my $temp ( keys %$data ) {
2963             $query .= "$temp = ?,";
2964             push( @bind, $data->{$temp} );
2965         }
2966
2967         # replace the last , by ",?)"
2968         $query =~ s/\,$//;
2969         my $bkup_sth = $dbh->prepare($query);
2970         $bkup_sth->execute(@bind);
2971         $bkup_sth->finish;
2972
2973         # delete the item
2974         my $del_sth = $dbh->prepare("DELETE FROM items WHERE itemnumber=?");
2975         $del_sth->execute($itemnumber);
2976         $del_sth->finish;
2977     }
2978     $sth->finish;
2979     return undef;
2980 }
2981
2982
2983
2984 =head2 modbiblio
2985
2986   $biblionumber = &modbiblio($biblio);
2987
2988 Update a biblio record.
2989
2990 C<$biblio> is a reference-to-hash whose keys are the fields in the
2991 biblio table in the Koha database. All fields must be present, not
2992 just the ones you wish to change.
2993
2994 C<&modbiblio> updates the record defined by
2995 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
2996
2997 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
2998 successful or not.
2999
3000 =cut
3001
3002 sub modbiblio {
3003     my ($biblio) = @_;
3004     my $dbh = C4::Context->dbh;
3005     my $biblionumber = _koha_modify_biblio( $dbh, $biblio );
3006     my $record = MARCkoha2marcBiblio( $biblionumber, $biblionumber );
3007     MARCmodbiblio( $dbh, $biblionumber, $record, "", 0 );
3008     return ($biblionumber);
3009 }    # sub modbiblio
3010
3011 =head2 modbibitem
3012
3013 &modbibitem($biblioitem)
3014
3015 =cut
3016
3017 sub modbibitem {
3018     my ($biblioitem) = @_;
3019     my $dbh = C4::Context->dbh;
3020     &_koha_modify_biblio( $dbh, $biblioitem );
3021 }    # sub modbibitem
3022
3023
3024 =head2 newitems
3025
3026 $errors = &newitems( $item, @barcodes );
3027
3028 =cut
3029
3030 sub newitems {
3031     my ( $item, @barcodes ) = @_;
3032     my $dbh = C4::Context->dbh;
3033     my $errors;
3034     my $itemnumber;
3035     my $error;
3036     foreach my $barcode (@barcodes) {
3037         ( $itemnumber, $error ) = &_koha_new_items( $dbh, $item, uc($barcode) );
3038         $errors .= $error;
3039         my $MARCitem =
3040           &MARCkoha2marcItem( $dbh, $item->{biblionumber}, $itemnumber );
3041         &MARCadditem( $MARCitem, $item->{biblionumber} );
3042     }
3043     return ($errors);
3044 }
3045
3046 =head2 moditem
3047
3048 $errors = &moditem( $item, $op );
3049
3050 =cut
3051
3052 sub moditem {
3053     my ( $item, $op ) = @_;
3054     my $dbh = C4::Context->dbh;
3055     &_koha_modify_item( $dbh, $item, $op );
3056
3057     # if we're just setting statuses, just update items table
3058     # it's faster and zebra and marc will be synched anyway by the cron job
3059     unless ( $op eq "setstatus" ) {
3060         my $MARCitem = &MARCkoha2marcItem( $dbh, $item->{'biblionumber'},
3061             $item->{'itemnum'} );
3062         &MARCmoditem( $MARCitem, $item->{biblionumber}, $item->{itemnum},
3063                       MARCfind_frameworkcode( $item->{biblionumber} ), 0 );
3064     }
3065 }
3066
3067 =head2 checkitems
3068
3069 $errors = &checkitems( $count, @barcodes );
3070
3071 =cut
3072
3073 sub checkitems {
3074     my ( $count, @barcodes ) = @_;
3075     my $dbh = C4::Context->dbh;
3076     my $error;
3077     my $sth = $dbh->prepare("Select * from items where barcode=?");
3078     for ( my $i = 0 ; $i < $count ; $i++ ) {
3079         $barcodes[$i] = uc $barcodes[$i];
3080         $sth->execute( $barcodes[$i] );
3081         if ( my $data = $sth->fetchrow_hashref ) {
3082             $error .= " Duplicate Barcode: $barcodes[$i]";
3083         }
3084     }
3085     $sth->finish;
3086     return ($error);
3087 }
3088
3089 =head1  OTHER FUNCTIONS
3090
3091 =head2 char_decode
3092
3093 my $string = char_decode( $string, $encoding );
3094
3095 converts ISO 5426 coded string to UTF-8
3096 sloppy code : should be improved in next issue
3097
3098 =cut
3099
3100 sub char_decode {
3101     my ( $string, $encoding ) = @_;
3102     $_ = $string;
3103
3104     $encoding = C4::Context->preference("marcflavour") unless $encoding;
3105     if ( $encoding eq "UNIMARC" ) {
3106
3107         #         s/\xe1/Æ/gm;
3108         s/\xe2/Ğ/gm;
3109         s/\xe9/Ø/gm;
3110         s/\xec/ş/gm;
3111         s/\xf1/æ/gm;
3112         s/\xf3/ğ/gm;
3113         s/\xf9/ø/gm;
3114         s/\xfb/ß/gm;
3115         s/\xc1\x61/à/gm;
3116         s/\xc1\x65/è/gm;
3117         s/\xc1\x69/ì/gm;
3118         s/\xc1\x6f/ò/gm;
3119         s/\xc1\x75/ù/gm;
3120         s/\xc1\x41/À/gm;
3121         s/\xc1\x45/È/gm;
3122         s/\xc1\x49/Ì/gm;
3123         s/\xc1\x4f/Ò/gm;
3124         s/\xc1\x55/Ù/gm;
3125         s/\xc2\x41/Á/gm;
3126         s/\xc2\x45/É/gm;
3127         s/\xc2\x49/Í/gm;
3128         s/\xc2\x4f/Ó/gm;
3129         s/\xc2\x55/Ú/gm;
3130         s/\xc2\x59/İ/gm;
3131         s/\xc2\x61/á/gm;
3132         s/\xc2\x65/é/gm;
3133         s/\xc2\x69/í/gm;
3134         s/\xc2\x6f/ó/gm;
3135         s/\xc2\x75/ú/gm;
3136         s/\xc2\x79/ı/gm;
3137         s/\xc3\x41/Â/gm;
3138         s/\xc3\x45/Ê/gm;
3139         s/\xc3\x49/Î/gm;
3140         s/\xc3\x4f/Ô/gm;
3141         s/\xc3\x55/Û/gm;
3142         s/\xc3\x61/â/gm;
3143         s/\xc3\x65/ê/gm;
3144         s/\xc3\x69/î/gm;
3145         s/\xc3\x6f/ô/gm;
3146         s/\xc3\x75/û/gm;
3147         s/\xc4\x41/Ã/gm;
3148         s/\xc4\x4e/Ñ/gm;
3149         s/\xc4\x4f/Õ/gm;
3150         s/\xc4\x61/ã/gm;
3151         s/\xc4\x6e/ñ/gm;
3152         s/\xc4\x6f/õ/gm;
3153         s/\xc8\x41/Ä/gm;
3154         s/\xc8\x45/Ë/gm;
3155         s/\xc8\x49/Ï/gm;
3156         s/\xc8\x61/ä/gm;
3157         s/\xc8\x65/ë/gm;
3158         s/\xc8\x69/ï/gm;
3159         s/\xc8\x6F/ö/gm;
3160         s/\xc8\x75/ü/gm;
3161         s/\xc8\x76/ÿ/gm;
3162         s/\xc9\x41/Ä/gm;
3163         s/\xc9\x45/Ë/gm;
3164         s/\xc9\x49/Ï/gm;
3165         s/\xc9\x4f/Ö/gm;
3166         s/\xc9\x55/Ü/gm;
3167         s/\xc9\x61/ä/gm;
3168         s/\xc9\x6f/ö/gm;
3169         s/\xc9\x75/ü/gm;
3170         s/\xca\x41/Å/gm;
3171         s/\xca\x61/å/gm;
3172         s/\xd0\x43/Ç/gm;
3173         s/\xd0\x63/ç/gm;
3174
3175         # this handles non-sorting blocks (if implementation requires this)
3176         $string = nsb_clean($_);
3177     }
3178     elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
3179         ##MARC-8 to UTF-8
3180
3181         s/\xe1\x61/à/gm;
3182         s/\xe1\x65/è/gm;
3183         s/\xe1\x69/ì/gm;
3184         s/\xe1\x6f/ò/gm;
3185         s/\xe1\x75/ù/gm;
3186         s/\xe1\x41/À/gm;
3187         s/\xe1\x45/È/gm;
3188         s/\xe1\x49/Ì/gm;
3189         s/\xe1\x4f/Ò/gm;
3190         s/\xe1\x55/Ù/gm;
3191         s/\xe2\x41/Á/gm;
3192         s/\xe2\x45/É/gm;
3193         s/\xe2\x49/Í/gm;
3194         s/\xe2\x4f/Ó/gm;
3195         s/\xe2\x55/Ú/gm;
3196         s/\xe2\x59/İ/gm;
3197         s/\xe2\x61/á/gm;
3198         s/\xe2\x65/é/gm;
3199         s/\xe2\x69/í/gm;
3200         s/\xe2\x6f/ó/gm;
3201         s/\xe2\x75/ú/gm;
3202         s/\xe2\x79/ı/gm;
3203         s/\xe3\x41/Â/gm;
3204         s/\xe3\x45/Ê/gm;
3205         s/\xe3\x49/Î/gm;
3206         s/\xe3\x4f/Ô/gm;
3207         s/\xe3\x55/Û/gm;
3208         s/\xe3\x61/â/gm;
3209         s/\xe3\x65/ê/gm;
3210         s/\xe3\x69/î/gm;
3211         s/\xe3\x6f/ô/gm;
3212         s/\xe3\x75/û/gm;
3213         s/\xe4\x41/Ã/gm;
3214         s/\xe4\x4e/Ñ/gm;
3215         s/\xe4\x4f/Õ/gm;
3216         s/\xe4\x61/ã/gm;
3217         s/\xe4\x6e/ñ/gm;
3218         s/\xe4\x6f/õ/gm;
3219         s/\xe6\x41/Ă/gm;
3220         s/\xe6\x45/Ĕ/gm;
3221         s/\xe6\x65/ĕ/gm;
3222         s/\xe6\x61/ă/gm;
3223         s/\xe8\x45/Ë/gm;
3224         s/\xe8\x49/Ï/gm;
3225         s/\xe8\x65/ë/gm;
3226         s/\xe8\x69/ï/gm;
3227         s/\xe8\x76/ÿ/gm;
3228         s/\xe9\x41/A/gm;
3229         s/\xe9\x4f/O/gm;
3230         s/\xe9\x55/U/gm;
3231         s/\xe9\x61/a/gm;
3232         s/\xe9\x6f/o/gm;
3233         s/\xe9\x75/u/gm;
3234         s/\xea\x41/A/gm;
3235         s/\xea\x61/a/gm;
3236
3237         #Additional Turkish characters
3238         s/\x1b//gm;
3239         s/\x1e//gm;
3240         s/(\xf0)s/\xc5\x9f/gm;
3241         s/(\xf0)S/\xc5\x9e/gm;
3242         s/(\xf0)c/ç/gm;
3243         s/(\xf0)C/Ç/gm;
3244         s/\xe7\x49/\\xc4\xb0/gm;
3245         s/(\xe6)G/\xc4\x9e/gm;
3246         s/(\xe6)g/ğ\xc4\x9f/gm;
3247         s/\xB8/ı/gm;
3248         s/\xB9/£/gm;
3249         s/(\xe8|\xc8)o/ö/gm;
3250         s/(\xe8|\xc8)O/Ö/gm;
3251         s/(\xe8|\xc8)u/ü/gm;
3252         s/(\xe8|\xc8)U/Ü/gm;
3253         s/\xc2\xb8/\xc4\xb1/gm;
3254         s/¸/\xc4\xb1/gm;
3255
3256         # this handles non-sorting blocks (if implementation requires this)
3257         $string = nsb_clean($_);
3258     }
3259     return ($string);
3260 }
3261
3262 =head2 PrepareItemrecordDisplay
3263
3264 PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber);
3265
3266 Returns a hash with all the fields for Display a given item data in a template
3267
3268 =cut
3269
3270 sub PrepareItemrecordDisplay {
3271
3272     my ( $bibnum, $itemnum ) = @_;
3273
3274     my $dbh = C4::Context->dbh;
3275     my $frameworkcode = &MARCfind_frameworkcode( $bibnum );
3276     my ( $itemtagfield, $itemtagsubfield ) =
3277       &MARCfind_marc_from_kohafield( $dbh, "items.itemnumber", $frameworkcode );
3278     my $tagslib = &MARCgettagslib( $dbh, 1, $frameworkcode );
3279     my $itemrecord = MARCgetitem( $bibnum, $itemnum) if ($itemnum);
3280     my @loop_data;
3281     my $authorised_values_sth =
3282       $dbh->prepare(
3283 "select authorised_value,lib from authorised_values where category=? order by lib"
3284       );
3285     foreach my $tag ( sort keys %{$tagslib} ) {
3286         my $previous_tag = '';
3287         if ( $tag ne '' ) {
3288             # loop through each subfield
3289             my $cntsubf;
3290             foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3291                 next if ( subfield_is_koha_internal_p($subfield) );
3292                 next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
3293                 my %subfield_data;
3294                 $subfield_data{tag}           = $tag;
3295                 $subfield_data{subfield}      = $subfield;
3296                 $subfield_data{countsubfield} = $cntsubf++;
3297                 $subfield_data{kohafield}     =
3298                   $tagslib->{$tag}->{$subfield}->{'kohafield'};
3299
3300          #        $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
3301                 $subfield_data{marc_lib} =
3302                     "<span id=\"error\" title=\""
3303                   . $tagslib->{$tag}->{$subfield}->{lib} . "\">"
3304                   . substr( $tagslib->{$tag}->{$subfield}->{lib}, 0, 12 )
3305                   . "</span>";
3306                 $subfield_data{mandatory} =
3307                   $tagslib->{$tag}->{$subfield}->{mandatory};
3308                 $subfield_data{repeatable} =
3309                   $tagslib->{$tag}->{$subfield}->{repeatable};
3310                 $subfield_data{hidden} = "display:none"
3311                   if $tagslib->{$tag}->{$subfield}->{hidden};
3312                 my ( $x, $value );
3313                 ( $x, $value ) = _find_value( $tag, $subfield, $itemrecord )
3314                   if ($itemrecord);
3315                 $value =~ s/"/&quot;/g;
3316
3317                 # search for itemcallnumber if applicable
3318                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
3319                     'items.itemcallnumber'
3320                     && C4::Context->preference('itemcallnumber') )
3321                 {
3322                     my $CNtag =
3323                       substr( C4::Context->preference('itemcallnumber'), 0, 3 );
3324                     my $CNsubfield =
3325                       substr( C4::Context->preference('itemcallnumber'), 3, 1 );
3326                     my $temp = $itemrecord->field($CNtag) if ($itemrecord);
3327                     if ($temp) {
3328                         $value = $temp->subfield($CNsubfield);
3329                     }
3330                 }
3331                 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
3332                     my @authorised_values;
3333                     my %authorised_lib;
3334
3335                     # builds list, depending on authorised value...
3336                     #---- branch
3337                     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq
3338                         "branches" )
3339                     {
3340                         if ( ( C4::Context->preference("IndependantBranches") )
3341                             && ( C4::Context->userenv->{flags} != 1 ) )
3342                         {
3343                             my $sth =
3344                               $dbh->prepare(
3345 "select branchcode,branchname from branches where branchcode = ? order by branchname"
3346                               );
3347                             $sth->execute( C4::Context->userenv->{branch} );
3348                             push @authorised_values, ""
3349                               unless (
3350                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
3351                             while ( my ( $branchcode, $branchname ) =
3352                                 $sth->fetchrow_array )
3353                             {
3354                                 push @authorised_values, $branchcode;
3355                                 $authorised_lib{$branchcode} = $branchname;
3356                             }
3357                         }
3358                         else {
3359                             my $sth =
3360                               $dbh->prepare(
3361 "select branchcode,branchname from branches order by branchname"
3362                               );
3363                             $sth->execute;
3364                             push @authorised_values, ""
3365                               unless (
3366                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
3367                             while ( my ( $branchcode, $branchname ) =
3368                                 $sth->fetchrow_array )
3369                             {
3370                                 push @authorised_values, $branchcode;
3371                                 $authorised_lib{$branchcode} = $branchname;
3372                             }
3373                         }
3374
3375                         #----- itemtypes
3376                     }
3377                     elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq
3378                         "itemtypes" )
3379                     {
3380                         my $sth =
3381                           $dbh->prepare(
3382 "select itemtype,description from itemtypes order by description"
3383                           );
3384                         $sth->execute;
3385                         push @authorised_values, ""
3386                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
3387                         while ( my ( $itemtype, $description ) =
3388                             $sth->fetchrow_array )
3389                         {
3390                             push @authorised_values, $itemtype;
3391                             $authorised_lib{$itemtype} = $description;
3392                         }
3393
3394                         #---- "true" authorised value
3395                     }
3396                     else {
3397                         $authorised_values_sth->execute(
3398                             $tagslib->{$tag}->{$subfield}->{authorised_value} );
3399                         push @authorised_values, ""
3400                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
3401                         while ( my ( $value, $lib ) =
3402                             $authorised_values_sth->fetchrow_array )
3403                         {
3404                             push @authorised_values, $value;
3405                             $authorised_lib{$value} = $lib;
3406                         }
3407                     }
3408                     $subfield_data{marc_value} = CGI::scrolling_list(
3409                         -name     => 'field_value',
3410                         -values   => \@authorised_values,
3411                         -default  => "$value",
3412                         -labels   => \%authorised_lib,
3413                         -size     => 1,
3414                         -tabindex => '',
3415                         -multiple => 0,
3416                     );
3417                 }
3418                 elsif ( $tagslib->{$tag}->{$subfield}->{thesaurus_category} ) {
3419                     $subfield_data{marc_value} =
3420 "<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>";
3421
3422 #"
3423 # COMMENTED OUT because No $i is provided with this API.
3424 # And thus, no value_builder can be activated.
3425 # BUT could be thought over.
3426 #         } elsif ($tagslib->{$tag}->{$subfield}->{'value_builder'}) {
3427 #             my $plugin="value_builder/".$tagslib->{$tag}->{$subfield}->{'value_builder'};
3428 #             require $plugin;
3429 #             my $extended_param = plugin_parameters($dbh,$itemrecord,$tagslib,$i,0);
3430 #             my ($function_name,$javascript) = plugin_javascript($dbh,$record,$tagslib,$i,0);
3431 #             $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";
3432                 }
3433                 else {
3434                     $subfield_data{marc_value} =
3435 "<input type=\"text\" name=\"field_value\" value=\"$value\" size=50 maxlength=255>";
3436                 }
3437                 push( @loop_data, \%subfield_data );
3438             }
3439         }
3440     }
3441     my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
3442       if ( $itemrecord && $itemrecord->field($itemtagfield) );
3443     return {
3444         'itemtagfield'    => $itemtagfield,
3445         'itemtagsubfield' => $itemtagsubfield,
3446         'itemnumber'      => $itemnumber,
3447         'iteminformation' => \@loop_data
3448     };
3449 }
3450
3451 =head2 nsb_clean
3452
3453 my $string = nsb_clean( $string, $encoding );
3454
3455 =cut
3456
3457 sub nsb_clean {
3458     my $NSB      = '\x88';    # NSB : begin Non Sorting Block
3459     my $NSE      = '\x89';    # NSE : Non Sorting Block end
3460                               # handles non sorting blocks
3461     my ($string) = @_;
3462     $_ = $string;
3463     s/$NSB/(/gm;
3464     s/[ ]{0,1}$NSE/) /gm;
3465     $string = $_;
3466     return ($string);
3467 }
3468
3469 =head2 zebraopfiles
3470
3471 &zebraopfiles( $dbh, $biblionumber, $record, $folder, $server );
3472
3473 =cut
3474
3475 sub zebraopfiles {
3476
3477     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
3478
3479     my $op;
3480     my $zebradir =
3481       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
3482     unless ( opendir( DIR, "$zebradir" ) ) {
3483         warn "$zebradir not found";
3484         return;
3485     }
3486     closedir DIR;
3487     my $filename = $zebradir . $biblionumber;
3488
3489     if ($record) {
3490         open( OUTPUT, ">", $filename . ".xml" );
3491         print OUTPUT $record;
3492         close OUTPUT;
3493     }
3494 }
3495
3496 =head2 zebraop
3497
3498 zebraop( $dbh, $biblionumber, $op, $server );
3499
3500 =cut
3501
3502 sub zebraop {
3503 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
3504     my ( $dbh, $biblionumber, $op, $server ) = @_;
3505
3506     #warn "SERVER:".$server;
3507 #
3508 # true zebraop commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
3509 # at the same time
3510 # replaced by a zebraqueue table, that is filled with zebraop to run.
3511 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
3512
3513 my $sth=$dbh->prepare("insert into zebraqueue  (biblio_auth_number ,server,operation) values(?,?,?)");
3514 $sth->execute($biblionumber,$server,$op);
3515 $sth->finish;
3516
3517 #
3518 #     my @Zconnbiblio;
3519 #     my $tried     = 0;
3520 #     my $recon     = 0;
3521 #     my $reconnect = 0;
3522 #     my $record;
3523 #     my $shadow;
3524 #
3525 #   reconnect:
3526 #     $Zconnbiblio[0] = C4::Context->Zconn( $server, 0, 1 );
3527 #
3528 #     if ( $server eq "biblioserver" ) {
3529 #
3530 #         # it's unclear to me whether this should be in xml or MARC format
3531 #         # but it is clear it should be nabbed from zebra rather than from
3532 #         # the koha tables
3533 #         $record = GetMarcBiblio($biblionumber);
3534 #         $record = $record->as_xml_record() if $record;
3535 # #            warn "RECORD $biblionumber => ".$record;
3536 #         $shadow="biblioservershadow";
3537 #
3538 #         #           warn "RECORD $biblionumber => ".$record;
3539 #         $shadow = "biblioservershadow";
3540 #
3541 #     }
3542 #     elsif ( $server eq "authorityserver" ) {
3543 #         $record = C4::AuthoritiesMarc::XMLgetauthority( $dbh, $biblionumber );
3544 #         $shadow = "authorityservershadow";
3545 #     }    ## Add other servers as necessary
3546 #
3547 #     my $Zpackage = $Zconnbiblio[0]->package();
3548 #     $Zpackage->option( action => $op );
3549 #     $Zpackage->option( record => $record );
3550 #
3551 #   retry:
3552 #     $Zpackage->send("update");
3553 #     my $i;
3554 #     my $event;
3555 #
3556 #     while ( ( $i = ZOOM::event( \@Zconnbiblio ) ) != 0 ) {
3557 #         $event = $Zconnbiblio[0]->last_event();
3558 #         last if $event == ZOOM::Event::ZEND;
3559 #     }
3560 #
3561 #     my ( $error, $errmsg, $addinfo, $diagset ) = $Zconnbiblio[0]->error_x();
3562 #     if ( $error == 10000 && $reconnect == 0 )
3563 #     {    ## This is serious ZEBRA server is not available -reconnect
3564 #         warn "problem with zebra server connection";
3565 #         $reconnect = 1;
3566 #         my $res = system('sc start "Z39.50 Server" >c:/zebraserver/error.log');
3567 #
3568 #         #warn "Trying to restart ZEBRA Server";
3569 #         #goto "reconnect";
3570 #     }
3571 #     elsif ( $error == 10007 && $tried < 2 )
3572 #     {    ## timeout --another 30 looonng seconds for this update
3573 #         $tried = $tried + 1;
3574 #         warn "warn: timeout, trying again";
3575 #         goto "retry";
3576 #     }
3577 #     elsif ( $error == 10004 && $recon == 0 ) {    ##Lost connection -reconnect
3578 #         $recon = 1;
3579 #         warn "error: reconnecting to zebra";
3580 #         goto "reconnect";
3581 #
3582 #    # as a last resort, we save the data to the filesystem to be indexed in batch
3583 #     }
3584 #     elsif ($error) {
3585 #         warn
3586 # "Error-$server   $op $biblionumber /errcode:, $error, /MSG:,$errmsg,$addinfo \n";
3587 #         $Zpackage->destroy();
3588 #         $Zconnbiblio[0]->destroy();
3589 #         zebraopfiles( $dbh, $biblionumber, $record, $op, $server );
3590 #         return;
3591 #     }
3592 #     if ( C4::Context->$shadow ) {
3593 #         $Zpackage->send('commit');
3594 #         while ( ( $i = ZOOM::event( \@Zconnbiblio ) ) != 0 ) {
3595 #
3596 #             #waiting zebra to finish;
3597 #          }
3598 #     }
3599 #     $Zpackage->destroy();
3600 }
3601
3602 =head2 calculatelc
3603
3604 $lc = calculatelc($classification);
3605
3606 =cut
3607
3608 sub calculatelc {
3609     my ($classification) = @_;
3610     $classification =~ s/^\s+|\s+$//g;
3611     my $i = 0;
3612     my $lc2;
3613     my $lc1;
3614
3615     for ( $i = 0 ; $i < length($classification) ; $i++ ) {
3616         my $c = ( substr( $classification, $i, 1 ) );
3617         if ( $c ge '0' && $c le '9' ) {
3618
3619             $lc2 = substr( $classification, $i );
3620             last;
3621         }
3622         else {
3623             $lc1 .= substr( $classification, $i, 1 );
3624
3625         }
3626     }    #while
3627
3628     my $other = length($lc1);
3629     if ( !$lc1 ) {
3630         $other = 0;
3631     }
3632
3633     my $extras;
3634     if ( $other < 4 ) {
3635         for ( 1 .. ( 4 - $other ) ) {
3636             $extras .= "0";
3637         }
3638     }
3639     $lc1 .= $extras;
3640     $lc2 =~ s/^ //g;
3641
3642     $lc2 =~ s/ //g;
3643     $extras = "";
3644     ##Find the decimal part of $lc2
3645     my $pos = index( $lc2, "." );
3646     if ( $pos < 0 ) { $pos = length($lc2); }
3647     if ( $pos >= 0 && $pos < 5 ) {
3648         ##Pad lc2 with zeros to create a 5digit decimal needed in marc record to sort as numeric
3649
3650         for ( 1 .. ( 5 - $pos ) ) {
3651             $extras .= "0";
3652         }
3653     }
3654     $lc2 = $extras . $lc2;
3655     return ( $lc1 . $lc2 );
3656 }
3657
3658 =head2 itemcalculator
3659
3660 $cutterextra = itemcalculator( $dbh, $biblioitem, $callnumber );
3661
3662 =cut
3663
3664 sub itemcalculator {
3665     my ( $dbh, $biblioitem, $callnumber ) = @_;
3666     my $sth =
3667       $dbh->prepare(
3668 "select classification, subclass from biblioitems where biblioitemnumber=?"
3669       );
3670
3671     $sth->execute($biblioitem);
3672     my ( $classification, $subclass ) = $sth->fetchrow;
3673     my $all         = $classification . " " . $subclass;
3674     my $total       = length($all);
3675     my $cutterextra = substr( $callnumber, $total - 1 );
3676
3677     return $cutterextra;
3678 }
3679
3680 END { }    # module clean-up code here (global destructor)
3681
3682 1;
3683
3684 __END__
3685
3686 =head1 AUTHOR
3687
3688 Koha Developement team <info@koha.org>
3689
3690 Paul POULAIN paul.poulain@free.fr
3691
3692 Joshua Ferraro jmf@liblime.com
3693
3694 =cut
3695
3696 # $Id$
3697 # $Log$
3698 # Revision 1.188  2007/03/09 14:31:47  tipaul
3699 # rel_3_0 moved to HEAD
3700 #
3701 # Revision 1.178.2.59  2007/02/28 10:01:13  toins
3702 # reporting bug fix from 2.2.7.1 to rel_3_0
3703 # LOG was :
3704 #               BUGFIX/improvement : limiting MARCsubject to 610 as 676 is dewey, and is somewhere else
3705 #
3706 # Revision 1.178.2.58  2007/02/05 16:50:01  toins
3707 # fix a mod_perl bug:
3708 # There was a global var modified into an internal function in {MARC|ISBD}detail.pl.
3709 # Moving this function in Biblio.pm
3710 #
3711 # Revision 1.178.2.57  2007/01/25 09:37:58  tipaul
3712 # removing warn
3713 #
3714 # Revision 1.178.2.56  2007/01/24 13:50:26  tipaul
3715 # Acquisition fix
3716 # removing newbiblio & newbiblioitems subs.
3717 # adding Koha2Marc
3718 #
3719 # IMHO, all biblio handling is better handled if they are done in a single place, the subs with MARC::Record as parameters.
3720 # 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.
3721 # 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.
3722 #
3723 # Revision 1.178.2.55  2007/01/17 18:07:17  alaurin
3724 # bugfixing for zebraqueue_start and biblio.pm :
3725 #
3726 #       - Zebraqueue_start : restoring function of deletion in zebraqueue DB list
3727 #
3728 #       -biblio.pm : changing method of default_record_format, now we have :
3729 #               MARC::File::XML->default_record_format(C4::Context->preference('marcflavour'));
3730 #
3731 #       with this line the encoding in zebra seems to be ok (in unimarc and marc21)
3732 #
3733 # Revision 1.178.2.54  2007/01/16 15:00:03  tipaul
3734 # donc try to delete the biblio in koha, just fill zebraqueue table !
3735 #
3736 # Revision 1.178.2.53  2007/01/16 10:24:11  tipaul
3737 # BUGFIXING :
3738 # when modifying or deleting an item, the biblio frameworkcode was emptied.
3739 #
3740 # Revision 1.178.2.52  2007/01/15 17:20:55  toins
3741 # *** empty log message ***
3742 #
3743 # Revision 1.178.2.51  2007/01/15 15:16:44  hdl
3744 # Uncommenting zebraop.
3745 #
3746 # Revision 1.178.2.50  2007/01/15 14:59:09  hdl
3747 # Adding creation of an unexpected serial any time.
3748 # +
3749 # USING Date::Calc and not Date::Manip.
3750 # WARNING : There are still some Bugs in next issue date management. (Date::Calc donot wrap easily next year calculation.)
3751 #
3752 # Revision 1.178.2.49  2007/01/12 10:12:30  toins
3753 # writing $record->as_formatted in the log when Modifying an item.
3754 #
3755 # Revision 1.178.2.48  2007/01/11 16:33:04  toins
3756 # write $record->as_formatted into the log.
3757 #
3758 # Revision 1.178.2.47  2007/01/10 16:46:27  toins
3759 # Theses modules need to use C4::Log.
3760 #
3761 # Revision 1.178.2.46  2007/01/10 16:31:15  toins
3762 # new systems preferences :
3763 #  - CataloguingLog (log the update/creation/deletion of a notice if set to 1)
3764 #  - BorrowersLog ( idem for borrowers )
3765 #  - IssueLog (log all issue if set to 1)
3766 #  - ReturnLog (log all return if set to 1)
3767 #  - SusbcriptionLog (log all creation/deletion/update of a subcription)
3768 #
3769 # All of theses are in a new tab called 'LOGFeatures' in systempreferences.pl
3770 #
3771 # Revision 1.178.2.45  2007/01/09 10:31:09  toins
3772 # sync with dev_week. ( new function : GetMarcSeries )
3773 #
3774 # Revision 1.178.2.44  2007/01/04 17:41:32  tipaul
3775 # 2 major bugfixes :
3776 # - deletion of an item deleted the whole biblio because of a wrong API
3777 # - create an item was bugguy for default framework
3778 #
3779 # Revision 1.178.2.43  2006/12/22 15:09:53  toins
3780 # removing C4::Database;
3781 #
3782 # Revision 1.178.2.42  2006/12/20 16:51:00  tipaul
3783 # ZEBRA update :
3784 # - adding a new table : when a biblio is added/modified/ deleted, an entry is entered in this table
3785 # - the zebraqueue_start.pl script read it & does the stuff.
3786 #
3787 # code coming from head (tumer). it can be run every minut instead of once every day for dev_week code.
3788 #
3789 # 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 !
3790 #
3791 # Revision 1.178.2.41  2006/12/20 08:54:44  toins
3792 # GetXmlBiblio wasn't exported.
3793 #
3794 # Revision 1.178.2.40  2006/12/19 16:45:56  alaurin
3795 # bugfixing, for zebra and authorities
3796 #
3797 # Revision 1.178.2.39  2006/12/08 17:55:44  toins
3798 # GetMarcAuthors now get authors for all subfields
3799 #
3800 # Revision 1.178.2.38  2006/12/07 15:42:14  toins
3801 # synching opac & intranet.
3802 # fix some broken link & bugs.
3803 # removing warn compilation.
3804 #
3805 # Revision 1.178.2.37  2006/12/07 11:09:39  tipaul
3806 # MAJOR FIX :
3807 # 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.
3808 # BUT for bulkmarcimport & mod_perl, the zebra conn must be persistant.
3809 #
3810 # Revision 1.178.2.36  2006/12/06 16:54:21  alaurin
3811 # restore function zebraop for delete biblios :
3812 #
3813 # 1) restore C4::Circulation::Circ2::itemissues, (was missing)
3814 # 2) restore zebraop value : delete_record
3815 #
3816 # Revision 1.178.2.35  2006/12/06 10:02:12  alaurin
3817 # bugfixing for delete a biblio :
3818 #
3819 # restore itemissue fonction .... :
3820 #
3821 # other is pointed, zebra error 224... for biblio is not deleted in zebra ..
3822 # ....
3823 #
3824 # Revision 1.178.2.34  2006/12/06 09:14:25  toins
3825 # Correct the link to the MARC subjects.
3826 #
3827 # Revision 1.178.2.33  2006/12/05 11:35:29  toins
3828 # Biblio.pm cleaned.
3829 # additionalauthors, bibliosubject, bibliosubtitle tables are now unused.
3830 # Some functions renamed according to the coding guidelines.
3831 #
3832 # Revision 1.178.2.32  2006/12/04 17:39:57  alaurin
3833 # bugfix :
3834 #
3835 # restore zebraop for update zebra
3836 #
3837 # Revision 1.178.2.31  2006/12/01 17:00:19  tipaul
3838 # additem needs $frameworkcode
3839 #
3840 # Revision 1.178.2.30  2006/11/30 18:23:51  toins
3841 # theses scripts don't need to use C4::Search.
3842 #
3843 # Revision 1.178.2.29  2006/11/30 17:17:01  toins
3844 # following functions moved from Search.p to Biblio.pm :
3845 # - bibdata
3846 # - itemsissues
3847 # - addauthor
3848 # - getMARCNotes
3849 # - getMARCsubjects
3850 #
3851 # Revision 1.178.2.28  2006/11/28 15:15:03  toins
3852 # sync with dev_week.
3853 # (deleteditems table wasn't getting populaated because the execute was commented out. This puts it back
3854 #     -- some table changes are needed as well, I'll commit those separately.)
3855 #
3856 # Revision 1.178.2.27  2006/11/20 16:52:05  alaurin
3857 # minor bugfixing :
3858 #
3859 # correcting in _koha_modify_biblioitem : restore the biblionumber line .
3860 #
3861 # now the sql update of biblioitems is ok ....
3862 #
3863 # Revision 1.178.2.26  2006/11/17 14:57:21  tipaul
3864 # code cleaning : moving bornum, borrnum, bornumber to a correct "borrowernumber"
3865 #
3866 # Revision 1.178.2.25  2006/11/17 13:18:58  tipaul
3867 # code cleaning : removing use of "bib", and replacing with "biblionumber"
3868 #
3869 # WARNING : I tried to do carefully, but there are probably some mistakes.
3870 # So if you encounter a problem you didn't have before, look for this change !!!
3871 # anyway, I urge everybody to use only "biblionumber", instead of "bib", "bi", "biblio" or anything else. will be easier to maintain !!!
3872 #
3873 # Revision 1.178.2.24  2006/11/17 11:18:47  tipaul
3874 # * removing useless subs
3875 # * moving bibid to biblionumber where needed
3876 #
3877 # Revision 1.178.2.23  2006/11/17 09:39:04  btoumi
3878 # bug fix double declaration of variable in same function
3879 #
3880 # Revision 1.178.2.22  2006/11/15 15:15:50  hdl
3881 # Final First Version for New Facility for subscription management.
3882 #
3883 # Now
3884 # use serials-collection.pl for history display
3885 # and serials-edit.pl for serial edition
3886 # subscription add and detail adds a new branch information to help IndependantBranches Library to manage different subscriptions for a serial
3887 #
3888 # This is aimed at replacing serials-receive and statecollection.
3889 #
3890 # Revision 1.178.2.21  2006/11/15 14:49:38  tipaul
3891 # in some cases, there are invalid utf8 chars in XML (at least in SANOP). this commit remove them on the fly.
3892 # 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...
3893 #
3894 # Revision 1.178.2.20  2006/10/31 17:20:49  toins
3895 # * moving bibitemdata from search to here.
3896 # * using _koha_modify_biblio instead of OLDmodbiblio.
3897 #
3898 # Revision 1.178.2.19  2006/10/20 15:26:41  toins
3899 # sync with dev_week.
3900 #
3901 # Revision 1.178.2.18  2006/10/19 11:57:04  btoumi
3902 # bug fix : wrong syntax in sub call
3903 #
3904 # Revision 1.178.2.17  2006/10/17 09:54:42  toins
3905 # ccode (re)-integration.
3906 #
3907 # Revision 1.178.2.16  2006/10/16 16:20:34  toins
3908 # MARCgetbiblio cleaned up.
3909 #
3910 # Revision 1.178.2.15  2006/10/11 14:26:56  tipaul
3911 # handling of UNIMARC :
3912 # - better management of field 100 = automatic creation of the field if needed & filling encoding to unicode.
3913 # - 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
3914 # - fixing a bug on MARCgetitem, that uses biblioitems.marc and not biblioitems.marcxml
3915 #
3916 # Revision 1.178.2.14  2006/10/11 07:59:36  tipaul
3917 # removing hardcoded ccode fiels in biblioitems
3918 #
3919 # Revision 1.178.2.13  2006/10/10 14:21:24  toins
3920 # Biblio.pm now returns a true value.
3921 #
3922 # Revision 1.178.2.12  2006/10/09 16:44:23  toins
3923 # Sync with dev_week.
3924 #
3925 # Revision 1.178.2.11  2006/10/06 13:23:49  toins
3926 # Synch with dev_week.
3927 #
3928 # Revision 1.178.2.10  2006/10/02 09:32:02  hdl
3929 # Adding GetItemStatus and GetItemLocation function in order to make serials-receive.pl work.
3930 #
3931 # *************WARNING.***************
3932 # tested for UNIMARC and using 'marcflavour' system preferences to set defaut_record_format.
3933 #
3934 # Revision 1.178.2.9  2006/09/26 07:54:20  hdl
3935 # Bug FIX: Correct accents for UNIMARC biblio MARC details.
3936 # (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)
3937 #
3938 # Revision 1.178.2.8  2006/09/25 14:46:22  hdl
3939 # Now using iso2709 MARC data for MARC.
3940 # (Works better for accents than XML)
3941 #
3942 # Revision 1.178.2.7  2006/09/20 13:44:14  hdl
3943 # Bug Fixing : Cataloguing was broken for UNIMARC.
3944 # Please test.
3945