C4/AuthoritiesMarc.pm

   1 package C4::AuthoritiesMarc;
   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 @EXPORT = qw(
  32         &AUTHgettagslib
  33         &MARCfindsubfield
  34         &MARCfind_frameworkcode
  35
  36         &AUTHaddauthority
  37         &AUTHmodauthority
  38         &AUTHdelauthority
  39         &AUTHaddsubfield
  40         &AUTHgetauthority
  41
  42         &MARCmodsubfield
  43         &AUTHhtml2marc
  44         &AUTHaddword
  45         &MARCaddword &MARCdelword
  46         &char_decode
  47  );
  48
  49
  50 sub AUTHgettagslib {
  51         my ($dbh,$forlibrarian,$authtypecode)= @_;
  52         warn "AUTH : $authtypecode";
  53         $authtypecode="" unless $authtypecode;
  54         warn "AUTH : $authtypecode";
  55         my $sth;
  56         my $libfield = ($forlibrarian eq 1)? 'liblibrarian' : 'libopac';
  57         # check that framework exists
  58         $sth=$dbh->prepare("select count(*) from auth_tag_structure where authtypecode=?");
  59         $sth->execute($authtypecode);
  60         my ($total) = $sth->fetchrow;
  61         $authtypecode="" unless ($total >0);
  62         $sth=$dbh->prepare("select tagfield,$libfield as lib,mandatory,repeatable from auth_tag_structure where authtypecode=? order by tagfield");
  63         $sth->execute($authtypecode);
  64         my ($lib,$tag,$res,$tab,$mandatory,$repeatable);
  65         while ( ($tag,$lib,$mandatory,$repeatable) = $sth->fetchrow) {
  66                 $res->{$tag}->{lib}=$lib;
  67                 $res->{$tab}->{tab}=""; # XXX
  68                 $res->{$tag}->{mandatory}=$mandatory;
  69                 $res->{$tag}->{repeatable}=$repeatable;
  70         }
  71
  72         $sth=$dbh->prepare("select tagfield,tagsubfield,$libfield as lib,tab, mandatory, repeatable,authorised_value,value_builder,seealso from auth_subfield_structure where authtypecode=? order by tagfield,tagsubfield");
  73         $sth->execute($authtypecode);
  74
  75         my $subfield;
  76         my $authorised_value;
  77         my $thesaurus_category;
  78         my $value_builder;
  79         my $kohafield;
  80         my $seealso;
  81         my $hidden;
  82         my $isurl;
  83         while ( ($tag, $subfield, $lib, $tab, $mandatory, $repeatable,$authorised_value,$value_builder,$seealso) = $sth->fetchrow) {
  84                 $res->{$tag}->{$subfield}->{lib}=$lib;
  85                 $res->{$tag}->{$subfield}->{tab}=$tab;
  86                 $res->{$tag}->{$subfield}->{mandatory}=$mandatory;
  87                 $res->{$tag}->{$subfield}->{repeatable}=$repeatable;
  88                 $res->{$tag}->{$subfield}->{authorised_value}=$authorised_value;
  89                 $res->{$tag}->{$subfield}->{thesaurus_category}=$thesaurus_category;
  90                 $res->{$tag}->{$subfield}->{value_builder}=$value_builder;
  91                 $res->{$tag}->{$subfield}->{seealso}=$seealso;
  92                 $res->{$tag}->{$subfield}->{hidden}=$hidden;
  93                 $res->{$tag}->{$subfield}->{isurl}=$isurl;
  94         }
  95         return $res;
  96 }
  97
  98 sub AUTHaddauthority {
  99 # pass the MARC::Record to this function, and it will create the records in the marc tables
 100         my ($dbh,$record,$authid,$authtypecode) = @_;
 101         my @fields=$record->fields();
 102 #       warn "IN AUTHaddauthority $authid => ".$record->as_formatted;
 103 # adding main table, and retrieving authid
 104 # if authid is sent, then it's not a true add, it's only a re-add, after a delete (ie, a mod)
 105 # if authid empty => true add, find a new authid number
 106         unless ($authid) {
 107                 $dbh->do("lock tables auth_header WRITE,auth_subfield_table WRITE, auth_word WRITE, stopwords READ");
 108                 my $sth=$dbh->prepare("insert into auth_header (datecreated,authtypecode) values (now(),?)");
 109                 $sth->execute($authtypecode);
 110                 $sth=$dbh->prepare("select max(authid) from auth_header");
 111                 $sth->execute;
 112                 ($authid)=$sth->fetchrow;
 113                 $sth->finish;
 114         }
 115         my $fieldcount=0;
 116         # now, add subfields...
 117         foreach my $field (@fields) {
 118                 $fieldcount++;
 119                 if ($field->tag() <10) {
 120                                 &AUTHaddsubfield($dbh,$authid,
 121                                                 $field->tag(),
 122                                                 '',
 123                                                 $fieldcount,
 124                                                 '',
 125                                                 1,
 126                                                 $field->data()
 127                                                 );
 128                 } else {
 129                         my @subfields=$field->subfields();
 130                         foreach my $subfieldcount (0..$#subfields) {
 131                                 &AUTHaddsubfield($dbh,$authid,
 132                                                 $field->tag(),
 133                                                 $field->indicator(1).$field->indicator(2),
 134                                                 $fieldcount,
 135                                                 $subfields[$subfieldcount][0],
 136                                                 $subfieldcount+1,
 137                                                 $subfields[$subfieldcount][1]
 138                                                 );
 139                         }
 140                 }
 141         }
 142         $dbh->do("unlock tables");
 143         return $authid;
 144 }
 145
 146
 147 sub AUTHaddsubfield {
 148 # Add a new subfield to a tag into the DB.
 149         my ($dbh,$authid,$tagid,$tag_indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalues) = @_;
 150         # if not value, end of job, we do nothing
 151         if (length($subfieldvalues) ==0) {
 152                 return;
 153         }
 154         if (not($subfieldcode)) {
 155                 $subfieldcode=' ';
 156         }
 157         my @subfieldvalues = split /\|/,$subfieldvalues;
 158         foreach my $subfieldvalue (@subfieldvalues) {
 159                 my $sth=$dbh->prepare("insert into auth_subfield_table (authid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values (?,?,?,?,?,?,?)");
 160                 $sth->execute($authid,(sprintf "%03s",$tagid),$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue);
 161                 if ($sth->errstr) {
 162                         warn "ERROR ==> insert into auth_subfield_table (authid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($authid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
 163                 }
 164                 &AUTHaddword($dbh,$authid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
 165         }
 166 }
 167
 168 sub AUTHgetauthority {
 169 # Returns MARC::Record of the biblio passed in parameter.
 170     my ($dbh,$authid)=@_;
 171     my $record = MARC::Record->new();
 172 #---- TODO : the leader is missing
 173         $record->leader('                        ');
 174     my $sth=$dbh->prepare("select authid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
 175                                  from auth_subfield_table
 176                                  where authid=? order by tag,tagorder,subfieldcode
 177                          ");
 178         $sth->execute($authid);
 179         my $prevtagorder=1;
 180         my $prevtag='XXX';
 181         my $previndicator;
 182         my $field; # for >=10 tags
 183         my $prevvalue; # for <10 tags
 184         while (my $row=$sth->fetchrow_hashref) {
 185                 if ($row->{tagorder} ne $prevtagorder || $row->{tag} ne $prevtag) {
 186                         $previndicator.="  ";
 187                         if ($prevtag <10) {
 188                         $record->add_fields((sprintf "%03s",$prevtag),$prevvalue) unless $prevtag eq "XXX"; # ignore the 1st loop
 189                         } else {
 190                                 $record->add_fields($field) unless $prevtag eq "XXX";
 191                         }
 192                         undef $field;
 193                         $prevtagorder=$row->{tagorder};
 194                         $prevtag = $row->{tag};
 195                         $previndicator=$row->{tag_indicator};
 196                         if ($row->{tag}<10) {
 197                                 $prevvalue = $row->{subfieldvalue};
 198                         } else {
 199                                 $field = MARC::Field->new((sprintf "%03s",$prevtag), substr($row->{tag_indicator}.'  ',0,1), substr($row->{tag_indicator}.'  ',1,1), $row->{'subfieldcode'}, $row->{'subfieldvalue'} );
 200                         }
 201                 } else {
 202                         if ($row->{tag} <10) {
 203                                 $record->add_fields((sprintf "%03s",$row->{tag}), $row->{'subfieldvalue'});
 204                         } else {
 205                                 $field->add_subfields($row->{'subfieldcode'}, $row->{'subfieldvalue'} );
 206                         }
 207                         $prevtag= $row->{tag};
 208                         $previndicator=$row->{tag_indicator};
 209                 }
 210         }
 211         # the last has not been included inside the loop... do it now !
 212         if ($prevtag ne "XXX") { # check that we have found something. Otherwise, prevtag is still XXX and we
 213                                                 # must return an empty record, not make MARC::Record fail because we try to
 214                                                 # create a record with XXX as field :-(
 215                 if ($prevtag <10) {
 216                         $record->add_fields($prevtag,$prevvalue);
 217                 } else {
 218         #               my $field = MARC::Field->new( $prevtag, "", "", %subfieldlist);
 219                         $record->add_fields($field);
 220                 }
 221         }
 222         return $record;
 223 }
 224
 225 sub AUTHmodauthority {
 226         my ($dbh,$authid,$record,$delete)=@_;
 227         my $oldrecord=&AUTHgetauthority($dbh,$authid);
 228         if ($oldrecord eq $record) {
 229                 return;
 230         }
 231 # 1st delete the authority,
 232 # 2nd recreate it
 233         &AUTHdelauthority($dbh,$authid,1);
 234         &AUTHaddauthority($dbh,$record,$authid);
 235         # FIXME : modify the authority in biblio too.
 236 }
 237
 238 sub AUTHdelauthority {
 239         my ($dbh,$authid,$keep_biblio) = @_;
 240 # if the keep_biblio is set to 1, then authority entries in biblio are preserved.
 241 # This flag is set when the delauthority is called by modauthority
 242 # due to a too complex structure of MARC (repeatable fields and subfields),
 243 # the best solution for a modif is to delete / recreate the record.
 244
 245         my $record = AUTHgetauthority($dbh,$authid);
 246         $dbh->do("delete from auth_biblio where authid=$authid");
 247         $dbh->do("delete from auth_subfield_table where authid=$authid");
 248         $dbh->do("delete from auth_word where authid=$authid");
 249 # FIXME : delete or not in biblio tables (depending on $keep_biblio flag)
 250 }
 251
 252 sub AUTHmodsubfield {
 253 # Subroutine changes a subfield value given a subfieldid.
 254         my ($dbh, $subfieldid, $subfieldvalue )=@_;
 255         $dbh->do("lock tables auth_subfield_table WRITE");
 256         my $sth=$dbh->prepare("update auth_subfield_table set subfieldvalue=? where subfieldid=?");
 257         $sth->execute($subfieldvalue, $subfieldid);
 258         $dbh->do("unlock tables");
 259         $sth->finish;
 260         $sth=$dbh->prepare("select authid,tag,tagorder,subfieldcode,subfieldid,subfieldorder from auth_subfield_table where subfieldid=?");
 261         $sth->execute($subfieldid);
 262         my ($authid,$tagid,$tagorder,$subfieldcode,$x,$subfieldorder) = $sth->fetchrow;
 263         $subfieldid=$x;
 264         &AUTHdelword($dbh,$authid,$tagid,$tagorder,$subfieldcode,$subfieldorder);
 265         &AUTHaddword($dbh,$authid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
 266         return($subfieldid, $subfieldvalue);
 267 }
 268
 269 sub AUTHfindsubfield {
 270     my ($dbh,$authid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue) = @_;
 271     my $resultcounter=0;
 272     my $subfieldid;
 273     my $lastsubfieldid;
 274     my $query="select subfieldid from auth_subfield_table where authid=? and tag=? and subfieldcode=?";
 275     my @bind_values = ($authid,$tag, $subfieldcode);
 276     if ($subfieldvalue) {
 277         $query .= " and subfieldvalue=?";
 278         push(@bind_values,$subfieldvalue);
 279     } else {
 280         if ($subfieldorder<1) {
 281             $subfieldorder=1;
 282         }
 283         $query .= " and subfieldorder=?";
 284         push(@bind_values,$subfieldorder);
 285     }
 286     my $sti=$dbh->prepare($query);
 287     $sti->execute(@bind_values);
 288     while (($subfieldid) = $sti->fetchrow) {
 289         $resultcounter++;
 290         $lastsubfieldid=$subfieldid;
 291     }
 292     if ($resultcounter>1) {
 293                 # Error condition.  Values given did not resolve into a unique record.  Don't know what to edit
 294                 # should rarely occur (only if we use subfieldvalue with a value that exists twice, which is strange)
 295                 return -1;
 296     } else {
 297                 return $lastsubfieldid;
 298     }
 299 }
 300
 301 sub AUTHfindsubfieldid {
 302         my ($dbh,$authid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
 303         my $sth=$dbh->prepare("select subfieldid from auth_subfield_table
 304                                 where authid=? and tag=? and tagorder=?
 305                                         and subfieldcode=? and subfieldorder=?");
 306         $sth->execute($authid,$tag,$tagorder,$subfield,$subfieldorder);
 307         my ($res) = $sth->fetchrow;
 308         unless ($res) {
 309                 $sth=$dbh->prepare("select subfieldid from auth_subfield_table
 310                                 where authid=? and tag=? and tagorder=?
 311                                         and subfieldcode=?");
 312                 $sth->execute($authid,$tag,$tagorder,$subfield);
 313                 ($res) = $sth->fetchrow;
 314         }
 315     return $res;
 316 }
 317
 318 sub AUTHfind_authtypecode {
 319         my ($dbh,$authid) = @_;
 320         my $sth = $dbh->prepare("select authtypecode from auth_header where authid=?");
 321         $sth->execute($authid);
 322         my ($authtypecode) = $sth->fetchrow;
 323         return $authtypecode;
 324 }
 325
 326 sub AUTHdelsubfield {
 327 # delete a subfield for $authid / tag / tagorder / subfield / subfieldorder
 328     my ($dbh,$authid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
 329     $dbh->do("delete from auth_subfield_table where authid='$authid' and
 330                         tag='$tag' and tagorder='$tagorder'
 331                         and subfieldcode='$subfield' and subfieldorder='$subfieldorder'
 332                         ");
 333 }
 334
 335 sub AUTHhtml2marc {
 336         my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
 337         my $prevtag = -1;
 338         my $record = MARC::Record->new();
 339 #       my %subfieldlist=();
 340         my $prevvalue; # if tag <10
 341         my $field; # if tag >=10
 342         for (my $i=0; $i< @$rtags; $i++) {
 343                 # rebuild MARC::Record
 344                 if (@$rtags[$i] ne $prevtag) {
 345                         if ($prevtag < 10) {
 346                                 if ($prevvalue) {
 347                                         $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
 348                                 }
 349                         } else {
 350                                 if ($field) {
 351                                         $record->add_fields($field);
 352                                 }
 353                         }
 354                         $indicators{@$rtags[$i]}.='  ';
 355                         if (@$rtags[$i] <10) {
 356                                 $prevvalue= @$rvalues[$i];
 357                         } else {
 358                                 $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
 359                         }
 360                         $prevtag = @$rtags[$i];
 361                 } else {
 362                         if (@$rtags[$i] <10) {
 363                                 $prevvalue=@$rvalues[$i];
 364                         } else {
 365                                 if (@$rvalues[$i]) {
 366                                         $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
 367                                 }
 368                         }
 369                         $prevtag= @$rtags[$i];
 370                 }
 371         }
 372         # the last has not been included inside the loop... do it now !
 373         $record->add_fields($field);
 374 #       warn $record->as_formatted;
 375         return $record;
 376 }
 377
 378 sub AUTHaddword {
 379 # split a subfield string and adds it into the word table.
 380 # removes stopwords
 381     my ($dbh,$authid,$tag,$tagorder,$subfieldid,$subfieldorder,$sentence) =@_;
 382     $sentence =~ s/(\.|\?|\:|\!|\'|,|\-|\"|\(|\)|\[|\]|\{|\})/ /g;
 383     my @words = split / /,$sentence;
 384     my $stopwords= C4::Context->stopwords;
 385     my $sth=$dbh->prepare("insert into auth_word (authid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word)
 386                         values (?,?,?,?,?,?,soundex(?))");
 387     foreach my $word (@words) {
 388 # we record only words longer than 2 car and not in stopwords hash
 389         if (length($word)>2 and !($stopwords->{uc($word)})) {
 390             $sth->execute($authid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,$word);
 391             if ($sth->err()) {
 392                 warn "ERROR ==> insert into auth_word (authid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word) values ($authid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,soundex($word))\n";
 393             }
 394         }
 395     }
 396 }
 397
 398 sub AUTHdelword {
 399 # delete words. this sub deletes all the words from a sentence. a subfield modif is done by a delete then a add
 400     my ($dbh,$authid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
 401     my $sth=$dbh->prepare("delete from auth_word where authid=? and tag=? and tagorder=? and subfieldid=? and subfieldorder=?");
 402     $sth->execute($authid,$tag,$tagorder,$subfield,$subfieldorder);
 403 }
 404
 405 sub char_decode {
 406         # converts ISO 5426 coded string to ISO 8859-1
 407         # sloppy code : should be improved in next issue
 408         my ($string,$encoding) = @_ ;
 409         $_ = $string ;
 410 #       $encoding = C4::Context->preference("marcflavour") unless $encoding;
 411         if ($encoding eq "UNIMARC") {
 412                 s/\xe1/Æ/gm ;
 413                 s/\xe2/Ð/gm ;
 414                 s/\xe9/Ø/gm ;
 415                 s/\xec/þ/gm ;
 416                 s/\xf1/æ/gm ;
 417                 s/\xf3/ð/gm ;
 418                 s/\xf9/ø/gm ;
 419                 s/\xfb/ß/gm ;
 420                 s/\xc1\x61/à/gm ;
 421                 s/\xc1\x65/è/gm ;
 422                 s/\xc1\x69/ì/gm ;
 423                 s/\xc1\x6f/ò/gm ;
 424                 s/\xc1\x75/ù/gm ;
 425                 s/\xc1\x41/À/gm ;
 426                 s/\xc1\x45/È/gm ;
 427                 s/\xc1\x49/Ì/gm ;
 428                 s/\xc1\x4f/Ò/gm ;
 429                 s/\xc1\x55/Ù/gm ;
 430                 s/\xc2\x41/Á/gm ;
 431                 s/\xc2\x45/É/gm ;
 432                 s/\xc2\x49/Í/gm ;
 433                 s/\xc2\x4f/Ó/gm ;
 434                 s/\xc2\x55/Ú/gm ;
 435                 s/\xc2\x59/Ý/gm ;
 436                 s/\xc2\x61/á/gm ;
 437                 s/\xc2\x65/é/gm ;
 438                 s/\xc2\x69/í/gm ;
 439                 s/\xc2\x6f/ó/gm ;
 440                 s/\xc2\x75/ú/gm ;
 441                 s/\xc2\x79/ý/gm ;
 442                 s/\xc3\x41/Â/gm ;
 443                 s/\xc3\x45/Ê/gm ;
 444                 s/\xc3\x49/Î/gm ;
 445                 s/\xc3\x4f/Ô/gm ;
 446                 s/\xc3\x55/Û/gm ;
 447                 s/\xc3\x61/â/gm ;
 448                 s/\xc3\x65/ê/gm ;
 449                 s/\xc3\x69/î/gm ;
 450                 s/\xc3\x6f/ô/gm ;
 451                 s/\xc3\x75/û/gm ;
 452                 s/\xc4\x41/Ã/gm ;
 453                 s/\xc4\x4e/Ñ/gm ;
 454                 s/\xc4\x4f/Õ/gm ;
 455                 s/\xc4\x61/ã/gm ;
 456                 s/\xc4\x6e/ñ/gm ;
 457                 s/\xc4\x6f/õ/gm ;
 458                 s/\xc8\x45/Ë/gm ;
 459                 s/\xc8\x49/Ï/gm ;
 460                 s/\xc8\x65/ë/gm ;
 461                 s/\xc8\x69/ï/gm ;
 462                 s/\xc8\x76/ÿ/gm ;
 463                 s/\xc9\x41/Ä/gm ;
 464                 s/\xc9\x4f/Ö/gm ;
 465                 s/\xc9\x55/Ü/gm ;
 466                 s/\xc9\x61/ä/gm ;
 467                 s/\xc9\x6f/ö/gm ;
 468                 s/\xc9\x75/ü/gm ;
 469                 s/\xca\x41/Å/gm ;
 470                 s/\xca\x61/å/gm ;
 471                 s/\xd0\x43/Ç/gm ;
 472                 s/\xd0\x63/ç/gm ;
 473                 # this handles non-sorting blocks (if implementation requires this)
 474                 $string = nsb_clean($_) ;
 475         } elsif ($encoding eq "USMARC" || $encoding eq "MARC21") {
 476                 if(/[\xc1-\xff]/) {
 477                         s/\xe1\x61/à/gm ;
 478                         s/\xe1\x65/è/gm ;
 479                         s/\xe1\x69/ì/gm ;
 480                         s/\xe1\x6f/ò/gm ;
 481                         s/\xe1\x75/ù/gm ;
 482                         s/\xe1\x41/À/gm ;
 483                         s/\xe1\x45/È/gm ;
 484                         s/\xe1\x49/Ì/gm ;
 485                         s/\xe1\x4f/Ò/gm ;
 486                         s/\xe1\x55/Ù/gm ;
 487                         s/\xe2\x41/Á/gm ;
 488                         s/\xe2\x45/É/gm ;
 489                         s/\xe2\x49/Í/gm ;
 490                         s/\xe2\x4f/Ó/gm ;
 491                         s/\xe2\x55/Ú/gm ;
 492                         s/\xe2\x59/Ý/gm ;
 493                         s/\xe2\x61/á/gm ;
 494                         s/\xe2\x65/é/gm ;
 495                         s/\xe2\x69/í/gm ;
 496                         s/\xe2\x6f/ó/gm ;
 497                         s/\xe2\x75/ú/gm ;
 498                         s/\xe2\x79/ý/gm ;
 499                         s/\xe3\x41/Â/gm ;
 500                         s/\xe3\x45/Ê/gm ;
 501                         s/\xe3\x49/Î/gm ;
 502                         s/\xe3\x4f/Ô/gm ;
 503                         s/\xe3\x55/Û/gm ;
 504                         s/\xe3\x61/â/gm ;
 505                         s/\xe3\x65/ê/gm ;
 506                         s/\xe3\x69/î/gm ;
 507                         s/\xe3\x6f/ô/gm ;
 508                         s/\xe3\x75/û/gm ;
 509                         s/\xe4\x41/Ã/gm ;
 510                         s/\xe4\x4e/Ñ/gm ;
 511                         s/\xe4\x4f/Õ/gm ;
 512                         s/\xe4\x61/ã/gm ;
 513                         s/\xe4\x6e/ñ/gm ;
 514                         s/\xe4\x6f/õ/gm ;
 515                         s/\xe8\x45/Ë/gm ;
 516                         s/\xe8\x49/Ï/gm ;
 517                         s/\xe8\x65/ë/gm ;
 518                         s/\xe8\x69/ï/gm ;
 519                         s/\xe8\x76/ÿ/gm ;
 520                         s/\xe9\x41/Ä/gm ;
 521                         s/\xe9\x4f/Ö/gm ;
 522                         s/\xe9\x55/Ü/gm ;
 523                         s/\xe9\x61/ä/gm ;
 524                         s/\xe9\x6f/ö/gm ;
 525                         s/\xe9\x75/ü/gm ;
 526                         s/\xea\x41/Å/gm ;
 527                         s/\xea\x61/å/gm ;
 528                         # this handles non-sorting blocks (if implementation requires this)
 529                         $string = nsb_clean($_) ;
 530                 }
 531         }
 532         return($string) ;
 533 }
 534
 535 sub nsb_clean {
 536         my $NSB = '\x88' ;              # NSB : begin Non Sorting Block
 537         my $NSE = '\x89' ;              # NSE : Non Sorting Block end
 538         # handles non sorting blocks
 539         my ($string) = @_ ;
 540         $_ = $string ;
 541         s/$NSB/(/gm ;
 542         s/[ ]{0,1}$NSE/) /gm ;
 543         $string = $_ ;
 544         return($string) ;
 545 }
 546
 547 END { }       # module clean-up code here (global destructor)
 548
 549 =back
 550
 551 =head1 AUTHOR
 552
 553 Koha Developement team <info@koha.org>
 554
 555 Paul POULAIN paul.poulain@free.fr
 556
 557 =cut
 558
 559 # $Id$
 560 # $Log$
 561 # Revision 1.1  2004/06/07 07:35:01  tipaul
 562 # MARC authority management package
 563 #