C4/Biblio.pm

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