C4/Biblio.pm

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