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