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