[Koha-cvs] CVS: koha/acqui.simple addbiblio.pl,1.13,1.14 marcimport.pl,1.24,1.25

[Paul POULAIN]

Update of /cvsroot/koha/koha/acqui.simple
In directory sc8-pr-cvs1:/tmp/cvs-serv16562/acqui.simple

Modified Files:
        addbiblio.pl marcimport.pl 
Log Message:
character encoding ISO646 => 8859-1, first draft

Index: addbiblio.pl
===================================================================
RCS file: /cvsroot/koha/koha/acqui.simple/addbiblio.pl,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -r1.13 -r1.14
*** addbiblio.pl        14 Jan 2003 16:43:50 -0000      1.13
--- addbiblio.pl        21 Jan 2003 08:13:50 -0000      1.14
***************
*** 51,54 ****
--- 51,55 ----
        $sth->execute($isbn);
        my ($file,$marc) = $sth->fetchrow;
+ #     $marc = char_decode($marc);
        if ($marc) {
                my $record = MARC::File::USMARC::decode($marc);
***************
*** 60,65 ****
--- 61,157 ----
        }
        return -1;
+ }
+ 
+ # some special chars in ISO 2709 (ISO 6630 and ISO 646 set)
  
+ my $IS3 = '\x1d' ;            # IS3 : record end
+ my $IS2 = '\x1e' ;            # IS2 : field end
+ my $IS1 = '\x1f' ;            # IS1 : begin subfield
+ my $NSB = '\x88' ;            # NSB : begin Non Sorting Block
+ my $NSE = '\x89' ;            # NSE : Non Sorting Block end
+ 
+ sub char_decode {
+       # converts ISO 5426 coded string to ISO 8859-1
+       # sloppy code : should be improved in next issue
+       my ($string) = @_ ;
+       $_ = $string ;
+       if(/[\xc1-\xff]/) {
+               s/\xe1/Æ/gm ;
+               s/\xe2/Ð/gm ;
+               s/\xe9/Ø/gm ;
+               s/\xec/þ/gm ;
+               s/\xf1/æ/gm ;
+               s/\xf3/ð/gm ;
+               s/\xf9/ø/gm ;
+               s/\xfb/ß/gm ;
+               s/\xc1\x61/à/gm ;
+               s/\xc1\x65/è/gm ;
+               s/\xc1\x69/ì/gm ;
+               s/\xc1\x6f/ò/gm ;
+               s/\xc1\x75/ù/gm ;
+               s/\xc1\x41/À/gm ;
+               s/\xc1\x45/È/gm ;
+               s/\xc1\x49/Ì/gm ;
+               s/\xc1\x4f/Ò/gm ;
+               s/\xc1\x55/Ù/gm ;
+               s/\xc2\x41/Á/gm ;
+               s/\xc2\x45/É/gm ;
+               s/\xc2\x49/Í/gm ;
+               s/\xc2\x4f/Ó/gm ;
+               s/\xc2\x55/Ú/gm ;
+               s/\xc2\x59/Ý/gm ;
+               s/\xc2\x61/á/gm ;
+               s/\xc2\x65/é/gm ;
+               s/\xc2\x69/í/gm ;
+               s/\xc2\x6f/ó/gm ;
+               s/\xc2\x75/ú/gm ;
+               s/\xc2\x79/ý/gm ;
+               s/\xc3\x41/Â/gm ;
+               s/\xc3\x45/Ê/gm ;
+               s/\xc3\x49/Î/gm ;
+               s/\xc3\x4f/Ô/gm ;
+               s/\xc3\x55/Û/gm ;
+               s/\xc3\x61/â/gm ;
+               s/\xc3\x65/ê/gm ;
+               s/\xc3\x69/î/gm ;
+               s/\xc3\x6f/ô/gm ;
+               s/\xc3\x75/û/gm ;
+               s/\xc4\x41/Ã/gm ;
+               s/\xc4\x4e/Ñ/gm ;
+               s/\xc4\x4f/Õ/gm ;
+               s/\xc4\x61/ã/gm ;
+               s/\xc4\x6e/ñ/gm ;
+               s/\xc4\x6f/õ/gm ;
+               s/\xc8\x45/Ë/gm ;
+               s/\xc8\x49/Ï/gm ;
+               s/\xc8\x65/ë/gm ;
+               s/\xc8\x69/ï/gm ;
+               s/\xc8\x76/ÿ/gm ;
+               s/\xc9\x41/Ä/gm ;
+               s/\xc9\x4f/Ö/gm ;
+               s/\xc9\x55/Ü/gm ;
+               s/\xc9\x61/ä/gm ;
+               s/\xc9\x6f/ö/gm ;
+               s/\xc9\x75/ü/gm ;
+               s/\xca\x41/Å/gm ;
+               s/\xca\x61/å/gm ;
+               s/\xd0\x43/Ç/gm ;
+               s/\xd0\x63/ç/gm ;
+       }
+       # this handles non-sorting blocks (if implementation requires this)
+       $string = nsb_clean($_) ;
+       return($string) ;
  }
+ 
+ sub nsb_clean {
+       # handles non sorting blocks
+       my ($string) = @_ ;
+       $_ = $string ;
+       s/$NSB/(/gm ;
+       s/[ ]{0,1}$NSE/) /gm ;
+       $string = $_ ;
+       return($string) ;
+ }
+ 
  my $input = new CGI;
  my $error = $input->param('error');
***************
*** 157,160 ****
--- 249,253 ----
                                if ($record ne -1) {
                                        my ($x,$value) = 
find_value($tag,$subfield,$record);
+                                       $value=char_decode($value);
                                        $indicator = $x if $x;
                                        if 
($tagslib->{$tag}->{$subfield}->{authorised_value}) {
***************
*** 211,214 ****
--- 304,308 ----
                                        my ($x,$value);
                                        ($x,$value) = 
find_value($tag,$subfield,$record) if ($record ne -1);
+                                       $value=char_decode($value);
                                        if 
($tagslib->{$tag}->{$subfield}->{authorised_value}) {
                                                my @authorised_values;

Index: marcimport.pl
===================================================================
RCS file: /cvsroot/koha/koha/acqui.simple/marcimport.pl,v
retrieving revision 1.24
retrieving revision 1.25
diff -C2 -r1.24 -r1.25
*** marcimport.pl       14 Jan 2003 16:41:17 -0000      1.24
--- marcimport.pl       21 Jan 2003 08:13:50 -0000      1.25
***************
*** 43,46 ****
--- 43,47 ----
  use C4::Output;
  use C4::Auth;
+ use MARC::Charset;
  
  #------------------
***************
*** 87,91 ****
        my $searchissn = $dbh->prepare("select biblioitemnumber from 
biblioitems where issn=?");
        my $searchbreeding = $dbh->prepare("select isbn from marc_breeding 
where isbn=?");
!       my $insertsql = $dbh->prepare("replace into marc_breeding 
(file,isbn,marc) values(?,?,?)");
        # fields used for import results
        my $imported=0;
--- 88,92 ----
        my $searchissn = $dbh->prepare("select biblioitemnumber from 
biblioitems where issn=?");
        my $searchbreeding = $dbh->prepare("select isbn from marc_breeding 
where isbn=?");
!       my $insertsql = $dbh->prepare("replace into marc_breeding 
(file,isbn,title,marc) values(?,?,?,?)");
        # fields used for import results
        my $imported=0;
***************
*** 126,133 ****
                                        if (!$breedingresult || 
$overwrite_biblio) {
                                                my $recoded;
! #                                             warn "IMPORT => 
$marcarray[$i]\x1D')";
!                                               $recoded = 
$marcrecord->as_usmarc(); #MARC::File::USMARC::encode($marcrecord);
! #                                             warn "RECODED : $recoded";
!                                               $insertsql 
->execute($filename,$oldbiblio->{isbn}.$oldbiblio->{issn},$recoded);
                                                $imported++;
                                        } else {
--- 127,132 ----
                                        if (!$breedingresult || 
$overwrite_biblio) {
                                                my $recoded;
!                                               $recoded = 
$marcrecord->as_usmarc();
!                                               $insertsql 
->execute($filename,$oldbiblio->{isbn}.$oldbiblio->{issn},$oldbiblio->{title},$recoded);
                                                $imported++;
                                        } else {
***************
*** 805,808 ****
--- 804,810 ----
  # log cleared, as marcimport is (almost) rewritten from scratch.
  # $Log$
+ # Revision 1.25  2003/01/21 08:13:50  tipaul
+ # character encoding ISO646 => 8859-1, first draft
+ #
  # Revision 1.24  2003/01/14 16:41:17  tipaul
  # bugfix : use gettemplate_and_user instead of gettemplate.