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