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