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 require Exporter;
  22 use C4::Context;
  23 use C4::Database;
  24 use MARC::Record;
  25
  26 use vars qw($VERSION @ISA @EXPORT);
  27
  28 # set the version for version checking
  29 $VERSION = 0.01;
  30
  31 @ISA = qw(Exporter);
  32
  33 #
  34 # don't forget MARCxxx subs are exported only for testing purposes. Should not be used
  35 # as the old-style API and the NEW one are the only public functions.
  36 #
  37 @EXPORT = qw(
  38   &updateBiblio &updateBiblioItem &updateItem
  39   &itemcount &newbiblio &newbiblioitem
  40   &modnote &newsubject &newsubtitle
  41   &modbiblio &checkitems
  42   &newitems &modbibitem
  43   &modsubtitle &modsubject &modaddauthor &moditem &countitems
  44   &delitem &deletebiblioitem &delbiblio
  45   &getbiblio
  46   &getbiblioitembybiblionumber
  47   &getbiblioitem &getitemsbybiblioitem
  48   &skip &getitemtypes
  49   &newcompletebiblioitem
  50
  51   &MARCfind_oldbiblionumber_from_MARCbibid
  52   &MARCfind_MARCbibid_from_oldbiblionumber
  53   &MARCfind_marc_from_kohafield
  54   &MARCfindsubfield
  55   &MARCfind_frameworkcode
  56   &MARCgettagslib
  57
  58   &NEWnewbiblio &NEWnewitem
  59   &NEWmodbiblio &NEWmoditem
  60   &NEWdelbiblio &NEWdelitem
  61
  62   &MARCaddbiblio &MARCadditem
  63   &MARCmodsubfield &MARCaddsubfield
  64   &MARCmodbiblio &MARCmoditem
  65   &MARCkoha2marcBiblio &MARCmarc2koha
  66   &MARCkoha2marcItem &MARChtml2marc
  67   &MARCgetbiblio &MARCgetitem
  68   &MARCaddword &MARCdelword
  69   &char_decode
  70 );
  71
  72 #
  73 #
  74 # MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC
  75 #
  76 #
  77 # all the following subs takes a MARC::Record as parameter and manage
  78 # the MARC-DB. They are called by the 1.0/1.2 xxx subs, and by the
  79 # NEWxxx subs (xxx deals with old-DB parameters, the NEWxxx deals with MARC-DB parameter)
  80
  81 =head1 NAME
  82
  83 C4::Biblio - acquisition, catalog  management functions
  84
  85 =head1 SYNOPSIS
  86
  87 move from 1.2 to 1.4 version :
  88 1.2 and previous version uses a specific API to manage biblios. This API uses old-DB style parameters.
  89 In the 1.4 version, we want to do 2 differents things :
  90  - keep populating the old-DB, that has a LOT less datas than MARC
  91  - populate the MARC-DB
  92 To populate the DBs we have 2 differents sources :
  93  - the standard acquisition system (through book sellers), that does'nt use MARC data
  94  - the MARC acquisition system, that uses MARC data.
  95
  96 Thus, we have 2 differents cases :
  97 - with the standard acquisition system, we have non MARC data and want to populate old-DB and MARC-DB, knowing it's an incomplete MARC-record
  98 - with the MARC acquisition system, we have MARC datas, and want to loose nothing in MARC-DB. So, we can't store datas in old-DB, then copy in MARC-DB. we MUST have an API for true MARC data, that populate MARC-DB then old-DB
  99
 100 That's why we need 4 subs :
 101 all I<subs beginning by MARC> manage only MARC tables. They manage MARC-DB with MARC::Record parameters
 102 all I<subs beginning by OLD> manage only OLD-DB tables. They manage old-DB with old-DB parameters
 103 all I<subs beginning by NEW> manage both OLD-DB and MARC tables. They use MARC::Record as parameters. it's the API that MUST be used in MARC acquisition system
 104 all I<subs beginning by seomething else> are the old-style API. They use old-DB as parameter, then call internally the OLD and MARC subs.
 105
 106 - NEW and old-style API should be used in koha to manage biblio
 107 - MARCsubs are divided in 2 parts :
 108 * some of them manage MARC parameters. They are heavily used in koha.
 109 * some of them manage MARC biblio : they are mostly used by NEW and old-style subs.
 110 - OLD are used internally only
 111
 112 all subs requires/use $dbh as 1st parameter.
 113
 114 I<NEWxxx related subs>
 115
 116 all subs requires/use $dbh as 1st parameter.
 117 those subs are used by the MARC-compliant version of koha : marc import, or marc management.
 118
 119 I<OLDxxx related subs>
 120
 121 all subs requires/use $dbh as 1st parameter.
 122 those subs are used by the MARC-compliant version of koha : marc import, or marc management.
 123
 124 They all are the exact copy of 1.0/1.2 version of the sub without the OLD.
 125 The OLDxxx is called by the original xxx sub.
 126 the 1.4 xxx sub also builds MARC::Record an calls the MARCxxx
 127
 128 WARNING : there is 1 difference between initialxxx and OLDxxx :
 129 the db header $dbh is always passed as parameter to avoid over-DB connexion
 130
 131 =head1 DESCRIPTION
 132
 133 =over 4
 134
 135 =item @tagslib = &MARCgettagslib($dbh,1|0,$itemtype);
 136
 137 last param is 1 for liblibrarian and 0 for libopac
 138 $itemtype contains the itemtype framework reference. If empty or does not exist, the default one is used
 139 returns a hash with tag/subfield meaning
 140 =item ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
 141
 142 finds MARC tag and subfield for a given kohafield
 143 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
 144
 145 =item $biblionumber = &MARCfind_oldbiblionumber_from_MARCbibid($dbh,$MARCbibi);
 146
 147 finds a old-db biblio number for a given MARCbibid number
 148
 149 =item $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$oldbiblionumber);
 150
 151 finds a MARC bibid from a old-db biblionumber
 152
 153 =item $MARCRecord = &MARCkoha2marcBiblio($dbh,$biblionumber,biblioitemnumber);
 154
 155 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem
 156
 157 =item $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);
 158
 159 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB item
 160
 161 =item $MARCRecord = &MARCkoha2marcSubtitle($dbh,$biblionumber,$subtitle);
 162
 163 MARCkoha2marcSubtitle is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB subtitle
 164
 165 =item $olddb = &MARCmarc2koha($dbh,$MARCRecord);
 166
 167 builds a hash with old-db datas from a MARC::Record
 168
 169 =item &MARCaddbiblio($dbh,$MARC::Record,$biblionumber);
 170
 171 creates a biblio (in the MARC tables only). $biblionumber is the old-db biblionumber of the biblio
 172
 173 =item &MARCaddsubfield($dbh,$bibid,$tagid,$indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
 174
 175 adds a subfield in a biblio (in the MARC tables only).
 176
 177 =item $MARCRecord = &MARCgetbiblio($dbh,$bibid);
 178
 179 Returns a MARC::Record for the biblio $bibid.
 180
 181 =item &MARCmodbiblio($dbh,$bibid,$record,$delete);
 182
 183 MARCmodbiblio changes a biblio for a biblio,MARC::Record passed as parameter
 184 It 1st delete the biblio, then recreates it.
 185 WARNING : the $delete parameter is not used anymore (too much unsolvable cases).
 186 =item ($subfieldid,$subfieldvalue) = &MARCmodsubfield($dbh,$subfieldid,$subfieldvalue);
 187
 188 MARCmodsubfield changes the value of a given subfield
 189
 190 =item $subfieldid = &MARCfindsubfield($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue);
 191
 192 MARCfindsubfield returns a subfield number given a bibid/tag/subfieldvalue values.
 193 Returns -1 if more than 1 answer
 194
 195 =item $subfieldid = &MARCfindsubfieldid($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
 196
 197 MARCfindsubfieldid find a subfieldid for a bibid/tag/tagorder/subfield/subfieldorder
 198
 199 =item &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
 200
 201 MARCdelsubfield delete a subfield for a bibid/tag/tagorder/subfield/subfieldorder
 202
 203 =item &MARCdelbiblio($dbh,$bibid);
 204
 205 MARCdelbiblio delete biblio $bibid
 206
 207 =item &MARCkoha2marcOnefield
 208
 209 used by MARCkoha2marc and should not be useful elsewhere
 210
 211 =item &MARCmarc2kohaOnefield
 212
 213 used by MARCmarc2koha and should not be useful elsewhere
 214
 215 =item MARCaddword
 216
 217 used to manage MARC_word table and should not be useful elsewhere
 218
 219 =item MARCdelword
 220
 221 used to manage MARC_word table and should not be useful elsewhere
 222
 223 =cut
 224
 225 sub MARCgettagslib {
 226     my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
 227     $frameworkcode = "" unless $frameworkcode;
 228     my $sth;
 229     my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
 230
 231     # check that framework exists
 232     $sth =
 233       $dbh->prepare(
 234         "select count(*) from marc_tag_structure where frameworkcode=?");
 235     $sth->execute($frameworkcode);
 236     my ($total) = $sth->fetchrow;
 237     $frameworkcode = "" unless ( $total > 0 );
 238     $sth =
 239       $dbh->prepare(
 240 "select tagfield,$libfield as lib,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield"
 241     );
 242     $sth->execute($frameworkcode);
 243     my ( $lib, $tag, $res, $tab, $mandatory, $repeatable );
 244
 245     while ( ( $tag, $lib, $mandatory, $repeatable ) = $sth->fetchrow ) {
 246         $res->{$tag}->{lib}        = $lib;
 247         $res->{$tab}->{tab}        = "";            # XXX
 248         $res->{$tag}->{mandatory}  = $mandatory;
 249         $res->{$tag}->{repeatable} = $repeatable;
 250     }
 251
 252     $sth =
 253       $dbh->prepare(
 254 "select tagfield,tagsubfield,$libfield as lib,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl from marc_subfield_structure where frameworkcode=? order by tagfield,tagsubfield"
 255     );
 256     $sth->execute($frameworkcode);
 257
 258     my $subfield;
 259     my $authorised_value;
 260     my $authtypecode;
 261     my $value_builder;
 262     my $kohafield;
 263     my $seealso;
 264     my $hidden;
 265     my $isurl;
 266
 267     while (
 268         ( $tag,         $subfield,   $lib,              $tab,
 269         $mandatory,     $repeatable, $authorised_value, $authtypecode,
 270         $value_builder, $kohafield,  $seealso,          $hidden,
 271         $isurl )
 272         = $sth->fetchrow
 273       )
 274     {
 275         $res->{$tag}->{$subfield}->{lib}              = $lib;
 276         $res->{$tag}->{$subfield}->{tab}              = $tab;
 277         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
 278         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
 279         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
 280         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
 281         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
 282         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
 283         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
 284         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
 285         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
 286     }
 287     return $res;
 288 }
 289
 290 sub MARCfind_marc_from_kohafield {
 291     my ( $dbh, $kohafield ) = @_;
 292     return 0, 0 unless $kohafield;
 293     my $sth =
 294       $dbh->prepare(
 295 "select tagfield,tagsubfield from marc_subfield_structure where kohafield=?"
 296     );
 297     $sth->execute($kohafield);
 298     my ( $tagfield, $tagsubfield ) = $sth->fetchrow;
 299     return ( $tagfield, $tagsubfield );
 300 }
 301
 302 sub MARCfind_oldbiblionumber_from_MARCbibid {
 303     my ( $dbh, $MARCbibid ) = @_;
 304     my $sth =
 305       $dbh->prepare("select biblionumber from marc_biblio where bibid=?");
 306     $sth->execute($MARCbibid);
 307     my ($biblionumber) = $sth->fetchrow;
 308     return $biblionumber;
 309 }
 310
 311 sub MARCfind_MARCbibid_from_oldbiblionumber {
 312     my ( $dbh, $oldbiblionumber ) = @_;
 313     my $sth =
 314       $dbh->prepare("select bibid from marc_biblio where biblionumber=?");
 315     $sth->execute($oldbiblionumber);
 316     my ($bibid) = $sth->fetchrow;
 317     return $bibid;
 318 }
 319
 320 sub MARCaddbiblio {
 321
 322 # pass the MARC::Record to this function, and it will create the records in the marc tables
 323     my ( $dbh, $record, $biblionumber, $frameworkcode, $bibid ) = @_;
 324     my @fields = $record->fields();
 325
 326     #   warn "IN MARCaddbiblio $bibid => ".$record->as_formatted;
 327     # my $bibid;
 328     # adding main table, and retrieving bibid
 329 # if bibid is sent, then it's not a true add, it's only a re-add, after a delete (ie, a mod)
 330     # if bibid empty => true add, find a new bibid number
 331     unless ($bibid) {
 332         $dbh->do(
 333 "lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ"
 334         );
 335         my $sth =
 336           $dbh->prepare(
 337 "insert into marc_biblio (datecreated,biblionumber,frameworkcode) values (now(),?,?)"
 338         );
 339         $sth->execute( $biblionumber, $frameworkcode );
 340         $sth = $dbh->prepare("select max(bibid) from marc_biblio");
 341         $sth->execute;
 342         ($bibid) = $sth->fetchrow;
 343         $sth->finish;
 344     }
 345     my $fieldcount = 0;
 346
 347     # now, add subfields...
 348     foreach my $field (@fields) {
 349         $fieldcount++;
 350         if ( $field->tag() < 10 ) {
 351             &MARCaddsubfield( $dbh, $bibid, $field->tag(), '', $fieldcount, '',
 352                 1, $field->data() );
 353         }
 354         else {
 355             my @subfields = $field->subfields();
 356             foreach my $subfieldcount ( 0 .. $#subfields ) {
 357                 &MARCaddsubfield(
 358                     $dbh,
 359                     $bibid,
 360                     $field->tag(),
 361                     $field->indicator(1) . $field->indicator(2),
 362                     $fieldcount,
 363                     $subfields[$subfieldcount][0],
 364                     $subfieldcount + 1,
 365                     $subfields[$subfieldcount][1]
 366                 );
 367             }
 368         }
 369     }
 370     $dbh->do("unlock tables");
 371     return $bibid;
 372 }
 373
 374 sub MARCadditem {
 375
 376 # pass the MARC::Record to this function, and it will create the records in the marc tables
 377     my ( $dbh, $record, $biblionumber ) = @_;
 378
 379     #    warn "adding : ".$record->as_formatted();
 380     # search for MARC biblionumber
 381     $dbh->do(
 382 "lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ"
 383     );
 384     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblionumber );
 385     my @fields = $record->fields();
 386     my $sth    =
 387       $dbh->prepare(
 388         "select max(tagorder) from marc_subfield_table where bibid=?");
 389     $sth->execute($bibid);
 390     my ($fieldcount) = $sth->fetchrow;
 391
 392     # now, add subfields...
 393     foreach my $field (@fields) {
 394         my @subfields = $field->subfields();
 395         $fieldcount++;
 396         foreach my $subfieldcount ( 0 .. $#subfields ) {
 397             &MARCaddsubfield(
 398                 $dbh,
 399                 $bibid,
 400                 $field->tag(),
 401                 $field->indicator(1) . $field->indicator(2),
 402                 $fieldcount,
 403                 $subfields[$subfieldcount][0],
 404                 $subfieldcount + 1,
 405                 $subfields[$subfieldcount][1]
 406             );
 407         }
 408     }
 409     $dbh->do("unlock tables");
 410     return $bibid;
 411 }
 412
 413 sub MARCaddsubfield {
 414
 415     # Add a new subfield to a tag into the DB.
 416     my (
 417         $dbh,      $bibid,        $tagid,         $tag_indicator,
 418         $tagorder, $subfieldcode, $subfieldorder, $subfieldvalues
 419       )
 420       = @_;
 421
 422     # if not value, end of job, we do nothing
 423     if ( length($subfieldvalues) == 0 ) {
 424         return;
 425     }
 426     if ( not($subfieldcode) ) {
 427         $subfieldcode = ' ';
 428     }
 429     my @subfieldvalues = split /\|/, $subfieldvalues;
 430     foreach my $subfieldvalue (@subfieldvalues) {
 431         if ( length($subfieldvalue) > 255 ) {
 432             $dbh->do(
 433 "lock tables marc_blob_subfield WRITE, marc_subfield_table WRITE"
 434             );
 435             my $sth =
 436               $dbh->prepare(
 437                 "insert into marc_blob_subfield (subfieldvalue) values (?)");
 438             $sth->execute($subfieldvalue);
 439             $sth =
 440               $dbh->prepare("select max(blobidlink)from marc_blob_subfield");
 441             $sth->execute;
 442             my ($res) = $sth->fetchrow;
 443             $sth =
 444               $dbh->prepare(
 445 "insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,valuebloblink) values (?,?,?,?,?,?,?)"
 446             );
 447             $sth->execute( $bibid, ( sprintf "%03s", $tagid ), $tagorder,
 448                 $tag_indicator, $subfieldcode, $subfieldorder, $res );
 449
 450             if ( $sth->errstr ) {
 451                 warn
 452 "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
 453             }
 454             $dbh->do("unlock tables");
 455         }
 456         else {
 457             my $sth =
 458               $dbh->prepare(
 459 "insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values (?,?,?,?,?,?,?)"
 460             );
 461             $sth->execute(
 462                 $bibid,        ( sprintf "%03s", $tagid ),
 463                 $tagorder,     $tag_indicator,
 464                 $subfieldcode, $subfieldorder,
 465                 $subfieldvalue
 466             );
 467             if ( $sth->errstr ) {
 468                 warn
 469 "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
 470             }
 471         }
 472         &MARCaddword(
 473             $dbh,          $bibid,         $tagid,       $tagorder,
 474             $subfieldcode, $subfieldorder, $subfieldvalue
 475         );
 476     }
 477 }
 478
 479 sub MARCgetbiblio {
 480
 481     # Returns MARC::Record of the biblio passed in parameter.
 482     my ( $dbh, $bibid ) = @_;
 483     my $record = MARC::Record->new();
 484
 485     #---- TODO : the leader is missing
 486     $record->leader('                        ');
 487     my $sth =
 488       $dbh->prepare(
 489 "select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
 490                                  from marc_subfield_table
 491                                  where bibid=? order by tag,tagorder,subfieldcode
 492                          "
 493     );
 494     my $sth2 =
 495       $dbh->prepare(
 496         "select subfieldvalue from marc_blob_subfield where blobidlink=?");
 497     $sth->execute($bibid);
 498     my $prevtagorder = 1;
 499     my $prevtag      = 'XXX';
 500     my $previndicator;
 501     my $field;        # for >=10 tags
 502     my $prevvalue;    # for <10 tags
 503     while ( my $row = $sth->fetchrow_hashref ) {
 504
 505         if ( $row->{'valuebloblink'} ) {    #---- search blob if there is one
 506             $sth2->execute( $row->{'valuebloblink'} );
 507             my $row2 = $sth2->fetchrow_hashref;
 508             $sth2->finish;
 509             $row->{'subfieldvalue'} = $row2->{'subfieldvalue'};
 510         }
 511         if ( $row->{tagorder} ne $prevtagorder || $row->{tag} ne $prevtag ) {
 512             $previndicator .= "  ";
 513             if ( $prevtag < 10 ) {
 514                 $record->add_fields( ( sprintf "%03s", $prevtag ), $prevvalue )
 515                   unless $prevtag eq "XXX";    # ignore the 1st loop
 516             }
 517             else {
 518                 $record->add_fields($field) unless $prevtag eq "XXX";
 519             }
 520             undef $field;
 521             $prevtagorder  = $row->{tagorder};
 522             $prevtag       = $row->{tag};
 523             $previndicator = $row->{tag_indicator};
 524             if ( $row->{tag} < 10 ) {
 525                 $prevvalue = $row->{subfieldvalue};
 526             }
 527             else {
 528                 $field = MARC::Field->new(
 529                     ( sprintf "%03s", $prevtag ),
 530                     substr( $row->{tag_indicator} . '  ', 0, 1 ),
 531                     substr( $row->{tag_indicator} . '  ', 1, 1 ),
 532                     $row->{'subfieldcode'},
 533                     $row->{'subfieldvalue'}
 534                 );
 535             }
 536         }
 537         else {
 538             if ( $row->{tag} < 10 ) {
 539                 $record->add_fields( ( sprintf "%03s", $row->{tag} ),
 540                     $row->{'subfieldvalue'} );
 541             }
 542             else {
 543                 $field->add_subfields( $row->{'subfieldcode'},
 544                     $row->{'subfieldvalue'} );
 545             }
 546             $prevtag       = $row->{tag};
 547             $previndicator = $row->{tag_indicator};
 548         }
 549     }
 550
 551     # the last has not been included inside the loop... do it now !
 552     if ( $prevtag ne "XXX" )
 553     { # check that we have found something. Otherwise, prevtag is still XXX and we
 554          # must return an empty record, not make MARC::Record fail because we try to
 555          # create a record with XXX as field :-(
 556         if ( $prevtag < 10 ) {
 557             $record->add_fields( $prevtag, $prevvalue );
 558         }
 559         else {
 560
 561             #           my $field = MARC::Field->new( $prevtag, "", "", %subfieldlist);
 562             $record->add_fields($field);
 563         }
 564     }
 565     return $record;
 566 }
 567
 568 sub MARCgetitem {
 569
 570     # Returns MARC::Record of the biblio passed in parameter.
 571     my ( $dbh, $bibid, $itemnumber ) = @_;
 572     my $record = MARC::Record->new();
 573
 574     # search MARC tagorder
 575     my $sth2 =
 576       $dbh->prepare(
 577 "select tagorder from marc_subfield_table,marc_subfield_structure where marc_subfield_table.tag=marc_subfield_structure.tagfield and marc_subfield_table.subfieldcode=marc_subfield_structure.tagsubfield and bibid=? and kohafield='items.itemnumber' and subfieldvalue=?"
 578     );
 579     $sth2->execute( $bibid, $itemnumber );
 580     my ($tagorder) = $sth2->fetchrow_array();
 581
 582     #---- TODO : the leader is missing
 583     my $sth =
 584       $dbh->prepare(
 585 "select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
 586                                  from marc_subfield_table
 587                                  where bibid=? and tagorder=? order by subfieldcode,subfieldorder
 588                          "
 589     );
 590     $sth2 =
 591       $dbh->prepare(
 592         "select subfieldvalue from marc_blob_subfield where blobidlink=?");
 593     $sth->execute( $bibid, $tagorder );
 594     while ( my $row = $sth->fetchrow_hashref ) {
 595         if ( $row->{'valuebloblink'} ) {    #---- search blob if there is one
 596             $sth2->execute( $row->{'valuebloblink'} );
 597             my $row2 = $sth2->fetchrow_hashref;
 598             $sth2->finish;
 599             $row->{'subfieldvalue'} = $row2->{'subfieldvalue'};
 600         }
 601         if ( $record->field( $row->{'tag'} ) ) {
 602             my $field;
 603
 604 #--- this test must stay as this, because of strange behaviour of mySQL/Perl DBI with char var containing a number...
 605             #--- sometimes, eliminates 0 at beginning, sometimes no ;-\\\
 606             if ( length( $row->{'tag'} ) < 3 ) {
 607                 $row->{'tag'} = "0" . $row->{'tag'};
 608             }
 609             $field = $record->field( $row->{'tag'} );
 610             if ($field) {
 611                 my $x =
 612                   $field->add_subfields( $row->{'subfieldcode'},
 613                     $row->{'subfieldvalue'} );
 614                 $record->delete_field($field);
 615                 $record->add_fields($field);
 616             }
 617         }
 618         else {
 619             if ( length( $row->{'tag'} ) < 3 ) {
 620                 $row->{'tag'} = "0" . $row->{'tag'};
 621             }
 622             my $temp =
 623               MARC::Field->new( $row->{'tag'}, " ", " ",
 624                 $row->{'subfieldcode'} => $row->{'subfieldvalue'} );
 625             $record->add_fields($temp);
 626         }
 627
 628     }
 629     return $record;
 630 }
 631
 632 sub MARCmodbiblio {
 633     my ( $dbh, $bibid, $record, $delete ) = @_;
 634     my $oldrecord = &MARCgetbiblio( $dbh, $bibid );
 635     if ( $oldrecord eq $record ) {
 636         return;
 637     }
 638
 639     # 1st delete the biblio,
 640     # 2nd recreate it
 641     my $biblionumber = MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
 642     &MARCdelbiblio( $dbh, $bibid, 1 );
 643     &MARCaddbiblio( $dbh, $record, $biblionumber, $bibid );
 644 }
 645
 646 sub MARCdelbiblio {
 647     my ( $dbh, $bibid, $keep_items ) = @_;
 648
 649     # if the keep_item is set to 1, then all items are preserved.
 650     # This flag is set when the delbiblio is called by modbiblio
 651     # due to a too complex structure of MARC (repeatable fields and subfields),
 652     # the best solution for a modif is to delete / recreate the record.
 653
 654 # 1st of all, copy the MARC::Record to deletedbiblio table => if a true deletion, MARC data will be kept.
 655 # if deletion called before MARCmodbiblio => won't do anything, as the oldbiblionumber doesn't
 656     # exist in deletedbiblio table
 657     my $record = MARCgetbiblio( $dbh, $bibid );
 658     my $oldbiblionumber =
 659       MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
 660     my $copy2deleted =
 661       $dbh->prepare("update deletedbiblio set marc=? where biblionumber=?");
 662     $copy2deleted->execute( $record->as_usmarc(), $oldbiblionumber );
 663
 664     # now, delete in MARC tables.
 665     if ( $keep_items eq 1 ) {
 666
 667         #search item field code
 668         my $sth =
 669           $dbh->prepare(
 670 "select tagfield from marc_subfield_structure where kohafield like 'items.%'"
 671         );
 672         $sth->execute;
 673         my $itemtag = $sth->fetchrow_hashref->{tagfield};
 674         $dbh->do(
 675 "delete from marc_subfield_table where bibid=$bibid and tag<>$itemtag"
 676         );
 677         $dbh->do(
 678 "delete from marc_word where bibid=$bibid and not (tagsubfield like \"$itemtag%\")"
 679         );
 680     }
 681     else {
 682         $dbh->do("delete from marc_biblio where bibid=$bibid");
 683         $dbh->do("delete from marc_subfield_table where bibid=$bibid");
 684         $dbh->do("delete from marc_word where bibid=$bibid");
 685     }
 686 }
 687
 688 sub MARCdelitem {
 689
 690     # delete the item passed in parameter in MARC tables.
 691     my ( $dbh, $bibid, $itemnumber ) = @_;
 692
 693     #    my $record = MARC::Record->new();
 694     # search MARC tagorder
 695     my $record = MARCgetitem( $dbh, $bibid, $itemnumber );
 696     my $copy2deleted =
 697       $dbh->prepare("update deleteditems set marc=? where itemnumber=?");
 698     $copy2deleted->execute( $record->as_usmarc(), $itemnumber );
 699
 700     my $sth2 =
 701       $dbh->prepare(
 702 "select tagorder from marc_subfield_table,marc_subfield_structure where marc_subfield_table.tag=marc_subfield_structure.tagfield and marc_subfield_table.subfieldcode=marc_subfield_structure.tagsubfield and bibid=? and kohafield='items.itemnumber' and subfieldvalue=?"
 703     );
 704     $sth2->execute( $bibid, $itemnumber );
 705     my ($tagorder) = $sth2->fetchrow_array();
 706     my $sth =
 707       $dbh->prepare(
 708         "delete from marc_subfield_table where bibid=? and tagorder=?");
 709     $sth->execute( $bibid, $tagorder );
 710 }
 711
 712 sub MARCmoditem {
 713     my ( $dbh, $record, $bibid, $itemnumber, $delete ) = @_;
 714     my $oldrecord = &MARCgetitem( $dbh, $bibid, $itemnumber );
 715
 716     # if nothing to change, don't waste time...
 717     if ( $oldrecord eq $record ) {
 718         return;
 719     }
 720
 721     # otherwise, skip through each subfield...
 722     my @fields = $record->fields();
 723
 724     # search old MARC item
 725     my $sth2 =
 726       $dbh->prepare(
 727 "select tagorder from marc_subfield_table,marc_subfield_structure where marc_subfield_table.tag=marc_subfield_structure.tagfield and marc_subfield_table.subfieldcode=marc_subfield_structure.tagsubfield and bibid=? and kohafield='items.itemnumber' and subfieldvalue=?"
 728     );
 729     $sth2->execute( $bibid, $itemnumber );
 730     my ($tagorder) = $sth2->fetchrow_array();
 731     foreach my $field (@fields) {
 732         my $oldfield      = $oldrecord->field( $field->tag() );
 733         my @subfields     = $field->subfields();
 734         my $subfieldorder = 0;
 735         foreach my $subfield (@subfields) {
 736             $subfieldorder++;
 737
 738             #                   warn "compare : $oldfield".$oldfield->subfield(@$subfield[0]);
 739             if ( $oldfield eq 0
 740                 or ( length( $oldfield->subfield( @$subfield[0] ) ) == 0 ) )
 741             {
 742
 743                 # just adding datas...
 744 #               warn "addfield : / $subfieldorder / @$subfield[0] - @$subfield[1]";
 745 #                               warn "NEW subfield : $bibid,".$field->tag().",".$tagorder.",".@$subfield[0].",".$subfieldorder.",".@$subfield[1].")";
 746                 &MARCaddsubfield(
 747                     $dbh,
 748                     $bibid,
 749                     $field->tag(),
 750                     $field->indicator(1) . $field->indicator(2),
 751                     $tagorder,
 752                     @$subfield[0],
 753                     $subfieldorder,
 754                     @$subfield[1]
 755                 );
 756             }
 757             else {
 758
 759 #               warn "modfield : / $subfieldorder / @$subfield[0] - @$subfield[1]";
 760                 # modify he subfield if it's a different string
 761                 if ( $oldfield->subfield( @$subfield[0] ) ne @$subfield[1] ) {
 762                     my $subfieldid = &MARCfindsubfieldid(
 763                         $dbh,          $bibid,
 764                         $field->tag(), $tagorder,
 765                         @$subfield[0], $subfieldorder
 766                     );
 767
 768 #                                       warn "changing : $subfieldid, $bibid,".$field->tag(),",$tagorder,@$subfield[0],@$subfield[1],$subfieldorder";
 769                     &MARCmodsubfield( $dbh, $subfieldid, @$subfield[1] );
 770                 }
 771             }
 772         }
 773     }
 774 }
 775
 776 sub MARCmodsubfield {
 777
 778     # Subroutine changes a subfield value given a subfieldid.
 779     my ( $dbh, $subfieldid, $subfieldvalue ) = @_;
 780     $dbh->do("lock tables marc_blob_subfield WRITE,marc_subfield_table WRITE");
 781     my $sth1 =
 782       $dbh->prepare(
 783         "select valuebloblink from marc_subfield_table where subfieldid=?");
 784     $sth1->execute($subfieldid);
 785     my ($oldvaluebloblink) = $sth1->fetchrow;
 786     $sth1->finish;
 787     my $sth;
 788
 789     # if too long, use a bloblink
 790     if ( length($subfieldvalue) > 255 ) {
 791
 792         # if already a bloblink, update it, otherwise, insert a new one.
 793         if ($oldvaluebloblink) {
 794             $sth =
 795               $dbh->prepare(
 796 "update marc_blob_subfield set subfieldvalue=? where blobidlink=?"
 797             );
 798             $sth->execute( $subfieldvalue, $oldvaluebloblink );
 799         }
 800         else {
 801             $sth =
 802               $dbh->prepare(
 803                 "insert into marc_blob_subfield (subfieldvalue) values (?)");
 804             $sth->execute($subfieldvalue);
 805             $sth =
 806               $dbh->prepare("select max(blobidlink) from marc_blob_subfield");
 807             $sth->execute;
 808             my ($res) = $sth->fetchrow;
 809             $sth =
 810               $dbh->prepare(
 811 "update marc_subfield_table set subfieldvalue=null, valuebloblink=? where subfieldid=?"
 812             );
 813             $sth->execute( $res, $subfieldid );
 814         }
 815     }
 816     else {
 817
 818 # note this can leave orphan bloblink. Not a big problem, but we should build somewhere a orphan deleting script...
 819         $sth =
 820           $dbh->prepare(
 821 "update marc_subfield_table set subfieldvalue=?,valuebloblink=null where subfieldid=?"
 822         );
 823         $sth->execute( $subfieldvalue, $subfieldid );
 824     }
 825     $dbh->do("unlock tables");
 826     $sth->finish;
 827     $sth =
 828       $dbh->prepare(
 829 "select bibid,tag,tagorder,subfieldcode,subfieldid,subfieldorder from marc_subfield_table where subfieldid=?"
 830     );
 831     $sth->execute($subfieldid);
 832     my ( $bibid, $tagid, $tagorder, $subfieldcode, $x, $subfieldorder ) =
 833       $sth->fetchrow;
 834     $subfieldid = $x;
 835     &MARCdelword( $dbh, $bibid, $tagid, $tagorder, $subfieldcode,
 836         $subfieldorder );
 837     &MARCaddword(
 838         $dbh,          $bibid,         $tagid,       $tagorder,
 839         $subfieldcode, $subfieldorder, $subfieldvalue
 840     );
 841     return ( $subfieldid, $subfieldvalue );
 842 }
 843
 844 sub MARCfindsubfield {
 845     my ( $dbh, $bibid, $tag, $subfieldcode, $subfieldorder, $subfieldvalue ) =
 846       @_;
 847     my $resultcounter = 0;
 848     my $subfieldid;
 849     my $lastsubfieldid;
 850     my $query =
 851 "select subfieldid from marc_subfield_table where bibid=? and tag=? and subfieldcode=?";
 852     my @bind_values = ( $bibid, $tag, $subfieldcode );
 853     if ($subfieldvalue) {
 854         $query .= " and subfieldvalue=?";
 855         push ( @bind_values, $subfieldvalue );
 856     }
 857     else {
 858         if ( $subfieldorder < 1 ) {
 859             $subfieldorder = 1;
 860         }
 861         $query .= " and subfieldorder=?";
 862         push ( @bind_values, $subfieldorder );
 863     }
 864     my $sti = $dbh->prepare($query);
 865     $sti->execute(@bind_values);
 866     while ( ($subfieldid) = $sti->fetchrow ) {
 867         $resultcounter++;
 868         $lastsubfieldid = $subfieldid;
 869     }
 870     if ( $resultcounter > 1 ) {
 871
 872 # Error condition.  Values given did not resolve into a unique record.  Don't know what to edit
 873 # should rarely occur (only if we use subfieldvalue with a value that exists twice, which is strange)
 874         return -1;
 875     }
 876     else {
 877         return $lastsubfieldid;
 878     }
 879 }
 880
 881 sub MARCfindsubfieldid {
 882     my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_;
 883     my $sth = $dbh->prepare( "select subfieldid from marc_subfield_table
 884                                 where bibid=? and tag=? and tagorder=?
 885                                         and subfieldcode=? and subfieldorder=?"
 886     );
 887     $sth->execute( $bibid, $tag, $tagorder, $subfield, $subfieldorder );
 888     my ($res) = $sth->fetchrow;
 889     unless ($res) {
 890         $sth = $dbh->prepare( "select subfieldid from marc_subfield_table
 891                                 where bibid=? and tag=? and tagorder=?
 892                                         and subfieldcode=?"
 893         );
 894         $sth->execute( $bibid, $tag, $tagorder, $subfield );
 895         ($res) = $sth->fetchrow;
 896     }
 897     return $res;
 898 }
 899
 900 sub MARCfind_frameworkcode {
 901     my ( $dbh, $bibid ) = @_;
 902     my $sth =
 903       $dbh->prepare("select frameworkcode from marc_biblio where bibid=?");
 904     $sth->execute($bibid);
 905     my ($frameworkcode) = $sth->fetchrow;
 906     return $frameworkcode;
 907 }
 908
 909 sub MARCdelsubfield {
 910
 911     # delete a subfield for $bibid / tag / tagorder / subfield / subfieldorder
 912     my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_;
 913     $dbh->do( "delete from marc_subfield_table where bibid='$bibid' and
 914                         tag='$tag' and tagorder='$tagorder'
 915                         and subfieldcode='$subfield' and subfieldorder='$subfieldorder'
 916                         "
 917     );
 918 }
 919
 920 sub MARCkoha2marcBiblio {
 921
 922     # this function builds partial MARC::Record from the old koha-DB fields
 923     my ( $dbh, $biblionumber, $biblioitemnumber ) = @_;
 924     my $sth =
 925       $dbh->prepare(
 926 "select tagfield,tagsubfield from marc_subfield_structure where kohafield=?"
 927     );
 928     my $record = MARC::Record->new();
 929
 930     #--- if bibid, then retrieve old-style koha data
 931     if ( $biblionumber > 0 ) {
 932         my $sth2 =
 933           $dbh->prepare(
 934 "select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp
 935                 from biblio where biblionumber=?"
 936         );
 937         $sth2->execute($biblionumber);
 938         my $row = $sth2->fetchrow_hashref;
 939         my $code;
 940         foreach $code ( keys %$row ) {
 941             if ( $row->{$code} ) {
 942                 &MARCkoha2marcOnefield( $sth, $record, "biblio." . $code,
 943                     $row->{$code} );
 944             }
 945         }
 946     }
 947
 948     #--- if biblioitem, then retrieve old-style koha data
 949     if ( $biblioitemnumber > 0 ) {
 950         my $sth2 =
 951           $dbh->prepare(
 952             " SELECT biblioitemnumber,biblionumber,volume,number,classification,
 953                                                 itemtype,url,isbn,issn,dewey,subclass,publicationyear,publishercode,
 954                                                 volumedate,volumeddesc,timestamp,illus,pages,notes AS bnotes,size,place
 955                                         FROM biblioitems
 956                                         WHERE biblioitemnumber=?
 957                                         "
 958         );
 959         $sth2->execute($biblioitemnumber);
 960         my $row = $sth2->fetchrow_hashref;
 961         my $code;
 962         foreach $code ( keys %$row ) {
 963             if ( $row->{$code} ) {
 964                 &MARCkoha2marcOnefield( $sth, $record, "biblioitems." . $code,
 965                     $row->{$code} );
 966             }
 967         }
 968     }
 969
 970     # other fields => additional authors, subjects, subtitles
 971     my $sth2 =
 972       $dbh->prepare(
 973         " SELECT author FROM additionalauthors WHERE biblionumber=?");
 974     $sth2->execute($biblionumber);
 975     while ( my $row = $sth2->fetchrow_hashref ) {
 976         &MARCkoha2marcOnefield( $sth, $record, "additionalauthors.author",
 977             $row->{'author'} );
 978     }
 979     my $sth2 =
 980       $dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?");
 981     $sth2->execute($biblionumber);
 982     while ( my $row = $sth2->fetchrow_hashref ) {
 983         &MARCkoha2marcOnefield( $sth, $record, "bibliosubject.subject",
 984             $row->{'subject'} );
 985     }
 986     my $sth2 =
 987       $dbh->prepare(
 988         " SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?");
 989     $sth2->execute($biblionumber);
 990     while ( my $row = $sth2->fetchrow_hashref ) {
 991         &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.title",
 992             $row->{'subtitle'} );
 993     }
 994     return $record;
 995 }
 996
 997 sub MARCkoha2marcItem {
 998
 999     # this function builds partial MARC::Record from the old koha-DB fields
1000     my ( $dbh, $biblionumber, $itemnumber ) = @_;
1001
1002     #    my $dbh=&C4Connect;
1003     my $sth =
1004       $dbh->prepare(
1005 "select tagfield,tagsubfield from marc_subfield_structure where kohafield=?"
1006     );
1007     my $record = MARC::Record->new();
1008
1009     #--- if item, then retrieve old-style koha data
1010     if ( $itemnumber > 0 ) {
1011
1012         #       print STDERR "prepare $biblionumber,$itemnumber\n";
1013         my $sth2 =
1014           $dbh->prepare(
1015 "SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned,
1016                                                 booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
1017                                                 datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,itemcallnumber,issues,renewals,
1018                                         reserves,restricted,binding,itemnotes,holdingbranch,timestamp
1019                                         FROM items
1020                                         WHERE itemnumber=?"
1021         );
1022         $sth2->execute($itemnumber);
1023         my $row = $sth2->fetchrow_hashref;
1024         my $code;
1025         foreach $code ( keys %$row ) {
1026             if ( $row->{$code} ) {
1027                 &MARCkoha2marcOnefield( $sth, $record, "items." . $code,
1028                     $row->{$code} );
1029             }
1030         }
1031     }
1032     return $record;
1033 }
1034
1035 sub MARCkoha2marcSubtitle {
1036
1037     # this function builds partial MARC::Record from the old koha-DB fields
1038     my ( $dbh, $bibnum, $subtitle ) = @_;
1039     my $sth =
1040       $dbh->prepare(
1041 "select tagfield,tagsubfield from marc_subfield_structure where kohafield=?"
1042     );
1043     my $record = MARC::Record->new();
1044     &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle",
1045         $subtitle );
1046     return $record;
1047 }
1048
1049 sub MARCkoha2marcOnefield {
1050     my ( $sth, $record, $kohafieldname, $value ) = @_;
1051     my $tagfield;
1052     my $tagsubfield;
1053     $sth->execute($kohafieldname);
1054     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
1055         if ( $record->field($tagfield) ) {
1056             my $tag = $record->field($tagfield);
1057             if ($tag) {
1058                 $tag->add_subfields( $tagsubfield, $value );
1059                 $record->delete_field($tag);
1060                 $record->add_fields($tag);
1061             }
1062         }
1063         else {
1064             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
1065         }
1066     }
1067     return $record;
1068 }
1069
1070 sub MARChtml2marc {
1071     my ( $dbh, $rtags, $rsubfields, $rvalues, %indicators ) = @_;
1072     my $prevtag = -1;
1073     my $record  = MARC::Record->new();
1074
1075     #   my %subfieldlist=();
1076     my $prevvalue;    # if tag <10
1077     my $field;        # if tag >=10
1078     for ( my $i = 0 ; $i < @$rtags ; $i++ ) {
1079
1080         # rebuild MARC::Record
1081         if ( @$rtags[$i] ne $prevtag ) {
1082             if ( $prevtag < 10 ) {
1083                 if ($prevvalue) {
1084                     $record->add_fields( ( sprintf "%03s", $prevtag ),
1085                         $prevvalue );
1086                 }
1087             }
1088             else {
1089                 if ($field) {
1090                     $record->add_fields($field);
1091                 }
1092             }
1093             $indicators{ @$rtags[$i] } .= '  ';
1094             if ( @$rtags[$i] < 10 ) {
1095                 $prevvalue = @$rvalues[$i];
1096             }
1097             else {
1098                 $field = MARC::Field->new(
1099                     ( sprintf "%03s", @$rtags[$i] ),
1100                     substr( $indicators{ @$rtags[$i] }, 0, 1 ),
1101                     substr( $indicators{ @$rtags[$i] }, 1, 1 ),
1102                     @$rsubfields[$i] => @$rvalues[$i]
1103                 );
1104             }
1105             $prevtag = @$rtags[$i];
1106         }
1107         else {
1108             if ( @$rtags[$i] < 10 ) {
1109                 $prevvalue = @$rvalues[$i];
1110             }
1111             else {
1112                 if ( @$rvalues[$i] ) {
1113                     $field->add_subfields( @$rsubfields[$i] => @$rvalues[$i] );
1114                 }
1115             }
1116             $prevtag = @$rtags[$i];
1117         }
1118     }
1119
1120     # the last has not been included inside the loop... do it now !
1121     $record->add_fields($field);
1122
1123     #   warn $record->as_formatted;
1124     return $record;
1125 }
1126
1127 sub MARCmarc2koha {
1128     my ( $dbh, $record ) = @_;
1129     my $sth =
1130       $dbh->prepare(
1131 "select tagfield,tagsubfield from marc_subfield_structure where kohafield=?"
1132     );
1133     my $result;
1134     my $sth2 = $dbh->prepare("SHOW COLUMNS from biblio");
1135     $sth2->execute;
1136     my $field;
1137
1138     #    print STDERR $record->as_formatted;
1139     while ( ($field) = $sth2->fetchrow ) {
1140         $result =
1141           &MARCmarc2kohaOneField( $sth, "biblio", $field, $record, $result );
1142     }
1143     $sth2 = $dbh->prepare("SHOW COLUMNS from biblioitems");
1144     $sth2->execute;
1145     while ( ($field) = $sth2->fetchrow ) {
1146         if ( $field eq 'notes' ) { $field = 'bnotes'; }
1147         $result =
1148           &MARCmarc2kohaOneField( $sth, "biblioitems", $field, $record,
1149             $result );
1150     }
1151     $sth2 = $dbh->prepare("SHOW COLUMNS from items");
1152     $sth2->execute;
1153     while ( ($field) = $sth2->fetchrow ) {
1154         $result =
1155           &MARCmarc2kohaOneField( $sth, "items", $field, $record, $result );
1156     }
1157
1158     # additional authors : specific
1159     $result =
1160       &MARCmarc2kohaOneField( $sth, "bibliosubtitle", "subtitle", $record,
1161         $result );
1162     $result =
1163       &MARCmarc2kohaOneField( $sth, "additionalauthors", "additionalauthors",
1164         $record, $result );
1165
1166     # modify copyrightdate to keep only the 1st year found
1167     my $temp = $result->{'copyrightdate'};
1168     $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
1169     if ( $1 > 0 ) {
1170         $result->{'copyrightdate'} = $1;
1171     }
1172     else {    # if no cYYYY, get the 1st date.
1173         $temp =~ m/(\d\d\d\d)/;
1174         $result->{'copyrightdate'} = $1;
1175     }
1176
1177     # modify publicationyear to keep only the 1st year found
1178     my $temp = $result->{'publicationyear'};
1179     $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
1180     if ( $1 > 0 ) {
1181         $result->{'publicationyear'} = $1;
1182     }
1183     else {    # if no cYYYY, get the 1st date.
1184         $temp =~ m/(\d\d\d\d)/;
1185         $result->{'publicationyear'} = $1;
1186     }
1187     return $result;
1188 }
1189
1190 sub MARCmarc2kohaOneField {
1191
1192 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
1193     my ( $sth, $kohatable, $kohafield, $record, $result ) = @_;
1194
1195     #    warn "kohatable / $kohafield / $result / ";
1196     my $res = "";
1197     my $tagfield;
1198     my $subfield;
1199     $sth->execute( $kohatable . "." . $kohafield );
1200     ( $tagfield, $subfield ) = $sth->fetchrow;
1201     foreach my $field ( $record->field($tagfield) ) {
1202         if ( $field->subfield($subfield) ) {
1203             if ( $result->{$kohafield} ) {
1204                 $result->{$kohafield} .= " | " . $field->subfield($subfield);
1205             }
1206             else {
1207                 $result->{$kohafield} = $field->subfield($subfield);
1208             }
1209         }
1210     }
1211     return $result;
1212 }
1213
1214 sub MARCaddword {
1215
1216     # split a subfield string and adds it into the word table.
1217     # removes stopwords
1218     my (
1219         $dbh,        $bibid,         $tag,    $tagorder,
1220         $subfieldid, $subfieldorder, $sentence
1221       )
1222       = @_;
1223     $sentence =~ s/(\.|\?|\:|\!|\'|,|\-|\"|\(|\)|\[|\]|\{|\})/ /g;
1224     my @words = split / /, $sentence;
1225     my $stopwords = C4::Context->stopwords;
1226     my $sth       =
1227       $dbh->prepare(
1228 "insert into marc_word (bibid, tagsubfield, tagorder, subfieldorder, word, sndx_word)
1229                         values (?,concat(?,?),?,?,?,soundex(?))"
1230     );
1231     foreach my $word (@words) {
1232
1233         # we record only words one char long and not in stopwords hash
1234         if ( length($word) >= 1 and !( $stopwords->{ uc($word) } ) ) {
1235             $sth->execute(
1236                 $bibid,         $tag,  $tagorder, $subfieldid,
1237                 $subfieldorder, $word, $word
1238             );
1239             if ( $sth->err() ) {
1240                 warn
1241 "ERROR ==> insert into marc_word (bibid, tagsubfield, tagorder, subfieldorder, word, sndx_word) values ($bibid,concat($tag,$subfieldid),$tagorder,$subfieldorder,$word,soundex($word))\n";
1242             }
1243         }
1244     }
1245 }
1246
1247 sub MARCdelword {
1248
1249 # delete words. this sub deletes all the words from a sentence. a subfield modif is done by a delete then a add
1250     my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_;
1251     my $sth =
1252       $dbh->prepare(
1253 "delete from marc_word where bibid=? and tagsubfield=concat(?,?) and tagorder=? and subfieldorder=?"
1254     );
1255     $sth->execute( $bibid, $tag, $subfield, $tagorder, $subfieldorder );
1256 }
1257
1258 #
1259 #
1260 # NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW
1261 #
1262 #
1263 # all the following subs are useful to manage MARC-DB with complete MARC records.
1264 # it's used with marcimport, and marc management tools
1265 #
1266
1267 =item ($bibid,$oldbibnum,$oldbibitemnum) = NEWnewbibilio($dbh,$MARCRecord,$oldbiblio,$oldbiblioitem);
1268
1269 creates a new biblio from a MARC::Record. The 3rd and 4th parameter are hashes and may be ignored. If only 2 params are passed to the sub, the old-db hashes
1270 are builded from the MARC::Record. If they are passed, they are used.
1271
1272 =item NEWnewitem($dbh, $record,$bibid);
1273
1274 adds an item in the db.
1275
1276 =cut
1277
1278 sub NEWnewbiblio {
1279     my ( $dbh, $record, $frameworkcode ) = @_;
1280     my $oldbibnum;
1281     my $oldbibitemnum;
1282     my $olddata = MARCmarc2koha( $dbh, $record );
1283     $oldbibnum = OLDnewbiblio( $dbh, $olddata );
1284     $olddata->{'biblionumber'} = $oldbibnum;
1285     $oldbibitemnum = OLDnewbiblioitem( $dbh, $olddata );
1286
1287     # search subtiles, addiauthors and subjects
1288     my ( $tagfield, $tagsubfield ) =
1289       MARCfind_marc_from_kohafield( $dbh, "additionalauthors.author" );
1290     my @addiauthfields = $record->field($tagfield);
1291     foreach my $addiauthfield (@addiauthfields) {
1292         my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
1293         foreach my $subfieldcount ( 0 .. $#addiauthsubfields ) {
1294             OLDmodaddauthor( $dbh, $oldbibnum,
1295                 $addiauthsubfields[$subfieldcount] );
1296         }
1297     }
1298     ( $tagfield, $tagsubfield ) =
1299       MARCfind_marc_from_kohafield( $dbh, "bibliosubtitle.title" );
1300     my @subtitlefields = $record->field($tagfield);
1301     foreach my $subtitlefield (@subtitlefields) {
1302         my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
1303         foreach my $subfieldcount ( 0 .. $#subtitlesubfields ) {
1304             OLDnewsubtitle( $dbh, $oldbibnum,
1305                 $subtitlesubfields[$subfieldcount] );
1306         }
1307     }
1308     ( $tagfield, $tagsubfield ) =
1309       MARCfind_marc_from_kohafield( $dbh, "bibliosubject.subject" );
1310     my @subj = $record->field($tagfield);
1311     my @subjects;
1312     foreach my $subject (@subj) {
1313         my @subjsubfield = $subject->subfield($tagsubfield);
1314         foreach my $subfieldcount ( 0 .. $#subjsubfield ) {
1315             push @subjects, $subjsubfield[$subfieldcount];
1316         }
1317     }
1318     OLDmodsubject( $dbh, $oldbibnum, 1, @subjects );
1319
1320     # we must add bibnum and bibitemnum in MARC::Record...
1321     # we build the new field with biblionumber and biblioitemnumber
1322     # we drop the original field
1323     # we add the new builded field.
1324 # NOTE : Works only if the field is ONLY for biblionumber and biblioitemnumber
1325     # (steve and paul : thinks 090 is a good choice)
1326     my $sth =
1327       $dbh->prepare(
1328 "select tagfield,tagsubfield from marc_subfield_structure where kohafield=?"
1329     );
1330     $sth->execute("biblio.biblionumber");
1331     ( my $tagfield1, my $tagsubfield1 ) = $sth->fetchrow;
1332     $sth->execute("biblioitems.biblioitemnumber");
1333     ( my $tagfield2, my $tagsubfield2 ) = $sth->fetchrow;
1334     if ( $tagfield1 != $tagfield2 ) {
1335         warn
1336 "Error in NEWnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number";
1337         print
1338 "Content-Type: text/html\n\nError in NEWnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number";
1339         die;
1340     }
1341     my $newfield = MARC::Field->new(
1342         $tagfield1, '', '', "$tagsubfield1" => $oldbibnum,
1343         "$tagsubfield2" => $oldbibitemnum
1344     );
1345
1346     # drop old field and create new one...
1347     my $old_field = $record->field($tagfield1);
1348     $record->delete_field($old_field);
1349     $record->add_fields($newfield);
1350     my $bibid = MARCaddbiblio( $dbh, $record, $oldbibnum, $frameworkcode );
1351     return ( $bibid, $oldbibnum, $oldbibitemnum );
1352 }
1353
1354 sub NEWmodbiblio {
1355     my ( $dbh, $record, $bibid, $frameworkcode ) = @_;
1356     $frameworkcode = "" unless $frameworkcode;
1357     &MARCmodbiblio( $dbh, $bibid, $record, 0 );
1358     my $oldbiblio = MARCmarc2koha( $dbh, $record );
1359     my $oldbiblionumber = OLDmodbiblio( $dbh, $oldbiblio );
1360     OLDmodbibitem( $dbh, $oldbiblio );
1361
1362     # now, modify addi authors, subject, addititles.
1363     my ( $tagfield, $tagsubfield ) =
1364       MARCfind_marc_from_kohafield( $dbh, "additionalauthors.author" );
1365     my @addiauthfields = $record->field($tagfield);
1366     foreach my $addiauthfield (@addiauthfields) {
1367         my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
1368         foreach my $subfieldcount ( 0 .. $#addiauthsubfields ) {
1369             OLDmodaddauthor( $dbh, $oldbiblionumber,
1370                 $addiauthsubfields[$subfieldcount] );
1371         }
1372     }
1373     ( $tagfield, $tagsubfield ) =
1374       MARCfind_marc_from_kohafield( $dbh, "bibliosubtitle.subtitle" );
1375     my @subtitlefields = $record->field($tagfield);
1376     foreach my $subtitlefield (@subtitlefields) {
1377         my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
1378         foreach my $subfieldcount ( 0 .. $#subtitlesubfields ) {
1379             OLDmodsubtitle( $dbh, $oldbiblionumber,
1380                 $subtitlesubfields[$subfieldcount] );
1381         }
1382     }
1383     ( $tagfield, $tagsubfield ) =
1384       MARCfind_marc_from_kohafield( $dbh, "bibliosubject.subject" );
1385     my @subj = $record->field($tagfield);
1386     my @subjects;
1387     foreach my $subject (@subj) {
1388         my @subjsubfield = $subject->subfield($tagsubfield);
1389         foreach my $subfieldcount ( 0 .. $#subjsubfield ) {
1390             push @subjects, $subjsubfield[$subfieldcount];
1391         }
1392     }
1393     OLDmodsubject( $dbh, $oldbiblionumber, 1, @subjects );
1394     return 1;
1395 }
1396
1397 sub NEWdelbiblio {
1398     my ( $dbh, $bibid ) = @_;
1399     my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
1400     &OLDdelbiblio( $dbh, $biblio );
1401     my $sth =
1402       $dbh->prepare(
1403         "select biblioitemnumber from biblioitems where biblionumber=?");
1404     $sth->execute($biblio);
1405     while ( my ($biblioitemnumber) = $sth->fetchrow ) {
1406         OLDdeletebiblioitem( $dbh, $biblioitemnumber );
1407     }
1408     &MARCdelbiblio( $dbh, $bibid, 0 );
1409 }
1410
1411 sub NEWnewitem {
1412     my ( $dbh, $record, $bibid ) = @_;
1413
1414     # add item in old-DB
1415     my $item = &MARCmarc2koha( $dbh, $record );
1416
1417     # needs old biblionumber and biblioitemnumber
1418     $item->{'biblionumber'} =
1419       MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
1420     my $sth =
1421       $dbh->prepare(
1422         "select biblioitemnumber from biblioitems where biblionumber=?");
1423     $sth->execute( $item->{'biblionumber'} );
1424     ( $item->{'biblioitemnumber'} ) = $sth->fetchrow;
1425     my ( $itemnumber, $error ) = &OLDnewitems( $dbh, $item, $item->{barcode} );
1426
1427     # add itemnumber to MARC::Record before adding the item.
1428     my $sth =
1429       $dbh->prepare(
1430 "select tagfield,tagsubfield from marc_subfield_structure where kohafield=?"
1431     );
1432     &MARCkoha2marcOnefield( $sth, $record, "items.itemnumber", $itemnumber );
1433
1434     # add the item
1435     my $bib = &MARCadditem( $dbh, $record, $item->{'biblionumber'} );
1436 }
1437
1438 sub NEWmoditem {
1439     my ( $dbh, $record, $bibid, $itemnumber, $delete ) = @_;
1440     &MARCmoditem( $dbh, $record, $bibid, $itemnumber, $delete );
1441     my $olditem = MARCmarc2koha( $dbh, $record );
1442     OLDmoditem( $dbh, $olditem );
1443 }
1444
1445 sub NEWdelitem {
1446     my ( $dbh, $bibid, $itemnumber ) = @_;
1447     my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
1448     &OLDdelitem( $dbh, $itemnumber );
1449     &MARCdelitem( $dbh, $bibid, $itemnumber );
1450 }
1451
1452 #
1453 #
1454 # OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD
1455 #
1456 #
1457
1458 =item $biblionumber = OLDnewbiblio($dbh,$biblio);
1459
1460 adds a record in biblio table. Datas are in the hash $biblio.
1461
1462 =item $biblionumber = OLDmodbiblio($dbh,$biblio);
1463
1464 modify a record in biblio table. Datas are in the hash $biblio.
1465
1466 =item OLDmodsubtitle($dbh,$bibnum,$subtitle);
1467
1468 modify subtitles in bibliosubtitle table.
1469
1470 =item OLDmodaddauthor($dbh,$bibnum,$author);
1471
1472 adds or modify additional authors
1473 NOTE :  Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
1474
1475 =item $errors = OLDmodsubject($dbh,$bibnum, $force, @subject);
1476
1477 modify/adds subjects
1478
1479 =item OLDmodbibitem($dbh, $biblioitem);
1480
1481 modify a biblioitem
1482
1483 =item OLDmodnote($dbh,$bibitemnum,$note
1484
1485 modify a note for a biblioitem
1486
1487 =item OLDnewbiblioitem($dbh,$biblioitem);
1488
1489 adds a biblioitem ($biblioitem is a hash with the values)
1490
1491 =item OLDnewsubject($dbh,$bibnum);
1492
1493 adds a subject
1494
1495 =item OLDnewsubtitle($dbh,$bibnum,$subtitle);
1496
1497 create a new subtitle
1498
1499 =item ($itemnumber,$errors)= OLDnewitems($dbh,$item,$barcode);
1500
1501 create a item. $item is a hash and $barcode the barcode.
1502
1503 =item OLDmoditem($dbh,$item);
1504
1505 modify item
1506
1507 =item OLDdelitem($dbh,$itemnum);
1508
1509 delete item
1510
1511 =item OLDdeletebiblioitem($dbh,$biblioitemnumber);
1512
1513 deletes a biblioitem
1514 NOTE : not standard sub name. Should be OLDdelbiblioitem()
1515
1516 =item OLDdelbiblio($dbh,$biblio);
1517
1518 delete a biblio
1519
1520 =cut
1521
1522 sub OLDnewbiblio {
1523     my ( $dbh, $biblio ) = @_;
1524
1525     #  my $dbh    = &C4Connect;
1526     my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
1527     $sth->execute;
1528     my $data   = $sth->fetchrow_arrayref;
1529     my $bibnum = $$data[0] + 1;
1530     my $series = 0;
1531
1532     if ( $biblio->{'seriestitle'} ) { $series = 1 }
1533     $sth->finish;
1534     $sth =
1535       $dbh->prepare(
1536 "insert into biblio set biblionumber  = ?, title = ?, author = ?, copyrightdate = ?, serial = ?, seriestitle = ?, notes = ?, abstract = ?"
1537     );
1538     $sth->execute(
1539         $bibnum,             $biblio->{'title'},
1540         $biblio->{'author'}, $biblio->{'copyrightdate'},
1541         $series,             $biblio->{'seriestitle'},
1542         $biblio->{'notes'},  $biblio->{'abstract'}
1543     );
1544
1545     $sth->finish;
1546
1547     #  $dbh->disconnect;
1548     return ($bibnum);
1549 }
1550
1551 sub OLDmodbiblio {
1552     my ( $dbh, $biblio ) = @_;
1553
1554     #  my $dbh   = C4Connect;
1555     my $query;
1556     my $sth;
1557
1558     $query = "";
1559     $sth   =
1560       $dbh->prepare(
1561 "Update biblio set title = ?, author = ?, abstract = ?, copyrightdate = ?, seriestitle = ?, serial = ?, unititle = ?, notes = ? where biblionumber = ?"
1562     );
1563     $sth->execute(
1564         $biblio->{'title'},       $biblio->{'author'},
1565         $biblio->{'abstract'},    $biblio->{'copyrightdate'},
1566         $biblio->{'seriestitle'}, $biblio->{'serial'},
1567         $biblio->{'unititle'},    $biblio->{'notes'},
1568         $biblio->{'biblionumber'}
1569     );
1570
1571     $sth->finish;
1572     return ( $biblio->{'biblionumber'} );
1573 }    # sub modbiblio
1574
1575 sub OLDmodsubtitle {
1576     my ( $dbh, $bibnum, $subtitle ) = @_;
1577     my $sth =
1578       $dbh->prepare(
1579         "update bibliosubtitle set subtitle = ? where biblionumber = ?");
1580     $sth->execute( $subtitle, $bibnum );
1581     $sth->finish;
1582 }    # sub modsubtitle
1583
1584 sub OLDmodaddauthor {
1585     my ( $dbh, $bibnum, @authors ) = @_;
1586
1587     #    my $dbh   = C4Connect;
1588     my $sth =
1589       $dbh->prepare("Delete from additionalauthors where biblionumber = ?");
1590
1591     $sth->execute($bibnum);
1592     $sth->finish;
1593     foreach my $author (@authors) {
1594         if ( $author ne '' ) {
1595             $sth =
1596               $dbh->prepare(
1597                 "Insert into additionalauthors set author = ?, biblionumber = ?"
1598             );
1599
1600             $sth->execute( $author, $bibnum );
1601
1602             $sth->finish;
1603         }    # if
1604     }
1605 }    # sub modaddauthor
1606
1607 sub OLDmodsubject {
1608     my ( $dbh, $bibnum, $force, @subject ) = @_;
1609
1610     #  my $dbh   = C4Connect;
1611     my $count = @subject;
1612     my $error;
1613     for ( my $i = 0 ; $i < $count ; $i++ ) {
1614         $subject[$i] =~ s/^ //g;
1615         $subject[$i] =~ s/ $//g;
1616         my $sth =
1617           $dbh->prepare(
1618 "select * from catalogueentry where entrytype = 's' and catalogueentry = ?"
1619         );
1620         $sth->execute( $subject[$i] );
1621
1622         if ( my $data = $sth->fetchrow_hashref ) {
1623         }
1624         else {
1625             if ( $force eq $subject[$i] || $force == 1 ) {
1626
1627                 # subject not in aut, chosen to force anway
1628                 # so insert into cataloguentry so its in auth file
1629                 my $sth2 =
1630                   $dbh->prepare(
1631 "Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)"
1632                 );
1633
1634                 $sth2->execute( $subject[$i] ) if ( $subject[$i] );
1635                 $sth2->finish;
1636             }
1637             else {
1638                 $error =
1639                   "$subject[$i]\n does not exist in the subject authority file";
1640                 my $sth2 =
1641                   $dbh->prepare(
1642 "Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)"
1643                 );
1644                 $sth2->execute( "$subject[$i] %", "% $subject[$i] %",
1645                     "% $subject[$i]" );
1646                 while ( my $data = $sth2->fetchrow_hashref ) {
1647                     $error .= "<br>$data->{'catalogueentry'}";
1648                 }    # while
1649                 $sth2->finish;
1650             }    # else
1651         }    # else
1652         $sth->finish;
1653     }    # else
1654     if ( $error eq '' ) {
1655         my $sth =
1656           $dbh->prepare("Delete from bibliosubject where biblionumber = ?");
1657         $sth->execute($bibnum);
1658         $sth->finish;
1659         $sth =
1660           $dbh->prepare(
1661             "Insert into bibliosubject (subject,biblionumber) values (?,?)");
1662         my $query;
1663         foreach $query (@subject) {
1664             $sth->execute( $query, $bibnum ) if ( $query && $bibnum );
1665         }    # foreach
1666         $sth->finish;
1667     }    # if
1668
1669     #  $dbh->disconnect;
1670     return ($error);
1671 }    # sub modsubject
1672
1673 sub OLDmodbibitem {
1674     my ( $dbh, $biblioitem ) = @_;
1675
1676     #    my $dbh   = C4Connect;
1677     my $query;
1678
1679     $biblioitem->{'itemtype'}      = $dbh->quote( $biblioitem->{'itemtype'} );
1680     $biblioitem->{'url'}           = $dbh->quote( $biblioitem->{'url'} );
1681     $biblioitem->{'isbn'}          = $dbh->quote( $biblioitem->{'isbn'} );
1682     $biblioitem->{'publishercode'} =
1683       $dbh->quote( $biblioitem->{'publishercode'} );
1684     $biblioitem->{'publicationyear'} =
1685       $dbh->quote( $biblioitem->{'publicationyear'} );
1686     $biblioitem->{'classification'} =
1687       $dbh->quote( $biblioitem->{'classification'} );
1688     $biblioitem->{'dewey'}       = $dbh->quote( $biblioitem->{'dewey'} );
1689     $biblioitem->{'subclass'}    = $dbh->quote( $biblioitem->{'subclass'} );
1690     $biblioitem->{'illus'}       = $dbh->quote( $biblioitem->{'illus'} );
1691     $biblioitem->{'pages'}       = $dbh->quote( $biblioitem->{'pages'} );
1692     $biblioitem->{'volumeddesc'} = $dbh->quote( $biblioitem->{'volumeddesc'} );
1693     $biblioitem->{'bnotes'}      = $dbh->quote( $biblioitem->{'bnotes'} );
1694     $biblioitem->{'size'}        = $dbh->quote( $biblioitem->{'size'} );
1695     $biblioitem->{'place'}       = $dbh->quote( $biblioitem->{'place'} );
1696
1697     $query = "Update biblioitems set
1698 itemtype        = $biblioitem->{'itemtype'},
1699 url             = $biblioitem->{'url'},
1700 isbn            = $biblioitem->{'isbn'},
1701 publishercode   = $biblioitem->{'publishercode'},
1702 publicationyear = $biblioitem->{'publicationyear'},
1703 classification  = $biblioitem->{'classification'},
1704 dewey           = $biblioitem->{'dewey'},
1705 subclass        = $biblioitem->{'subclass'},
1706 illus           = $biblioitem->{'illus'},
1707 pages           = $biblioitem->{'pages'},
1708 volumeddesc     = $biblioitem->{'volumeddesc'},
1709 notes           = $biblioitem->{'bnotes'},
1710 size            = $biblioitem->{'size'},
1711 place           = $biblioitem->{'place'}
1712 where biblioitemnumber = $biblioitem->{'biblioitemnumber'}";
1713
1714     $dbh->do($query);
1715     if ( $dbh->errstr ) {
1716         warn "$query";
1717     }
1718
1719     #    $dbh->disconnect;
1720 }    # sub modbibitem
1721
1722 sub OLDmodnote {
1723     my ( $dbh, $bibitemnum, $note ) = @_;
1724
1725     #  my $dbh=C4Connect;
1726     my $query = "update biblioitems set notes='$note' where
1727   biblioitemnumber='$bibitemnum'";
1728     my $sth = $dbh->prepare($query);
1729     $sth->execute;
1730     $sth->finish;
1731
1732     #  $dbh->disconnect;
1733 }
1734
1735 sub OLDnewbiblioitem {
1736     my ( $dbh, $biblioitem ) = @_;
1737
1738     #  my $dbh   = C4Connect;
1739     my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems");
1740     my $data;
1741     my $bibitemnum;
1742
1743     $sth->execute;
1744     $data       = $sth->fetchrow_arrayref;
1745     $bibitemnum = $$data[0] + 1;
1746
1747     $sth->finish;
1748
1749     $sth = $dbh->prepare( "insert into biblioitems set
1750                                                                         biblioitemnumber = ?,           biblionumber     = ?,
1751                                                                         volume           = ?,                   number           = ?,
1752                                                                         classification  = ?,                    itemtype         = ?,
1753                                                                         url              = ?,                           isbn             = ?,
1754                                                                         issn             = ?,                           dewey            = ?,
1755                                                                         subclass         = ?,                           publicationyear  = ?,
1756                                                                         publishercode    = ?,           volumedate       = ?,
1757                                                                         volumeddesc      = ?,           illus            = ?,
1758                                                                         pages            = ?,                           notes            = ?,
1759                                                                         size             = ?,                           lccn             = ?,
1760                                                                         marc             = ?,                           place            = ?"
1761     );
1762     $sth->execute(
1763         $bibitemnum,                     $biblioitem->{'biblionumber'},
1764         $biblioitem->{'volume'},         $biblioitem->{'number'},
1765         $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
1766         $biblioitem->{'url'},            $biblioitem->{'isbn'},
1767         $biblioitem->{'issn'},           $biblioitem->{'dewey'},
1768         $biblioitem->{'subclass'},       $biblioitem->{'publicationyear'},
1769         $biblioitem->{'publishercode'},  $biblioitem->{'volumedate'},
1770         $biblioitem->{'volumeddesc'},    $biblioitem->{'illus'},
1771         $biblioitem->{'pages'},          $biblioitem->{'bnotes'},
1772         $biblioitem->{'size'},           $biblioitem->{'lccn'},
1773         $biblioitem->{'marc'},           $biblioitem->{'place'}
1774     );
1775     $sth->finish;
1776
1777     #    $dbh->disconnect;
1778     return ($bibitemnum);
1779 }
1780
1781 sub OLDnewsubject {
1782     my ( $dbh, $bibnum ) = @_;
1783     my $sth =
1784       $dbh->prepare("insert into bibliosubject (biblionumber) values (?)");
1785     $sth->execute($bibnum);
1786     $sth->finish;
1787 }
1788
1789 sub OLDnewsubtitle {
1790     my ( $dbh, $bibnum, $subtitle ) = @_;
1791     my $sth =
1792       $dbh->prepare(
1793         "insert into bibliosubtitle set biblionumber = ?, subtitle = ?");
1794     $sth->execute( $bibnum, $subtitle );
1795     $sth->finish;
1796 }
1797
1798 sub OLDnewitems {
1799     my ( $dbh, $item, $barcode ) = @_;
1800
1801     #  my $dbh   = C4Connect;
1802     my $sth = $dbh->prepare("Select max(itemnumber) from items");
1803     my $data;
1804     my $itemnumber;
1805     my $error = "";
1806
1807     $sth->execute;
1808     $data       = $sth->fetchrow_hashref;
1809     $itemnumber = $data->{'max(itemnumber)'} + 1;
1810     $sth->finish;
1811
1812 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
1813     if ( $item->{'loan'} ) {
1814         $item->{'notforloan'} = $item->{'loan'};
1815     }
1816
1817     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1818     if ( $item->{'dateaccessioned'} ) {
1819         $sth = $dbh->prepare( "Insert into items set
1820                                                         itemnumber           = ?,                               biblionumber         = ?,
1821                                                         biblioitemnumber     = ?,                               barcode              = ?,
1822                                                         booksellerid         = ?,                                       dateaccessioned      = ?,
1823                                                         homebranch           = ?,                               holdingbranch        = ?,
1824                                                         price                = ?,                                               replacementprice     = ?,
1825                                                         replacementpricedate = NOW(),   itemnotes            = ?,
1826                                                         itemcallnumber  =?,                                                     notforloan = ?
1827                                                         "
1828         );
1829         $sth->execute(
1830             $itemnumber,                 $item->{'biblionumber'},
1831             $item->{'biblioitemnumber'}, $barcode,
1832             $item->{'booksellerid'},     $item->{'dateaccessioned'},
1833             $item->{'homebranch'},       $item->{'holdingbranch'},
1834             $item->{'price'},            $item->{'replacementprice'},
1835             $item->{'itemnotes'},        $item->{'itemcallnumber'},
1836             $item->{'notforloan'}
1837         );
1838     }
1839     else {
1840         $sth = $dbh->prepare( "Insert into items set
1841                                                         itemnumber           = ?,                               biblionumber         = ?,
1842                                                         biblioitemnumber     = ?,                               barcode              = ?,
1843                                                         booksellerid         = ?,                                       dateaccessioned      = NOW(),
1844                                                         homebranch           = ?,                               holdingbranch        = ?,
1845                                                         price                = ?,                                               replacementprice     = ?,
1846                                                         replacementpricedate = NOW(),   itemnotes            = ?,
1847                                                         itemcallnumber = ? , notforloan = ?
1848                                                         "
1849         );
1850         $sth->execute(
1851             $itemnumber,                 $item->{'biblionumber'},
1852             $item->{'biblioitemnumber'}, $barcode,
1853             $item->{'booksellerid'},     $item->{'homebranch'},
1854             $item->{'holdingbranch'},    $item->{'price'},
1855             $item->{'replacementprice'}, $item->{'itemnotes'},
1856             $item->{'itemcallnumber'},   $item->{'notforloan'}
1857         );
1858     }
1859     if ( defined $sth->errstr ) {
1860         $error .= $sth->errstr;
1861     }
1862     $sth->finish;
1863     return ( $itemnumber, $error );
1864 }
1865
1866 sub OLDmoditem {
1867     my ( $dbh, $item ) = @_;
1868
1869 #  my ($dbh,$loan,$itemnum,$bibitemnum,$barcode,$notes,$homebranch,$lost,$wthdrawn,$replacement)=@_;
1870     #  my $dbh=C4Connect;
1871     $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
1872     my $query =
1873 "update items set  barcode=?,itemnotes=?,itemcallnumber=?,notforloan=? where itemnumber=?";
1874     my @bind = (
1875         $item->{'barcode'},        $item->{'notes'},
1876         $item->{'itemcallnumber'}, $item->{'notforloan'},
1877         $item->{'itemnum'}
1878     );
1879     if ( $item->{'barcode'} eq '' ) {
1880         $item->{'notforloan'} = 0 unless $item->{'notforloan'};
1881         $query = "update items set notforloan=? where itemnumber=?";
1882         @bind = ( $item->{'notforloan'}, $item->{'itemnum'} );
1883     }
1884     if ( $item->{'lost'} ne '' ) {
1885         $query = "update items set biblioitemnumber=?,
1886                              barcode=?,
1887                              itemnotes=?,
1888                              homebranch=?,
1889                              itemlost=?,
1890                              wthdrawn=?,
1891                              itemcallnumber=?,
1892                              notforloan=?,
1893                           where itemnumber=?";
1894         @bind = (
1895             $item->{'bibitemnum'},     $item->{'barcode'},
1896             $item->{'notes'},          $item->{'homebranch'},
1897             $item->{'lost'},           $item->{'wthdrawn'},
1898             $item->{'itemcallnumber'}, $item->{'notforloan'},
1899             $item->{'itemnum'}
1900         );
1901     }
1902     if ( $item->{'replacement'} ne '' ) {
1903         $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1904     }
1905     my $sth = $dbh->prepare($query);
1906     $sth->execute(@bind);
1907     $sth->finish;
1908
1909     #  $dbh->disconnect;
1910 }
1911
1912 sub OLDdelitem {
1913     my ( $dbh, $itemnum ) = @_;
1914
1915     #  my $dbh=C4Connect;
1916     my $sth = $dbh->prepare("select * from items where itemnumber=?");
1917     $sth->execute($itemnum);
1918     my $data = $sth->fetchrow_hashref;
1919     $sth->finish;
1920     my $query = "Insert into deleteditems set ";
1921     my @bind  = ();
1922     foreach my $temp ( keys %$data ) {
1923         $query .= "$temp = ?,";
1924         push ( @bind, $data->{$temp} );
1925     }
1926     $query =~ s/\,$//;
1927
1928     #  print $query;
1929     $sth = $dbh->prepare($query);
1930     $sth->execute(@bind);
1931     $sth->finish;
1932     $sth = $dbh->prepare("Delete from items where itemnumber=?");
1933     $sth->execute($itemnum);
1934     $sth->finish;
1935
1936     #  $dbh->disconnect;
1937 }
1938
1939 sub OLDdeletebiblioitem {
1940     my ( $dbh, $biblioitemnumber ) = @_;
1941
1942     #    my $dbh   = C4Connect;
1943     my $sth = $dbh->prepare( "Select * from biblioitems
1944 where biblioitemnumber = ?"
1945     );
1946     my $results;
1947
1948     $sth->execute($biblioitemnumber);
1949
1950     if ( $results = $sth->fetchrow_hashref ) {
1951         $sth->finish;
1952         $sth =
1953           $dbh->prepare(
1954 "Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
1955                                         isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
1956                                         pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
1957         );
1958
1959         $sth->execute(
1960             $results->{biblioitemnumber}, $results->{biblionumber},
1961             $results->{volume},           $results->{number},
1962             $results->{classification},   $results->{itemtype},
1963             $results->{isbn},             $results->{issn},
1964             $results->{dewey},            $results->{subclass},
1965             $results->{publicationyear},  $results->{publishercode},
1966             $results->{volumedate},       $results->{volumeddesc},
1967             $results->{timestamp},        $results->{illus},
1968             $results->{pages},            $results->{notes},
1969             $results->{size},             $results->{url},
1970             $results->{lccn}
1971         );
1972         my $sth2 =
1973           $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?");
1974         $sth2->execute($biblioitemnumber);
1975         $sth2->finish();
1976     }    # if
1977     $sth->finish;
1978
1979     # Now delete all the items attached to the biblioitem
1980     $sth = $dbh->prepare("Select * from items where biblioitemnumber = ?");
1981     $sth->execute($biblioitemnumber);
1982     my @results;
1983     while ( my $data = $sth->fetchrow_hashref ) {
1984         my $query = "Insert into deleteditems set ";
1985         my @bind  = ();
1986         foreach my $temp ( keys %$data ) {
1987             $query .= "$temp = ?,";
1988             push ( @bind, $data->{$temp} );
1989         }
1990         $query =~ s/\,$//;
1991         my $sth2 = $dbh->prepare($query);
1992         $sth2->execute(@bind);
1993     }    # while
1994     $sth->finish;
1995     $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
1996     $sth->execute($biblioitemnumber);
1997     $sth->finish();
1998
1999     #    $dbh->disconnect;
2000 }    # sub deletebiblioitem
2001
2002 sub OLDdelbiblio {
2003     my ( $dbh, $biblio ) = @_;
2004     my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
2005     $sth->execute($biblio);
2006     if ( my $data = $sth->fetchrow_hashref ) {
2007         $sth->finish;
2008         my $query = "Insert into deletedbiblio set ";
2009         my @bind  = ();
2010         foreach my $temp ( keys %$data ) {
2011             $query .= "$temp = ?,";
2012             push ( @bind, $data->{$temp} );
2013         }
2014
2015         #replacing the last , by ",?)"
2016         $query =~ s/\,$//;
2017         $sth = $dbh->prepare($query);
2018         $sth->execute(@bind);
2019         $sth->finish;
2020         $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
2021         $sth->execute($biblio);
2022         $sth->finish;
2023     }
2024     $sth->finish;
2025 }
2026
2027 #
2028 #
2029 # old functions
2030 #
2031 #
2032
2033 sub itemcount {
2034     my ($biblio) = @_;
2035     my $dbh = C4::Context->dbh;
2036
2037     #  print $query;
2038     my $sth = $dbh->prepare("Select count(*) from items where biblionumber=?");
2039     $sth->execute($biblio);
2040     my $data = $sth->fetchrow_hashref;
2041     $sth->finish;
2042     return ( $data->{'count(*)'} );
2043 }
2044
2045 =item getorder
2046
2047   ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
2048
2049 Looks up the order with the given biblionumber and biblioitemnumber.
2050
2051 Returns a two-element array. C<$ordernumber> is the order number.
2052 C<$order> is a reference-to-hash describing the order; its keys are
2053 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
2054 tables of the Koha database.
2055
2056 =cut
2057
2058 #'
2059 # FIXME - This is effectively identical to &C4::Catalogue::getorder.
2060 # Pick one and stick with it.
2061 sub getorder {
2062     my ( $bi, $bib ) = @_;
2063     my $dbh = C4::Context->dbh;
2064     my $sth = $dbh->prepare( "Select ordernumber
2065         from aqorders
2066         where biblionumber=? and biblioitemnumber=?"
2067     );
2068     $sth->execute( $bib, $bi );
2069
2070     # FIXME - Use fetchrow_array(), since we're only interested in the one
2071     # value.
2072     my $ordnum = $sth->fetchrow_hashref;
2073     $sth->finish;
2074     my $order = getsingleorder( $ordnum->{'ordernumber'} );
2075     return ( $order, $ordnum->{'ordernumber'} );
2076 }
2077
2078 =item getsingleorder
2079
2080   $order = &getsingleorder($ordernumber);
2081
2082 Looks up an order by order number.
2083
2084 Returns a reference-to-hash describing the order. The keys of
2085 C<$order> are fields from the biblio, biblioitems, aqorders, and
2086 aqorderbreakdown tables of the Koha database.
2087
2088 =cut
2089
2090 #'
2091 # FIXME - This is effectively identical to
2092 # &C4::Catalogue::getsingleorder.
2093 # Pick one and stick with it.
2094 sub getsingleorder {
2095     my ($ordnum) = @_;
2096     my $dbh = C4::Context->dbh;
2097     my $sth =
2098       $dbh->prepare(
2099         "Select * from biblio,biblioitems,aqorders left join aqorderbreakdown
2100   on aqorders.ordernumber=aqorderbreakdown.ordernumber
2101   where aqorders.ordernumber=?
2102   and biblio.biblionumber=aqorders.biblionumber
2103   and biblioitems.biblioitemnumber=aqorders.biblioitemnumber"
2104     );
2105     $sth->execute($ordnum);
2106     my $data = $sth->fetchrow_hashref;
2107     $sth->finish;
2108     return ($data);
2109 }
2110
2111 sub newbiblio {
2112     my ($biblio) = @_;
2113     my $dbh    = C4::Context->dbh;
2114     my $bibnum = OLDnewbiblio( $dbh, $biblio );
2115
2116     # finds new (MARC bibid
2117     #   my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
2118     my $record = &MARCkoha2marcBiblio( $dbh, $bibnum );
2119     MARCaddbiblio( $dbh, $record, $bibnum );
2120     return ($bibnum);
2121 }
2122
2123 =item modbiblio
2124
2125   $biblionumber = &modbiblio($biblio);
2126
2127 Update a biblio record.
2128
2129 C<$biblio> is a reference-to-hash whose keys are the fields in the
2130 biblio table in the Koha database. All fields must be present, not
2131 just the ones you wish to change.
2132
2133 C<&modbiblio> updates the record defined by
2134 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
2135
2136 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
2137 successful or not.
2138
2139 =cut
2140
2141 sub modbiblio {
2142     my ($biblio) = @_;
2143     my $dbh = C4::Context->dbh;
2144     my $biblionumber = OLDmodbiblio( $dbh, $biblio );
2145     my $record = MARCkoha2marcBiblio( $dbh, $biblionumber, $biblionumber );
2146
2147     # finds new (MARC bibid
2148     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblionumber );
2149     MARCmodbiblio( $dbh, $bibid, $record, 0 );
2150     return ($biblionumber);
2151 }    # sub modbiblio
2152
2153 =item modsubtitle
2154
2155   &modsubtitle($biblionumber, $subtitle);
2156
2157 Sets the subtitle of a book.
2158
2159 C<$biblionumber> is the biblionumber of the book to modify.
2160
2161 C<$subtitle> is the new subtitle.
2162
2163 =cut
2164
2165 sub modsubtitle {
2166     my ( $bibnum, $subtitle ) = @_;
2167     my $dbh = C4::Context->dbh;
2168     &OLDmodsubtitle( $dbh, $bibnum, $subtitle );
2169 }    # sub modsubtitle
2170
2171 =item modaddauthor
2172
2173   &modaddauthor($biblionumber, $author);
2174
2175 Replaces all additional authors for the book with biblio number
2176 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
2177 C<&modaddauthor> deletes all additional authors.
2178
2179 =cut
2180
2181 sub modaddauthor {
2182     my ( $bibnum, @authors ) = @_;
2183     my $dbh = C4::Context->dbh;
2184     &OLDmodaddauthor( $dbh, $bibnum, @authors );
2185 }    # sub modaddauthor
2186
2187 =item modsubject
2188
2189   $error = &modsubject($biblionumber, $force, @subjects);
2190
2191 $force - a subject to force
2192
2193 $error - Error message, or undef if successful.
2194
2195 =cut
2196
2197 sub modsubject {
2198     my ( $bibnum, $force, @subject ) = @_;
2199     my $dbh = C4::Context->dbh;
2200     my $error = &OLDmodsubject( $dbh, $bibnum, $force, @subject );
2201     return ($error);
2202 }    # sub modsubject
2203
2204 sub modbibitem {
2205     my ($biblioitem) = @_;
2206     my $dbh = C4::Context->dbh;
2207     &OLDmodbibitem( $dbh, $biblioitem );
2208 }    # sub modbibitem
2209
2210 sub modnote {
2211     my ( $bibitemnum, $note ) = @_;
2212     my $dbh = C4::Context->dbh;
2213     &OLDmodnote( $dbh, $bibitemnum, $note );
2214 }
2215
2216 sub newbiblioitem {
2217     my ($biblioitem) = @_;
2218     my $dbh        = C4::Context->dbh;
2219     my $bibitemnum = &OLDnewbiblioitem( $dbh, $biblioitem );
2220
2221     ################################################################
2222     ## Fix template and shift this to newbiblio
2223     my @subjects = split ( /\n/, $biblioitem->{'subjectheadings'} );
2224     modsubject( $biblioitem->{'biblionumber'}, 1, @subjects );
2225
2226     ################################################################
2227     my $MARCbiblio =
2228       MARCkoha2marcBiblio( $dbh, 0, $bibitemnum )
2229       ; # the 0 means "do NOT retrieve biblio, only biblioitem, in the MARC record
2230     my $bibid =
2231       &MARCfind_MARCbibid_from_oldbiblionumber( $dbh,
2232         $biblioitem->{biblionumber} );
2233     &MARCaddbiblio( $dbh, $MARCbiblio, $biblioitem->{biblionumber}, $bibid );
2234     return ($bibitemnum);
2235 }
2236
2237 sub newsubject {
2238     my ($bibnum) = @_;
2239     my $dbh = C4::Context->dbh;
2240     &OLDnewsubject( $dbh, $bibnum );
2241 }
2242
2243 sub newsubtitle {
2244     my ( $bibnum, $subtitle ) = @_;
2245     my $dbh = C4::Context->dbh;
2246     &OLDnewsubtitle( $dbh, $bibnum, $subtitle );
2247 }
2248
2249 sub newitems {
2250     my ( $item, @barcodes ) = @_;
2251     my $dbh = C4::Context->dbh;
2252     my $errors;
2253     my $itemnumber;
2254     my $error;
2255     foreach my $barcode (@barcodes) {
2256         ( $itemnumber, $error ) = &OLDnewitems( $dbh, $item, uc($barcode) );
2257         $errors .= $error;
2258         my $MARCitem =
2259           &MARCkoha2marcItem( $dbh, $item->{biblionumber}, $itemnumber );
2260         &MARCadditem( $dbh, $MARCitem, $item->{biblionumber} );
2261     }
2262     return ($errors);
2263 }
2264
2265 sub moditem {
2266     my ($item) = @_;
2267     my $dbh = C4::Context->dbh;
2268     &OLDmoditem( $dbh, $item );
2269     my $MARCitem =
2270       &MARCkoha2marcItem( $dbh, $item->{'biblionumber'}, $item->{'itemnum'} );
2271     my $bibid =
2272       &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $item->{biblionumber} );
2273     &MARCmoditem( $dbh, $MARCitem, $bibid, $item->{itemnum}, 0 );
2274 }
2275
2276 sub checkitems {
2277     my ( $count, @barcodes ) = @_;
2278     my $dbh = C4::Context->dbh;
2279     my $error;
2280     my $sth = $dbh->prepare("Select * from items where barcode=?");
2281     for ( my $i = 0 ; $i < $count ; $i++ ) {
2282         $barcodes[$i] = uc $barcodes[$i];
2283         $sth->execute( $barcodes[$i] );
2284         if ( my $data = $sth->fetchrow_hashref ) {
2285             $error .= " Duplicate Barcode: $barcodes[$i]";
2286         }
2287     }
2288     $sth->finish;
2289     return ($error);
2290 }
2291
2292 sub countitems {
2293     my ($bibitemnum) = @_;
2294     my $dbh   = C4::Context->dbh;
2295     my $query = "";
2296     my $sth   =
2297       $dbh->prepare("Select count(*) from items where biblioitemnumber=?");
2298     $sth->execute($bibitemnum);
2299     my $data = $sth->fetchrow_hashref;
2300     $sth->finish;
2301     return ( $data->{'count(*)'} );
2302 }
2303
2304 sub delitem {
2305     my ($itemnum) = @_;
2306     my $dbh = C4::Context->dbh;
2307     &OLDdelitem( $dbh, $itemnum );
2308 }
2309
2310 sub deletebiblioitem {
2311     my ($biblioitemnumber) = @_;
2312     my $dbh = C4::Context->dbh;
2313     &OLDdeletebiblioitem( $dbh, $biblioitemnumber );
2314 }    # sub deletebiblioitem
2315
2316 sub delbiblio {
2317     my ($biblio) = @_;
2318     my $dbh = C4::Context->dbh;
2319     &OLDdelbiblio( $dbh, $biblio );
2320     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio );
2321     &MARCdelbiblio( $dbh, $bibid, 0 );
2322 }
2323
2324 sub getbiblio {
2325     my ($biblionumber) = @_;
2326     my $dbh = C4::Context->dbh;
2327     my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
2328
2329     # || die "Cannot prepare $query\n" . $dbh->errstr;
2330     my $count = 0;
2331     my @results;
2332
2333     $sth->execute($biblionumber);
2334
2335     # || die "Cannot execute $query\n" . $sth->errstr;
2336     while ( my $data = $sth->fetchrow_hashref ) {
2337         $results[$count] = $data;
2338         $count++;
2339     }    # while
2340
2341     $sth->finish;
2342     return ( $count, @results );
2343 }    # sub getbiblio
2344
2345 sub getbiblioitem {
2346     my ($biblioitemnum) = @_;
2347     my $dbh = C4::Context->dbh;
2348     my $sth = $dbh->prepare( "Select * from biblioitems where
2349 biblioitemnumber = ?"
2350     );
2351     my $count = 0;
2352     my @results;
2353
2354     $sth->execute($biblioitemnum);
2355
2356     while ( my $data = $sth->fetchrow_hashref ) {
2357         $results[$count] = $data;
2358         $count++;
2359     }    # while
2360
2361     $sth->finish;
2362     return ( $count, @results );
2363 }    # sub getbiblioitem
2364
2365 sub getbiblioitembybiblionumber {
2366     my ($biblionumber) = @_;
2367     my $dbh = C4::Context->dbh;
2368     my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
2369     my $count = 0;
2370     my @results;
2371
2372     $sth->execute($biblionumber);
2373
2374     while ( my $data = $sth->fetchrow_hashref ) {
2375         $results[$count] = $data;
2376         $count++;
2377     }    # while
2378
2379     $sth->finish;
2380     return ( $count, @results );
2381 }    # sub
2382
2383 sub getitemtypes {
2384     my $dbh   = C4::Context->dbh;
2385     my $query = "select * from itemtypes order by description";
2386     my $sth   = $dbh->prepare($query);
2387
2388     # || die "Cannot prepare $query" . $dbh->errstr;
2389     my $count = 0;
2390     my @results;
2391
2392     $sth->execute;
2393
2394     # || die "Cannot execute $query\n" . $sth->errstr;
2395     while ( my $data = $sth->fetchrow_hashref ) {
2396         $results[$count] = $data;
2397         $count++;
2398     }    # while
2399
2400     $sth->finish;
2401     return ( $count, @results );
2402 }    # sub getitemtypes
2403
2404 sub getitemsbybiblioitem {
2405     my ($biblioitemnum) = @_;
2406     my $dbh = C4::Context->dbh;
2407     my $sth = $dbh->prepare( "Select * from items, biblio where
2408 biblio.biblionumber = items.biblionumber and biblioitemnumber
2409 = ?"
2410     );
2411
2412     # || die "Cannot prepare $query\n" . $dbh->errstr;
2413     my $count = 0;
2414     my @results;
2415
2416     $sth->execute($biblioitemnum);
2417
2418     # || die "Cannot execute $query\n" . $sth->errstr;
2419     while ( my $data = $sth->fetchrow_hashref ) {
2420         $results[$count] = $data;
2421         $count++;
2422     }    # while
2423
2424     $sth->finish;
2425     return ( $count, @results );
2426 }    # sub getitemsbybiblioitem
2427
2428 sub logchange {
2429
2430     # Subroutine to log changes to databases
2431 # Eventually, this subroutine will be used to create a log of all changes made,
2432     # with the possibility of "undo"ing some changes
2433     my $database = shift;
2434     if ( $database eq 'kohadb' ) {
2435         my $type     = shift;
2436         my $section  = shift;
2437         my $item     = shift;
2438         my $original = shift;
2439         my $new      = shift;
2440
2441         #       print STDERR "KOHA: $type $section $item $original $new\n";
2442     }
2443     elsif ( $database eq 'marc' ) {
2444         my $type        = shift;
2445         my $Record_ID   = shift;
2446         my $tag         = shift;
2447         my $mark        = shift;
2448         my $subfield_ID = shift;
2449         my $original    = shift;
2450         my $new         = shift;
2451
2452 #       print STDERR "MARC: $type $Record_ID $tag $mark $subfield_ID $original $new\n";
2453     }
2454 }
2455
2456 #------------------------------------------------
2457
2458 #---------------------------------------
2459 # Find a biblio entry, or create a new one if it doesn't exist.
2460 #  If a "subtitle" entry is in hash, add it to subtitle table
2461 sub getoraddbiblio {
2462
2463     # input params
2464     my (
2465         $dbh,       # db handle
2466                     # FIXME - Unused argument
2467         $biblio,    # hash ref to fields
2468     ) = @_;
2469
2470     # return
2471     my $biblionumber;
2472
2473     my $debug = 0;
2474     my $sth;
2475     my $error;
2476
2477     #-----
2478     $dbh = C4::Context->dbh;
2479
2480     print "<PRE>Looking for biblio </PRE>\n" if $debug;
2481     $sth = $dbh->prepare( "select biblionumber
2482                 from biblio
2483                 where title=? and author=?
2484                   and copyrightdate=? and seriestitle=?"
2485     );
2486     $sth->execute(
2487         $biblio->{title},     $biblio->{author},
2488         $biblio->{copyright}, $biblio->{seriestitle}
2489     );
2490     if ( $sth->rows ) {
2491         ($biblionumber) = $sth->fetchrow;
2492         print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
2493     }
2494     else {
2495
2496         # Doesn't exist.  Add new one.
2497         print "<PRE>Adding biblio</PRE>\n" if $debug;
2498         ( $biblionumber, $error ) = &newbiblio($biblio);
2499         if ($biblionumber) {
2500             print "<PRE>Added with biblio number=$biblionumber</PRE>\n"
2501               if $debug;
2502             if ( $biblio->{subtitle} ) {
2503                 &newsubtitle( $biblionumber, $biblio->{subtitle} );
2504             }    # if subtitle
2505         }
2506         else {
2507             print "<PRE>Couldn't add biblio: $error</PRE>\n" if $debug;
2508         }    # if added
2509     }
2510
2511     return $biblionumber, $error;
2512
2513 }    # sub getoraddbiblio
2514
2515 sub char_decode {
2516
2517     # converts ISO 5426 coded string to ISO 8859-1
2518     # sloppy code : should be improved in next issue
2519     my ( $string, $encoding ) = @_;
2520     $_ = $string;
2521
2522     #   $encoding = C4::Context->preference("marcflavour") unless $encoding;
2523     if ( $encoding eq "UNIMARC" ) {
2524         s/\xe1/Æ/gm;
2525         s/\xe2/Ð/gm;
2526         s/\xe9/Ø/gm;
2527         s/\xec/þ/gm;
2528         s/\xf1/æ/gm;
2529         s/\xf3/ð/gm;
2530         s/\xf9/ø/gm;
2531         s/\xfb/ß/gm;
2532         s/\xc1\x61/à/gm;
2533         s/\xc1\x65/è/gm;
2534         s/\xc1\x69/ì/gm;
2535         s/\xc1\x6f/ò/gm;
2536         s/\xc1\x75/ù/gm;
2537         s/\xc1\x41/À/gm;
2538         s/\xc1\x45/È/gm;
2539         s/\xc1\x49/Ì/gm;
2540         s/\xc1\x4f/Ò/gm;
2541         s/\xc1\x55/Ù/gm;
2542         s/\xc2\x41/Á/gm;
2543         s/\xc2\x45/É/gm;
2544         s/\xc2\x49/Í/gm;
2545         s/\xc2\x4f/Ó/gm;
2546         s/\xc2\x55/Ú/gm;
2547         s/\xc2\x59/Ý/gm;
2548         s/\xc2\x61/á/gm;
2549         s/\xc2\x65/é/gm;
2550         s/\xc2\x69/í/gm;
2551         s/\xc2\x6f/ó/gm;
2552         s/\xc2\x75/ú/gm;
2553         s/\xc2\x79/ý/gm;
2554         s/\xc3\x41/Â/gm;
2555         s/\xc3\x45/Ê/gm;
2556         s/\xc3\x49/Î/gm;
2557         s/\xc3\x4f/Ô/gm;
2558         s/\xc3\x55/Û/gm;
2559         s/\xc3\x61/â/gm;
2560         s/\xc3\x65/ê/gm;
2561         s/\xc3\x69/î/gm;
2562         s/\xc3\x6f/ô/gm;
2563         s/\xc3\x75/û/gm;
2564         s/\xc4\x41/Ã/gm;
2565         s/\xc4\x4e/Ñ/gm;
2566         s/\xc4\x4f/Õ/gm;
2567         s/\xc4\x61/ã/gm;
2568         s/\xc4\x6e/ñ/gm;
2569         s/\xc4\x6f/õ/gm;
2570         s/\xc8\x45/Ë/gm;
2571         s/\xc8\x49/Ï/gm;
2572         s/\xc8\x65/ë/gm;
2573         s/\xc8\x69/ï/gm;
2574         s/\xc8\x76/ÿ/gm;
2575         s/\xc9\x41/Ä/gm;
2576         s/\xc9\x4f/Ö/gm;
2577         s/\xc9\x55/Ü/gm;
2578         s/\xc9\x61/ä/gm;
2579         s/\xc9\x6f/ö/gm;
2580         s/\xc9\x75/ü/gm;
2581         s/\xca\x41/Å/gm;
2582         s/\xca\x61/å/gm;
2583         s/\xd0\x43/Ç/gm;
2584         s/\xd0\x63/ç/gm;
2585
2586         # this handles non-sorting blocks (if implementation requires this)
2587         $string = nsb_clean($_);
2588     }
2589     elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2590         if (/[\xc1-\xff]/) {
2591             s/\xe1\x61/à/gm;
2592             s/\xe1\x65/è/gm;
2593             s/\xe1\x69/ì/gm;
2594             s/\xe1\x6f/ò/gm;
2595             s/\xe1\x75/ù/gm;
2596             s/\xe1\x41/À/gm;
2597             s/\xe1\x45/È/gm;
2598             s/\xe1\x49/Ì/gm;
2599             s/\xe1\x4f/Ò/gm;
2600             s/\xe1\x55/Ù/gm;
2601             s/\xe2\x41/Á/gm;
2602             s/\xe2\x45/É/gm;
2603             s/\xe2\x49/Í/gm;
2604             s/\xe2\x4f/Ó/gm;
2605             s/\xe2\x55/Ú/gm;
2606             s/\xe2\x59/Ý/gm;
2607             s/\xe2\x61/á/gm;
2608             s/\xe2\x65/é/gm;
2609             s/\xe2\x69/í/gm;
2610             s/\xe2\x6f/ó/gm;
2611             s/\xe2\x75/ú/gm;
2612             s/\xe2\x79/ý/gm;
2613             s/\xe3\x41/Â/gm;
2614             s/\xe3\x45/Ê/gm;
2615             s/\xe3\x49/Î/gm;
2616             s/\xe3\x4f/Ô/gm;
2617             s/\xe3\x55/Û/gm;
2618             s/\xe3\x61/â/gm;
2619             s/\xe3\x65/ê/gm;
2620             s/\xe3\x69/î/gm;
2621             s/\xe3\x6f/ô/gm;
2622             s/\xe3\x75/û/gm;
2623             s/\xe4\x41/Ã/gm;
2624             s/\xe4\x4e/Ñ/gm;
2625             s/\xe4\x4f/Õ/gm;
2626             s/\xe4\x61/ã/gm;
2627             s/\xe4\x6e/ñ/gm;
2628             s/\xe4\x6f/õ/gm;
2629             s/\xe8\x45/Ë/gm;
2630             s/\xe8\x49/Ï/gm;
2631             s/\xe8\x65/ë/gm;
2632             s/\xe8\x69/ï/gm;
2633             s/\xe8\x76/ÿ/gm;
2634             s/\xe9\x41/Ä/gm;
2635             s/\xe9\x4f/Ö/gm;
2636             s/\xe9\x55/Ü/gm;
2637             s/\xe9\x61/ä/gm;
2638             s/\xe9\x6f/ö/gm;
2639             s/\xe9\x75/ü/gm;
2640             s/\xea\x41/Å/gm;
2641             s/\xea\x61/å/gm;
2642
2643             # this handles non-sorting blocks (if implementation requires this)
2644             $string = nsb_clean($_);
2645         }
2646     }
2647     return ($string);
2648 }
2649
2650 sub nsb_clean {
2651     my $NSB = '\x88';    # NSB : begin Non Sorting Block
2652     my $NSE = '\x89';    # NSE : Non Sorting Block end
2653                          # handles non sorting blocks
2654     my ($string) = @_;
2655     $_ = $string;
2656     s/$NSB/(/gm;
2657     s/[ ]{0,1}$NSE/) /gm;
2658     $string = $_;
2659     return ($string);
2660 }
2661
2662 END { }    # module clean-up code here (global destructor)
2663
2664 =back
2665
2666 =head1 AUTHOR
2667
2668 Koha Developement team <info@koha.org>
2669
2670 Paul POULAIN paul.poulain@free.fr
2671
2672 =cut
2673
2674 # $Id$
2675 # $Log$
2676 # Revision 1.95  2004/06/26 23:19:59  rangi
2677 # Fixing modaddauthor, and adding getitemtypes.
2678 # Also tidying up formatting of code
2679 #
2680 # Revision 1.94  2004/06/17 08:16:32  tipaul
2681 # merging tag & subfield in marc_word for better perfs
2682 #
2683 # Revision 1.93  2004/06/11 15:38:06  joshferraro
2684 # Changes MARCaddword to index words >= 1 char ... needed for more accurate
2685 # searches using SearchMarc routines.
2686 #
2687 # Revision 1.92  2004/06/10 08:29:01  tipaul
2688 # MARC authority management (continued)
2689 #
2690 # Revision 1.91  2004/06/03 10:03:01  tipaul
2691 # * frameworks and itemtypes are independant
2692 # * in the MARC editor, showing the + to duplicate a tag only if the tag is repeatable
2693 #
2694 # Revision 1.90  2004/05/28 08:25:53  tipaul
2695 # hidding hidden & isurl constraints into MARC subfield structure
2696 #
2697 # Revision 1.89  2004/05/27 21:47:21  rangi
2698 # Fix for bug 787
2699 #
2700 # Revision 1.88  2004/05/18 15:23:49  tipaul
2701 # framework management : 1 MARC framework for each itemtype
2702 #
2703 # Revision 1.87  2004/05/18 11:54:07  tipaul
2704 # getitemtypes moved in Koha.pm
2705 #
2706 # Revision 1.86  2004/05/03 09:19:22  tipaul
2707 # some fixes for mysql prepare & execute
2708 #
2709 # Revision 1.85  2004/04/02 14:55:48  tipaul
2710 # renaming items.bulk field to items.itemcallnumber.
2711 # Will be used to store call number for libraries that don't use dewey classification.
2712 # Note it's related to ITEMS, not biblio.
2713 #
2714 # Revision 1.84  2004/03/24 17:18:30  joshferraro
2715 # Fixes bug 749 by removing the comma on line 1488.
2716 #
2717 # Revision 1.83  2004/03/15 14:31:50  tipaul
2718 # adding a minor check
2719 #
2720 # Revision 1.82  2004/03/07 05:47:31  acli
2721 # Various updates/fixes from rel_2_0
2722 # Fixes for bugs 721 (templating), 727, and 734
2723 #
2724 # Revision 1.81  2004/03/06 20:26:13  tipaul
2725 # adding seealso feature in MARC searches
2726 #
2727 # Revision 1.80  2004/02/12 13:40:56  tipaul
2728 # deleting subs duplicated by error
2729 #
2730 # Revision 1.79  2004/02/11 08:40:09  tipaul
2731 # synch'ing 2.0.0 branch and head
2732 #
2733 # Revision 1.78.2.3  2004/02/10 13:15:46  tipaul
2734 # removing 2 warnings
2735 #
2736 # Revision 1.78.2.2  2004/01/26 10:38:06  tipaul
2737 # dealing correctly "bulk" field
2738 #
2739 # Revision 1.78.2.1  2004/01/13 17:29:53  tipaul
2740 # * minor html fixes
2741 # * adding publisher in acquisition process (& ordering basket by publisher)
2742 #
2743 # Revision 1.78  2003/12/09 15:57:28  tipaul
2744 # rolling back to working char_decode sub
2745 #
2746 # Revision 1.77  2003/12/03 17:47:14  tipaul
2747 # bugfixes for biblio deletion
2748 #
2749 # Revision 1.76  2003/12/03 01:43:41  slef
2750 # conflict markers?
2751 #
2752 # Revision 1.75  2003/12/03 01:42:03  slef
2753 # bug 662 fixes securing DBI
2754 #
2755 # Revision 1.74  2003/11/28 09:48:33  tipaul
2756 # bugfix : misusing prepare & execute => now using prepare(?) and execute($var)
2757 #
2758 # Revision 1.73  2003/11/28 09:45:25  tipaul
2759 # bugfix for iso2709 file import in the "notforloan" field.
2760 #
2761 # But notforloan field called "loan" somewhere, so in case "loan" is used, copied to "notforloan" to avoid a bug.
2762 #
2763 # Revision 1.72  2003/11/24 17:40:14  tipaul
2764 # fix for #385
2765 #
2766 # Revision 1.71  2003/11/24 16:28:49  tipaul
2767 # biblio & item deletion now works fine in MARC editor.
2768 # Stores deleted biblio/item in the marc field of the deletedbiblio/deleteditem table.
2769 #
2770 # Revision 1.70  2003/11/24 13:29:55  tipaul
2771 # moving $id from beginning to end of file (70 commits... huge comments...)
2772 #
2773 # Revision 1.69  2003/11/24 13:27:17  tipaul
2774 # fix for #380 (bibliosubject)
2775 #
2776 # Revision 1.68  2003/11/06 17:18:30  tipaul
2777 # bugfix for #384
2778 #
2779 # 1st draft for MARC biblio deletion.
2780 # Still does not work well, but at least, Biblio.pm compiles & it should'nt break too many things
2781 # (Note the trash in the MARCdetail, but don't use it, please :-) )
2782 #
2783 # Revision 1.67  2003/10/25 08:46:27  tipaul
2784 # minor fixes for bilbio deletion (still buggy)
2785 #
2786 # Revision 1.66  2003/10/17 10:02:56  tipaul
2787 # Indexing only words longer than 2 letters. Was >=2 before, & 2 letters words usually means nothing.
2788 #
2789 # Revision 1.65  2003/10/14 09:45:29  tipaul
2790 # adding rebuildnonmarc.pl script : run this script when you change a link between marc and non MARC DB. It rebuilds the non-MARC DB (long operation)
2791 #
2792 # Revision 1.64  2003/10/06 15:20:51  tipaul
2793 # fix for 536 (subtitle error)
2794 #
2795 # Revision 1.63  2003/10/01 13:25:49  tipaul
2796 # seems a char encoding problem modified something in char_decode sub... changing back to something that works...
2797 #
2798 # Revision 1.62  2003/09/17 14:21:13  tipaul
2799 # fixing bug that makes a MARC biblio disappear when using full acquisition (order => recieve ==> MARC editor).
2800 # Before this 2 lines fix, the MARC biblio was deleted during recieve, and had to be entirely recreated :-(
2801 #
2802 # Revision 1.61  2003/09/17 10:24:39  tipaul
2803 # notforloan value in itemtype was overwritting notforloan value in a given item.
2804 # I changed this behaviour :
2805 # if notforloan is set for a given item, and NOT for all items from this itemtype, the notforloan is kept.
2806 # If notforloan is set for itemtype, it's used (and impossible to loan a specific item from this itemtype)
2807 #
2808 # Revision 1.60  2003/09/04 14:11:23  tipaul
2809 # fix for 593 (data duplication in MARC-DB)
2810 #
2811 # Revision 1.58  2003/08/06 12:54:52  tipaul
2812 # fix for publicationyear : extracting numeric value from MARC string, like for copyrightdate.
2813 # (note that copyrightdate still extracted to get numeric format)
2814 #
2815 # Revision 1.57  2003/07/15 23:09:18  slef
2816 # change show columns to use biblioitems bnotes too
2817 #
2818 # Revision 1.56  2003/07/15 11:34:52  slef
2819 # fixes from paul email
2820 #
2821 # Revision 1.55  2003/07/15 00:02:49  slef
2822 # Work on bug 515... can we do a single-side rename of notes to bnotes?
2823 #
2824 # Revision 1.54  2003/07/11 11:51:32  tipaul
2825 # *** empty log message ***
2826 #
2827 # Revision 1.52  2003/07/10 10:37:19  tipaul
2828 # fix for copyrightdate problem, #514
2829 #
2830 # Revision 1.51  2003/07/02 14:47:17  tipaul
2831 # fix for #519 : items.dateaccessioned imports incorrectly
2832 #
2833 # Revision 1.49  2003/06/17 11:21:13  tipaul
2834 # improvments/fixes for z3950 support.
2835 # * Works now even on ADD, not only on MODIFY
2836 # * able to search on ISBN, author, title
2837 #
2838 # Revision 1.48  2003/06/16 09:22:53  rangi
2839 # Just added an order clause to getitemtypes
2840 #
2841 # Revision 1.47  2003/05/20 16:22:44  tipaul
2842 # fixing typo in Biblio.pm POD
2843 #
2844 # Revision 1.46  2003/05/19 13:45:18  tipaul
2845 # support for subtitles, additional authors, subject.
2846 # This supports is only for MARC <-> OLD-DB link. It worked previously, but values entered as MARC were not reported to OLD-DB, neither values entered as OLD-DB were reported to MARC.
2847 # Note that some OLD-DB subs are strange (dummy ?) see OLDmodsubject, OLDmodsubtitle, OLDmodaddiauthor in C4/Biblio.pm
2848 # For example it seems impossible to have more that 1 addi author and 1 subtitle. In MARC it's not the case. So, if you enter more than one, I'm afraid only the LAST will be stored.
2849 #
2850 # Revision 1.45  2003/04/29 16:50:49  tipaul
2851 # really proud of this commit :-)
2852 # z3950 search and import seems to works fine.
2853 # Let me explain how :
2854 # * a "search z3950" button is added in the addbiblio template.
2855 # * when clicked, a popup appears and z3950/search.pl is called
2856 # * z3950/search.pl calls addz3950search in the DB
2857 # * the z3950 daemon retrieve the records and stores them in z3950results AND in marc_breeding table.
2858 # * as long as there as searches pending, the popup auto refresh every 2 seconds, and says how many searches are pending.
2859 # * when the user clicks on a z3950 result => the parent popup is called with the requested biblio, and auto-filled
2860 #
2861 # Note :
2862 # * character encoding support : (It's a nightmare...) In the z3950servers table, a "encoding" column has been added. You can put "UNIMARC" or "USMARC" in this column. Depending on this, the char_decode in C4::Biblio.pm replaces marc-char-encode by an iso 8859-1 encoding. Note that in the breeding import this value has been added too, for a better support.
2863 # * the marc_breeding and z3950* tables have been modified : they have an encoding column and the random z3950 number is stored too for convenience => it's the key I use to list only requested biblios in the popup.
2864 #
2865 # Revision 1.44  2003/04/28 13:07:14  tipaul
2866 # Those fixes solves the "internal server error" with MARC::Record 1.12.
2867 # It was due to an illegal contruction in Koha : we tried to retrive subfields from <10 tags.
2868 # That's not possible. MARC::Record accepted this in 0.93 version, but it was fixed after.
2869 # Now, the construct/retrieving is OK !
2870 #
2871 # Revision 1.43  2003/04/10 13:56:02  tipaul
2872 # Fix some bugs :
2873 # * worked in 1.9.0, but not in 1.9.1 :
2874 # - modif of a biblio didn't work
2875 # - empty fields where not shown when modifying a biblio. empty fields managed by the library (ie in tab 0->9 in MARC parameter table) MUST be entered, even if not presented.
2876 #
2877 # * did not work before :
2878 # - repeatable subfields now works correctly. Enter 2 subfields separated by | and they will be splitted during saving.
2879 # - dropped the last subfield of the MARC form :-(
2880 #
2881 # Internal changes :
2882 # - MARCmodbiblio now works by deleting and recreating the biblio. It's not perf optimized, but MARC is a "do_something_impossible_to_trace" standard, so, it's the best solution. not a problem for me, as biblio are rarely modified.
2883 # Note the MARCdelbiblio has been rewritted to enable deletion of a biblio WITHOUT deleting items.
2884 #
2885 # Revision 1.42  2003/04/04 08:41:11  tipaul
2886 # last commits before 1.9.1
2887 #
2888 # Revision 1.41  2003/04/01 12:26:43  tipaul
2889 # fixes
2890 #
2891 # Revision 1.40  2003/03/11 15:14:03  tipaul
2892 # pod updating
2893 #
2894 # Revision 1.39  2003/03/07 16:35:42  tipaul
2895 # * moving generic functions to Koha.pm
2896 # * improvement of SearchMarc.pm
2897 # * bugfixes
2898 # * code cleaning
2899 #
2900 # Revision 1.38  2003/02/27 16:51:59  tipaul
2901 # * moving prepare / execute to ? form.
2902 # * some # cleaning
2903 # * little bugfix.
2904 # * road to 1.9.2 => acquisition and cataloguing merging
2905 #
2906 # Revision 1.37  2003/02/12 11:03:03  tipaul
2907 # Support for 000 -> 010 fields.
2908 # Those fields doesn't have subfields.
2909 # In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@".
2910 # Note it's only virtual : when rebuilding the MARC::Record, the koha API handle correctly "@" subfields => the resulting MARC record has a 00x field without subfield.
2911 #
2912 # Revision 1.36  2003/02/12 11:01:01  tipaul
2913 # Support for 000 -> 010 fields.
2914 # Those fields doesn't have subfields.
2915 # In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@".
2916 # Note it's only virtual : when rebuilding the MARC::Record, the koha API handle correctly "@" subfields => the resulting MARC record has a 00x field without subfield.
2917 #
2918 # Revision 1.35  2003/02/03 18:46:00  acli
2919 # Minor factoring in C4/Biblio.pm, plus change to export the per-tag
2920 # 'mandatory' property to a per-subfield 'tag_mandatory' template parameter,
2921 # so that addbiblio.tmpl can distinguish between mandatory subfields in a
2922 # mandatory tag and mandatory subfields in an optional tag
2923 #
2924 # Not-minor factoring in acqui.simple/addbiblio.pl to make the if-else blocks
2925 # smaller, and to add some POD; need further testing for this
2926 #
2927 # Added function to check if a MARC subfield name is "koha-internal" (instead
2928 # of checking it for 'lib' and 'tag' everywhere); temporarily added to Koha.pm
2929 #
2930 # Use above function in acqui.simple/additem.pl and search.marc/search.pl
2931 #
2932 # Revision 1.34  2003/01/28 14:50:04  tipaul
2933 # fixing MARCmodbiblio API and reindenting code
2934 #
2935 # Revision 1.33  2003/01/23 12:22:37  tipaul
2936 # adding char_decode to decode MARC21 or UNIMARC extended chars
2937 #
2938 # Revision 1.32  2002/12/16 15:08:50  tipaul
2939 # small but important bugfix (fixes a problem in export)
2940 #
2941 # Revision 1.31  2002/12/13 16:22:04  tipaul
2942 # 1st draft of marc export
2943 #
2944 # Revision 1.30  2002/12/12 21:26:35  tipaul
2945 # YAB ! (Yet Another Bugfix) => related to biblio modif
2946 # (some warning cleaning too)
2947 #
2948 # Revision 1.29  2002/12/12 16:35:00  tipaul
2949 # adding authentification with Auth.pm and
2950 # MAJOR BUGFIX on marc biblio modification
2951 #
2952 # Revision 1.28  2002/12/10 13:30:03  tipaul
2953 # fugfixes from Dombes Abbey work
2954 #
2955 # Revision 1.27  2002/11/19 12:36:16  tipaul
2956 # road to 1.3.2
2957 # various bugfixes, improvments, and migration from acquisition.pm to biblio.pm
2958 #
2959 # Revision 1.26  2002/11/12 15:58:43  tipaul
2960 # road to 1.3.2 :
2961 # * many bugfixes
2962 # * adding value_builder : you can map a subfield in the marc_subfield_structure to a sub stored in "value_builder" directory. In this directory you can create screen used to build values with any method. In this commit is a 1st draft of the builder for 100$a unimarc french subfield, which is composed of 35 digits, with 12 differents values (only the 4th first are provided for instance)
2963 #
2964 # Revision 1.25  2002/10/25 10:58:26  tipaul
2965 # Road to 1.3.2
2966 # * bugfixes and improvements
2967 #
2968 # Revision 1.24  2002/10/24 12:09:01  arensb
2969 # Fixed "no title" warning when generating HTML documentation from POD.
2970 #
2971 # Revision 1.23  2002/10/16 12:43:08  arensb
2972 # Added some FIXME comments.
2973 #
2974 # Revision 1.22  2002/10/15 13:39:17  tipaul
2975 # removing Acquisition.pm
2976 # deleting unused code in biblio.pm, rewriting POD and answering most FIXME comments
2977 #
2978 # Revision 1.21  2002/10/13 11:34:14  arensb
2979 # Replaced expressions of the form "$x = $x <op> $y" with "$x <op>= $y".
2980 # Thus, $x = $x+2 becomes $x += 2, and so forth.
2981 #
2982 # Revision 1.20  2002/10/13 08:28:32  arensb
2983 # Deleted unused variables.
2984 # Removed trailing whitespace.
2985 #
2986 # Revision 1.19  2002/10/13 05:56:10  arensb
2987 # Added some FIXME comments.
2988 #
2989 # Revision 1.18  2002/10/11 12:34:53  arensb
2990 # Replaced &requireDBI with C4::Context->dbh
2991 #
2992 # Revision 1.17  2002/10/10 14:48:25  tipaul
2993 # bugfixes
2994 #
2995 # Revision 1.16  2002/10/07 14:04:26  tipaul
2996 # road to 1.3.1 : viewing MARC biblio
2997 #
2998 # Revision 1.15  2002/10/05 09:49:25  arensb
2999 # Merged with arensb-context branch: use C4::Context->dbh instead of
3000 # &C4Connect, and generally prefer C4::Context over C4::Database.
3001 #
3002 # Revision 1.14  2002/10/03 11:28:18  tipaul
3003 # Extending Context.pm to add stopword management and using it in MARC-API.
3004 # First benchmarks show a medium speed improvement, which  is nice as this part is heavily called.
3005 #
3006 # Revision 1.13  2002/10/02 16:26:44  tipaul
3007 # road to 1.3.1
3008 #
3009 # Revision 1.12.2.4  2002/10/05 07:09:31  arensb
3010 # Merged in changes from main branch.
3011 #
3012 # Revision 1.12.2.3  2002/10/05 06:12:10  arensb
3013 # Added a whole mess of FIXME comments.
3014 #
3015 # Revision 1.12.2.2  2002/10/05 04:03:14  arensb
3016 # Added some missing semicolons.
3017 #
3018 # Revision 1.12.2.1  2002/10/04 02:24:01  arensb
3019 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
3020 # C4Connect.
3021 #
3022 # Revision 1.12.2.3  2002/10/05 06:12:10  arensb
3023 # Added a whole mess of FIXME comments.
3024 #
3025 # Revision 1.12.2.2  2002/10/05 04:03:14  arensb
3026 # Added some missing semicolons.
3027 #
3028 # Revision 1.12.2.1  2002/10/04 02:24:01  arensb
3029 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
3030 # C4Connect.
3031 #
3032 # Revision 1.12  2002/10/01 11:48:51  arensb
3033 # Added some FIXME comments, mostly marking duplicate functions.
3034 #
3035 # Revision 1.11  2002/09/24 13:49:26  tipaul
3036 # long WAS the road to 1.3.0...
3037 # coming VERY SOON NOW...
3038 # modifying installer and buildrelease to update the DB
3039 #
3040 # Revision 1.10  2002/09/22 16:50:08  arensb
3041 # Added some FIXME comments.
3042 #
3043 # Revision 1.9  2002/09/20 12:57:46  tipaul
3044 # long is the road to 1.4.0
3045 # * MARCadditem and MARCmoditem now wroks
3046 # * various bugfixes in MARC management
3047 # !!! 1.3.0 should be released very soon now. Be careful !!!
3048 #
3049 # Revision 1.8  2002/09/10 13:53:52  tipaul
3050 # MARC API continued...
3051 # * some bugfixes
3052 # * multiple item management : MARCadditem and MARCmoditem have been added. They suppose that ALL the MARC field linked to koha-item are in the same MARC tag (on the same line of MARC file)
3053 #
3054 # Note : it should not be hard for marcimport and marcexport to re-link fields from internal tag/subfield to "legal" tag/subfield.
3055 #
3056 # Revision 1.7  2002/08/14 18:12:51  tonnesen
3057 # Added copyright statement to all .pl and .pm files
3058 #
3059 # Revision 1.6  2002/07/25 13:40:31  tipaul
3060 # pod documenting the API.
3061 #
3062 # Revision 1.5  2002/07/24 16:11:37  tipaul
3063 # Now, the API...
3064 # Database.pm and Output.pm are almost not modified (var test...)
3065 #
3066 # Biblio.pm is almost completly rewritten.
3067 #
3068 # WHAT DOES IT ??? ==> END of Hitchcock suspens
3069 #
3070 # 1st, it does... nothing...
3071 # Every old API should be there. So if MARC-stuff is not done, the behaviour is EXACTLY the same (if there is no added bug, of course). So, if you use normal acquisition, you won't find anything new neither on screen or old-DB tables ...
3072 #
3073 # All old-API functions have been cloned. for example, the "newbiblio" sub, now has become :
3074 # * a "newbiblio" sub, with the same parameters. It just call a sub named OLDnewbiblio
3075 # * a "OLDnewbiblio" sub, which is a copy/paste of the previous newbiblio sub. Then, when you want to add the MARC-DB stuff, you can modify the newbiblio sub without modifying the OLDnewbiblio one. If we correct a bug in 1.2 in newbiblio, we can do the same in main branch by correcting OLDnewbiblio.
3076 # * The MARC stuff is usually done through a sub named MARCxxx where xxx is the same as OLDxxx. For example, newbiblio calls MARCnewbiblio. the MARCxxx subs use a MARC::Record as parameter.
3077 # The last thing to solve was to manage biblios through real MARC import : they must populate the old-db, but must populate the MARC-DB too, without loosing information (if we go from MARC::Record to old-data then back to MARC::Record, we loose A LOT OF ROWS). To do this, there are subs beginning by "NEWxxx" : they manage datas with MARC::Record datas. they call OLDxxx sub too (to populate old-DB), but MARCxxx subs too, with a complete MARC::Record ;-)
3078 #
3079 # In Biblio.pm, there are some subs that permits to build a old-style record from a MARC::Record, and the opposite. There is also a sub finding a MARC-bibid from a old-biblionumber and the opposite too.
3080 # Note we have decided with steve that a old-biblio <=> a MARC-Biblio.
3081 #