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