koha-dev.rot13.org Git - koha_gimpoz/blob - 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     );
 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 responsability
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
2229     while ($params->[$i]){ # browse all CGI params
2230         my $param = $params->[$i];
2231         my $newfield=0;
2232         # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2233         if ($param eq 'biblionumber') {
2234             my ( $biblionumbertagfield, $biblionumbertagsubfield ) =
2235                 &GetMarcFromKohaField( "biblio.biblionumber", '' );
2236             if ($biblionumbertagfield < 10) {
2237                 $newfield = MARC::Field->new(
2238                     $biblionumbertagfield,
2239                     $cgi->param($param),
2240                 );
2241             } else {
2242                 $newfield = MARC::Field->new(
2243                     $biblionumbertagfield,
2244                     '',
2245                     '',
2246                     "$biblionumbertagsubfield" => $cgi->param($param),
2247                 );
2248             }
2249             push @fields,$newfield if($newfield);
2250         }
2251         elsif ($param =~ /^tag_(\d*)_indicator_/){ # new field start when having 'input name="..._indicator_..."
2252             my $tag  = $1;
2253
2254             my $ind1 = substr($cgi->param($param),0,1);
2255             my $ind2 = substr($cgi->param($param),1,1);
2256
2257             my $j=$i+1;
2258
2259             if($tag < 10){ # no code for theses fields
2260     # in MARC editor, 000 contains the leader.
2261                 if ($tag eq '000' ) {
2262                     $record->leader($cgi->param($params->[$j+1])) if length($cgi->param($params->[$j+1]))==24;
2263     # between 001 and 009 (included)
2264                 } else {
2265                     $newfield = MARC::Field->new(
2266                         $tag,
2267                         $cgi->param($params->[$j+1]),
2268                     );
2269                 }
2270     # > 009, deal with subfields
2271             } else {
2272                 while($params->[$j] =~ /_code_/){ # browse all it's subfield
2273                     my $inner_param = $params->[$j];
2274                     if ($newfield){
2275                         if($cgi->param($params->[$j+1])){  # only if there is a value (code => value)
2276                             $newfield->add_subfields(
2277                                 $cgi->param($inner_param) => $cgi->param($params->[$j+1])
2278                             );
2279                         }
2280                     } else {
2281                         if ( $cgi->param($params->[$j+1]) ) { # creating only if there is a value (code => value)
2282                             $newfield = MARC::Field->new(
2283                                 $tag,
2284                                 ''.$ind1,
2285                                 ''.$ind2,
2286                                 $cgi->param($inner_param) => $cgi->param($params->[$j+1]),
2287                             );
2288                         }
2289                     }
2290                     $j+=2;
2291                 }
2292             }
2293             push @fields,$newfield if($newfield);
2294         }
2295         $i++;
2296     }
2297
2298     $record->append_fields(@fields);
2299     return $record;
2300 }
2301
2302 =head2 TransformMarcToKoha
2303
2304 =over 4
2305
2306         $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
2307
2308 =back
2309
2310 =cut
2311
2312 sub TransformMarcToKoha {
2313     my ( $dbh, $record, $frameworkcode ) = @_;
2314
2315     #  FIXME :: This query is unused..
2316     #    my $sth =
2317     #      $dbh->prepare(
2318     #"select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
2319     #      );
2320
2321     my $result;
2322     my $sth2 = $dbh->prepare("SHOW COLUMNS from biblio");
2323     $sth2->execute;
2324     my $field;
2325     while ( ($field) = $sth2->fetchrow ) {
2326         $result =
2327           &TransformMarcToKohaOneField( "biblio", $field, $record, $result,
2328             $frameworkcode );
2329     }
2330     my $sth2 = $dbh->prepare("SHOW COLUMNS from biblioitems");
2331     $sth2->execute;
2332     while ( ($field) = $sth2->fetchrow ) {
2333         if ( $field eq 'notes' ) { $field = 'bnotes'; }
2334         $result =
2335           &TransformMarcToKohaOneField( "biblioitems", $field, $record, $result,
2336             $frameworkcode );
2337     }
2338     $sth2 = $dbh->prepare("SHOW COLUMNS from items");
2339     $sth2->execute;
2340     while ( ($field) = $sth2->fetchrow ) {
2341         $result =
2342           &TransformMarcToKohaOneField( "items", $field, $record, $result,
2343             $frameworkcode );
2344     }
2345
2346     #
2347     # modify copyrightdate to keep only the 1st year found
2348     my $temp = $result->{'copyrightdate'};
2349     $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2350     if ( $1 > 0 ) {
2351         $result->{'copyrightdate'} = $1;
2352     }
2353     else {                      # if no cYYYY, get the 1st date.
2354         $temp =~ m/(\d\d\d\d)/;
2355         $result->{'copyrightdate'} = $1;
2356     }
2357
2358     # modify publicationyear to keep only the 1st year found
2359     $temp = $result->{'publicationyear'};
2360     $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2361     if ( $1 > 0 ) {
2362         $result->{'publicationyear'} = $1;
2363     }
2364     else {                      # if no cYYYY, get the 1st date.
2365         $temp =~ m/(\d\d\d\d)/;
2366         $result->{'publicationyear'} = $1;
2367     }
2368     return $result;
2369 }
2370
2371 =head2 TransformMarcToKohaOneField
2372
2373 =over 4
2374
2375 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2376
2377 =back
2378
2379 =cut
2380
2381 sub TransformMarcToKohaOneField {
2382
2383     # FIXME ? if a field has a repeatable subfield that is used in old-db,
2384     # only the 1st will be retrieved...
2385     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2386     my $res = "";
2387     my ( $tagfield, $subfield ) =
2388       GetMarcFromKohaField( $kohatable . "." . $kohafield,
2389         $frameworkcode );
2390     foreach my $field ( $record->field($tagfield) ) {
2391         if ( $field->tag() < 10 ) {
2392             if ( $result->{$kohafield} ) {
2393                 $result->{$kohafield} .= " | " . $field->data();
2394             }
2395             else {
2396                 $result->{$kohafield} = $field->data();
2397             }
2398         }
2399         else {
2400             if ( $field->subfields ) {
2401                 my @subfields = $field->subfields();
2402                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2403                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2404                         if ( $result->{$kohafield} ) {
2405                             $result->{$kohafield} .=
2406                               " | " . $subfields[$subfieldcount][1];
2407                         }
2408                         else {
2409                             $result->{$kohafield} =
2410                               $subfields[$subfieldcount][1];
2411                         }
2412                     }
2413                 }
2414             }
2415         }
2416     }
2417     return $result;
2418 }
2419
2420 =head1  OTHER FUNCTIONS
2421
2422 =head2 char_decode
2423
2424 =over 4
2425
2426 my $string = char_decode( $string, $encoding );
2427
2428 converts ISO 5426 coded string to UTF-8
2429 sloppy code : should be improved in next issue
2430
2431 =back
2432
2433 =cut
2434
2435 sub char_decode {
2436     my ( $string, $encoding ) = @_;
2437     $_ = $string;
2438
2439     $encoding = C4::Context->preference("marcflavour") unless $encoding;
2440     if ( $encoding eq "UNIMARC" ) {
2441
2442         #         s/\xe1/Æ/gm;
2443         s/\xe2/Ğ/gm;
2444         s/\xe9/Ø/gm;
2445         s/\xec/ş/gm;
2446         s/\xf1/æ/gm;
2447         s/\xf3/ğ/gm;
2448         s/\xf9/ø/gm;
2449         s/\xfb/ß/gm;
2450         s/\xc1\x61/à/gm;
2451         s/\xc1\x65/è/gm;
2452         s/\xc1\x69/ì/gm;
2453         s/\xc1\x6f/ò/gm;
2454         s/\xc1\x75/ù/gm;
2455         s/\xc1\x41/À/gm;
2456         s/\xc1\x45/È/gm;
2457         s/\xc1\x49/Ì/gm;
2458         s/\xc1\x4f/Ò/gm;
2459         s/\xc1\x55/Ù/gm;
2460         s/\xc2\x41/Á/gm;
2461         s/\xc2\x45/É/gm;
2462         s/\xc2\x49/Í/gm;
2463         s/\xc2\x4f/Ó/gm;
2464         s/\xc2\x55/Ú/gm;
2465         s/\xc2\x59/İ/gm;
2466         s/\xc2\x61/á/gm;
2467         s/\xc2\x65/é/gm;
2468         s/\xc2\x69/í/gm;
2469         s/\xc2\x6f/ó/gm;
2470         s/\xc2\x75/ú/gm;
2471         s/\xc2\x79/ı/gm;
2472         s/\xc3\x41/Â/gm;
2473         s/\xc3\x45/Ê/gm;
2474         s/\xc3\x49/Î/gm;
2475         s/\xc3\x4f/Ô/gm;
2476         s/\xc3\x55/Û/gm;
2477         s/\xc3\x61/â/gm;
2478         s/\xc3\x65/ê/gm;
2479         s/\xc3\x69/î/gm;
2480         s/\xc3\x6f/ô/gm;
2481         s/\xc3\x75/û/gm;
2482         s/\xc4\x41/Ã/gm;
2483         s/\xc4\x4e/Ñ/gm;
2484         s/\xc4\x4f/Õ/gm;
2485         s/\xc4\x61/ã/gm;
2486         s/\xc4\x6e/ñ/gm;
2487         s/\xc4\x6f/õ/gm;
2488         s/\xc8\x41/Ä/gm;
2489         s/\xc8\x45/Ë/gm;
2490         s/\xc8\x49/Ï/gm;
2491         s/\xc8\x61/ä/gm;
2492         s/\xc8\x65/ë/gm;
2493         s/\xc8\x69/ï/gm;
2494         s/\xc8\x6F/ö/gm;
2495         s/\xc8\x75/ü/gm;
2496         s/\xc8\x76/ÿ/gm;
2497         s/\xc9\x41/Ä/gm;
2498         s/\xc9\x45/Ë/gm;
2499         s/\xc9\x49/Ï/gm;
2500         s/\xc9\x4f/Ö/gm;
2501         s/\xc9\x55/Ü/gm;
2502         s/\xc9\x61/ä/gm;
2503         s/\xc9\x6f/ö/gm;
2504         s/\xc9\x75/ü/gm;
2505         s/\xca\x41/Å/gm;
2506         s/\xca\x61/å/gm;
2507         s/\xd0\x43/Ç/gm;
2508         s/\xd0\x63/ç/gm;
2509
2510         # this handles non-sorting blocks (if implementation requires this)
2511         $string = nsb_clean($_);
2512     }
2513     elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2514         ##MARC-8 to UTF-8
2515
2516         s/\xe1\x61/à/gm;
2517         s/\xe1\x65/è/gm;
2518         s/\xe1\x69/ì/gm;
2519         s/\xe1\x6f/ò/gm;
2520         s/\xe1\x75/ù/gm;
2521         s/\xe1\x41/À/gm;
2522         s/\xe1\x45/È/gm;
2523         s/\xe1\x49/Ì/gm;
2524         s/\xe1\x4f/Ò/gm;
2525         s/\xe1\x55/Ù/gm;
2526         s/\xe2\x41/Á/gm;
2527         s/\xe2\x45/É/gm;
2528         s/\xe2\x49/Í/gm;
2529         s/\xe2\x4f/Ó/gm;
2530         s/\xe2\x55/Ú/gm;
2531         s/\xe2\x59/İ/gm;
2532         s/\xe2\x61/á/gm;
2533         s/\xe2\x65/é/gm;
2534         s/\xe2\x69/í/gm;
2535         s/\xe2\x6f/ó/gm;
2536         s/\xe2\x75/ú/gm;
2537         s/\xe2\x79/ı/gm;
2538         s/\xe3\x41/Â/gm;
2539         s/\xe3\x45/Ê/gm;
2540         s/\xe3\x49/Î/gm;
2541         s/\xe3\x4f/Ô/gm;
2542         s/\xe3\x55/Û/gm;
2543         s/\xe3\x61/â/gm;
2544         s/\xe3\x65/ê/gm;
2545         s/\xe3\x69/î/gm;
2546         s/\xe3\x6f/ô/gm;
2547         s/\xe3\x75/û/gm;
2548         s/\xe4\x41/Ã/gm;
2549         s/\xe4\x4e/Ñ/gm;
2550         s/\xe4\x4f/Õ/gm;
2551         s/\xe4\x61/ã/gm;
2552         s/\xe4\x6e/ñ/gm;
2553         s/\xe4\x6f/õ/gm;
2554         s/\xe6\x41/Ă/gm;
2555         s/\xe6\x45/Ĕ/gm;
2556         s/\xe6\x65/ĕ/gm;
2557         s/\xe6\x61/ă/gm;
2558         s/\xe8\x45/Ë/gm;
2559         s/\xe8\x49/Ï/gm;
2560         s/\xe8\x65/ë/gm;
2561         s/\xe8\x69/ï/gm;
2562         s/\xe8\x76/ÿ/gm;
2563         s/\xe9\x41/A/gm;
2564         s/\xe9\x4f/O/gm;
2565         s/\xe9\x55/U/gm;
2566         s/\xe9\x61/a/gm;
2567         s/\xe9\x6f/o/gm;
2568         s/\xe9\x75/u/gm;
2569         s/\xea\x41/A/gm;
2570         s/\xea\x61/a/gm;
2571
2572         #Additional Turkish characters
2573         s/\x1b//gm;
2574         s/\x1e//gm;
2575         s/(\xf0)s/\xc5\x9f/gm;
2576         s/(\xf0)S/\xc5\x9e/gm;
2577         s/(\xf0)c/ç/gm;
2578         s/(\xf0)C/Ç/gm;
2579         s/\xe7\x49/\\xc4\xb0/gm;
2580         s/(\xe6)G/\xc4\x9e/gm;
2581         s/(\xe6)g/ğ\xc4\x9f/gm;
2582         s/\xB8/ı/gm;
2583         s/\xB9/£/gm;
2584         s/(\xe8|\xc8)o/ö/gm;
2585         s/(\xe8|\xc8)O/Ö/gm;
2586         s/(\xe8|\xc8)u/ü/gm;
2587         s/(\xe8|\xc8)U/Ü/gm;
2588         s/\xc2\xb8/\xc4\xb1/gm;
2589         s/¸/\xc4\xb1/gm;
2590
2591         # this handles non-sorting blocks (if implementation requires this)
2592         $string = nsb_clean($_);
2593     }
2594     return ($string);
2595 }
2596
2597 =head2 nsb_clean
2598
2599 =over 4
2600
2601 my $string = nsb_clean( $string, $encoding );
2602
2603 =back
2604
2605 =cut
2606
2607 sub nsb_clean {
2608     my $NSB      = '\x88';    # NSB : begin Non Sorting Block
2609     my $NSE      = '\x89';    # NSE : Non Sorting Block end
2610                               # handles non sorting blocks
2611     my ($string) = @_;
2612     $_ = $string;
2613     s/$NSB/(/gm;
2614     s/[ ]{0,1}$NSE/) /gm;
2615     $string = $_;
2616     return ($string);
2617 }
2618
2619 =head2 PrepareItemrecordDisplay
2620
2621 =over 4
2622
2623 PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber);
2624
2625 Returns a hash with all the fields for Display a given item data in a template
2626
2627 =back
2628
2629 =cut
2630
2631 sub PrepareItemrecordDisplay {
2632
2633     my ( $bibnum, $itemnum ) = @_;
2634
2635     my $dbh = C4::Context->dbh;
2636     my $frameworkcode = &GetFrameworkCode( $bibnum );
2637     my ( $itemtagfield, $itemtagsubfield ) =
2638       &GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2639     my $tagslib = &GetMarcStructure( 1, $frameworkcode );
2640     my $itemrecord = GetMarcItem( $bibnum, $itemnum) if ($itemnum);
2641     my @loop_data;
2642     my $authorised_values_sth =
2643       $dbh->prepare(
2644 "select authorised_value,lib from authorised_values where category=? order by lib"
2645       );
2646     foreach my $tag ( sort keys %{$tagslib} ) {
2647         my $previous_tag = '';
2648         if ( $tag ne '' ) {
2649             # loop through each subfield
2650             my $cntsubf;
2651             foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
2652                 next if ( subfield_is_koha_internal_p($subfield) );
2653                 next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
2654                 my %subfield_data;
2655                 $subfield_data{tag}           = $tag;
2656                 $subfield_data{subfield}      = $subfield;
2657                 $subfield_data{countsubfield} = $cntsubf++;
2658                 $subfield_data{kohafield}     =
2659                   $tagslib->{$tag}->{$subfield}->{'kohafield'};
2660
2661          #        $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
2662                 $subfield_data{marc_lib} =
2663                     "<span id=\"error\" title=\""
2664                   . $tagslib->{$tag}->{$subfield}->{lib} . "\">"
2665                   . substr( $tagslib->{$tag}->{$subfield}->{lib}, 0, 12 )
2666                   . "</span>";
2667                 $subfield_data{mandatory} =
2668                   $tagslib->{$tag}->{$subfield}->{mandatory};
2669                 $subfield_data{repeatable} =
2670                   $tagslib->{$tag}->{$subfield}->{repeatable};
2671                 $subfield_data{hidden} = "display:none"
2672                   if $tagslib->{$tag}->{$subfield}->{hidden};
2673                 my ( $x, $value );
2674                 ( $x, $value ) = _find_value( $tag, $subfield, $itemrecord )
2675                   if ($itemrecord);
2676                 $value =~ s/"/&quot;/g;
2677
2678                 # search for itemcallnumber if applicable
2679                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
2680                     'items.itemcallnumber'
2681                     && C4::Context->preference('itemcallnumber') )
2682                 {
2683                     my $CNtag =
2684                       substr( C4::Context->preference('itemcallnumber'), 0, 3 );
2685                     my $CNsubfield =
2686                       substr( C4::Context->preference('itemcallnumber'), 3, 1 );
2687                     my $temp = $itemrecord->field($CNtag) if ($itemrecord);
2688                     if ($temp) {
2689                         $value = $temp->subfield($CNsubfield);
2690                     }
2691                 }
2692                 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
2693                     my @authorised_values;
2694                     my %authorised_lib;
2695
2696                     # builds list, depending on authorised value...
2697                     #---- branch
2698                     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq
2699                         "branches" )
2700                     {
2701                         if ( ( C4::Context->preference("IndependantBranches") )
2702                             && ( C4::Context->userenv->{flags} != 1 ) )
2703                         {
2704                             my $sth =
2705                               $dbh->prepare(
2706 "select branchcode,branchname from branches where branchcode = ? order by branchname"
2707                               );
2708                             $sth->execute( C4::Context->userenv->{branch} );
2709                             push @authorised_values, ""
2710                               unless (
2711                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
2712                             while ( my ( $branchcode, $branchname ) =
2713                                 $sth->fetchrow_array )
2714                             {
2715                                 push @authorised_values, $branchcode;
2716                                 $authorised_lib{$branchcode} = $branchname;
2717                             }
2718                         }
2719                         else {
2720                             my $sth =
2721                               $dbh->prepare(
2722 "select branchcode,branchname from branches order by branchname"
2723                               );
2724                             $sth->execute;
2725                             push @authorised_values, ""
2726                               unless (
2727                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
2728                             while ( my ( $branchcode, $branchname ) =
2729                                 $sth->fetchrow_array )
2730                             {
2731                                 push @authorised_values, $branchcode;
2732                                 $authorised_lib{$branchcode} = $branchname;
2733                             }
2734                         }
2735
2736                         #----- itemtypes
2737                     }
2738                     elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq
2739                         "itemtypes" )
2740                     {
2741                         my $sth =
2742                           $dbh->prepare(
2743 "select itemtype,description from itemtypes order by description"
2744                           );
2745                         $sth->execute;
2746                         push @authorised_values, ""
2747                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2748                         while ( my ( $itemtype, $description ) =
2749                             $sth->fetchrow_array )
2750                         {
2751                             push @authorised_values, $itemtype;
2752                             $authorised_lib{$itemtype} = $description;
2753                         }
2754
2755                         #---- "true" authorised value
2756                     }
2757                     else {
2758                         $authorised_values_sth->execute(
2759                             $tagslib->{$tag}->{$subfield}->{authorised_value} );
2760                         push @authorised_values, ""
2761                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2762                         while ( my ( $value, $lib ) =
2763                             $authorised_values_sth->fetchrow_array )
2764                         {
2765                             push @authorised_values, $value;
2766                             $authorised_lib{$value} = $lib;
2767                         }
2768                     }
2769                     $subfield_data{marc_value} = CGI::scrolling_list(
2770                         -name     => 'field_value',
2771                         -values   => \@authorised_values,
2772                         -default  => "$value",
2773                         -labels   => \%authorised_lib,
2774                         -size     => 1,
2775                         -tabindex => '',
2776                         -multiple => 0,
2777                     );
2778                 }
2779                 elsif ( $tagslib->{$tag}->{$subfield}->{thesaurus_category} ) {
2780                     $subfield_data{marc_value} =
2781 "<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>";
2782
2783 #"
2784 # COMMENTED OUT because No $i is provided with this API.
2785 # And thus, no value_builder can be activated.
2786 # BUT could be thought over.
2787 #         } elsif ($tagslib->{$tag}->{$subfield}->{'value_builder'}) {
2788 #             my $plugin="value_builder/".$tagslib->{$tag}->{$subfield}->{'value_builder'};
2789 #             require $plugin;
2790 #             my $extended_param = plugin_parameters($dbh,$itemrecord,$tagslib,$i,0);
2791 #             my ($function_name,$javascript) = plugin_javascript($dbh,$record,$tagslib,$i,0);
2792 #             $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";
2793                 }
2794                 else {
2795                     $subfield_data{marc_value} =
2796 "<input type=\"text\" name=\"field_value\" value=\"$value\" size=50 maxlength=255>";
2797                 }
2798                 push( @loop_data, \%subfield_data );
2799             }
2800         }
2801     }
2802     my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
2803       if ( $itemrecord && $itemrecord->field($itemtagfield) );
2804     return {
2805         'itemtagfield'    => $itemtagfield,
2806         'itemtagsubfield' => $itemtagsubfield,
2807         'itemnumber'      => $itemnumber,
2808         'iteminformation' => \@loop_data
2809     };
2810 }
2811 #"
2812
2813 #
2814 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2815 # at the same time
2816 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2817 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2818 # =head2 ModZebrafiles
2819 #
2820 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2821 #
2822 # =cut
2823 #
2824 # sub ModZebrafiles {
2825 #
2826 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2827 #
2828 #     my $op;
2829 #     my $zebradir =
2830 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2831 #     unless ( opendir( DIR, "$zebradir" ) ) {
2832 #         warn "$zebradir not found";
2833 #         return;
2834 #     }
2835 #     closedir DIR;
2836 #     my $filename = $zebradir . $biblionumber;
2837 #
2838 #     if ($record) {
2839 #         open( OUTPUT, ">", $filename . ".xml" );
2840 #         print OUTPUT $record;
2841 #         close OUTPUT;
2842 #     }
2843 # }
2844
2845 =head2 ModZebra
2846
2847 =over 4
2848
2849 ModZebra( $biblionumber, $op, $server, $newRecord );
2850
2851     $biblionumber is the biblionumber we want to index
2852     $op is specialUpdate or delete, and is used to know what we want to do
2853     $server is the server that we want to update
2854     $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.
2855
2856 =back
2857
2858 =cut
2859
2860 sub ModZebra {
2861 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2862     my ( $biblionumber, $op, $server, $newRecord ) = @_;
2863     my $dbh=C4::Context->dbh;
2864
2865     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2866     # at the same time
2867     # replaced by a zebraqueue table, that is filled with ModZebra to run.
2868     # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2869
2870     if (C4::Context->preference("NoZebra")) {
2871         # lock the nozebra table : we will read index lines, update them in Perl process
2872         # and write everything in 1 transaction.
2873         # lock the table to avoid someone else overwriting what we are doing
2874         $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE');
2875         my %result; # the result hash that will be builded by deletion / add, and written on mySQL at the end, to improve speed
2876         my $record;
2877         if ($server eq 'biblioserver') {
2878             $record= GetMarcBiblio($biblionumber);
2879         } else {
2880             $record= C4::AuthoritiesMarc::GetAuthority($biblionumber);
2881         }
2882         if ($op eq 'specialUpdate') {
2883             # OK, we have to add or update the record
2884             # 1st delete (virtually, in indexes) ...
2885             %result = _DelBiblioNoZebra($biblionumber,$record,$server);
2886             # ... add the record
2887             %result=_AddBiblioNoZebra($biblionumber,$newRecord, $server, %result);
2888         } else {
2889             # it's a deletion, delete the record...
2890             # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
2891             %result=_DelBiblioNoZebra($biblionumber,$record,$server);
2892         }
2893         # ok, now update the database...
2894         my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
2895         foreach my $key (keys %result) {
2896             foreach my $index (keys %{$result{$key}}) {
2897                 $sth->execute($result{$key}->{$index}, $server, $key, $index);
2898             }
2899         }
2900         $dbh->do('UNLOCK TABLES');
2901
2902     } else {
2903         #
2904         # we use zebra, just fill zebraqueue table
2905         #
2906         my $sth=$dbh->prepare("insert into zebraqueue  (biblio_auth_number ,server,operation) values(?,?,?)");
2907         $sth->execute($biblionumber,$server,$op);
2908         $sth->finish;
2909     }
2910 }
2911
2912 =head2 GetNoZebraIndexes
2913
2914     %indexes = GetNoZebraIndexes;
2915
2916     return the data from NoZebraIndexes syspref.
2917
2918 =cut
2919
2920 sub GetNoZebraIndexes {
2921     my $index = C4::Context->preference('NoZebraIndexes');
2922     my %indexes;
2923     foreach my $line (split /('|"),/,$index) {
2924         $line =~ /(.*)=>(.*)/;
2925         my $index = substr($1,1); # get the index, don't forget to remove initial ' or "
2926         my $fields = $2;
2927         $index =~ s/'|"| //g;
2928         $fields =~ s/'|"| //g;
2929         $indexes{$index}=$fields;
2930     }
2931     return %indexes;
2932 }
2933
2934 =head1 INTERNAL FUNCTIONS
2935
2936 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
2937
2938     function to delete a biblio in NoZebra indexes
2939     This function does NOT delete anything in database : it reads all the indexes entries
2940     that have to be deleted & delete them in the hash
2941     The SQL part is done either :
2942     - after the Add if we are modifying a biblio (delete + add again)
2943     - immediatly after this sub if we are doing a true deletion.
2944     $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
2945
2946 =cut
2947
2948
2949 sub _DelBiblioNoZebra {
2950     my ($biblionumber, $record, $server)=@_;
2951
2952     # Get the indexes
2953     my $dbh = C4::Context->dbh;
2954     # Get the indexes
2955     my %index;
2956     my $title;
2957     if ($server eq 'biblioserver') {
2958         %index=GetNoZebraIndexes;
2959         # get title of the record (to store the 10 first letters with the index)
2960         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
2961         $title = lc($record->subfield($titletag,$titlesubfield));
2962     } else {
2963         # for authorities, the "title" is the $a mainentry
2964         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
2965         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
2966         $title = $record->subfield($authref->{auth_tag_to_report},'a');
2967         $index{'mainmainentry'}= $authref->{'auth_tag_to_report'}.'a';
2968         $index{'mainentry'}    = $authref->{'auth_tag_to_report'}.'*';
2969         $index{'auth_type'}    = '152b';
2970     }
2971
2972     my %result;
2973     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2974     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2975     # limit to 10 char, should be enough, and limit the DB size
2976     $title = substr($title,0,10);
2977     #parse each field
2978     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2979     foreach my $field ($record->fields()) {
2980         #parse each subfield
2981         next if $field->tag <10;
2982         foreach my $subfield ($field->subfields()) {
2983             my $tag = $field->tag();
2984             my $subfieldcode = $subfield->[0];
2985             my $indexed=0;
2986             # check each index to see if the subfield is stored somewhere
2987             # otherwise, store it in __RAW__ index
2988             foreach my $key (keys %index) {
2989 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2990                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
2991                     $indexed=1;
2992                     my $line= lc $subfield->[1];
2993                     # remove meaningless value in the field...
2994                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2995                     # ... and split in words
2996                     foreach (split / /,$line) {
2997                         next unless $_; # skip  empty values (multiple spaces)
2998                         # if the entry is already here, do nothing, the biblionumber has already be removed
2999                         unless ($result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) {
3000                             # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
3001                             $sth2->execute($server,$key,$_);
3002                             my $existing_biblionumbers = $sth2->fetchrow;
3003                             # it exists
3004                             if ($existing_biblionumbers) {
3005 #                                 warn " existing for $key $_: $existing_biblionumbers";
3006                                 $result{$key}->{$_} =$existing_biblionumbers;
3007                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3008                             }
3009                         }
3010                     }
3011                 }
3012             }
3013             # the subfield is not indexed, store it in __RAW__ index anyway
3014             unless ($indexed) {
3015                 my $line= lc $subfield->[1];
3016                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3017                 # ... and split in words
3018                 foreach (split / /,$line) {
3019                     next unless $_; # skip  empty values (multiple spaces)
3020                     # if the entry is already here, do nothing, the biblionumber has already be removed
3021                     unless ($result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/) {
3022                         # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
3023                         $sth2->execute($server,'__RAW__',$_);
3024                         my $existing_biblionumbers = $sth2->fetchrow;
3025                         # it exists
3026                         if ($existing_biblionumbers) {
3027                             $result{'__RAW__'}->{$_} =$existing_biblionumbers;
3028                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3029                         }
3030                     }
3031                 }
3032             }
3033         }
3034     }
3035     return %result;
3036 }
3037
3038 =head2 _AddBiblioNoZebra($biblionumber, $record, $server, %result);
3039
3040     function to add a biblio in NoZebra indexes
3041
3042 =cut
3043
3044 sub _AddBiblioNoZebra {
3045     my ($biblionumber, $record, $server, %result)=@_;
3046     my $dbh = C4::Context->dbh;
3047     # Get the indexes
3048     my %index;
3049     my $title;
3050     if ($server eq 'biblioserver') {
3051         %index=GetNoZebraIndexes;
3052         # get title of the record (to store the 10 first letters with the index)
3053         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
3054         $title = lc($record->subfield($titletag,$titlesubfield));
3055     } else {
3056         # warn "server : $server";
3057         # for authorities, the "title" is the $a mainentry
3058         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
3059         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
3060         $title = $record->subfield($authref->{auth_tag_to_report},'a');
3061         $index{'mainmainentry'} = $authref->{auth_tag_to_report}.'a';
3062         $index{'mainentry'}     = $authref->{auth_tag_to_report}.'*';
3063         $index{'auth_type'}     = '152b';
3064     }
3065
3066     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3067     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
3068     # limit to 10 char, should be enough, and limit the DB size
3069     $title = substr($title,0,10);
3070     #parse each field
3071     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3072     foreach my $field ($record->fields()) {
3073         #parse each subfield
3074         next if $field->tag <10;
3075         foreach my $subfield ($field->subfields()) {
3076             my $tag = $field->tag();
3077             my $subfieldcode = $subfield->[0];
3078             my $indexed=0;
3079             # check each index to see if the subfield is stored somewhere
3080             # otherwise, store it in __RAW__ index
3081             foreach my $key (keys %index) {
3082 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3083                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
3084                     $indexed=1;
3085                     my $line= lc $subfield->[1];
3086                     # remove meaningless value in the field...
3087                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3088                     # ... and split in words
3089                     foreach (split / /,$line) {
3090                         next unless $_; # skip  empty values (multiple spaces)
3091                         # if the entry is already here, improve weight
3092 #                         warn "managing $_";
3093                         if ($result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) {
3094                             my $weight=$1+1;
3095                             $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3096                             $result{$key}->{$_} .= "$biblionumber,$title-$weight;";
3097                         } else {
3098                             # get the value if it exist in the nozebra table, otherwise, create it
3099                             $sth2->execute($server,$key,$_);
3100                             my $existing_biblionumbers = $sth2->fetchrow;
3101                             # it exists
3102                             if ($existing_biblionumbers) {
3103                                 $result{$key}->{$_} =$existing_biblionumbers;
3104                                 my $weight=$1+1;
3105                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3106                                 $result{$key}->{$_} .= "$biblionumber,$title-$weight;";
3107                             # create a new ligne for this entry
3108                             } else {
3109 #                             warn "INSERT : $server / $key / $_";
3110                                 $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).', indexname='.$dbh->quote($key).',value='.$dbh->quote($_));
3111                                 $result{$key}->{$_}.="$biblionumber,$title-1;";
3112                             }
3113                         }
3114                     }
3115                 }
3116             }
3117             # the subfield is not indexed, store it in __RAW__ index anyway
3118             unless ($indexed) {
3119                 my $line= lc $subfield->[1];
3120                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3121                 # ... and split in words
3122                 foreach (split / /,$line) {
3123                     next unless $_; # skip  empty values (multiple spaces)
3124                     # if the entry is already here, improve weight
3125                     if ($result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/) {
3126                         my $weight=$1+1;
3127                         $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3128                         $result{'__RAW__'}->{$_} .= "$biblionumber,$title-$weight;";
3129                     } else {
3130                         # get the value if it exist in the nozebra table, otherwise, create it
3131                         $sth2->execute($server,'__RAW__',$_);
3132                         my $existing_biblionumbers = $sth2->fetchrow;
3133                         # it exists
3134                         if ($existing_biblionumbers) {
3135                             $result{'__RAW__'}->{$_} =$existing_biblionumbers;
3136                             my $weight=$1+1;
3137                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3138                             $result{'__RAW__'}->{$_} .= "$biblionumber,$title-$weight;";
3139                         # create a new ligne for this entry
3140                         } else {
3141                             $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).',  indexname="__RAW__",value='.$dbh->quote($_));
3142                             $result{'__RAW__'}->{$_}.="$biblionumber,$title-1;";
3143                         }
3144                     }
3145                 }
3146             }
3147         }
3148     }
3149     return %result;
3150 }
3151
3152
3153 =head2 MARCitemchange
3154
3155 =over 4
3156
3157 &MARCitemchange( $record, $itemfield, $newvalue )
3158
3159 Function to update a single value in an item field.
3160 Used twice, could probably be replaced by something else, but works well...
3161
3162 =back
3163
3164 =back
3165
3166 =cut
3167
3168 sub MARCitemchange {
3169     my ( $record, $itemfield, $newvalue ) = @_;
3170     my $dbh = C4::Context->dbh;
3171
3172     my ( $tagfield, $tagsubfield ) =
3173       GetMarcFromKohaField( $itemfield, "" );
3174     if ( ($tagfield) && ($tagsubfield) ) {
3175         my $tag = $record->field($tagfield);
3176         if ($tag) {
3177             $tag->update( $tagsubfield => $newvalue );
3178             $record->delete_field($tag);
3179             $record->insert_fields_ordered($tag);
3180         }
3181     }
3182 }
3183
3184 =head2 _koha_add_biblio
3185
3186 =over 4
3187
3188 _koha_add_biblio($dbh,$biblioitem);
3189
3190 Internal function to add a biblio ($biblio is a hash with the values)
3191
3192 =back
3193
3194 =cut
3195
3196 sub _koha_add_biblio {
3197     my ( $dbh, $biblio, $frameworkcode ) = @_;
3198     my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
3199     $sth->execute;
3200     my $data         = $sth->fetchrow_arrayref;
3201     my $biblionumber = $$data[0] + 1;
3202     my $series       = 0;
3203
3204     if ( $biblio->{'seriestitle'} ) { $series = 1 }
3205     $sth->finish;
3206     $sth = $dbh->prepare(
3207         "INSERT INTO biblio
3208     SET biblionumber  = ?, title = ?, author = ?, copyrightdate = ?, serial = ?, seriestitle = ?, notes = ?, abstract = ?, unititle = ?, frameworkcode = ? "
3209     );
3210     $sth->execute(
3211         $biblionumber,         $biblio->{'title'},
3212         $biblio->{'author'},   $biblio->{'copyrightdate'},
3213         $biblio->{'serial'},   $biblio->{'seriestitle'},
3214         $biblio->{'notes'},    $biblio->{'abstract'},
3215         $biblio->{'unititle'}, $frameworkcode
3216     );
3217
3218     $sth->finish;
3219     return ($biblionumber);
3220 }
3221
3222 =head2 _find_value
3223
3224 =over 4
3225
3226 ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
3227
3228 Find the given $subfield in the given $tag in the given
3229 MARC::Record $record.  If the subfield is found, returns
3230 the (indicators, value) pair; otherwise, (undef, undef) is
3231 returned.
3232
3233 PROPOSITION :
3234 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
3235 I suggest we export it from this module.
3236
3237 =back
3238
3239 =cut
3240
3241 sub _find_value {
3242     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
3243     my @result;
3244     my $indicator;
3245     if ( $tagfield < 10 ) {
3246         if ( $record->field($tagfield) ) {
3247             push @result, $record->field($tagfield)->data();
3248         }
3249         else {
3250             push @result, "";
3251         }
3252     }
3253     else {
3254         foreach my $field ( $record->field($tagfield) ) {
3255             my @subfields = $field->subfields();
3256             foreach my $subfield (@subfields) {
3257                 if ( @$subfield[0] eq $insubfield ) {
3258                     push @result, @$subfield[1];
3259                     $indicator = $field->indicator(1) . $field->indicator(2);
3260                 }
3261             }
3262         }
3263     }
3264     return ( $indicator, @result );
3265 }
3266
3267 =head2 _koha_modify_biblio
3268
3269 =over 4
3270
3271 $biblionumber = _koha_modify_biblio($dbh,$biblio);
3272 Internal function for updating the biblio table
3273
3274 =back
3275
3276 =cut
3277
3278 sub _koha_modify_biblio {
3279     my ( $dbh, $biblio ) = @_;
3280     # FIXME: this code could be made more portable by not hard-coding
3281     #        the values that are supposed to be in biblio table
3282     my $query = qq{
3283         UPDATE biblio
3284         SET    title = ?,
3285                author = ?,
3286                abstract = ?,
3287                copyrightdate = ?,
3288                seriestitle = ?,
3289                serial = ?,
3290                unititle = ?,
3291                notes = ?
3292         WHERE  biblionumber = ?
3293     };
3294     my $sth = $dbh->prepare($query);
3295
3296     $sth->execute(
3297         $biblio->{'title'},
3298         $biblio->{'author'},
3299         $biblio->{'abstract'},
3300         $biblio->{'copyrightdate'},
3301         $biblio->{'seriestitle'},
3302         $biblio->{'serial'},
3303         $biblio->{'unititle'},
3304         $biblio->{'notes'},
3305         $biblio->{'biblionumber'}
3306     ) if $biblio->{'biblionumber'};
3307
3308     warn $sth->err if $sth->err;
3309     warn "BIG ERROR :: No biblionumber for $biblio->{title}" if $biblio->{biblionumber} !~ /\d+/; # if it is not a number
3310     return ( $biblio->{'biblionumber'} );
3311 }
3312
3313 =head2 _koha_modify_biblioitem
3314
3315 =over 4
3316
3317 _koha_modify_biblioitem( $dbh, $biblioitem );
3318
3319 =back
3320
3321 =cut
3322
3323 sub _koha_modify_biblioitem {
3324     my ( $dbh, $biblioitem ) = @_;
3325     my $query;
3326 ##Recalculate LC in case it changed --TG
3327
3328     $biblioitem->{'itemtype'}      = $dbh->quote( $biblioitem->{'itemtype'} );
3329     $biblioitem->{'url'}           = $dbh->quote( $biblioitem->{'url'} );
3330     $biblioitem->{'isbn'}          = $dbh->quote( $biblioitem->{'isbn'} );
3331     $biblioitem->{'issn'}          = $dbh->quote( $biblioitem->{'issn'} );
3332     $biblioitem->{'publishercode'} =
3333       $dbh->quote( $biblioitem->{'publishercode'} );
3334     $biblioitem->{'publicationyear'} =
3335       $dbh->quote( $biblioitem->{'publicationyear'} );
3336     $biblioitem->{'classification'} =
3337       $dbh->quote( $biblioitem->{'classification'} );
3338     $biblioitem->{'dewey'}        = $dbh->quote( $biblioitem->{'dewey'} );
3339     $biblioitem->{'subclass'}     = $dbh->quote( $biblioitem->{'subclass'} );
3340     $biblioitem->{'illus'}        = $dbh->quote( $biblioitem->{'illus'} );
3341     $biblioitem->{'pages'}        = $dbh->quote( $biblioitem->{'pages'} );
3342     $biblioitem->{'volumeddesc'}  = $dbh->quote( $biblioitem->{'volumeddesc'} );
3343     $biblioitem->{'bnotes'}       = $dbh->quote( $biblioitem->{'bnotes'} );
3344     $biblioitem->{'size'}         = $dbh->quote( $biblioitem->{'size'} );
3345     $biblioitem->{'place'}        = $dbh->quote( $biblioitem->{'place'} );
3346     $biblioitem->{'collectiontitle'}        = $dbh->quote( $biblioitem->{'collectiontitle'} );
3347     $biblioitem->{'collectionissn'}         = $dbh->quote( $biblioitem->{'collectionissn'} );
3348     $biblioitem->{'collectionvolume'}       = $dbh->quote( $biblioitem->{'collectionvolume'} );
3349     $biblioitem->{'editionstatement'}       = $dbh->quote( $biblioitem->{'editionstatement'} );
3350     $biblioitem->{'editionresponsability'}  = $dbh->quote( $biblioitem->{'editionresponsability'} );
3351     $biblioitem->{'ccode'}        = $dbh->quote( $biblioitem->{'ccode'} );
3352     $biblioitem->{'biblionumber'} =
3353       $dbh->quote( $biblioitem->{'biblionumber'} );
3354
3355     $query = "UPDATE biblioitems SET
3356         itemtype        = $biblioitem->{'itemtype'},
3357         url             = $biblioitem->{'url'},
3358         isbn            = $biblioitem->{'isbn'},
3359         issn            = $biblioitem->{'issn'},
3360         publishercode   = $biblioitem->{'publishercode'},
3361         publicationyear = $biblioitem->{'publicationyear'},
3362         classification  = $biblioitem->{'classification'},
3363         dewey           = $biblioitem->{'dewey'},
3364         subclass        = $biblioitem->{'subclass'},
3365         illus           = $biblioitem->{'illus'},
3366         pages           = $biblioitem->{'pages'},
3367         volumeddesc     = $biblioitem->{'volumeddesc'},
3368         notes           = $biblioitem->{'bnotes'},
3369         size            = $biblioitem->{'size'},
3370         place           = $biblioitem->{'place'},
3371         collectiontitle = $biblioitem->{'collectiontitle'},
3372         collectionissn  = $biblioitem->{'collectionissn'},
3373         collectionvolume= $biblioitem->{'collectionvolume'},
3374         editionstatement= $biblioitem->{'editionstatement'},
3375         editionresponsability= $biblioitem->{'editionresponsability'},
3376         ccode           = $biblioitem->{'ccode'}
3377         where biblionumber = $biblioitem->{'biblionumber'}";
3378
3379     $dbh->do($query);
3380     if ( $dbh->errstr ) {
3381         warn "ERROR in _koha_modify_biblioitem $query";
3382     }
3383 }
3384
3385 =head2 _koha_add_biblioitem
3386
3387 =over 4
3388
3389 _koha_add_biblioitem( $dbh, $biblioitem );
3390
3391 Internal function to add a biblioitem
3392
3393 =back
3394
3395 =cut
3396
3397 sub _koha_add_biblioitem {
3398     my ( $dbh, $biblioitem ) = @_;
3399
3400     #  my $dbh   = C4Connect;
3401     my $sth = $dbh->prepare("SELECT max(biblioitemnumber) FROM biblioitems");
3402     my $data;
3403     my $bibitemnum;
3404
3405     $sth->execute;
3406     $data       = $sth->fetchrow_arrayref;
3407     $bibitemnum = $$data[0] + 1;
3408
3409     $sth->finish;
3410
3411     $sth = $dbh->prepare(
3412         "INSERT INTO biblioitems SET
3413             biblioitemnumber = ?, biblionumber    = ?,
3414             volume           = ?, number          = ?,
3415             classification   = ?, itemtype        = ?,
3416             url              = ?, isbn            = ?,
3417             issn             = ?, dewey           = ?,
3418             subclass         = ?, publicationyear = ?,
3419             publishercode    = ?, volumedate      = ?,
3420             volumeddesc      = ?, illus           = ?,
3421             pages            = ?, notes           = ?,
3422             size             = ?, lccn            = ?,
3423             marc             = ?, lcsort          = ?,
3424             place            = ?, ccode           = ?,
3425             collectiontitle  = ?, collectionissn  = ?,
3426             collectionvolume = ?, editionstatement= ?,
3427             editionresponsability= ?
3428           "
3429     );
3430     my ($lcsort) =
3431       calculatelc( $biblioitem->{'classification'} )
3432       . $biblioitem->{'subclass'};
3433     $sth->execute(
3434         $bibitemnum,                     $biblioitem->{'biblionumber'},
3435         $biblioitem->{'volume'},         $biblioitem->{'number'},
3436         $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
3437         $biblioitem->{'url'},            $biblioitem->{'isbn'},
3438         $biblioitem->{'issn'},           $biblioitem->{'dewey'},
3439         $biblioitem->{'subclass'},       $biblioitem->{'publicationyear'},
3440         $biblioitem->{'publishercode'},  $biblioitem->{'volumedate'},
3441         $biblioitem->{'volumeddesc'},    $biblioitem->{'illus'},
3442         $biblioitem->{'pages'},          $biblioitem->{'bnotes'},
3443         $biblioitem->{'size'},           $biblioitem->{'lccn'},
3444         $biblioitem->{'marc'},           $biblioitem->{'place'},
3445         $lcsort,                         $biblioitem->{'ccode'},
3446         $biblioitem->{'collectiontitle'},$biblioitem->{'collectionissn'},
3447         $biblioitem->{'collectionvolume'},$biblioitem->{'editionstatement'},
3448         $biblioitem->{'editionresponsability'}
3449     );
3450     $sth->finish;
3451     return ($bibitemnum);
3452 }
3453
3454 =head2 _koha_new_items
3455
3456 =over 4
3457
3458 _koha_new_items( $dbh, $item, $barcode );
3459
3460 =back
3461
3462 =cut
3463
3464 sub _koha_new_items {
3465     my ( $dbh, $item, $barcode ) = @_;
3466
3467     #  my $dbh   = C4Connect;
3468     my $sth = $dbh->prepare("Select max(itemnumber) from items");
3469     my $data;
3470     my $itemnumber;
3471     my $error = "";
3472
3473     $sth->execute;
3474     $data       = $sth->fetchrow_hashref;
3475     $itemnumber = $data->{'max(itemnumber)'} + 1;
3476     $sth->finish;
3477 ## Now calculate lccalnumber
3478     my ($cutterextra) = itemcalculator(
3479         $dbh,
3480         $item->{'biblioitemnumber'},
3481         $item->{'itemcallnumber'}
3482     );
3483
3484 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
3485     if ( $item->{'loan'} ) {
3486         $item->{'notforloan'} = $item->{'loan'};
3487     }
3488
3489     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
3490     if ( $item->{'dateaccessioned'} eq '' || !$item->{'dateaccessioned'} ) {
3491
3492         $sth = $dbh->prepare(
3493             "Insert into items set
3494             itemnumber           = ?,     biblionumber     = ?,
3495             multivolumepart      = ?,
3496             biblioitemnumber     = ?,     barcode          = ?,
3497             booksellerid         = ?,     dateaccessioned  = NOW(),
3498             homebranch           = ?,     holdingbranch    = ?,
3499             price                = ?,     replacementprice = ?,
3500             replacementpricedate = NOW(), datelastseen     = NOW(),
3501             multivolume          = ?,     stack            = ?,
3502             itemlost             = ?,     wthdrawn         = ?,
3503             paidfor              = ?,     itemnotes        = ?,
3504             itemcallnumber       =?,      notforloan       = ?,
3505             location             = ?,     Cutterextra      = ?
3506           "
3507         );
3508         $sth->execute(
3509             $itemnumber,                $item->{'biblionumber'},
3510             $item->{'multivolumepart'}, $item->{'biblioitemnumber'},
3511             $barcode,                   $item->{'booksellerid'},
3512             $item->{'homebranch'},      $item->{'holdingbranch'},
3513             $item->{'price'},           $item->{'replacementprice'},
3514             $item->{multivolume},       $item->{stack},
3515             $item->{itemlost},          $item->{wthdrawn},
3516             $item->{paidfor},           $item->{'itemnotes'},
3517             $item->{'itemcallnumber'},  $item->{'notforloan'},
3518             $item->{'location'},        $cutterextra
3519         );
3520     }
3521     else {
3522         $sth = $dbh->prepare(
3523             "INSERT INTO items SET
3524             itemnumber           = ?,     biblionumber     = ?,
3525             multivolumepart      = ?,
3526             biblioitemnumber     = ?,     barcode          = ?,
3527             booksellerid         = ?,     dateaccessioned  = ?,
3528             homebranch           = ?,     holdingbranch    = ?,
3529             price                = ?,     replacementprice = ?,
3530             replacementpricedate = NOW(), datelastseen     = NOW(),
3531             multivolume          = ?,     stack            = ?,
3532             itemlost             = ?,     wthdrawn         = ?,
3533             paidfor              = ?,     itemnotes        = ?,
3534             itemcallnumber       = ?,     notforloan       = ?,
3535             location             = ?,
3536             Cutterextra          = ?
3537                             "
3538         );
3539         $sth->execute(
3540             $itemnumber,                 $item->{'biblionumber'},
3541             $item->{'multivolumepart'},  $item->{'biblioitemnumber'},
3542             $barcode,                    $item->{'booksellerid'},
3543             $item->{'dateaccessioned'},  $item->{'homebranch'},
3544             $item->{'holdingbranch'},    $item->{'price'},
3545             $item->{'replacementprice'}, $item->{multivolume},
3546             $item->{stack},              $item->{itemlost},
3547             $item->{wthdrawn},           $item->{paidfor},
3548             $item->{'itemnotes'},        $item->{'itemcallnumber'},
3549             $item->{'notforloan'},       $item->{'location'},
3550             $cutterextra
3551         );
3552     }
3553     if ( defined $sth->errstr ) {
3554         $error .= $sth->errstr;
3555     }
3556     return ( $itemnumber, $error );
3557 }
3558
3559 =head2 _koha_modify_item
3560
3561 =over 4
3562
3563 _koha_modify_item( $dbh, $item, $op );
3564
3565 =back
3566
3567 =cut
3568
3569 sub _koha_modify_item {
3570     my ( $dbh, $item, $op ) = @_;
3571     $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
3572
3573     # if all we're doing is setting statuses, just update those and get out
3574     if ( $op eq "setstatus" ) {
3575         my $query =
3576           "UPDATE items SET itemlost=?,wthdrawn=?,binding=? WHERE itemnumber=?";
3577         my @bind = (
3578             $item->{'itemlost'}, $item->{'wthdrawn'},
3579             $item->{'binding'},  $item->{'itemnumber'}
3580         );
3581         my $sth = $dbh->prepare($query);
3582         $sth->execute(@bind);
3583         $sth->finish;
3584         return undef;
3585     }
3586 ## Now calculate lccalnumber
3587     my ($cutterextra) =
3588       itemcalculator( $dbh, $item->{'bibitemnum'}, $item->{'itemcallnumber'} );
3589
3590     my $query = "UPDATE items SET
3591 barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,homebranch=?,cutterextra=?, onloan=?, binding=?";
3592
3593     my @bind = (
3594         $item->{'barcode'},        $item->{'notes'},
3595         $item->{'itemcallnumber'}, $item->{'notforloan'},
3596         $item->{'location'},       $item->{multivolumepart},
3597         $item->{multivolume},      $item->{stack},
3598         $item->{wthdrawn},         $item->{holdingbranch},
3599         $item->{homebranch},       $cutterextra,
3600         $item->{onloan},           $item->{binding}
3601     );
3602     if ( $item->{'lost'} ne '' ) {
3603         $query =
3604 "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
3605                             itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
3606                              location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,cutterextra=?,onloan=?, binding=?";
3607         @bind = (
3608             $item->{'bibitemnum'},     $item->{'barcode'},
3609             $item->{'notes'},          $item->{'homebranch'},
3610             $item->{'lost'},           $item->{'wthdrawn'},
3611             $item->{'itemcallnumber'}, $item->{'notforloan'},
3612             $item->{'location'},       $item->{multivolumepart},
3613             $item->{multivolume},      $item->{stack},
3614             $item->{wthdrawn},         $item->{holdingbranch},
3615             $cutterextra,              $item->{onloan},
3616             $item->{binding}
3617         );
3618         if ( $item->{homebranch} ) {
3619             $query .= ",homebranch=?";
3620             push @bind, $item->{homebranch};
3621         }
3622         if ( $item->{holdingbranch} ) {
3623             $query .= ",holdingbranch=?";
3624             push @bind, $item->{holdingbranch};
3625         }
3626     }
3627     $query .= " where itemnumber=?";
3628     push @bind, $item->{'itemnum'};
3629     if ( $item->{'replacement'} ne '' ) {
3630         $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
3631     }
3632     my $sth = $dbh->prepare($query);
3633     $sth->execute(@bind);
3634     $sth->finish;
3635 }
3636
3637 =head2 _koha_delete_biblio
3638
3639 =over 4
3640
3641 $error = _koha_delete_biblio($dbh,$biblionumber);
3642
3643 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3644
3645 C<$dbh> - the database handle
3646 C<$biblionumber> - the biblionumber of the biblio to be deleted
3647
3648 =back
3649
3650 =cut
3651
3652 # FIXME: add error handling
3653
3654 sub _koha_delete_biblio {
3655     my ( $dbh, $biblionumber ) = @_;
3656
3657     # get all the data for this biblio
3658     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3659     $sth->execute($biblionumber);
3660
3661     if ( my $data = $sth->fetchrow_hashref ) {
3662
3663         # save the record in deletedbiblio
3664         # find the fields to save
3665         my $query = "INSERT INTO deletedbiblio SET ";
3666         my @bind  = ();
3667         foreach my $temp ( keys %$data ) {
3668             $query .= "$temp = ?,";
3669             push( @bind, $data->{$temp} );
3670         }
3671
3672         # replace the last , by ",?)"
3673         $query =~ s/\,$//;
3674         my $bkup_sth = $dbh->prepare($query);
3675         $bkup_sth->execute(@bind);
3676         $bkup_sth->finish;
3677
3678         # delete the biblio
3679         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3680         $del_sth->execute($biblionumber);
3681         $del_sth->finish;
3682     }
3683     $sth->finish;
3684     return undef;
3685 }
3686
3687 =head2 _koha_delete_biblioitems
3688
3689 =over 4
3690
3691 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3692
3693 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3694
3695 C<$dbh> - the database handle
3696 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3697
3698 =back
3699
3700 =cut
3701
3702 # FIXME: add error handling
3703
3704 sub _koha_delete_biblioitems {
3705     my ( $dbh, $biblioitemnumber ) = @_;
3706
3707     # get all the data for this biblioitem
3708     my $sth =
3709       $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3710     $sth->execute($biblioitemnumber);
3711
3712     if ( my $data = $sth->fetchrow_hashref ) {
3713
3714         # save the record in deletedbiblioitems
3715         # find the fields to save
3716         my $query = "INSERT INTO deletedbiblioitems SET ";
3717         my @bind  = ();
3718         foreach my $temp ( keys %$data ) {
3719             $query .= "$temp = ?,";
3720             push( @bind, $data->{$temp} );
3721         }
3722
3723         # replace the last , by ",?)"
3724         $query =~ s/\,$//;
3725         my $bkup_sth = $dbh->prepare($query);
3726         $bkup_sth->execute(@bind);
3727         $bkup_sth->finish;
3728
3729         # delete the biblioitem
3730         my $del_sth =
3731           $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3732         $del_sth->execute($biblioitemnumber);
3733         $del_sth->finish;
3734     }
3735     $sth->finish;
3736     return undef;
3737 }
3738
3739 =head2 _koha_delete_item
3740
3741 =over 4
3742
3743 _koha_delete_item( $dbh, $itemnum );
3744
3745 Internal function to delete an item record from the koha tables
3746
3747 =back
3748
3749 =cut
3750
3751 sub _koha_delete_item {
3752     my ( $dbh, $itemnum ) = @_;
3753
3754     my $sth = $dbh->prepare("select * from items where itemnumber=?");
3755     $sth->execute($itemnum);
3756     my $data = $sth->fetchrow_hashref;
3757     $sth->finish;
3758     my $query = "Insert into deleteditems set ";
3759     my @bind  = ();
3760     foreach my $temp ( keys %$data ) {
3761         $query .= "$temp = ?,";
3762         push( @bind, $data->{$temp} );
3763     }
3764     $query =~ s/\,$//;
3765
3766     #  print $query;
3767     $sth = $dbh->prepare($query);
3768     $sth->execute(@bind);
3769     $sth->finish;
3770     $sth = $dbh->prepare("Delete from items where itemnumber=?");
3771     $sth->execute($itemnum);
3772     $sth->finish;
3773 }
3774
3775 =head1 UNEXPORTED FUNCTIONS
3776
3777 =over 4
3778
3779 =head2 calculatelc
3780
3781 $lc = calculatelc($classification);
3782
3783 =back
3784
3785 =cut
3786
3787 sub calculatelc {
3788     my ($classification) = @_;
3789     $classification =~ s/^\s+|\s+$//g;
3790     my $i = 0;
3791     my $lc2;
3792     my $lc1;
3793
3794     for ( $i = 0 ; $i < length($classification) ; $i++ ) {
3795         my $c = ( substr( $classification, $i, 1 ) );
3796         if ( $c ge '0' && $c le '9' ) {
3797
3798             $lc2 = substr( $classification, $i );
3799             last;
3800         }
3801         else {
3802             $lc1 .= substr( $classification, $i, 1 );
3803
3804         }
3805     }    #while
3806
3807     my $other = length($lc1);
3808     if ( !$lc1 ) {
3809         $other = 0;
3810     }
3811
3812     my $extras;
3813     if ( $other < 4 ) {
3814         for ( 1 .. ( 4 - $other ) ) {
3815             $extras .= "0";
3816         }
3817     }
3818     $lc1 .= $extras;
3819     $lc2 =~ s/^ //g;
3820
3821     $lc2 =~ s/ //g;
3822     $extras = "";
3823     ##Find the decimal part of $lc2
3824     my $pos = index( $lc2, "." );
3825     if ( $pos < 0 ) { $pos = length($lc2); }
3826     if ( $pos >= 0 && $pos < 5 ) {
3827         ##Pad lc2 with zeros to create a 5digit decimal needed in marc record to sort as numeric
3828
3829         for ( 1 .. ( 5 - $pos ) ) {
3830             $extras .= "0";
3831         }
3832     }
3833     $lc2 = $extras . $lc2;
3834     return ( $lc1 . $lc2 );
3835 }
3836
3837 =head2 itemcalculator
3838
3839 =over 4
3840
3841 $cutterextra = itemcalculator( $dbh, $biblioitem, $callnumber );
3842
3843 =back
3844
3845 =cut
3846
3847 sub itemcalculator {
3848     my ( $dbh, $biblioitem, $callnumber ) = @_;
3849     my $sth =
3850       $dbh->prepare(
3851 "select classification, subclass from biblioitems where biblioitemnumber=?"
3852       );
3853
3854     $sth->execute($biblioitem);
3855     my ( $classification, $subclass ) = $sth->fetchrow;
3856     my $all         = $classification . " " . $subclass;
3857     my $total       = length($all);
3858     my $cutterextra = substr( $callnumber, $total - 1 );
3859
3860     return $cutterextra;
3861 }
3862
3863 =head2 ModBiblioMarc
3864
3865     &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3866
3867     Add MARC data for a biblio to koha
3868
3869     Function exported, but should NOT be used, unless you really know what you're doing
3870
3871 =cut
3872
3873 sub ModBiblioMarc {
3874
3875 # pass the MARC::Record to this function, and it will create the records in the marc field
3876     my ( $record, $biblionumber, $frameworkcode ) = @_;
3877     my $dbh = C4::Context->dbh;
3878     my @fields = $record->fields();
3879     if ( !$frameworkcode ) {
3880         $frameworkcode = "";
3881     }
3882     my $sth =
3883       $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3884     $sth->execute( $frameworkcode, $biblionumber );
3885     $sth->finish;
3886     my $encoding = C4::Context->preference("marcflavour");
3887
3888     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3889     if ( $encoding eq "UNIMARC" ) {
3890         my $string;
3891         if ( length($record->subfield( 100, "a" )) == 35 ) {
3892             $string = $record->subfield( 100, "a" );
3893             my $f100 = $record->field(100);
3894             $record->delete_field($f100);
3895         }
3896         else {
3897             $string = POSIX::strftime( "%Y%m%d", localtime );
3898             $string =~ s/\-//g;
3899             $string = sprintf( "%-*s", 35, $string );
3900         }
3901         substr( $string, 22, 6, "frey50" );
3902         unless ( $record->subfield( 100, "a" ) ) {
3903             $record->insert_grouped_field(
3904                 MARC::Field->new( 100, "", "", "a" => $string ) );
3905         }
3906     }
3907     ModZebra($biblionumber,"specialUpdate","biblioserver",$record);
3908     $sth =
3909       $dbh->prepare(
3910         "update biblioitems set marc=?,marcxml=?  where biblionumber=?");
3911     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding),
3912         $biblionumber );
3913     $sth->finish;
3914     return $biblionumber;
3915 }
3916
3917 =head2 AddItemInMarc
3918
3919 =over 4
3920
3921 $newbiblionumber = AddItemInMarc( $record, $biblionumber, $frameworkcode );
3922
3923 Add an item in a MARC record and save the MARC record
3924
3925 Function exported, but should NOT be used, unless you really know what you're doing
3926
3927 =back
3928
3929 =cut
3930
3931 sub AddItemInMarc {
3932
3933     # pass the MARC::Record to this function, and it will create the records in the marc tables
3934     my ( $record, $biblionumber, $frameworkcode ) = @_;
3935     my $newrec = &GetMarcBiblio($biblionumber);
3936
3937     # create it
3938     my @fields = $record->fields();
3939     foreach my $field (@fields) {
3940         $newrec->append_fields($field);
3941     }
3942
3943     # FIXME: should we be making sure the biblionumbers are the same?
3944     my $newbiblionumber =
3945       &ModBiblioMarc( $newrec, $biblionumber, $frameworkcode );
3946     return $newbiblionumber;
3947 }
3948
3949 =head2 z3950_extended_services
3950
3951 z3950_extended_services($serviceType,$serviceOptions,$record);
3952
3953     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.
3954
3955 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
3956
3957 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
3958
3959     action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
3960
3961 and maybe
3962
3963     recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
3964     syntax => the record syntax (transfer syntax)
3965     databaseName = Database from connection object
3966
3967     To set serviceOptions, call set_service_options($serviceType)
3968
3969 C<$record> the record, if one is needed for the service type
3970
3971     A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
3972
3973 =cut
3974
3975 sub z3950_extended_services {
3976     my ( $server, $serviceType, $action, $serviceOptions ) = @_;
3977
3978     # get our connection object
3979     my $Zconn = C4::Context->Zconn( $server, 0, 1 );
3980
3981     # create a new package object
3982     my $Zpackage = $Zconn->package();
3983
3984     # set our options
3985     $Zpackage->option( action => $action );
3986
3987     if ( $serviceOptions->{'databaseName'} ) {
3988         $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
3989     }
3990     if ( $serviceOptions->{'recordIdNumber'} ) {
3991         $Zpackage->option(
3992             recordIdNumber => $serviceOptions->{'recordIdNumber'} );
3993     }
3994     if ( $serviceOptions->{'recordIdOpaque'} ) {
3995         $Zpackage->option(
3996             recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
3997     }
3998
3999  # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
4000  #if ($serviceType eq 'itemorder') {
4001  #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
4002  #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
4003  #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
4004  #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
4005  #}
4006
4007     if ( $serviceOptions->{record} ) {
4008         $Zpackage->option( record => $serviceOptions->{record} );
4009
4010         # can be xml or marc
4011         if ( $serviceOptions->{'syntax'} ) {
4012             $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
4013         }
4014     }
4015
4016     # send the request, handle any exception encountered
4017     eval { $Zpackage->send($serviceType) };
4018     if ( $@ && $@->isa("ZOOM::Exception") ) {
4019         return "error:  " . $@->code() . " " . $@->message() . "\n";
4020     }
4021
4022     # free up package resources
4023     $Zpackage->destroy();
4024 }
4025
4026 =head2 set_service_options
4027
4028 my $serviceOptions = set_service_options($serviceType);
4029
4030 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
4031
4032 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
4033
4034 =cut
4035
4036 sub set_service_options {
4037     my ($serviceType) = @_;
4038     my $serviceOptions;
4039
4040 # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
4041 #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
4042
4043     if ( $serviceType eq 'commit' ) {
4044
4045         # nothing to do
4046     }
4047     if ( $serviceType eq 'create' ) {
4048
4049         # nothing to do
4050     }
4051     if ( $serviceType eq 'drop' ) {
4052         die "ERROR: 'drop' not currently supported (by Zebra)";
4053     }
4054     return $serviceOptions;
4055 }
4056
4057 =head2 GetItemsCount
4058
4059 $count = &GetItemsCount( $biblionumber);
4060 this function return count of item with $biblionumber
4061 =cut
4062
4063 sub GetItemsCount {
4064     my ( $biblionumber ) = @_;
4065     my $dbh = C4::Context->dbh;
4066     my $query = qq|SELECT count(*)
4067                   FROM  items
4068                   WHERE biblionumber=?|;
4069     my $sth = $dbh->prepare($query);
4070     $sth->execute($biblionumber);
4071     my $count = $sth->fetchrow;
4072     $sth->finish;
4073     return ($count);
4074 }
4075
4076 END { }    # module clean-up code here (global destructor)
4077
4078 1;
4079
4080 __END__
4081
4082 =head1 AUTHOR
4083
4084 Koha Developement team <info@koha.org>
4085
4086 Paul POULAIN paul.poulain@free.fr
4087
4088 Joshua Ferraro jmf@liblime.com
4089
4090 =cut
4091
4092 # $Id$
4093 # $Log$
4094 # Revision 1.221  2007/07/31 16:01:11  toins
4095 # Some new functions.
4096 # TransformHTMLtoMarc rewrited.
4097 #
4098 # Revision 1.220  2007/07/20 15:43:16  hdl
4099 # Bug Fixing GetMarcSubjects.
4100 # Links parameters were mixed.
4101 #
4102 # Revision 1.218  2007/07/19 07:40:08  hdl
4103 # Adding selection by location for inventory
4104 #
4105 # Revision 1.217  2007/07/03 13:47:44  tipaul
4106 # fixing some display bugs (itemtype not properly returned and a html table bug that makes items appear strangely
4107 #
4108 # Revision 1.216  2007/07/03 09:40:58  tipaul
4109 # return itemtype description properly
4110 #
4111 # Revision 1.215  2007/07/03 09:33:05  tipaul
4112 # 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
4113 #
4114 # Revision 1.214  2007/07/02 09:13:22  tipaul
4115 # 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
4116 #
4117 # Revision 1.213  2007/06/25 15:01:45  tipaul
4118 # bugfixes on unimarc 100 handling (the field used for encoding)
4119 #
4120 # Revision 1.212  2007/06/15 13:44:44  tipaul
4121 # some fixes (and only fixes)
4122 #
4123 # Revision 1.211  2007/06/15 09:40:06  toins
4124 # do not get $3 $4 and $5 on GetMarcSubjects GetMarcAuthors on unimarc flavour.
4125 #
4126 # Revision 1.210  2007/06/13 13:03:34  toins
4127 # removing warn compilation.
4128 #
4129 # Revision 1.209  2007/05/23 16:19:40  tipaul
4130 # various bugfixes (minor) and french translation updated
4131 #
4132 # Revision 1.208  2007/05/22 09:13:54  tipaul
4133 # Bugfixes & improvements (various and minor) :
4134 # - updating templates to have tmpl_process3.pl running without any errors
4135 # - adding a drupal-like css for prog templates (with 3 small images)
4136 # - fixing some bugs in circulation & other scripts
4137 # - updating french translation
4138 # - fixing some typos in templates
4139 #
4140 # Revision 1.207  2007/05/22 08:51:19  hdl
4141 # Changing GetMarcStructure signature.
4142 # Deleting first parameter $dbh
4143 #
4144 # Revision 1.206  2007/05/21 08:44:17  btoumi
4145 # add security when u delete biblio :
4146 # u must delete linked items before delete biblio
4147 #
4148 # Revision 1.205  2007/05/11 16:04:03  btoumi
4149 # bug fix:
4150 # problem in  displayed label link  with subject in detail.tmpl
4151 # ex: label random => rdom
4152 #
4153 # Revision 1.204  2007/05/10 14:45:15  tipaul
4154 # Koha NoZebra :
4155 # - support for authorities
4156 # - some bugfixes in ordering and "CCL" parsing
4157 # - support for authorities <=> biblios walking
4158 #
4159 # Seems I can do what I want now, so I consider its done, except for bugfixes that will be needed i m sure !
4160 #
4161 # Revision 1.203  2007/05/03 15:16:02  tipaul
4162 # BUGFIX for : NoZebra
4163 # - NoZebra features : seems they work fine now (adding, modifying, deleting)
4164 # - Biblio edition major bugfix : before this commit editing a biblio resulted in an item removal in marcxml field
4165 #
4166 # Revision 1.202  2007/05/02 16:44:31  tipaul
4167 # NoZebra SQL index management :
4168 # * adding 3 subs in Biblio.pm
4169 # - GetNoZebraIndexes, that get the index structure in a new systempreference (added with this commit)
4170 # - _DelBiblioNoZebra, that retrieve all index entries for a biblio and remove in a variable the biblio reference
4171 # - _AddBiblioNoZebra, that add index entries for a biblio.
4172 # 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).
4173 # I think the code has to be more deeply tested, but it works at least partially.
4174 #
4175 # Revision 1.201  2007/04/27 14:00:49  hdl
4176 # Removing $dbh from GetMarcFromKohaField (dbh is not used in this function.)
4177 #
4178 # Revision 1.200  2007/04/25 16:26:42  tipaul
4179 # 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 :
4180 # - add nozebra table management on biblio editing
4181 # - the index table content is hardcoded. I still have to add some specific systempref to let the library update it
4182 # - manage pagination (next/previous)
4183 # - manage facets
4184 # WHAT works :
4185 # - NZgetRecords : has exactly the same API & returns as zebra getQuery, except that some parameters are unused
4186 # - search & sort works quite good
4187 # - CQL parser is better that what I thought I could do : title="harry and sally" and publicationyear>2000 not itemtype=LIVR should work fine
4188 #
4189 # Revision 1.199  2007/04/24 09:07:53  tipaul
4190 # moving dotransfer to Biblio.pm::ModItemTransfer + some CheckReserves fixes
4191 #
4192 # Revision 1.198  2007/04/23 15:21:17  tipaul
4193 # renaming currenttransfers to transferstoreceive
4194 #
4195 # Revision 1.197  2007/04/18 17:00:14  tipaul
4196 # removing all useless %env / $env
4197 #
4198 # Revision 1.196  2007/04/17 08:48:00  tipaul
4199 # circulation cleaning continued: bufixing
4200 #
4201 # Revision 1.195  2007/04/04 16:46:22  tipaul
4202 # HUGE COMMIT : code cleaning circulation.
4203 #
4204 # some stuff to do, i'll write a mail on koha-devel NOW !
4205 #
4206 # Revision 1.194  2007/03/30 12:00:42  tipaul
4207 # 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...
4208 #
4209 # Revision 1.193  2007/03/29 16:45:53  tipaul
4210 # Code cleaning of Biblio.pm (continued)
4211 #
4212 # All subs have be cleaned :
4213 # - removed useless
4214 # - merged some
4215 # - reordering Biblio.pm completly
4216 # - using only naming conventions
4217 #
4218 # Seems to have broken nothing, but it still has to be heavily tested.
4219 # Note that Biblio.pm is now much more efficient than previously & probably more reliable as well.
4220 #
4221 # Revision 1.192  2007/03/29 13:30:31  tipaul
4222 # Code cleaning :
4223 # == Biblio.pm cleaning (useless) ==
4224 # * some sub declaration dropped
4225 # * removed modbiblio sub
4226 # * removed moditem sub
4227 # * removed newitems. It was used only in finishrecieve. Replaced by a TransformKohaToMarc+AddItem, that is better.
4228 # * removed MARCkoha2marcItem
4229 # * removed MARCdelsubfield declaration
4230 # * removed MARCkoha2marcBiblio
4231 #
4232 # == Biblio.pm cleaning (naming conventions) ==
4233 # * MARCgettagslib renamed to GetMarcStructure
4234 # * MARCgetitems renamed to GetMarcItem
4235 # * MARCfind_frameworkcode renamed to GetFrameworkCode
4236 # * MARCmarc2koha renamed to TransformMarcToKoha
4237 # * MARChtml2marc renamed to TransformHtmlToMarc
4238 # * MARChtml2xml renamed to TranformeHtmlToXml
4239 # * zebraop renamed to ModZebra
4240 #
4241 # == MARC=OFF ==
4242 # * removing MARC=OFF related scripts (in cataloguing directory)
4243 # * removed checkitems (function related to MARC=off feature, that is completly broken in head. If someone want to reintroduce it, hard work coming...)
4244 # * removed getitemsbybiblioitem (used only by MARC=OFF scripts, that is removed as well)
4245 #
4246 # Revision 1.191  2007/03/29 09:42:13  tipaul
4247 # adding default value new feature into cataloguing. The system (definition) part has already been added by toins
4248 #
4249 # Revision 1.190  2007/03/29 08:45:19  hdl
4250 # Deleting ignore_errors(1) pour MARC::Charset
4251 #
4252 # Revision 1.189  2007/03/28 10:39:16  hdl
4253 # removing $dbh as a parameter in AuthoritiesMarc functions
4254 # And reporting all differences into the scripts taht relies on those functions.