C4/Biblio.pm

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