C4/Biblio.pm

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