[Koha-cvs] CVS: koha/C4 Biblio.pm,1.32,1.33
Paul POULAIN
tipaul at users.sourceforge.net
Thu Jan 23 13:22:40 CET 2003
Update of /cvsroot/koha/koha/C4
In directory sc8-pr-cvs1:/tmp/cvs-serv6190/C4
Modified Files:
Biblio.pm
Log Message:
adding char_decode to decode MARC21 or UNIMARC extended chars
Index: Biblio.pm
===================================================================
RCS file: /cvsroot/koha/koha/C4/Biblio.pm,v
retrieving revision 1.32
retrieving revision 1.33
diff -C2 -r1.32 -r1.33
*** Biblio.pm 16 Dec 2002 15:08:50 -0000 1.32
--- Biblio.pm 23 Jan 2003 12:22:37 -0000 1.33
***************
*** 2,5 ****
--- 2,8 ----
# $Id$
# $Log$
+ # Revision 1.33 2003/01/23 12:22:37 tipaul
+ # adding char_decode to decode MARC21 or UNIMARC extended chars
+ #
# Revision 1.32 2002/12/16 15:08:50 tipaul
# small but important bugfix (fixes a problem in export)
***************
*** 191,195 ****
&getitemtypes &getbiblio
&getbiblioitembybiblionumber
! &getbiblioitem &getitemsbybiblioitem &isbnsearch
&skip
&newcompletebiblioitem
--- 194,198 ----
&getitemtypes &getbiblio
&getbiblioitembybiblionumber
! &getbiblioitem &getitemsbybiblioitem
&skip
&newcompletebiblioitem
***************
*** 211,214 ****
--- 214,218 ----
&MARCgetbiblio &MARCgetitem
&MARCaddword &MARCdelword
+ &char_decode
);
***************
*** 559,563 ****
$row->{'subfieldvalue'}=$row2->{'subfieldvalue'};
}
- # warn "$row->{bibid} = $row->{tag} - $row->{subfieldcode} -> value : $row->{subfieldvalue}";
if ($row->{tagorder} ne $prevtagorder || $row->{tag} ne $prevtag) {
if (length($prevtag) <3) {
--- 563,566 ----
***************
*** 565,574 ****
}
$previndicator.=" ";
- # warn "NEW : subfieldcode : $prevtag".substr($previndicator,0,1).substr($previndicator,1,1),;
- # foreach my $x (keys %subfieldlist) {
- # warn " $x => ".$subfieldlist{$x};
- # }
my $field = MARC::Field->new( $prevtag, substr($previndicator,0,1), substr($previndicator,1,1), %subfieldlist);
! # warn $field;
$record->add_fields($field);
$prevtagorder=$row->{tagorder};
--- 568,573 ----
}
$previndicator.=" ";
my $field = MARC::Field->new( $prevtag, substr($previndicator,0,1), substr($previndicator,1,1), %subfieldlist);
! undef %subfieldlist;
$record->add_fields($field);
$prevtagorder=$row->{tagorder};
***************
*** 578,585 ****
%subfieldlist->{$row->{'subfieldcode'}} = $row->{'subfieldvalue'};
} else {
- # warn "subfieldcode : $row->{'subfieldcode'} / value : $row->{'subfieldvalue'}, tag : $row->{tag}";
- # if (%subfieldlist->{$row->{'subfieldcode'}}) {
- # %subfieldlist->{$row->{'subfieldcode'}}.='|';
- # }
%subfieldlist->{$row->{'subfieldcode'}} .= $row->{'subfieldvalue'};
$prevtag= $row->{tag};
--- 577,580 ----
***************
*** 589,596 ****
# the last has not been included inside the loop... do it now !
my $field = MARC::Field->new( $prevtag, "", "", %subfieldlist);
- # warn "NEW : subfieldcode : $prevtag".substr($previndicator,0,1).substr($previndicator,1,1),;
- # foreach my $x (keys %subfieldlist) {
- # warn " $x => ".$subfieldlist{$x};
- # }
$record->add_fields($field);
return $record;
--- 584,587 ----
***************
*** 2030,2097 ****
} # sub getitemsbybiblioitem
- sub isbnsearch {
- my ($isbn) = @_;
- my $dbh = C4::Context->dbh;
- my $count = 0;
- my $query;
- my $sth;
- my @results;
-
- $isbn = $dbh->quote($isbn);
- $query = "Select distinct biblio.* from biblio, biblioitems where
- biblio.biblionumber = biblioitems.biblionumber
- and isbn = $isbn";
- $sth = $dbh->prepare($query);
-
- $sth->execute;
- while (my $data = $sth->fetchrow_hashref) {
- $results[$count] = $data;
- $count++;
- } # while
-
- $sth->finish;
- return($count, @results);
- } # sub isbnsearch
-
- #sub skip {
- # At the moment this is just a straight copy of the subject code. Needs heavy
- # modification to work for additional authors, obviously.
- # Check for additional author changes
-
- # my $newadditionalauthor='';
- # my $additionalauthors;
- # foreach $newadditionalauthor (@{$biblio->{'additionalauthor'}}) {
- # $additionalauthors->{$newadditionalauthor}=1;
- # if ($origadditionalauthors->{$newadditionalauthor}) {
- # $additionalauthors->{$newadditionalauthor}=2;
- # } else {
- # my $q_newadditionalauthor=$dbh->quote($newadditionalauthor);
- # my $sth=$dbh->prepare("insert into biblioadditionalauthors (additionalauthor,biblionumber) values ($q_newadditionalauthor, $biblionumber)");
- # $sth->execute;
- # logchange('kohadb', 'add', 'biblio', 'additionalauthor', $newadditionalauthor);
- # my $subfields;
- # $subfields->{1}->{'Subfield_Mark'}='a';
- # $subfields->{1}->{'Subfield_Value'}=$newadditionalauthor;
- # my $tag='650';
- # my $Record_ID;
- # foreach $Record_ID (@marcrecords) {
- # addTag($env, $Record_ID, $tag, ' ', ' ', $subfields);
- # logchange('marc', 'add', $Record_ID, '650', 'a', $newadditionalauthor);
- # }
- # }
- # }
- # my $origadditionalauthor;
- # foreach $origadditionalauthor (keys %$origadditionalauthors) {
- # if ($additionalauthors->{$origadditionalauthor} == 1) {
- # my $q_origadditionalauthor=$dbh->quote($origadditionalauthor);
- # logchange('kohadb', 'delete', 'biblio', '$biblionumber', 'additionalauthor', $origadditionalauthor);
- # my $sth=$dbh->prepare("delete from biblioadditionalauthors where biblionumber=$biblionumber and additionalauthor=$q_origadditionalauthor");
- # $sth->execute;
- # }
- # }
- #
- #}
- # $dbh->disconnect;
- #}
sub logchange {
--- 2021,2024 ----
***************
*** 2171,2174 ****
--- 2098,2240 ----
} # sub getoraddbiblio
+
+ sub char_decode {
+ # converts ISO 5426 coded string to ISO 8859-1
+ # sloppy code : should be improved in next issue
+ my ($string) = @_ ;
+ $_ = $string ;
+ if (C4::Context->preference("marcflavour") eq "UNIMARC") {
+ 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 ;
+ } else {
+ if(/[\xc1-\xff]/) {
+ s/\xe1\x61/à/gm ;
+ s/\xe1\x65/è/gm ;
+ s/\xe1\x69/ì/gm ;
+ s/\xe1\x6f/ò/gm ;
+ s/\xe1\x75/ù/gm ;
+ s/\xe1\x41/À/gm ;
+ s/\xe1\x45/È/gm ;
+ s/\xe1\x49/Ì/gm ;
+ s/\xe1\x4f/Ò/gm ;
+ s/\xe1\x55/Ù/gm ;
+ s/\xe2\x41/Á/gm ;
+ s/\xe2\x45/É/gm ;
+ s/\xe2\x49/Í/gm ;
+ s/\xe2\x4f/Ó/gm ;
+ s/\xe2\x55/Ú/gm ;
+ s/\xe2\x59/Ý/gm ;
+ s/\xe2\x61/á/gm ;
+ s/\xe2\x65/é/gm ;
+ s/\xe2\x69/í/gm ;
+ s/\xe2\x6f/ó/gm ;
+ s/\xe2\x75/ú/gm ;
+ s/\xe2\x79/ý/gm ;
+ s/\xe3\x41/Â/gm ;
+ s/\xe3\x45/Ê/gm ;
+ s/\xe3\x49/Î/gm ;
+ s/\xe3\x4f/Ô/gm ;
+ s/\xe3\x55/Û/gm ;
+ s/\xe3\x61/â/gm ;
+ s/\xe3\x65/ê/gm ;
+ s/\xe3\x69/î/gm ;
+ s/\xe3\x6f/ô/gm ;
+ s/\xe3\x75/û/gm ;
+ s/\xe4\x41/Ã/gm ;
+ s/\xe4\x4e/Ñ/gm ;
+ s/\xe4\x4f/Õ/gm ;
+ s/\xe4\x61/ã/gm ;
+ s/\xe4\x6e/ñ/gm ;
+ s/\xe4\x6f/õ/gm ;
+ s/\xe8\x45/Ë/gm ;
+ s/\xe8\x49/Ï/gm ;
+ s/\xe8\x65/ë/gm ;
+ s/\xe8\x69/ï/gm ;
+ s/\xe8\x76/ÿ/gm ;
+ s/\xe9\x41/Ä/gm ;
+ s/\xe9\x4f/Ö/gm ;
+ s/\xe9\x55/Ü/gm ;
+ s/\xe9\x61/ä/gm ;
+ s/\xe9\x6f/ö/gm ;
+ s/\xe9\x75/ü/gm ;
+ s/\xea\x41/Å/gm ;
+ s/\xea\x61/å/gm ;
+ }
+ }
+ # this handles non-sorting blocks (if implementation requires this)
+ $string = nsb_clean($_) ;
+ return($string) ;
+ }
+
+ sub nsb_clean {
+ my $NSB = '\x88' ; # NSB : begin Non Sorting Block
+ my $NSE = '\x89' ; # NSE : Non Sorting Block end
+ # handles non sorting blocks
+ my ($string) = @_ ;
+ $_ = $string ;
+ s/$NSB/(/gm ;
+ s/[ ]{0,1}$NSE/) /gm ;
+ $string = $_ ;
+ return($string) ;
+ }
END { } # module clean-up code here (global destructor)
More information about the Koha-cvs
mailing list