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