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