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         $query =~ s/\,$//;
1514 #  print $query;
1515         $sth=$dbh->prepare($query);
1516         $sth->execute(@bind);
1517         $sth->finish;
1518         $sth=$dbh->prepare("Delete from items where itemnumber=?");
1519         $sth->execute($itemnum);
1520         $sth->finish;
1521 #  $dbh->disconnect;
1522 }
1523
1524 sub OLDdeletebiblioitem {
1525     my ($dbh,$biblioitemnumber) = @_;
1526 #    my $dbh   = C4Connect;
1527     my $sth   = $dbh->prepare("Select * from biblioitems
1528 where biblioitemnumber = ?");
1529     my $results;
1530
1531     $sth->execute($biblioitemnumber);
1532
1533     if ($results = $sth->fetchrow_hashref) {
1534         $sth->finish;
1535         $sth=$dbh->prepare("Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
1536                                         isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
1537                                         pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)");
1538
1539         $sth->execute($results->{biblioitemnumber}, $results->{biblionumber}, $results->{volume}, $results->{number}, $results->{classification}, $results->{itemtype},
1540                                         $results->{isbn}, $results->{issn} ,$results->{dewey} ,$results->{subclass} ,$results->{publicationyear} ,$results->{publishercode} ,$results->{volumedate} ,$results->{volumeddesc} ,$results->{timestamp} ,$results->{illus} ,
1541                                         $results->{pages} ,$results->{notes} ,$results->{size} ,$results->{url} ,$results->{lccn} );
1542         my $sth2 = $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?");
1543         $sth2->execute($biblioitemnumber);
1544         $sth2->finish();
1545     } # if
1546     $sth->finish;
1547 # Now delete all the items attached to the biblioitem
1548         $sth   = $dbh->prepare("Select * from items where biblioitemnumber = ?");
1549         $sth->execute($biblioitemnumber);
1550         my @results;
1551         while (my $data = $sth->fetchrow_hashref) {
1552                 my $query="Insert into deleteditems set ";
1553                 my @bind = ();
1554                 foreach my $temp (keys %$data){
1555                         $query .= "$temp = ?,";
1556                         push(@bind,$data->{$temp});
1557                 }
1558                 $query =~ s/\,$//;
1559                 warn "Q 1560 : $query";
1560                 my $sth2=$dbh->prepare($query);
1561                 $sth2->execute(@bind);
1562         } # while
1563         $sth->finish;
1564         $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
1565         $sth->execute($biblioitemnumber);
1566         $sth->finish();
1567 #    $dbh->disconnect;
1568 } # sub deletebiblioitem
1569
1570 sub OLDdelbiblio{
1571         my ($dbh,$biblio)=@_;
1572         my $sth=$dbh->prepare("select * from biblio where biblionumber=?");
1573         $sth->execute($biblio);
1574         if (my $data=$sth->fetchrow_hashref){
1575                 $sth->finish;
1576                 my $query="Insert into deletedbiblio set ";
1577                 my @bind =();
1578                 foreach my $temp (keys %$data){
1579                         $query .= "$temp = ?,";
1580                         push(@bind,$data->{$temp});
1581                 }
1582                 #replacing the last , by ",?)"
1583                 $query=~ s/\,$//;
1584                 warn "Q olddelbiblio : $query";
1585                 $sth=$dbh->prepare($query);
1586                 $sth->execute(@bind);
1587                 $sth->finish;
1588                 $sth=$dbh->prepare("Delete from biblio where biblionumber=?");
1589                 $sth->execute($biblio);
1590                 $sth->finish;
1591         }
1592         $sth->finish;
1593 }
1594
1595 #
1596 #
1597 # old functions
1598 #
1599 #
1600
1601 sub itemcount{
1602   my ($biblio)=@_;
1603   my $dbh = C4::Context->dbh;
1604 #  print $query;
1605   my $sth=$dbh->prepare("Select count(*) from items where biblionumber=?");
1606   $sth->execute($biblio);
1607   my $data=$sth->fetchrow_hashref;
1608   $sth->finish;
1609   return($data->{'count(*)'});
1610 }
1611
1612 =item getorder
1613
1614   ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
1615
1616 Looks up the order with the given biblionumber and biblioitemnumber.
1617
1618 Returns a two-element array. C<$ordernumber> is the order number.
1619 C<$order> is a reference-to-hash describing the order; its keys are
1620 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
1621 tables of the Koha database.
1622
1623 =cut
1624 #'
1625 # FIXME - This is effectively identical to &C4::Catalogue::getorder.
1626 # Pick one and stick with it.
1627 sub getorder{
1628   my ($bi,$bib)=@_;
1629   my $dbh = C4::Context->dbh;
1630   my $sth=$dbh->prepare("Select ordernumber
1631         from aqorders
1632         where biblionumber=? and biblioitemnumber=?");
1633   $sth->execute($bib,$bi);
1634   # FIXME - Use fetchrow_array(), since we're only interested in the one
1635   # value.
1636   my $ordnum=$sth->fetchrow_hashref;
1637   $sth->finish;
1638   my $order=getsingleorder($ordnum->{'ordernumber'});
1639   return ($order,$ordnum->{'ordernumber'});
1640 }
1641
1642 =item getsingleorder
1643
1644   $order = &getsingleorder($ordernumber);
1645
1646 Looks up an order by order number.
1647
1648 Returns a reference-to-hash describing the order. The keys of
1649 C<$order> are fields from the biblio, biblioitems, aqorders, and
1650 aqorderbreakdown tables of the Koha database.
1651
1652 =cut
1653 #'
1654 # FIXME - This is effectively identical to
1655 # &C4::Catalogue::getsingleorder.
1656 # Pick one and stick with it.
1657 sub getsingleorder {
1658   my ($ordnum)=@_;
1659   my $dbh = C4::Context->dbh;
1660   my $sth=$dbh->prepare("Select * from biblio,biblioitems,aqorders,aqorderbreakdown
1661   where aqorders.ordernumber=?
1662   and biblio.biblionumber=aqorders.biblionumber and
1663   biblioitems.biblioitemnumber=aqorders.biblioitemnumber and
1664   aqorders.ordernumber=aqorderbreakdown.ordernumber");
1665   $sth->execute($ordnum);
1666   my $data=$sth->fetchrow_hashref;
1667   $sth->finish;
1668   return($data);
1669 }
1670
1671 sub newbiblio {
1672         my ($biblio) = @_;
1673         my $dbh    = C4::Context->dbh;
1674         my $bibnum=OLDnewbiblio($dbh,$biblio);
1675         # finds new (MARC bibid
1676 #       my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1677         my $record = &MARCkoha2marcBiblio($dbh,$bibnum);
1678         MARCaddbiblio($dbh,$record,$bibnum);
1679         return($bibnum);
1680 }
1681
1682 =item modbiblio
1683
1684   $biblionumber = &modbiblio($biblio);
1685
1686 Update a biblio record.
1687
1688 C<$biblio> is a reference-to-hash whose keys are the fields in the
1689 biblio table in the Koha database. All fields must be present, not
1690 just the ones you wish to change.
1691
1692 C<&modbiblio> updates the record defined by
1693 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1694
1695 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1696 successful or not.
1697
1698 =cut
1699
1700 sub modbiblio {
1701         my ($biblio) = @_;
1702         my $dbh  = C4::Context->dbh;
1703         my $biblionumber=OLDmodbiblio($dbh,$biblio);
1704         my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
1705         # finds new (MARC bibid
1706         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
1707         MARCmodbiblio($dbh,$bibid,$record,0);
1708         return($biblionumber);
1709 } # sub modbiblio
1710
1711 =item modsubtitle
1712
1713   &modsubtitle($biblionumber, $subtitle);
1714
1715 Sets the subtitle of a book.
1716
1717 C<$biblionumber> is the biblionumber of the book to modify.
1718
1719 C<$subtitle> is the new subtitle.
1720
1721 =cut
1722
1723 sub modsubtitle {
1724   my ($bibnum, $subtitle) = @_;
1725   my $dbh   = C4::Context->dbh;
1726   &OLDmodsubtitle($dbh,$bibnum,$subtitle);
1727 } # sub modsubtitle
1728
1729 =item modaddauthor
1730
1731   &modaddauthor($biblionumber, $author);
1732
1733 Replaces all additional authors for the book with biblio number
1734 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1735 C<&modaddauthor> deletes all additional authors.
1736
1737 =cut
1738
1739 sub modaddauthor {
1740     my ($bibnum, $author) = @_;
1741     my $dbh   = C4::Context->dbh;
1742     &OLDmodaddauthor($dbh,$bibnum,$author);
1743 } # sub modaddauthor
1744
1745 =item modsubject
1746
1747   $error = &modsubject($biblionumber, $force, @subjects);
1748
1749 $force - a subject to force
1750
1751 $error - Error message, or undef if successful.
1752
1753 =cut
1754
1755 sub modsubject {
1756   my ($bibnum, $force, @subject) = @_;
1757   my $dbh   = C4::Context->dbh;
1758   my $error= &OLDmodsubject($dbh,$bibnum,$force, @subject);
1759   return($error);
1760 } # sub modsubject
1761
1762 sub modbibitem {
1763     my ($biblioitem) = @_;
1764     my $dbh   = C4::Context->dbh;
1765     &OLDmodbibitem($dbh,$biblioitem);
1766 } # sub modbibitem
1767
1768 sub modnote {
1769   my ($bibitemnum,$note)=@_;
1770   my $dbh = C4::Context->dbh;
1771   &OLDmodnote($dbh,$bibitemnum,$note);
1772 }
1773
1774 sub newbiblioitem {
1775         my ($biblioitem) = @_;
1776         my $dbh   = C4::Context->dbh;
1777         my $bibitemnum = &OLDnewbiblioitem($dbh,$biblioitem);
1778         my $MARCbiblio= MARCkoha2marcBiblio($dbh,0,$bibitemnum); # the 0 means "do NOT retrieve biblio, only biblioitem, in the MARC record
1779         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblioitem->{biblionumber});
1780         &MARCaddbiblio($dbh,$MARCbiblio,$biblioitem->{biblionumber},$bibid);
1781         return($bibitemnum);
1782 }
1783
1784 sub newsubject {
1785   my ($bibnum)=@_;
1786   my $dbh = C4::Context->dbh;
1787   &OLDnewsubject($dbh,$bibnum);
1788 }
1789
1790 sub newsubtitle {
1791     my ($bibnum, $subtitle) = @_;
1792     my $dbh   = C4::Context->dbh;
1793     &OLDnewsubtitle($dbh,$bibnum,$subtitle);
1794 }
1795
1796 sub newitems {
1797   my ($item, @barcodes) = @_;
1798   my $dbh   = C4::Context->dbh;
1799   my $errors;
1800   my $itemnumber;
1801   my $error;
1802   foreach my $barcode (@barcodes) {
1803       ($itemnumber,$error)=&OLDnewitems($dbh,$item,uc($barcode));
1804       $errors .=$error;
1805       my $MARCitem = &MARCkoha2marcItem($dbh,$item->{biblionumber},$itemnumber);
1806       &MARCadditem($dbh,$MARCitem,$item->{biblionumber});
1807   }
1808   return($errors);
1809 }
1810
1811 sub moditem {
1812     my ($item) = @_;
1813     my $dbh = C4::Context->dbh;
1814     &OLDmoditem($dbh,$item);
1815     my $MARCitem = &MARCkoha2marcItem($dbh,$item->{'biblionumber'},$item->{'itemnum'});
1816     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$item->{biblionumber});
1817     &MARCmoditem($dbh,$MARCitem,$bibid,$item->{itemnum},0);
1818 }
1819
1820 sub checkitems{
1821   my ($count,@barcodes)=@_;
1822   my $dbh = C4::Context->dbh;
1823   my $error;
1824   my $sth=$dbh->prepare("Select * from items where barcode=?");
1825   for (my $i=0;$i<$count;$i++){
1826     $barcodes[$i]=uc $barcodes[$i];
1827     $sth->execute($barcodes[$i]);
1828     if (my $data=$sth->fetchrow_hashref){
1829       $error.=" Duplicate Barcode: $barcodes[$i]";
1830     }
1831   }
1832   $sth->finish;
1833   return($error);
1834 }
1835
1836 sub countitems{
1837   my ($bibitemnum)=@_;
1838   my $dbh = C4::Context->dbh;
1839   my $query="";
1840   my $sth=$dbh->prepare("Select count(*) from items where biblioitemnumber=?");
1841   $sth->execute($bibitemnum);
1842   my $data=$sth->fetchrow_hashref;
1843   $sth->finish;
1844   return($data->{'count(*)'});
1845 }
1846
1847 sub delitem{
1848   my ($itemnum)=@_;
1849   my $dbh = C4::Context->dbh;
1850   &OLDdelitem($dbh,$itemnum);
1851 }
1852
1853 sub deletebiblioitem {
1854     my ($biblioitemnumber) = @_;
1855     my $dbh   = C4::Context->dbh;
1856     &OLDdeletebiblioitem($dbh,$biblioitemnumber);
1857 } # sub deletebiblioitem
1858
1859
1860 sub delbiblio {
1861         my ($biblio)=@_;
1862         my $dbh = C4::Context->dbh;
1863         &OLDdelbiblio($dbh,$biblio);
1864         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblio);
1865         &MARCdelbiblio($dbh,$bibid,0);
1866 }
1867
1868 sub getitemtypes {
1869   my $dbh   = C4::Context->dbh;
1870   my $sth   = $dbh->prepare("select * from itemtypes order by description");
1871   my $count = 0;
1872   my @results;
1873
1874   $sth->execute;
1875   while (my $data = $sth->fetchrow_hashref) {
1876     $results[$count] = $data;
1877     $count++;
1878   } # while
1879
1880   $sth->finish;
1881   return($count, @results);
1882 } # sub getitemtypes
1883
1884 sub getbiblio {
1885     my ($biblionumber) = @_;
1886     my $dbh   = C4::Context->dbh;
1887     my $sth   = $dbh->prepare("Select * from biblio where biblionumber = ?");
1888       # || die "Cannot prepare $query\n" . $dbh->errstr;
1889     my $count = 0;
1890     my @results;
1891
1892     $sth->execute($biblionumber);
1893       # || die "Cannot execute $query\n" . $sth->errstr;
1894     while (my $data = $sth->fetchrow_hashref) {
1895       $results[$count] = $data;
1896       $count++;
1897     } # while
1898
1899     $sth->finish;
1900     return($count, @results);
1901 } # sub getbiblio
1902
1903 sub getbiblioitem {
1904     my ($biblioitemnum) = @_;
1905     my $dbh   = C4::Context->dbh;
1906     my $sth   = $dbh->prepare("Select * from biblioitems where
1907 biblioitemnumber = ?");
1908     my $count = 0;
1909     my @results;
1910
1911     $sth->execute($biblioitemnum);
1912
1913     while (my $data = $sth->fetchrow_hashref) {
1914         $results[$count] = $data;
1915         $count++;
1916     } # while
1917
1918     $sth->finish;
1919     return($count, @results);
1920 } # sub getbiblioitem
1921
1922 sub getbiblioitembybiblionumber {
1923     my ($biblionumber) = @_;
1924     my $dbh   = C4::Context->dbh;
1925     my $sth   = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
1926     my $count = 0;
1927     my @results;
1928
1929     $sth->execute($biblionumber);
1930
1931     while (my $data = $sth->fetchrow_hashref) {
1932         $results[$count] = $data;
1933         $count++;
1934     } # while
1935
1936     $sth->finish;
1937     return($count, @results);
1938 } # sub
1939
1940 sub getitemsbybiblioitem {
1941     my ($biblioitemnum) = @_;
1942     my $dbh   = C4::Context->dbh;
1943     my $sth   = $dbh->prepare("Select * from items, biblio where
1944 biblio.biblionumber = items.biblionumber and biblioitemnumber
1945 = ?");
1946       # || die "Cannot prepare $query\n" . $dbh->errstr;
1947     my $count = 0;
1948     my @results;
1949
1950     $sth->execute($biblioitemnum);
1951       # || die "Cannot execute $query\n" . $sth->errstr;
1952     while (my $data = $sth->fetchrow_hashref) {
1953       $results[$count] = $data;
1954       $count++;
1955     } # while
1956
1957     $sth->finish;
1958     return($count, @results);
1959 } # sub getitemsbybiblioitem
1960
1961
1962 sub logchange {
1963 # Subroutine to log changes to databases
1964 # Eventually, this subroutine will be used to create a log of all changes made,
1965 # with the possibility of "undo"ing some changes
1966     my $database=shift;
1967     if ($database eq 'kohadb') {
1968         my $type=shift;
1969         my $section=shift;
1970         my $item=shift;
1971         my $original=shift;
1972         my $new=shift;
1973 #       print STDERR "KOHA: $type $section $item $original $new\n";
1974     } elsif ($database eq 'marc') {
1975         my $type=shift;
1976         my $Record_ID=shift;
1977         my $tag=shift;
1978         my $mark=shift;
1979         my $subfield_ID=shift;
1980         my $original=shift;
1981         my $new=shift;
1982 #       print STDERR "MARC: $type $Record_ID $tag $mark $subfield_ID $original $new\n";
1983     }
1984 }
1985
1986 #------------------------------------------------
1987
1988
1989 #---------------------------------------
1990 # Find a biblio entry, or create a new one if it doesn't exist.
1991 #  If a "subtitle" entry is in hash, add it to subtitle table
1992 sub getoraddbiblio {
1993         # input params
1994         my (
1995           $dbh,         # db handle
1996                         # FIXME - Unused argument
1997           $biblio,      # hash ref to fields
1998         )=@_;
1999
2000         # return
2001         my $biblionumber;
2002
2003         my $debug=0;
2004         my $sth;
2005         my $error;
2006
2007         #-----
2008         $dbh = C4::Context->dbh;
2009
2010         print "<PRE>Looking for biblio </PRE>\n" if $debug;
2011         $sth=$dbh->prepare("select biblionumber
2012                 from biblio
2013                 where title=? and author=?
2014                   and copyrightdate=? and seriestitle=?");
2015         $sth->execute(
2016                 $biblio->{title}, $biblio->{author},
2017                 $biblio->{copyright}, $biblio->{seriestitle} );
2018         if ($sth->rows) {
2019             ($biblionumber) = $sth->fetchrow;
2020             print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
2021         } else {
2022             # Doesn't exist.  Add new one.
2023             print "<PRE>Adding biblio</PRE>\n" if $debug;
2024             ($biblionumber,$error)=&newbiblio($biblio);
2025             if ( $biblionumber ) {
2026               print "<PRE>Added with biblio number=$biblionumber</PRE>\n" if $debug;
2027               if ( $biblio->{subtitle} ) {
2028                 &newsubtitle($biblionumber,$biblio->{subtitle} );
2029               } # if subtitle
2030             } else {
2031                 print "<PRE>Couldn't add biblio: $error</PRE>\n" if $debug;
2032             } # if added
2033         }
2034
2035         return $biblionumber,$error;
2036
2037 } # sub getoraddbiblio
2038
2039 sub char_decode {
2040         # converts ISO 5426 coded string to ISO 8859-1
2041         # sloppy code : should be improved in next issue
2042         my ($string,$encoding) = @_ ;
2043         $_ = $string ;
2044 #       $encoding = C4::Context->preference("marcflavour") unless $encoding;
2045         if ($encoding eq "UNIMARC") {
2046                 s/\xe1/\80/gm ;
2047                 s/\xe2/\80/gm ;
2048                 s/\xe9/\80/gm ;
2049                 s/\xec/\80/gm ;
2050                 s/\xf1/\80/gm ;
2051                 s/\xf3/\80/gm ;
2052                 s/\xf9/\80/gm ;
2053                 s/\xfb/\80/gm ;
2054                 s/\xc1\x61/\80/gm ;
2055                 s/\xc1\x65/\80/gm ;
2056                 s/\xc1\x69/\80/gm ;
2057                 s/\xc1\x6f/\80/gm ;
2058                 s/\xc1\x75/\80/gm ;
2059                 s/\xc1\x41/\80/gm ;
2060                 s/\xc1\x45/\80/gm ;
2061                 s/\xc1\x49/\80/gm ;
2062                 s/\xc1\x4f/\80/gm ;
2063                 s/\xc1\x55/\80/gm ;
2064                 s/\xc2\x41/\80/gm ;
2065                 s/\xc2\x45/\80/gm ;
2066                 s/\xc2\x49/\80/gm ;
2067                 s/\xc2\x4f/\80/gm ;
2068                 s/\xc2\x55/\80/gm ;
2069                 s/\xc2\x59/\80/gm ;
2070                 s/\xc2\x61/\80/gm ;
2071                 s/\xc2\x65/\80/gm ;
2072                 s/\xc2\x69/\80/gm ;
2073                 s/\xc2\x6f/\80/gm ;
2074                 s/\xc2\x75/\80/gm ;
2075                 s/\xc2\x79/\80/gm ;
2076                 s/\xc3\x41/\80/gm ;
2077                 s/\xc3\x45/\80/gm ;
2078                 s/\xc3\x49/\80/gm ;
2079                 s/\xc3\x4f/\80/gm ;
2080                 s/\xc3\x55/\80/gm ;
2081                 s/\xc3\x61/\80/gm ;
2082                 s/\xc3\x65/\80/gm ;
2083                 s/\xc3\x69/\80/gm ;
2084                 s/\xc3\x6f/\80/gm ;
2085                 s/\xc3\x75/\80/gm ;
2086                 s/\xc4\x41/\80/gm ;
2087                 s/\xc4\x4e/\80/gm ;
2088                 s/\xc4\x4f/\80/gm ;
2089                 s/\xc4\x61/\80/gm ;
2090                 s/\xc4\x6e/\80/gm ;
2091                 s/\xc4\x6f/\80/gm ;
2092                 s/\xc8\x45/\80/gm ;
2093                 s/\xc8\x49/\80/gm ;
2094                 s/\xc8\x65/\80/gm ;
2095                 s/\xc8\x69/\80/gm ;
2096                 s/\xc8\x76/\80/gm ;
2097                 s/\xc9\x41/\80/gm ;
2098                 s/\xc9\x4f/\80/gm ;
2099                 s/\xc9\x55/\80/gm ;
2100                 s/\xc9\x61/\80/gm ;
2101                 s/\xc9\x6f/\80/gm ;
2102                 s/\xc9\x75/\80/gm ;
2103                 s/\xca\x41/\80/gm ;
2104                 s/\xca\x61/\80/gm ;
2105                 s/\xd0\x43/\80/gm ;
2106                 s/\xd0\x63/\80/gm ;
2107                 # this handles non-sorting blocks (if implementation requires this)
2108                 $string = nsb_clean($_) ;
2109         } elsif ($encoding eq "USMARC" || $encoding eq "MARC21") {
2110                 if(/[\xc1-\xff]/) {
2111                         s/\xe1\x61/\80/gm ;
2112                         s/\xe1\x65/\80/gm ;
2113                         s/\xe1\x69/\80/gm ;
2114                         s/\xe1\x6f/\80/gm ;
2115                         s/\xe1\x75/\80/gm ;
2116                         s/\xe1\x41/\80/gm ;
2117                         s/\xe1\x45/\80/gm ;
2118                         s/\xe1\x49/\80/gm ;
2119                         s/\xe1\x4f/\80/gm ;
2120                         s/\xe1\x55/\80/gm ;
2121                         s/\xe2\x41/\80/gm ;
2122                         s/\xe2\x45/\80/gm ;
2123                         s/\xe2\x49/\80/gm ;
2124                         s/\xe2\x4f/\80/gm ;
2125                         s/\xe2\x55/\80/gm ;
2126                         s/\xe2\x59/\80/gm ;
2127                         s/\xe2\x61/\80/gm ;
2128                         s/\xe2\x65/\80/gm ;
2129                         s/\xe2\x69/\80/gm ;
2130                         s/\xe2\x6f/\80/gm ;
2131                         s/\xe2\x75/\80/gm ;
2132                         s/\xe2\x79/\80/gm ;
2133                         s/\xe3\x41/\80/gm ;
2134                         s/\xe3\x45/\80/gm ;
2135                         s/\xe3\x49/\80/gm ;
2136                         s/\xe3\x4f/\80/gm ;
2137                         s/\xe3\x55/\80/gm ;
2138                         s/\xe3\x61/\80/gm ;
2139                         s/\xe3\x65/\80/gm ;
2140                         s/\xe3\x69/\80/gm ;
2141                         s/\xe3\x6f/\80/gm ;
2142                         s/\xe3\x75/\80/gm ;
2143                         s/\xe4\x41/\80/gm ;
2144                         s/\xe4\x4e/\80/gm ;
2145                         s/\xe4\x4f/\80/gm ;
2146                         s/\xe4\x61/\80/gm ;
2147                         s/\xe4\x6e/\80/gm ;
2148                         s/\xe4\x6f/\80/gm ;
2149                         s/\xe8\x45/\80/gm ;
2150                         s/\xe8\x49/\80/gm ;
2151                         s/\xe8\x65/\80/gm ;
2152                         s/\xe8\x69/\80/gm ;
2153                         s/\xe8\x76/\80/gm ;
2154                         s/\xe9\x41/\80/gm ;
2155                         s/\xe9\x4f/\80/gm ;
2156                         s/\xe9\x55/\80/gm ;
2157                         s/\xe9\x61/\80/gm ;
2158                         s/\xe9\x6f/\80/gm ;
2159                         s/\xe9\x75/\80/gm ;
2160                         s/\xea\x41/\80/gm ;
2161                         s/\xea\x61/\80/gm ;
2162                         # this handles non-sorting blocks (if implementation requires this)
2163                         $string = nsb_clean($_) ;
2164                 }
2165         }
2166         return($string) ;
2167 }
2168
2169 sub nsb_clean {
2170         my $NSB = '\x88' ;              # NSB : begin Non Sorting Block
2171         my $NSE = '\x89' ;              # NSE : Non Sorting Block end
2172         # handles non sorting blocks
2173         my ($string) = @_ ;
2174         $_ = $string ;
2175         s/$NSB/(/gm ;
2176         s/[ ]{0,1}$NSE/) /gm ;
2177         $string = $_ ;
2178         return($string) ;
2179 }
2180
2181 END { }       # module clean-up code here (global destructor)
2182
2183 =back
2184
2185 =head1 AUTHOR
2186
2187 Koha Developement team <info@koha.org>
2188
2189 Paul POULAIN paul.poulain@free.fr
2190
2191 =cut
2192
2193 # $Id$
2194 # $Log$
2195 # Revision 1.78  2003/12/09 15:57:28  tipaul
2196 # rolling back to working char_decode sub
2197 #
2198 # Revision 1.77  2003/12/03 17:47:14  tipaul
2199 # bugfixes for biblio deletion
2200 #
2201 # Revision 1.76  2003/12/03 01:43:41  slef
2202 # conflict markers?
2203 #
2204 # Revision 1.75  2003/12/03 01:42:03  slef
2205 # bug 662 fixes securing DBI
2206 #
2207 # Revision 1.74  2003/11/28 09:48:33  tipaul
2208 # bugfix : misusing prepare & execute => now using prepare(?) and execute($var)
2209 #
2210 # Revision 1.73  2003/11/28 09:45:25  tipaul
2211 # bugfix for iso2709 file import in the "notforloan" field.
2212 #
2213 # But notforloan field called "loan" somewhere, so in case "loan" is used, copied to "notforloan" to avoid a bug.
2214 #
2215 # Revision 1.72  2003/11/24 17:40:14  tipaul
2216 # fix for #385
2217 #
2218 # Revision 1.71  2003/11/24 16:28:49  tipaul
2219 # biblio & item deletion now works fine in MARC editor.
2220 # Stores deleted biblio/item in the marc field of the deletedbiblio/deleteditem table.
2221 #
2222 # Revision 1.70  2003/11/24 13:29:55  tipaul
2223 # moving $id from beginning to end of file (70 commits... huge comments...)
2224 #
2225 # Revision 1.69  2003/11/24 13:27:17  tipaul
2226 # fix for #380 (bibliosubject)
2227 #
2228 # Revision 1.68  2003/11/06 17:18:30  tipaul
2229 # bugfix for #384
2230 #
2231 # 1st draft for MARC biblio deletion.
2232 # Still does not work well, but at least, Biblio.pm compiles & it should'nt break too many things
2233 # (Note the trash in the MARCdetail, but don't use it, please :-) )
2234 #
2235 # Revision 1.67  2003/10/25 08:46:27  tipaul
2236 # minor fixes for bilbio deletion (still buggy)
2237 #
2238 # Revision 1.66  2003/10/17 10:02:56  tipaul
2239 # Indexing only words longer than 2 letters. Was >=2 before, & 2 letters words usually means nothing.
2240 #
2241 # Revision 1.65  2003/10/14 09:45:29  tipaul
2242 # 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)
2243 #
2244 # Revision 1.64  2003/10/06 15:20:51  tipaul
2245 # fix for 536 (subtitle error)
2246 #
2247 # Revision 1.63  2003/10/01 13:25:49  tipaul
2248 # seems a char encoding problem modified something in char_decode sub... changing back to something that works...
2249 #
2250 # Revision 1.62  2003/09/17 14:21:13  tipaul
2251 # fixing bug that makes a MARC biblio disappear when using full acquisition (order => recieve ==> MARC editor).
2252 # Before this 2 lines fix, the MARC biblio was deleted during recieve, and had to be entirely recreated :-(
2253 #
2254 # Revision 1.61  2003/09/17 10:24:39  tipaul
2255 # notforloan value in itemtype was overwritting notforloan value in a given item.
2256 # I changed this behaviour :
2257 # if notforloan is set for a given item, and NOT for all items from this itemtype, the notforloan is kept.
2258 # If notforloan is set for itemtype, it's used (and impossible to loan a specific item from this itemtype)
2259 #
2260 # Revision 1.60  2003/09/04 14:11:23  tipaul
2261 # fix for 593 (data duplication in MARC-DB)
2262 #
2263 # Revision 1.58  2003/08/06 12:54:52  tipaul
2264 # fix for publicationyear : extracting numeric value from MARC string, like for copyrightdate.
2265 # (note that copyrightdate still extracted to get numeric format)
2266 #
2267 # Revision 1.57  2003/07/15 23:09:18  slef
2268 # change show columns to use biblioitems bnotes too
2269 #
2270 # Revision 1.56  2003/07/15 11:34:52  slef
2271 # fixes from paul email
2272 #
2273 # Revision 1.55  2003/07/15 00:02:49  slef
2274 # Work on bug 515... can we do a single-side rename of notes to bnotes?
2275 #
2276 # Revision 1.54  2003/07/11 11:51:32  tipaul
2277 # *** empty log message ***
2278 #
2279 # Revision 1.52  2003/07/10 10:37:19  tipaul
2280 # fix for copyrightdate problem, #514
2281 #
2282 # Revision 1.51  2003/07/02 14:47:17  tipaul
2283 # fix for #519 : items.dateaccessioned imports incorrectly
2284 #
2285 # Revision 1.49  2003/06/17 11:21:13  tipaul
2286 # improvments/fixes for z3950 support.
2287 # * Works now even on ADD, not only on MODIFY
2288 # * able to search on ISBN, author, title
2289 #
2290 # Revision 1.48  2003/06/16 09:22:53  rangi
2291 # Just added an order clause to getitemtypes
2292 #
2293 # Revision 1.47  2003/05/20 16:22:44  tipaul
2294 # fixing typo in Biblio.pm POD
2295 #
2296 # Revision 1.46  2003/05/19 13:45:18  tipaul
2297 # support for subtitles, additional authors, subject.
2298 # 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.
2299 # Note that some OLD-DB subs are strange (dummy ?) see OLDmodsubject, OLDmodsubtitle, OLDmodaddiauthor in C4/Biblio.pm
2300 # 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.
2301 #
2302 # Revision 1.45  2003/04/29 16:50:49  tipaul
2303 # really proud of this commit :-)
2304 # z3950 search and import seems to works fine.
2305 # Let me explain how :
2306 # * a "search z3950" button is added in the addbiblio template.
2307 # * when clicked, a popup appears and z3950/search.pl is called
2308 # * z3950/search.pl calls addz3950search in the DB
2309 # * the z3950 daemon retrieve the records and stores them in z3950results AND in marc_breeding table.
2310 # * as long as there as searches pending, the popup auto refresh every 2 seconds, and says how many searches are pending.
2311 # * when the user clicks on a z3950 result => the parent popup is called with the requested biblio, and auto-filled
2312 #
2313 # Note :
2314 # * 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.
2315 # * 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.
2316 #
2317 # Revision 1.44  2003/04/28 13:07:14  tipaul
2318 # Those fixes solves the "internal server error" with MARC::Record 1.12.
2319 # It was due to an illegal contruction in Koha : we tried to retrive subfields from <10 tags.
2320 # That's not possible. MARC::Record accepted this in 0.93 version, but it was fixed after.
2321 # Now, the construct/retrieving is OK !
2322 #
2323 # Revision 1.43  2003/04/10 13:56:02  tipaul
2324 # Fix some bugs :
2325 # * worked in 1.9.0, but not in 1.9.1 :
2326 # - modif of a biblio didn't work
2327 # - 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.
2328 #
2329 # * did not work before :
2330 # - repeatable subfields now works correctly. Enter 2 subfields separated by | and they will be splitted during saving.
2331 # - dropped the last subfield of the MARC form :-(
2332 #
2333 # Internal changes :
2334 # - 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.
2335 # Note the MARCdelbiblio has been rewritted to enable deletion of a biblio WITHOUT deleting items.
2336 #
2337 # Revision 1.42  2003/04/04 08:41:11  tipaul
2338 # last commits before 1.9.1
2339 #
2340 # Revision 1.41  2003/04/01 12:26:43  tipaul
2341 # fixes
2342 #
2343 # Revision 1.40  2003/03/11 15:14:03  tipaul
2344 # pod updating
2345 #
2346 # Revision 1.39  2003/03/07 16:35:42  tipaul
2347 # * moving generic functions to Koha.pm
2348 # * improvement of SearchMarc.pm
2349 # * bugfixes
2350 # * code cleaning
2351 #
2352 # Revision 1.38  2003/02/27 16:51:59  tipaul
2353 # * moving prepare / execute to ? form.
2354 # * some # cleaning
2355 # * little bugfix.
2356 # * road to 1.9.2 => acquisition and cataloguing merging
2357 #
2358 # Revision 1.37  2003/02/12 11:03:03  tipaul
2359 # Support for 000 -> 010 fields.
2360 # Those fields doesn't have subfields.
2361 # In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@".
2362 # 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.
2363 #
2364 # Revision 1.36  2003/02/12 11:01:01  tipaul
2365 # Support for 000 -> 010 fields.
2366 # Those fields doesn't have subfields.
2367 # In koha, we will use a specific "trick" : fields <10 will have a "virtual" subfield : "@".
2368 # 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.
2369 #
2370 # Revision 1.35  2003/02/03 18:46:00  acli
2371 # Minor factoring in C4/Biblio.pm, plus change to export the per-tag
2372 # 'mandatory' property to a per-subfield 'tag_mandatory' template parameter,
2373 # so that addbiblio.tmpl can distinguish between mandatory subfields in a
2374 # mandatory tag and mandatory subfields in an optional tag
2375 #
2376 # Not-minor factoring in acqui.simple/addbiblio.pl to make the if-else blocks
2377 # smaller, and to add some POD; need further testing for this
2378 #
2379 # Added function to check if a MARC subfield name is "koha-internal" (instead
2380 # of checking it for 'lib' and 'tag' everywhere); temporarily added to Koha.pm
2381 #
2382 # Use above function in acqui.simple/additem.pl and search.marc/search.pl
2383 #
2384 # Revision 1.34  2003/01/28 14:50:04  tipaul
2385 # fixing MARCmodbiblio API and reindenting code
2386 #
2387 # Revision 1.33  2003/01/23 12:22:37  tipaul
2388 # adding char_decode to decode MARC21 or UNIMARC extended chars
2389 #
2390 # Revision 1.32  2002/12/16 15:08:50  tipaul
2391 # small but important bugfix (fixes a problem in export)
2392 #
2393 # Revision 1.31  2002/12/13 16:22:04  tipaul
2394 # 1st draft of marc export
2395 #
2396 # Revision 1.30  2002/12/12 21:26:35  tipaul
2397 # YAB ! (Yet Another Bugfix) => related to biblio modif
2398 # (some warning cleaning too)
2399 #
2400 # Revision 1.29  2002/12/12 16:35:00  tipaul
2401 # adding authentification with Auth.pm and
2402 # MAJOR BUGFIX on marc biblio modification
2403 #
2404 # Revision 1.28  2002/12/10 13:30:03  tipaul
2405 # fugfixes from Dombes Abbey work
2406 #
2407 # Revision 1.27  2002/11/19 12:36:16  tipaul
2408 # road to 1.3.2
2409 # various bugfixes, improvments, and migration from acquisition.pm to biblio.pm
2410 #
2411 # Revision 1.26  2002/11/12 15:58:43  tipaul
2412 # road to 1.3.2 :
2413 # * many bugfixes
2414 # * 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)
2415 #
2416 # Revision 1.25  2002/10/25 10:58:26  tipaul
2417 # Road to 1.3.2
2418 # * bugfixes and improvements
2419 #
2420 # Revision 1.24  2002/10/24 12:09:01  arensb
2421 # Fixed "no title" warning when generating HTML documentation from POD.
2422 #
2423 # Revision 1.23  2002/10/16 12:43:08  arensb
2424 # Added some FIXME comments.
2425 #
2426 # Revision 1.22  2002/10/15 13:39:17  tipaul
2427 # removing Acquisition.pm
2428 # deleting unused code in biblio.pm, rewriting POD and answering most FIXME comments
2429 #
2430 # Revision 1.21  2002/10/13 11:34:14  arensb
2431 # Replaced expressions of the form "$x = $x <op> $y" with "$x <op>= $y".
2432 # Thus, $x = $x+2 becomes $x += 2, and so forth.
2433 #
2434 # Revision 1.20  2002/10/13 08:28:32  arensb
2435 # Deleted unused variables.
2436 # Removed trailing whitespace.
2437 #
2438 # Revision 1.19  2002/10/13 05:56:10  arensb
2439 # Added some FIXME comments.
2440 #
2441 # Revision 1.18  2002/10/11 12:34:53  arensb
2442 # Replaced &requireDBI with C4::Context->dbh
2443 #
2444 # Revision 1.17  2002/10/10 14:48:25  tipaul
2445 # bugfixes
2446 #
2447 # Revision 1.16  2002/10/07 14:04:26  tipaul
2448 # road to 1.3.1 : viewing MARC biblio
2449 #
2450 # Revision 1.15  2002/10/05 09:49:25  arensb
2451 # Merged with arensb-context branch: use C4::Context->dbh instead of
2452 # &C4Connect, and generally prefer C4::Context over C4::Database.
2453 #
2454 # Revision 1.14  2002/10/03 11:28:18  tipaul
2455 # Extending Context.pm to add stopword management and using it in MARC-API.
2456 # First benchmarks show a medium speed improvement, which  is nice as this part is heavily called.
2457 #
2458 # Revision 1.13  2002/10/02 16:26:44  tipaul
2459 # road to 1.3.1
2460 #
2461 # Revision 1.12.2.4  2002/10/05 07:09:31  arensb
2462 # Merged in changes from main branch.
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.2.3  2002/10/05 06:12:10  arensb
2475 # Added a whole mess of FIXME comments.
2476 #
2477 # Revision 1.12.2.2  2002/10/05 04:03:14  arensb
2478 # Added some missing semicolons.
2479 #
2480 # Revision 1.12.2.1  2002/10/04 02:24:01  arensb
2481 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
2482 # C4Connect.
2483 #
2484 # Revision 1.12  2002/10/01 11:48:51  arensb
2485 # Added some FIXME comments, mostly marking duplicate functions.
2486 #
2487 # Revision 1.11  2002/09/24 13:49:26  tipaul
2488 # long WAS the road to 1.3.0...
2489 # coming VERY SOON NOW...
2490 # modifying installer and buildrelease to update the DB
2491 #
2492 # Revision 1.10  2002/09/22 16:50:08  arensb
2493 # Added some FIXME comments.
2494 #
2495 # Revision 1.9  2002/09/20 12:57:46  tipaul
2496 # long is the road to 1.4.0
2497 # * MARCadditem and MARCmoditem now wroks
2498 # * various bugfixes in MARC management
2499 # !!! 1.3.0 should be released very soon now. Be careful !!!
2500 #
2501 # Revision 1.8  2002/09/10 13:53:52  tipaul
2502 # MARC API continued...
2503 # * some bugfixes
2504 # * 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)
2505 #
2506 # Note : it should not be hard for marcimport and marcexport to re-link fields from internal tag/subfield to "legal" tag/subfield.
2507 #
2508 # Revision 1.7  2002/08/14 18:12:51  tonnesen
2509 # Added copyright statement to all .pl and .pm files
2510 #
2511 # Revision 1.6  2002/07/25 13:40:31  tipaul
2512 # pod documenting the API.
2513 #
2514 # Revision 1.5  2002/07/24 16:11:37  tipaul
2515 # Now, the API...
2516 # Database.pm and Output.pm are almost not modified (var test...)
2517 #
2518 # Biblio.pm is almost completly rewritten.
2519 #
2520 # WHAT DOES IT ??? ==> END of Hitchcock suspens
2521 #
2522 # 1st, it does... nothing...
2523 # 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 ...
2524 #
2525 # All old-API functions have been cloned. for example, the "newbiblio" sub, now has become :
2526 # * a "newbiblio" sub, with the same parameters. It just call a sub named OLDnewbiblio
2527 # * 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.
2528 # * 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.
2529 # 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 ;-)
2530 #
2531 # 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.
2532 # Note we have decided with steve that a old-biblio <=> a MARC-Biblio.
2533 #
2534
2535 sub itemcount{
2536   my ($biblio)=@_;
2537   my $dbh = C4::Context->dbh;
2538   my $query="Select count(*) from items where biblionumber=$biblio";
2539 #  print $query;
2540   my $sth=$dbh->prepare($query);
2541   $sth->execute;
2542   my $data=$sth->fetchrow_hashref;
2543   $sth->finish;
2544   return($data->{'count(*)'});
2545 }
2546
2547 =item getorder
2548
2549   ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
2550
2551 Looks up the order with the given biblionumber and biblioitemnumber.
2552
2553 Returns a two-element array. C<$ordernumber> is the order number.
2554 C<$order> is a reference-to-hash describing the order; its keys are
2555 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
2556 tables of the Koha database.
2557
2558 =cut
2559 #'
2560 # FIXME - This is effectively identical to &C4::Catalogue::getorder.
2561 # Pick one and stick with it.
2562 sub getorder{
2563   my ($bi,$bib)=@_;
2564   my $dbh = C4::Context->dbh;
2565   my $query="Select ordernumber
2566         from aqorders
2567         where biblionumber=? and biblioitemnumber=?";
2568   my $sth=$dbh->prepare($query);
2569   $sth->execute($bib,$bi);
2570   # FIXME - Use fetchrow_array(), since we're only interested in the one
2571   # value.
2572   my $ordnum=$sth->fetchrow_hashref;
2573   $sth->finish;
2574   my $order=getsingleorder($ordnum->{'ordernumber'});
2575 #  print $query;
2576   return ($order,$ordnum->{'ordernumber'});
2577 }
2578
2579 =item getsingleorder
2580
2581   $order = &getsingleorder($ordernumber);
2582
2583 Looks up an order by order number.
2584
2585 Returns a reference-to-hash describing the order. The keys of
2586 C<$order> are fields from the biblio, biblioitems, aqorders, and
2587 aqorderbreakdown tables of the Koha database.
2588
2589 =cut
2590 #'
2591 # FIXME - This is effectively identical to
2592 # &C4::Catalogue::getsingleorder.
2593 # Pick one and stick with it.
2594 sub getsingleorder {
2595   my ($ordnum)=@_;
2596   my $dbh = C4::Context->dbh;
2597   my $query="Select * from biblio,biblioitems,aqorders,aqorderbreakdown
2598   where aqorders.ordernumber=?
2599   and biblio.biblionumber=aqorders.biblionumber and
2600   biblioitems.biblioitemnumber=aqorders.biblioitemnumber and
2601   aqorders.ordernumber=aqorderbreakdown.ordernumber";
2602   my $sth=$dbh->prepare($query);
2603   $sth->execute($ordnum);
2604   my $data=$sth->fetchrow_hashref;
2605   $sth->finish;
2606   return($data);
2607 }
2608
2609 sub newbiblio {
2610         my ($biblio) = @_;
2611         my $dbh    = C4::Context->dbh;
2612         my $bibnum=OLDnewbiblio($dbh,$biblio);
2613         # finds new (MARC bibid
2614 #       my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
2615         my $record = &MARCkoha2marcBiblio($dbh,$bibnum);
2616         MARCaddbiblio($dbh,$record,$bibnum);
2617         return($bibnum);
2618 }
2619
2620 =item modbiblio
2621
2622   $biblionumber = &modbiblio($biblio);
2623
2624 Update a biblio record.
2625
2626 C<$biblio> is a reference-to-hash whose keys are the fields in the
2627 biblio table in the Koha database. All fields must be present, not
2628 just the ones you wish to change.
2629
2630 C<&modbiblio> updates the record defined by
2631 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
2632
2633 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
2634 successful or not.
2635
2636 =cut
2637
2638 sub modbiblio {
2639         my ($biblio) = @_;
2640         my $dbh  = C4::Context->dbh;
2641         my $biblionumber=OLDmodbiblio($dbh,$biblio);
2642         my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
2643         # finds new (MARC bibid
2644         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
2645         MARCmodbiblio($dbh,$bibid,$record,0);
2646         return($biblionumber);
2647 } # sub modbiblio
2648
2649 =item modsubtitle
2650
2651   &modsubtitle($biblionumber, $subtitle);
2652
2653 Sets the subtitle of a book.
2654
2655 C<$biblionumber> is the biblionumber of the book to modify.
2656
2657 C<$subtitle> is the new subtitle.
2658
2659 =cut
2660
2661 sub modsubtitle {
2662   my ($bibnum, $subtitle) = @_;
2663   my $dbh   = C4::Context->dbh;
2664   &OLDmodsubtitle($dbh,$bibnum,$subtitle);
2665 } # sub modsubtitle
2666
2667 =item modaddauthor
2668
2669   &modaddauthor($biblionumber, $author);
2670
2671 Replaces all additional authors for the book with biblio number
2672 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
2673 C<&modaddauthor> deletes all additional authors.
2674
2675 =cut
2676
2677 sub modaddauthor {
2678     my ($bibnum, $author) = @_;
2679     my $dbh   = C4::Context->dbh;
2680     &OLDmodaddauthor($dbh,$bibnum,$author);
2681 } # sub modaddauthor
2682
2683 =item modsubject
2684
2685   $error = &modsubject($biblionumber, $force, @subjects);
2686
2687 $force - a subject to force
2688
2689 $error - Error message, or undef if successful.
2690
2691 =cut
2692
2693 sub modsubject {
2694   my ($bibnum, $force, @subject) = @_;
2695   my $dbh   = C4::Context->dbh;
2696   my $error= &OLDmodsubject($dbh,$bibnum,$force, @subject);
2697   return($error);
2698 } # sub modsubject
2699
2700 sub modbibitem {
2701     my ($biblioitem) = @_;
2702     my $dbh   = C4::Context->dbh;
2703     &OLDmodbibitem($dbh,$biblioitem);
2704 } # sub modbibitem
2705
2706 sub modnote {
2707   my ($bibitemnum,$note)=@_;
2708   my $dbh = C4::Context->dbh;
2709   &OLDmodnote($dbh,$bibitemnum,$note);
2710 }
2711
2712 sub newbiblioitem {
2713         my ($biblioitem) = @_;
2714         my $dbh   = C4::Context->dbh;
2715         my $bibitemnum = &OLDnewbiblioitem($dbh,$biblioitem);
2716         my $MARCbiblio= MARCkoha2marcBiblio($dbh,0,$bibitemnum); # the 0 means "do NOT retrieve biblio, only biblioitem, in the MARC record
2717         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblioitem->{biblionumber});
2718         &MARCaddbiblio($dbh,$MARCbiblio,$biblioitem->{biblionumber},$bibid);
2719         return($bibitemnum);
2720 }
2721
2722 sub newsubject {
2723   my ($bibnum)=@_;
2724   my $dbh = C4::Context->dbh;
2725   &OLDnewsubject($dbh,$bibnum);
2726 }
2727
2728 sub newsubtitle {
2729     my ($bibnum, $subtitle) = @_;
2730     my $dbh   = C4::Context->dbh;
2731     &OLDnewsubtitle($dbh,$bibnum,$subtitle);
2732 }
2733
2734 sub newitems {
2735   my ($item, @barcodes) = @_;
2736   my $dbh   = C4::Context->dbh;
2737   my $errors;
2738   my $itemnumber;
2739   my $error;
2740   foreach my $barcode (@barcodes) {
2741       ($itemnumber,$error)=&OLDnewitems($dbh,$item,uc($barcode));
2742       $errors .=$error;
2743       my $MARCitem = &MARCkoha2marcItem($dbh,$item->{biblionumber},$itemnumber);
2744       &MARCadditem($dbh,$MARCitem,$item->{biblionumber});
2745   }
2746   return($errors);
2747 }
2748
2749 sub moditem {
2750     my ($item) = @_;
2751     my $dbh = C4::Context->dbh;
2752     &OLDmoditem($dbh,$item);
2753     my $MARCitem = &MARCkoha2marcItem($dbh,$item->{'biblionumber'},$item->{'itemnum'});
2754     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$item->{biblionumber});
2755     &MARCmoditem($dbh,$MARCitem,$bibid,$item->{itemnum},0);
2756 }
2757
2758 sub checkitems{
2759   my ($count,@barcodes)=@_;
2760   my $dbh = C4::Context->dbh;
2761   my $error;
2762   for (my $i=0;$i<$count;$i++){
2763     $barcodes[$i]=uc $barcodes[$i];
2764     my $query="Select * from items where barcode='$barcodes[$i]'";
2765     my $sth=$dbh->prepare($query);
2766     $sth->execute;
2767     if (my $data=$sth->fetchrow_hashref){
2768       $error.=" Duplicate Barcode: $barcodes[$i]";
2769     }
2770     $sth->finish;
2771   }
2772   return($error);
2773 }
2774
2775 sub countitems{
2776   my ($bibitemnum)=@_;
2777   my $dbh = C4::Context->dbh;
2778   my $query="Select count(*) from items where biblioitemnumber='$bibitemnum'";
2779   my $sth=$dbh->prepare($query);
2780   $sth->execute;
2781   my $data=$sth->fetchrow_hashref;
2782   $sth->finish;
2783   return($data->{'count(*)'});
2784 }
2785
2786 sub delitem{
2787   my ($itemnum)=@_;
2788   my $dbh = C4::Context->dbh;
2789   &OLDdelitem($dbh,$itemnum);
2790 }
2791
2792 sub deletebiblioitem {
2793     my ($biblioitemnumber) = @_;
2794     my $dbh   = C4::Context->dbh;
2795     &OLDdeletebiblioitem($dbh,$biblioitemnumber);
2796 } # sub deletebiblioitem
2797
2798
2799 sub delbiblio {
2800         my ($biblio)=@_;
2801         my $dbh = C4::Context->dbh;
2802         &OLDdelbiblio($dbh,$biblio);
2803         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblio);
2804         &MARCdelbiblio($dbh,$bibid,0);
2805 }
2806
2807 sub getitemtypes {
2808   my $dbh   = C4::Context->dbh;
2809   my $query = "select * from itemtypes order by description";
2810   my $sth   = $dbh->prepare($query);
2811     # || die "Cannot prepare $query" . $dbh->errstr;
2812   my $count = 0;
2813   my @results;
2814
2815   $sth->execute;
2816     # || die "Cannot execute $query\n" . $sth->errstr;
2817   while (my $data = $sth->fetchrow_hashref) {
2818     $results[$count] = $data;
2819     $count++;
2820   } # while
2821
2822   $sth->finish;
2823   return($count, @results);
2824 } # sub getitemtypes
2825
2826 sub getbiblio {
2827     my ($biblionumber) = @_;
2828     my $dbh   = C4::Context->dbh;
2829     my $query = "Select * from biblio where biblionumber = $biblionumber";
2830     my $sth   = $dbh->prepare($query);
2831       # || die "Cannot prepare $query\n" . $dbh->errstr;
2832     my $count = 0;
2833     my @results;
2834
2835     $sth->execute;
2836       # || die "Cannot execute $query\n" . $sth->errstr;
2837     while (my $data = $sth->fetchrow_hashref) {
2838       $results[$count] = $data;
2839       $count++;
2840     } # while
2841
2842     $sth->finish;
2843     return($count, @results);
2844 } # sub getbiblio
2845
2846 sub getbiblioitem {
2847     my ($biblioitemnum) = @_;
2848     my $dbh   = C4::Context->dbh;
2849     my $query = "Select * from biblioitems where
2850 biblioitemnumber = $biblioitemnum";
2851     my $sth   = $dbh->prepare($query);
2852     my $count = 0;
2853     my @results;
2854
2855     $sth->execute;
2856
2857     while (my $data = $sth->fetchrow_hashref) {
2858         $results[$count] = $data;
2859         $count++;
2860     } # while
2861
2862     $sth->finish;
2863     return($count, @results);
2864 } # sub getbiblioitem
2865
2866 sub getbiblioitembybiblionumber {
2867     my ($biblionumber) = @_;
2868     my $dbh   = C4::Context->dbh;
2869     my $query = "Select * from biblioitems where biblionumber =
2870 $biblionumber";
2871     my $sth   = $dbh->prepare($query);
2872     my $count = 0;
2873     my @results;
2874
2875     $sth->execute;
2876
2877     while (my $data = $sth->fetchrow_hashref) {
2878         $results[$count] = $data;
2879         $count++;
2880     } # while
2881
2882     $sth->finish;
2883     return($count, @results);
2884 } # sub
2885
2886 sub getitemsbybiblioitem {
2887     my ($biblioitemnum) = @_;
2888     my $dbh   = C4::Context->dbh;
2889     my $query = "Select * from items, biblio where
2890 biblio.biblionumber = items.biblionumber and biblioitemnumber
2891 = $biblioitemnum";
2892     my $sth   = $dbh->prepare($query);
2893       # || die "Cannot prepare $query\n" . $dbh->errstr;
2894     my $count = 0;
2895     my @results;
2896
2897     $sth->execute;
2898       # || die "Cannot execute $query\n" . $sth->errstr;
2899     while (my $data = $sth->fetchrow_hashref) {
2900       $results[$count] = $data;
2901       $count++;
2902     } # while
2903
2904     $sth->finish;
2905     return($count, @results);
2906 } # sub getitemsbybiblioitem
2907
2908
2909 sub logchange {
2910 # Subroutine to log changes to databases
2911 # Eventually, this subroutine will be used to create a log of all changes made,
2912 # with the possibility of "undo"ing some changes
2913     my $database=shift;
2914     if ($database eq 'kohadb') {
2915         my $type=shift;
2916         my $section=shift;
2917         my $item=shift;
2918         my $original=shift;
2919         my $new=shift;
2920 #       print STDERR "KOHA: $type $section $item $original $new\n";
2921     } elsif ($database eq 'marc') {
2922         my $type=shift;
2923         my $Record_ID=shift;
2924         my $tag=shift;
2925         my $mark=shift;
2926         my $subfield_ID=shift;
2927         my $original=shift;
2928         my $new=shift;
2929 #       print STDERR "MARC: $type $Record_ID $tag $mark $subfield_ID $original $new\n";
2930     }
2931 }
2932
2933 #------------------------------------------------
2934
2935
2936 #---------------------------------------
2937 # Find a biblio entry, or create a new one if it doesn't exist.
2938 #  If a "subtitle" entry is in hash, add it to subtitle table
2939 sub getoraddbiblio {
2940         # input params
2941         my (
2942           $dbh,         # db handle
2943                         # FIXME - Unused argument
2944           $biblio,      # hash ref to fields
2945         )=@_;
2946
2947         # return
2948         my $biblionumber;
2949
2950         my $debug=0;
2951         my $sth;
2952         my $error;
2953
2954         #-----
2955         $dbh = C4::Context->dbh;
2956
2957         print "<PRE>Looking for biblio </PRE>\n" if $debug;
2958         $sth=$dbh->prepare("select biblionumber
2959                 from biblio
2960                 where title=? and author=?
2961                   and copyrightdate=? and seriestitle=?");
2962         $sth->execute(
2963                 $biblio->{title}, $biblio->{author},
2964                 $biblio->{copyright}, $biblio->{seriestitle} );
2965         if ($sth->rows) {
2966             ($biblionumber) = $sth->fetchrow;
2967             print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
2968         } else {
2969             # Doesn't exist.  Add new one.
2970             print "<PRE>Adding biblio</PRE>\n" if $debug;
2971             ($biblionumber,$error)=&newbiblio($biblio);
2972             if ( $biblionumber ) {
2973               print "<PRE>Added with biblio number=$biblionumber</PRE>\n" if $debug;
2974               if ( $biblio->{subtitle} ) {
2975                 &newsubtitle($biblionumber,$biblio->{subtitle} );
2976               } # if subtitle
2977             } else {
2978                 print "<PRE>Couldn't add biblio: $error</PRE>\n" if $debug;
2979             } # if added
2980         }
2981
2982         return $biblionumber,$error;
2983
2984 } # sub getoraddbiblio
2985
2986 sub char_decode {
2987         # converts ISO 5426 coded string to ISO 8859-1
2988         # sloppy code : should be improved in next issue
2989         my ($string,$encoding) = @_ ;
2990         $_ = $string ;
2991 #       $encoding = C4::Context->preference("marcflavour") unless $encoding;
2992         if ($encoding eq "UNIMARC") {
2993                 s/\xe1/Æ/gm ;
2994                 s/\xe2/Ð/gm ;
2995                 s/\xe9/Ø/gm ;
2996                 s/\xec/þ/gm ;
2997                 s/\xf1/æ/gm ;
2998                 s/\xf3/ð/gm ;
2999                 s/\xf9/ø/gm ;
3000                 s/\xfb/ß/gm ;
3001                 s/\xc1\x61/à/gm ;
3002                 s/\xc1\x65/è/gm ;
3003                 s/\xc1\x69/ì/gm ;
3004                 s/\xc1\x6f/ò/gm ;
3005                 s/\xc1\x75/ù/gm ;
3006                 s/\xc1\x41/À/gm ;
3007                 s/\xc1\x45/È/gm ;
3008                 s/\xc1\x49/Ì/gm ;
3009                 s/\xc1\x4f/Ò/gm ;
3010                 s/\xc1\x55/Ù/gm ;
3011                 s/\xc2\x41/Á/gm ;
3012                 s/\xc2\x45/É/gm ;
3013                 s/\xc2\x49/Í/gm ;
3014                 s/\xc2\x4f/Ó/gm ;
3015                 s/\xc2\x55/Ú/gm ;
3016                 s/\xc2\x59/Ý/gm ;
3017                 s/\xc2\x61/á/gm ;
3018                 s/\xc2\x65/é/gm ;
3019                 s/\xc2\x69/í/gm ;
3020                 s/\xc2\x6f/ó/gm ;
3021                 s/\xc2\x75/ú/gm ;
3022                 s/\xc2\x79/ý/gm ;
3023                 s/\xc3\x41/Â/gm ;
3024                 s/\xc3\x45/Ê/gm ;
3025                 s/\xc3\x49/Î/gm ;
3026                 s/\xc3\x4f/Ô/gm ;
3027                 s/\xc3\x55/Û/gm ;
3028                 s/\xc3\x61/â/gm ;
3029                 s/\xc3\x65/ê/gm ;
3030                 s/\xc3\x69/î/gm ;
3031                 s/\xc3\x6f/ô/gm ;
3032                 s/\xc3\x75/û/gm ;
3033                 s/\xc4\x41/Ã/gm ;
3034                 s/\xc4\x4e/Ñ/gm ;
3035                 s/\xc4\x4f/Õ/gm ;
3036                 s/\xc4\x61/ã/gm ;
3037                 s/\xc4\x6e/ñ/gm ;
3038                 s/\xc4\x6f/õ/gm ;
3039                 s/\xc8\x45/Ë/gm ;
3040                 s/\xc8\x49/Ï/gm ;
3041                 s/\xc8\x65/ë/gm ;
3042                 s/\xc8\x69/ï/gm ;
3043                 s/\xc8\x76/ÿ/gm ;
3044                 s/\xc9\x41/Ä/gm ;
3045                 s/\xc9\x4f/Ö/gm ;
3046                 s/\xc9\x55/Ü/gm ;
3047                 s/\xc9\x61/ä/gm ;
3048                 s/\xc9\x6f/ö/gm ;
3049                 s/\xc9\x75/ü/gm ;
3050                 s/\xca\x41/Å/gm ;
3051                 s/\xca\x61/å/gm ;
3052                 s/\xd0\x43/Ç/gm ;
3053                 s/\xd0\x63/ç/gm ;
3054                 # this handles non-sorting blocks (if implementation requires this)
3055                 $string = nsb_clean($_) ;
3056         } elsif ($encoding eq "USMARC" || $encoding eq "MARC21") {
3057                 if(/[\xc1-\xff]/) {
3058                         s/\xe1\x61/à/gm ;
3059                         s/\xe1\x65/è/gm ;
3060                         s/\xe1\x69/ì/gm ;
3061                         s/\xe1\x6f/ò/gm ;
3062                         s/\xe1\x75/ù/gm ;
3063                         s/\xe1\x41/À/gm ;
3064                         s/\xe1\x45/È/gm ;
3065                         s/\xe1\x49/Ì/gm ;
3066                         s/\xe1\x4f/Ò/gm ;
3067                         s/\xe1\x55/Ù/gm ;
3068                         s/\xe2\x41/Á/gm ;
3069                         s/\xe2\x45/É/gm ;
3070                         s/\xe2\x49/Í/gm ;
3071                         s/\xe2\x4f/Ó/gm ;
3072                         s/\xe2\x55/Ú/gm ;
3073                         s/\xe2\x59/Ý/gm ;
3074                         s/\xe2\x61/á/gm ;
3075                         s/\xe2\x65/é/gm ;
3076                         s/\xe2\x69/í/gm ;
3077                         s/\xe2\x6f/ó/gm ;
3078                         s/\xe2\x75/ú/gm ;
3079                         s/\xe2\x79/ý/gm ;
3080                         s/\xe3\x41/Â/gm ;
3081                         s/\xe3\x45/Ê/gm ;
3082                         s/\xe3\x49/Î/gm ;
3083                         s/\xe3\x4f/Ô/gm ;
3084                         s/\xe3\x55/Û/gm ;
3085                         s/\xe3\x61/â/gm ;
3086                         s/\xe3\x65/ê/gm ;
3087                         s/\xe3\x69/î/gm ;
3088                         s/\xe3\x6f/ô/gm ;
3089                         s/\xe3\x75/û/gm ;
3090                         s/\xe4\x41/Ã/gm ;
3091                         s/\xe4\x4e/Ñ/gm ;
3092                         s/\xe4\x4f/Õ/gm ;
3093                         s/\xe4\x61/ã/gm ;
3094                         s/\xe4\x6e/ñ/gm ;
3095                         s/\xe4\x6f/õ/gm ;
3096                         s/\xe8\x45/Ë/gm ;
3097                         s/\xe8\x49/Ï/gm ;
3098                         s/\xe8\x65/ë/gm ;
3099                         s/\xe8\x69/ï/gm ;
3100                         s/\xe8\x76/ÿ/gm ;
3101                         s/\xe9\x41/Ä/gm ;
3102                         s/\xe9\x4f/Ö/gm ;
3103                         s/\xe9\x55/Ü/gm ;
3104                         s/\xe9\x61/ä/gm ;
3105                         s/\xe9\x6f/ö/gm ;
3106                         s/\xe9\x75/ü/gm ;
3107                         s/\xea\x41/Å/gm ;
3108                         s/\xea\x61/å/gm ;
3109                         # this handles non-sorting blocks (if implementation requires this)
3110                         $string = nsb_clean($_) ;
3111                 }
3112         }
3113         return($string) ;
3114 }
3115
3116 sub nsb_clean {
3117         my $NSB = '\x88' ;              # NSB : begin Non Sorting Block
3118         my $NSE = '\x89' ;              # NSE : Non Sorting Block end
3119         # handles non sorting blocks
3120         my ($string) = @_ ;
3121         $_ = $string ;
3122         s/$NSB/(/gm ;
3123         s/[ ]{0,1}$NSE/) /gm ;
3124         $string = $_ ;
3125         return($string) ;
3126 }
3127
3128 END { }       # module clean-up code here (global destructor)
3129
3130 =back
3131
3132 =head1 AUTHOR
3133
3134 Koha Developement team <info@koha.org>
3135
3136 Paul POULAIN paul.poulain@free.fr
3137
3138 =cut