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