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