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