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