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