X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FKoha.pm;h=4239fa6cba8934c69265119dec82327961c88bf2;hb=7521b75420ece170bcba2543ddf62e3a66101176;hp=b458b27cc954930e84364374606f578d4e2da9eb;hpb=2ffd5b7228f4e638583162d483e1dd2febeafe1b;p=koha.git
diff --git a/C4/Koha.pm b/C4/Koha.pm
index b458b27cc9..4239fa6cba 100644
--- a/C4/Koha.pm
+++ b/C4/Koha.pm
@@ -17,19 +17,49 @@ package C4::Koha;
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id$
use strict;
-require Exporter;
use C4::Context;
use C4::Output;
-use vars qw($VERSION @ISA @EXPORT);
-
-$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
+use vars qw($VERSION @ISA @EXPORT $DEBUG);
+
+BEGIN {
+ $VERSION = 3.01;
+ require Exporter;
+ @ISA = qw(Exporter);
+ @EXPORT = qw(
+ &slashifyDate
+ &DisplayISBN
+ &subfield_is_koha_internal_p
+ &GetPrinters &GetPrinter
+ &GetItemTypes &getitemtypeinfo
+ &GetCcodes
+ &get_itemtypeinfos_of
+ &getframeworks &getframeworkinfo
+ &getauthtypes &getauthtype
+ &getallthemes
+ &getFacets
+ &displayServers
+ &getnbpages
+ &getitemtypeimagesrcfromurl
+ &get_infos_of
+ &get_notforloan_label_of
+ &getitemtypeimagedir
+ &getitemtypeimagesrc
+ &GetAuthorisedValues
+ &FixEncoding
+ &GetKohaAuthorisedValues
+ &GetAuthValCode
+ &GetManagedTagSubfields
+
+ $DEBUG
+ );
+ $DEBUG = 0;
+}
=head1 NAME
-C4::Koha - Perl Module containing convenience functions for Koha scripts
+ C4::Koha - Perl Module containing convenience functions for Koha scripts
=head1 SYNOPSIS
@@ -38,56 +68,19 @@ C4::Koha - Perl Module containing convenience functions for Koha scripts
=head1 DESCRIPTION
-Koha.pm provides many functions for Koha scripts.
+ Koha.pm provides many functions for Koha scripts.
=head1 FUNCTIONS
=over 2
=cut
-
-@ISA = qw(Exporter);
-@EXPORT = qw(
- &slashifyDate
- &DisplayISBN
- &subfield_is_koha_internal_p
- &GetPrinters &GetPrinter
- &GetItemTypes &getitemtypeinfo
- &GetCcodes
- &GetAuthItemlost
- &GetAuthItembinding
- &get_itemtypeinfos_of
- &getframeworks &getframeworkinfo
- &getauthtypes &getauthtype
- &getallthemes
- &getFacets
- &displaySortby
- &displayIndexes
- &displaySubtypesLimit
- &displayLimitTypes
- &displayServers
- &getnbpages
- &getitemtypeimagesrcfromurl
- &get_infos_of
- &get_notforloan_label_of
- &GetDepartements
- &GetDepartementLib
- &getitemtypeimagedir
- &getitemtypeimagesrc
- &GetAuthorisedValues
- &FixEncoding
- &GetKohaAuthorisedValues
- $DEBUG
- );
-
-my $DEBUG = 0;
-
=head2 slashifyDate
$slash_date = &slashifyDate($dash_date);
-Takes a string of the form "DD-MM-YYYY" (or anything separated by
-dashes), converts it to the form "YYYY/MM/DD", and returns the result.
+ Takes a string of the form "DD-MM-YYYY" (or anything separated by
+ dashes), converts it to the form "YYYY/MM/DD", and returns the result.
=cut
@@ -102,12 +95,13 @@ sub slashifyDate {
=head2 DisplayISBN
-my $string = DisplayISBN( $isbn );
+ my $string = DisplayISBN( $isbn );
=cut
sub DisplayISBN {
my ($isbn) = @_;
+ if (length ($isbn)<13){
my $seg1;
if ( substr( $isbn, 0, 1 ) <= 7 ) {
$seg1 = substr( $isbn, 0, 1 );
@@ -128,7 +122,7 @@ sub DisplayISBN {
my $seg2;
if ( substr( $x, 0, 2 ) <= 19 ) {
- # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
+ # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
$seg2 = substr( $x, 0, 2 );
}
elsif ( substr( $x, 0, 3 ) <= 699 ) {
@@ -150,6 +144,52 @@ sub DisplayISBN {
$seg3 = substr( $seg3, 0, length($seg3) - 1 );
my $seg4 = substr( $x, -1, 1 );
return "$seg1-$seg2-$seg3-$seg4";
+ } else {
+ my $seg1;
+ $seg1 = substr( $isbn, 0, 3 );
+ my $seg2;
+ if ( substr( $isbn, 3, 1 ) <= 7 ) {
+ $seg2 = substr( $isbn, 3, 1 );
+ }
+ elsif ( substr( $isbn, 3, 2 ) <= 94 ) {
+ $seg2 = substr( $isbn, 3, 2 );
+ }
+ elsif ( substr( $isbn, 3, 3 ) <= 995 ) {
+ $seg2 = substr( $isbn, 3, 3 );
+ }
+ elsif ( substr( $isbn, 3, 4 ) <= 9989 ) {
+ $seg2 = substr( $isbn, 3, 4 );
+ }
+ else {
+ $seg2 = substr( $isbn, 3, 5 );
+ }
+ my $x = substr( $isbn, length($seg2) +3);
+ my $seg3;
+ if ( substr( $x, 0, 2 ) <= 19 ) {
+
+ # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
+ $seg3 = substr( $x, 0, 2 );
+ }
+ elsif ( substr( $x, 0, 3 ) <= 699 ) {
+ $seg3 = substr( $x, 0, 3 );
+ }
+ elsif ( substr( $x, 0, 4 ) <= 8399 ) {
+ $seg3 = substr( $x, 0, 4 );
+ }
+ elsif ( substr( $x, 0, 5 ) <= 89999 ) {
+ $seg3 = substr( $x, 0, 5 );
+ }
+ elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
+ $seg3 = substr( $x, 0, 6 );
+ }
+ else {
+ $seg3 = substr( $x, 0, 7 );
+ }
+ my $seg4 = substr( $x, length($seg3) );
+ $seg4 = substr( $seg4, 0, length($seg4) - 1 );
+ my $seg5 = substr( $x, -1, 1 );
+ return "$seg1-$seg2-$seg3-$seg4-$seg5";
+ }
}
# FIXME.. this should be moved to a MARC-specific module
@@ -173,31 +213,30 @@ build a HTML select with the following code :
=head3 in PERL SCRIPT
-my $itemtypes = GetItemTypes;
-my @itemtypesloop;
-foreach my $thisitemtype (sort keys %$itemtypes) {
- my $selected = 1 if $thisitemtype eq $itemtype;
- my %row =(value => $thisitemtype,
- selected => $selected,
- description => $itemtypes->{$thisitemtype}->{'description'},
- );
- push @itemtypesloop, \%row;
-}
-$template->param(itemtypeloop => \@itemtypesloop);
+ my $itemtypes = GetItemTypes;
+ my @itemtypesloop;
+ foreach my $thisitemtype (sort keys %$itemtypes) {
+ my $selected = 1 if $thisitemtype eq $itemtype;
+ my %row =(value => $thisitemtype,
+ selected => $selected,
+ description => $itemtypes->{$thisitemtype}->{'description'},
+ );
+ push @itemtypesloop, \%row;
+ }
+ $template->param(itemtypeloop => \@itemtypesloop);
=head3 in TEMPLATE
-
-
+
=cut
@@ -224,6 +263,7 @@ sub get_itemtypeinfos_of {
my $query = '
SELECT itemtype,
description,
+ imageurl,
notforloan
FROM itemtypes
WHERE itemtype IN (' . join( ',', map( { "'" . $_ . "'" } @itemtypes ) ) . ')
@@ -253,66 +293,6 @@ sub GetCcodes {
return ( $count, @results );
}
-=head2
-
-grab itemlost authorized values
-
-=cut
-
-sub GetAuthItemlost {
- my $itemlost = shift;
- my $count = 0;
- my @results;
- my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare(
- "SELECT * FROM authorised_values ORDER BY authorised_value");
- $sth->execute;
- while ( my $data = $sth->fetchrow_hashref ) {
- if ( $data->{category} eq "ITEMLOST" ) {
- $count++;
- if ( $itemlost eq $data->{'authorised_value'} ) {
- $data->{'selected'} = 1;
- }
- $results[$count] = $data;
-
- #warn "data: $data";
- }
- }
- $sth->finish;
- return ( $count, @results );
-}
-
-=head2 GetAuthItembinding
-
-grab itemlost authorized values
-
-=cut
-
-sub GetAuthItembinding {
- my $itembinding = shift;
- my $count = 0;
- my @results;
- my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare(
- "SELECT * FROM authorised_values ORDER BY authorised_value");
- $sth->execute;
- while ( my $data = $sth->fetchrow_hashref ) {
- if ( $data->{category} eq "BINDING" ) {
- $count++;
- if ( $itembinding eq $data->{'authorised_value'} ) {
- $data->{'selected'} = 1;
- }
- $results[$count] = $data;
-
- #warn "data: $data";
- }
- }
- $sth->finish;
- return ( $count, @results );
-}
-
=head2 getauthtypes
$authtypes = &getauthtypes();
@@ -488,13 +468,11 @@ sub getitemtypeimagesrc {
=head2 GetPrinters
- $printers = &GetPrinters($env);
+ $printers = &GetPrinters();
@queues = keys %$printers;
Returns information about existing printer queues.
-C<$env> is ignored.
-
C<$printers> is a reference-to-hash whose keys are the print queues
defined in the printers table of the Koha database. The values are
references-to-hash, whose keys are the fields in the printers table.
@@ -502,7 +480,6 @@ references-to-hash, whose keys are the fields in the printers table.
=cut
sub GetPrinters {
- my ($env) = @_;
my %printers;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("select * from printers");
@@ -605,7 +582,7 @@ sub getFacets {
},
{
link_value => 'branch',
- label_value => 'Branches',
+ label_value => 'Libraries',
tags => [ '995', ],
subfield => 'b',
expanded => '1',
@@ -653,7 +630,7 @@ sub getFacets {
},
{
link_value => 'branch',
- label_value => 'Branches',
+ label_value => 'Libraries',
tags => [ '952', ],
subfield => 'b',
expanded => '1',
@@ -728,6 +705,8 @@ labels.
=cut
+# FIXME - why not use GetAuthorisedValues ??
+#
sub get_notforloan_label_of {
my $dbh = C4::Context->dbh;
@@ -758,285 +737,6 @@ SELECT lib,
return \%notforloan_label_of;
}
-sub displaySortby {
- my ($sort_by) = @_;
- my $sort_by_loop = [
- { value => "1=9523 >i", label => "Popularity (Most to Least)" },
- { value => "1=9523 <i", label => "Popularity (Least to Most)" },
- { value => "1=1003 <i", label => "Author (A-Z)" },
- { value => "1=1003 >i", label => "Author (Z-A)" },
- {
- value => "1=20 <i",
- label => "Call Number (Non-fiction 0-9 to Fiction A-Z)"
- },
- {
- value => "1=20 >i",
- label => "Call Number (Fiction Z-A to Non-fiction 9-0)"
- },
- { value => "1=31 >i", label => "Dates" },
- {
- value => "1=31 >i",
- label =>
- " Publication/Copyright Date: Newest to Oldest"
- },
- {
- value => "1=31 <i",
- label =>
- " Publication/Copyright Date: Oldest to Newest"
- },
- {
- value => "1=32 >i",
- label => " Acquisition Date: Newest to Oldest"
- },
- {
- value => "1=32 <i",
- label => " Acquisition Date: Oldest to Newest"
- },
- { value => "1=36 <i", label => "Title (A-Z)" },
- { value => "1=36 >i", label => "Title (Z-A)" },
- ];
- for my $hash (@$sort_by_loop) {
-
- #warn "sort by: $sort_by ... hash:".$hash->{value};
- if ($sort_by && $hash->{value} eq $sort_by ) {
- $hash->{selected} = "selected";
- }
- }
- return $sort_by_loop;
-
-}
-
-sub displayIndexes {
- my $indexes = [
- { value => '', label => 'Keyword' },
- { value => 'au', label => 'Author' },
- {
- value => 'au,phr',
- label => ' Author Phrase'
- },
- { value => 'cpn', label => ' Corporate Name' },
- { value => 'cfn', label => ' Conference Name' },
- {
- value => 'cpn,phr',
- label => ' Corporate Name Phrase'
- },
- {
- value => 'cfn,phr',
- label => ' Conference Name Phrase'
- },
- { value => 'pn', label => ' Personal Name' },
- {
- value => 'pn,phr',
- label => ' Personal Name Phrase'
- },
- { value => 'ln', label => 'Language' },
-
- # { value => 'mt', label => 'Material Type' },
- # { value => 'mt,phr', label => 'Material Type Phrase' },
- # { value => 'mc', label => 'Musical Composition' },
- # { value => 'mc,phr', label => 'Musical Composition Phrase' },
-
- { value => 'nt', label => 'Notes/Comments' },
- { value => 'pb', label => 'Publisher' },
- { value => 'pl', label => 'Publisher Location' },
- { value => 'sn', label => 'Standard Number' },
- { value => 'nb', label => ' ISBN' },
- { value => 'ns', label => ' ISSN' },
- { value => 'lcn', label => ' Call Number' },
- { value => 'su', label => 'Subject' },
- {
- value => 'su,phr',
- label => ' Subject Phrase'
- },
-
-# { value => 'de', label => ' Descriptor' },
-# { value => 'ge', label => ' Genre/Form' },
-# { value => 'gc', label => ' Geographic Coverage' },
-
-# { value => 'nc', label => ' Named Corporation and Conference' },
-# { value => 'na', label => ' Named Person' },
-
- { value => 'ti', label => 'Title' },
- { value => 'ti,phr', label => ' Title Phrase' },
- { value => 'se', label => ' Series Title' },
- ];
- return $indexes;
-}
-
-sub displaySubtypesLimit {
- my $outer_subtype_limits_loop = [
-
- { # in MARC21, aud codes are stored in 008/22 (Target audience)
- name => "limit",
- inner_subtype_limits_loop => [
- {
- value => '',
- label => 'Any Audience',
- selected => "selected"
- },
- { value => 'aud:a', label => 'Easy', },
- { value => 'aud:c', label => 'Juvenile', },
- { value => 'aud:d', label => 'Young Adult', },
- { value => 'aud:e', label => 'Adult', },
-
- ],
- },
- { # in MARC21, fic is in 008/33, bio in 008/34, mus in LDR/06
- name => "limit",
- inner_subtype_limits_loop => [
- { value => '', label => 'Any Content', selected => "selected" },
- { value => 'fic:1', label => 'Fiction', },
- { value => 'fic:0', label => 'Non Fiction', },
- { value => 'bio:b', label => 'Biography', },
- { value => 'mus:j', label => 'Musical recording', },
- { value => 'mus:i', label => 'Non-musical recording', },
-
- ],
- },
- { # MARC21, these are codes stored in 007/00-01
- name => "limit",
- inner_subtype_limits_loop => [
- { value => '', label => 'Any Format', selected => "selected" },
- { value => 'l-format:ta', label => 'Regular print', },
- { value => 'l-format:tb', label => 'Large print', },
- { value => 'l-format:fk', label => 'Braille', },
- { value => '', label => '-----------', },
- { value => 'l-format:sd', label => 'CD audio', },
- { value => 'l-format:ss', label => 'Cassette recording', },
- {
- value => 'l-format:vf',
- label => 'VHS tape / Videocassette',
- },
- { value => 'l-format:vd', label => 'DVD video / Videodisc', },
- { value => 'l-format:co', label => 'CD Software', },
- { value => 'l-format:cr', label => 'Website', },
-
- ],
- },
- { # in MARC21, these are codes in 008/24-28
- name => "limit",
- inner_subtype_limits_loop => [
- { value => '', label => 'Additional Content Types', },
- { value => 'ctype:a', label => 'Abstracts/summaries', },
- { value => 'ctype:b', label => 'Bibliographies', },
- { value => 'ctype:c', label => 'Catalogs', },
- { value => 'ctype:d', label => 'Dictionaries', },
- { value => 'ctype:e', label => 'Encyclopedias ', },
- { value => 'ctype:f', label => 'Handbooks', },
- { value => 'ctype:g', label => 'Legal articles', },
- { value => 'ctype:i', label => 'Indexes', },
- { value => 'ctype:j', label => 'Patent document', },
- { value => 'ctype:k', label => 'Discographies', },
- { value => 'ctype:l', label => 'Legislation', },
- { value => 'ctype:m', label => 'Theses', },
- { value => 'ctype:n', label => 'Surveys', },
- { value => 'ctype:o', label => 'Reviews', },
- { value => 'ctype:p', label => 'Programmed texts', },
- { value => 'ctype:q', label => 'Filmographies', },
- { value => 'ctype:r', label => 'Directories', },
- { value => 'ctype:s', label => 'Statistics', },
- { value => 'ctype:t', label => 'Technical reports', },
- { value => 'ctype:v', label => 'Legal cases and case notes', },
- { value => 'ctype:w', label => 'Law reports and digests', },
- { value => 'ctype:z', label => 'Treaties ', },
- ],
- },
- ];
- return $outer_subtype_limits_loop;
-}
-
-sub displayLimitTypes {
- my $outer_limit_types_loop = [
-
- {
- inner_limit_types_loop => [
- {
- label => "Books",
- id => "mc-books",
- name => "limit",
- value => "(mc-collection:AF or mc-collection:MYS or mc-collection:SCI or mc-collection:NF or mc-collection:YA or mc-collection:BIO or mc-collection:LP or mc-collection:LPNF)",
- icon => "search-books.gif",
- title =>
-"Books, Pamphlets, Technical reports, Manuscripts, Legal papers, Theses and dissertations",
- },
-
- {
- label => "Movies",
- id => "mc-movies",
- name => "limit",
- value => "(mc-collection:DVD or mc-collection:AV or mc-collection:AVJ or mc-collection:AVJN or mc-collection:AVJNF or mc-collection:AVNF)",
- icon => "search-movies.gif",
- title =>
-"Motion pictures, Videorecordings, Filmstrips, Slides, Transparencies, Photos, Cards, Charts, Drawings",
- },
-
- {
- label => "Music",
- id => "mc-music",
- name => "limit",
- value => "(mc-collection:CDM)",
- icon => "search-music.gif",
- title => "Spoken, Books on CD and Cassette",
- },
- ],
- },
- {
- inner_limit_types_loop => [
- {
- label => "Audio Books",
- id => "mc-audio-books",
- name => "limit",
- value => "(mc-collection:AB or mc-collection:AC or mc-collection:JAC or mc-collection:YAC)",
- icon => "search-audio-books.gif",
- title => "Spoken, Books on CD and Cassette",
- },
-
- {
- label => "Local History Materials",
- id => "mc-local-history",
- name => "limit",
- value => "mc-collection:LH",
- icon => "Local history.gif",
- title => "Local History Materials",
- },
-
- {label => "Large Print",
- id => "mc-large-print",
- name => "limit",
- value => "(mc-collection:LP or mc-collection:LPNF)",
- icon => "search-large-print.gif ",
- title => "Large Print",},
- ],
- },
-{ inner_limit_types_loop => [
- {label => "Kids",
- id => "mc-kids",
- name => "limit",
- value => "(mc-collection:EASY or mc-collection:JNF or mc-collection:JF or mc-collection:JREF or mc-collection:JB)",
- icon => "search-kids.gif",
- title => "Music",},
-
- {label => "Software/Internet",
- id => "mc-sofware-web",
- name => "limit",
- value => "(mc-collection:CDR)",
- icon => "search-software-web.gif",
- title => "Kits",},
-
- {label => "Reference",
- id => "mc-reference",
- name => "limit",
- value => "mc-collection:REF",
- icon => "search-reference.gif",
- title => "Reference",},
-
- ],
- },
-
- ];
- return $outer_limit_types_loop;
-}
-
sub displayServers {
my ( $position, $type ) = @_;
my $dbh = C4::Context->dbh;
@@ -1088,34 +788,20 @@ sub displaySecondaryServers {
return; #$secondary_servers_loop;
}
-sub GetDepartements {
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare(
- "SELECT authorised_value,lib FROM authorised_values WHERE category='DPT'
- "
- );
- $sth->execute;
- my @getdepartements;
- my $i = 0;
- while ( my $data = $sth->fetchrow_hashref ) {
- $getdepartements[$i] = $data;
- $i++;
- }
- $sth->finish;
- return (@getdepartements);
-}
+=head2 GetAuthValCode
-sub GetDepartementLib {
- my ($authorisedvalue) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare(
-"SELECT lib,authorised_value FROM authorised_values WHERE category='DPT' AND authorised_value=?
- "
- );
- $sth->execute($authorisedvalue);
- my (@lib) = $sth->fetchrow_array;
- $sth->finish;
- return (@lib);
+$authvalcode = GetAuthValCode($kohafield,$frameworkcode);
+
+=cut
+
+sub GetAuthValCode {
+ my ($kohafield,$fwcode) = @_;
+ my $dbh = C4::Context->dbh;
+ $fwcode='' unless $fwcode;
+ my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
+ $sth->execute($kohafield,$fwcode);
+ my ($authvalcode) = $sth->fetchrow_array;
+ return $authvalcode;
}
=head2 GetAuthorisedValues
@@ -1130,17 +816,94 @@ Set C<$category> on input args if you want to limits your query to this one. Thi
=cut
sub GetAuthorisedValues {
- my $category = shift;
+ my ($category,$selected) = @_;
+ my $count = 0;
+ my @results;
my $dbh = C4::Context->dbh;
my $query = "SELECT * FROM authorised_values";
$query .= " WHERE category = '" . $category . "'" if $category;
my $sth = $dbh->prepare($query);
$sth->execute;
- my $data = $sth->fetchall_arrayref({});
- return $data;
+ while (my $data=$sth->fetchrow_hashref) {
+ if ($selected eq $data->{'authorised_value'} ) {
+ $data->{'selected'} = 1;
+ }
+ $results[$count] = $data;
+ $count++;
+ }
+ #my $data = $sth->fetchall_arrayref({});
+ return \@results; #$data;
+}
+
+=head2 GetKohaAuthorisedValues
+
+ Takes $dbh , $kohafield as parameters.
+ returns hashref of authvalCode => liblibrarian
+ or undef if no authvals defined for kohafield.
+
+=cut
+
+sub GetKohaAuthorisedValues {
+ my ($kohafield,$fwcode) = @_;
+ $fwcode='' unless $fwcode;
+ my %values;
+ my $dbh = C4::Context->dbh;
+ my $avcode = GetAuthValCode($kohafield,$fwcode);
+ if ($avcode) {
+ my $sth = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
+ $sth->execute($avcode);
+ while ( my ($val, $lib) = $sth->fetchrow_array ) {
+ $values{$val}= $lib;
+ }
+ }
+ return \%values;
}
+=head2 GetManagedTagSubfields
+
+=over 4
+
+$res = GetManagedTagSubfields();
+
+=back
+
+Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
+
+NOTE: This function is used only by the (incomplete) bulk editing feature. Since
+that feature currently does not deal with items and biblioitems changes
+correctly, those tags are specifically excluded from the list prepared
+by this function.
+
+For future reference, if a bulk item editing feature is implemented at some point, it
+needs some design thought -- for example, circulation status fields should not
+be changed willy-nilly.
+
+=cut
+
+sub GetManagedTagSubfields{
+ my $dbh=C4::Context->dbh;
+ my $rq=$dbh->prepare(qq|
+SELECT
+ DISTINCT CONCAT( marc_subfield_structure.tagfield, tagsubfield ) AS tagsubfield,
+ marc_subfield_structure.liblibrarian as subfielddesc,
+ marc_tag_structure.liblibrarian as tagdesc
+FROM marc_subfield_structure
+ LEFT JOIN marc_tag_structure
+ ON marc_tag_structure.tagfield = marc_subfield_structure.tagfield
+ AND marc_tag_structure.frameworkcode = marc_subfield_structure.frameworkcode
+WHERE marc_subfield_structure.tab>=0
+AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield like 'items.%')
+AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield = 'biblioitems.itemtype')
+AND marc_subfield_structure.kohafield <> 'biblio.biblionumber'
+AND marc_subfield_structure.kohafield <> 'biblioitems.biblioitemnumber'
+ORDER BY marc_subfield_structure.tagfield, tagsubfield|);
+ $rq->execute;
+ my $data=$rq->fetchall_arrayref({});
+ return $data;
+}
+
+
=item fixEncoding
$marcrecord = &fixEncoding($marcblob);
@@ -1150,80 +913,498 @@ Returns a well encoded marcrecord.
=cut
sub FixEncoding {
my $marc=shift;
+ my $encoding=shift;
my $record = MARC::Record->new_from_usmarc($marc);
- if (C4::Context->preference("MARCFLAVOUR") eq "UNIMARC"){
- use Encode::Guess;
- my $targetcharset="utf8" if (C4::Context->preference("TemplateEncoding") eq "utf-8");
- $targetcharset="latin1" if (C4::Context->preference("TemplateEncoding") eq "iso-8859-1");
- my $decoder = guess_encoding($marc, qw/utf8 latin1/);
-# die $decoder unless ref($decoder);
- if (ref($decoder)) {
+ if (C4::Context->preference("marcflavour") eq "UNIMARC"){
+ my $targetcharset="utf8";
+ if ($encoding && $targetcharset ne $encoding){
my $newRecord=MARC::Record->new();
- foreach my $field ($record->fields()){
- if ($field->tag()<'010'){
- $newRecord->insert_grouped_field($field);
- } else {
- my $newField;
- my $createdfield=0;
- foreach my $subfield ($field->subfields()){
- if ($createdfield){
- if (($newField->tag eq '100')) {
- substr($subfield->[1],26,2,"0103") if ($targetcharset eq "latin1");
- substr($subfield->[1],26,4,"5050") if ($targetcharset eq "utf8");
+ if ($encoding!~/5426/){
+ use Text::Iconv;
+ my $decoder = Text::Iconv->new($encoding,$targetcharset);
+ my $newRecord=MARC::Record->new();
+ foreach my $field ($record->fields()){
+ if ($field->tag()<'010'){
+ $newRecord->insert_grouped_field($field);
+ } else {
+ my $newField;
+ my $createdfield=0;
+ foreach my $subfield ($field->subfields()){
+ if ($createdfield){
+ if (($newField->tag eq '100')) {
+ substr($subfield->[1],26,4,"5050") if ($targetcharset eq "utf8");
+ }
+ map {$decoder->convert($_)} @$subfield;
+ $newField->add_subfields($subfield->[0]=>$subfield->[1]);
+ } else {
+ map {$decoder->convert($_)} @$subfield;
+ $newField=MARC::Field->new($field->tag(),$field->indicator(1),$field->indicator(2),$subfield->[0]=>$subfield->[1]);
+ $createdfield=1;
+ }
+ }
+ $newRecord->insert_grouped_field($newField);
}
- map {C4::Biblio::char_decode($_,"UNIMARC")} @$subfield;
- $newField->add_subfields($subfield->[0]=>$subfield->[1]);
- } else {
- map {C4::Biblio::char_decode($_,"UNIMARC")} @$subfield;
- $newField=MARC::Field->new($field->tag(),$field->indicator(1),$field->indicator(2),$subfield->[0]=>$subfield->[1]);
- $createdfield=1;
- }
- }
- $newRecord->insert_grouped_field($newField);
- }
+ }
+ }elsif ($encoding=~/5426/){
+ foreach my $field ($record->fields()){
+ if ($field->tag()<'010'){
+ $newRecord->insert_grouped_field($field);
+ } else {
+ my $newField;
+ my $createdfield=0;
+ foreach my $subfield ($field->subfields()){
+# my $utf8=eval{MARC::Charset::marc8_to_utf8($subfield->[1])};
+# if ($@) {warn "z3950 character conversion error $@ ";$utf8=$subfield->[1]};
+ my $utf8=char_decode5426($subfield->[1]);
+ if (($field->tag eq '100')) {
+ substr($utf8,26,4,"5050");
+ }
+ if ($createdfield){
+ $newField->add_subfields($subfield->[0]=>$utf8);
+ } else {
+ $newField=MARC::Field->new($field->tag(),$field->indicator(1),$field->indicator(2),$subfield->[0]=>$utf8);
+ $createdfield=1;
+ }
+ }
+ $newRecord->insert_grouped_field($newField);
+ }
+ }
}
- # warn $newRecord->as_formatted();
- return $newRecord;
- } else {
- return $record;
- }
- } else {
- return $record;
+# warn $newRecord->as_formatted();
+ return $newRecord;
+ }
+ return $record;
}
+ return $record;
}
-=head2 GetKohaAuthorisedValues
-
- Takes $dbh , $kohafield as parameters.
- returns hashref of authvalCode => liblibrarian
- or undef if no authvals defined for kohafield.
-
-=cut
-sub GetKohaAuthorisedValues {
- my ($kohafield) = @_;
- my %values;
- my $dbh = C4::Context->dbh;
- my $sthnflstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=?');
- $sthnflstatus->execute($kohafield);
- my $authorised_valuecode = $sthnflstatus->fetchrow;
- if ($authorised_valuecode) {
- $sthnflstatus = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
- $sthnflstatus->execute($authorised_valuecode);
- while ( my ($val, $lib) = $sthnflstatus->fetchrow_array ) {
- $values{$val}= $lib;
+sub char_decode5426 {
+ my ( $string) = @_;
+ my $result;
+my %chars;
+$chars{0xb0}=0x0101;#3/0ayn[ain]
+$chars{0xb1}=0x0623;#3/1alif/hamzah[alefwithhamzaabove]
+#$chars{0xb2}=0x00e0;#'Ã ';
+$chars{0xb2}=0x00e0;#3/2leftlowsinglequotationmark
+#$chars{0xb3}=0x00e7;#'ç';
+$chars{0xb3}=0x00e7;#3/2leftlowsinglequotationmark
+# $chars{0xb4}='è';
+$chars{0xb4}=0x00e8;
+# $chars{0xb5}='é';
+$chars{0xb5}=0x00e9;
+$chars{0x97}=0x003c;#3/2leftlowsinglequotationmark
+$chars{0x98}=0x003e;#3/2leftlowsinglequotationmark
+$chars{0xfa}=0x0153;#oe
+$chars{0x81d1}=0x00b0;
+
+####
+## combined characters iso5426
+
+$chars{0xc041}=0x1ea2; # capital a with hook above
+$chars{0xc045}=0x1eba; # capital e with hook above
+$chars{0xc049}=0x1ec8; # capital i with hook above
+$chars{0xc04f}=0x1ece; # capital o with hook above
+$chars{0xc055}=0x1ee6; # capital u with hook above
+$chars{0xc059}=0x1ef6; # capital y with hook above
+$chars{0xc061}=0x1ea3; # small a with hook above
+$chars{0xc065}=0x1ebb; # small e with hook above
+$chars{0xc069}=0x1ec9; # small i with hook above
+$chars{0xc06f}=0x1ecf; # small o with hook above
+$chars{0xc075}=0x1ee7; # small u with hook above
+$chars{0xc079}=0x1ef7; # small y with hook above
+
+ # 4/1 grave accent
+$chars{0xc141}=0x00c0; # capital a with grave accent
+$chars{0xc145}=0x00c8; # capital e with grave accent
+$chars{0xc149}=0x00cc; # capital i with grave accent
+$chars{0xc14f}=0x00d2; # capital o with grave accent
+$chars{0xc155}=0x00d9; # capital u with grave accent
+$chars{0xc157}=0x1e80; # capital w with grave
+$chars{0xc159}=0x1ef2; # capital y with grave
+$chars{0xc161}=0x00e0; # small a with grave accent
+$chars{0xc165}=0x00e8; # small e with grave accent
+$chars{0xc169}=0x00ec; # small i with grave accent
+$chars{0xc16f}=0x00f2; # small o with grave accent
+$chars{0xc175}=0x00f9; # small u with grave accent
+$chars{0xc177}=0x1e81; # small w with grave
+$chars{0xc179}=0x1ef3; # small y with grave
+ # 4/2 acute accent
+$chars{0xc241}=0x00c1; # capital a with acute accent
+$chars{0xc243}=0x0106; # capital c with acute accent
+$chars{0xc245}=0x00c9; # capital e with acute accent
+$chars{0xc247}=0x01f4; # capital g with acute
+$chars{0xc249}=0x00cd; # capital i with acute accent
+$chars{0xc24b}=0x1e30; # capital k with acute
+$chars{0xc24c}=0x0139; # capital l with acute accent
+$chars{0xc24d}=0x1e3e; # capital m with acute
+$chars{0xc24e}=0x0143; # capital n with acute accent
+$chars{0xc24f}=0x00d3; # capital o with acute accent
+$chars{0xc250}=0x1e54; # capital p with acute
+$chars{0xc252}=0x0154; # capital r with acute accent
+$chars{0xc253}=0x015a; # capital s with acute accent
+$chars{0xc255}=0x00da; # capital u with acute accent
+$chars{0xc257}=0x1e82; # capital w with acute
+$chars{0xc259}=0x00dd; # capital y with acute accent
+$chars{0xc25a}=0x0179; # capital z with acute accent
+$chars{0xc261}=0x00e1; # small a with acute accent
+$chars{0xc263}=0x0107; # small c with acute accent
+$chars{0xc265}=0x00e9; # small e with acute accent
+$chars{0xc267}=0x01f5; # small g with acute
+$chars{0xc269}=0x00ed; # small i with acute accent
+$chars{0xc26b}=0x1e31; # small k with acute
+$chars{0xc26c}=0x013a; # small l with acute accent
+$chars{0xc26d}=0x1e3f; # small m with acute
+$chars{0xc26e}=0x0144; # small n with acute accent
+$chars{0xc26f}=0x00f3; # small o with acute accent
+$chars{0xc270}=0x1e55; # small p with acute
+$chars{0xc272}=0x0155; # small r with acute accent
+$chars{0xc273}=0x015b; # small s with acute accent
+$chars{0xc275}=0x00fa; # small u with acute accent
+$chars{0xc277}=0x1e83; # small w with acute
+$chars{0xc279}=0x00fd; # small y with acute accent
+$chars{0xc27a}=0x017a; # small z with acute accent
+$chars{0xc2e1}=0x01fc; # capital ae with acute
+$chars{0xc2f1}=0x01fd; # small ae with acute
+ # 4/3 circumflex accent
+$chars{0xc341}=0x00c2; # capital a with circumflex accent
+$chars{0xc343}=0x0108; # capital c with circumflex
+$chars{0xc345}=0x00ca; # capital e with circumflex accent
+$chars{0xc347}=0x011c; # capital g with circumflex
+$chars{0xc348}=0x0124; # capital h with circumflex
+$chars{0xc349}=0x00ce; # capital i with circumflex accent
+$chars{0xc34a}=0x0134; # capital j with circumflex
+$chars{0xc34f}=0x00d4; # capital o with circumflex accent
+$chars{0xc353}=0x015c; # capital s with circumflex
+$chars{0xc355}=0x00db; # capital u with circumflex
+$chars{0xc357}=0x0174; # capital w with circumflex
+$chars{0xc359}=0x0176; # capital y with circumflex
+$chars{0xc35a}=0x1e90; # capital z with circumflex
+$chars{0xc361}=0x00e2; # small a with circumflex accent
+$chars{0xc363}=0x0109; # small c with circumflex
+$chars{0xc365}=0x00ea; # small e with circumflex accent
+$chars{0xc367}=0x011d; # small g with circumflex
+$chars{0xc368}=0x0125; # small h with circumflex
+$chars{0xc369}=0x00ee; # small i with circumflex accent
+$chars{0xc36a}=0x0135; # small j with circumflex
+$chars{0xc36e}=0x00f1; # small n with tilde
+$chars{0xc36f}=0x00f4; # small o with circumflex accent
+$chars{0xc373}=0x015d; # small s with circumflex
+$chars{0xc375}=0x00fb; # small u with circumflex
+$chars{0xc377}=0x0175; # small w with circumflex
+$chars{0xc379}=0x0177; # small y with circumflex
+$chars{0xc37a}=0x1e91; # small z with circumflex
+ # 4/4 tilde
+$chars{0xc441}=0x00c3; # capital a with tilde
+$chars{0xc445}=0x1ebc; # capital e with tilde
+$chars{0xc449}=0x0128; # capital i with tilde
+$chars{0xc44e}=0x00d1; # capital n with tilde
+$chars{0xc44f}=0x00d5; # capital o with tilde
+$chars{0xc455}=0x0168; # capital u with tilde
+$chars{0xc456}=0x1e7c; # capital v with tilde
+$chars{0xc459}=0x1ef8; # capital y with tilde
+$chars{0xc461}=0x00e3; # small a with tilde
+$chars{0xc465}=0x1ebd; # small e with tilde
+$chars{0xc469}=0x0129; # small i with tilde
+$chars{0xc46e}=0x00f1; # small n with tilde
+$chars{0xc46f}=0x00f5; # small o with tilde
+$chars{0xc475}=0x0169; # small u with tilde
+$chars{0xc476}=0x1e7d; # small v with tilde
+$chars{0xc479}=0x1ef9; # small y with tilde
+ # 4/5 macron
+$chars{0xc541}=0x0100; # capital a with macron
+$chars{0xc545}=0x0112; # capital e with macron
+$chars{0xc547}=0x1e20; # capital g with macron
+$chars{0xc549}=0x012a; # capital i with macron
+$chars{0xc54f}=0x014c; # capital o with macron
+$chars{0xc555}=0x016a; # capital u with macron
+$chars{0xc561}=0x0101; # small a with macron
+$chars{0xc565}=0x0113; # small e with macron
+$chars{0xc567}=0x1e21; # small g with macron
+$chars{0xc569}=0x012b; # small i with macron
+$chars{0xc56f}=0x014d; # small o with macron
+$chars{0xc575}=0x016b; # small u with macron
+$chars{0xc572}=0x0159; # small r with macron
+$chars{0xc5e1}=0x01e2; # capital ae with macron
+$chars{0xc5f1}=0x01e3; # small ae with macron
+ # 4/6 breve
+$chars{0xc641}=0x0102; # capital a with breve
+$chars{0xc645}=0x0114; # capital e with breve
+$chars{0xc647}=0x011e; # capital g with breve
+$chars{0xc649}=0x012c; # capital i with breve
+$chars{0xc64f}=0x014e; # capital o with breve
+$chars{0xc655}=0x016c; # capital u with breve
+$chars{0xc661}=0x0103; # small a with breve
+$chars{0xc665}=0x0115; # small e with breve
+$chars{0xc667}=0x011f; # small g with breve
+$chars{0xc669}=0x012d; # small i with breve
+$chars{0xc66f}=0x014f; # small o with breve
+$chars{0xc675}=0x016d; # small u with breve
+ # 4/7 dot above
+$chars{0xc7b0}=0x01e1; # Ain with dot above
+$chars{0xc742}=0x1e02; # capital b with dot above
+$chars{0xc743}=0x010a; # capital c with dot above
+$chars{0xc744}=0x1e0a; # capital d with dot above
+$chars{0xc745}=0x0116; # capital e with dot above
+$chars{0xc746}=0x1e1e; # capital f with dot above
+$chars{0xc747}=0x0120; # capital g with dot above
+$chars{0xc748}=0x1e22; # capital h with dot above
+$chars{0xc749}=0x0130; # capital i with dot above
+$chars{0xc74d}=0x1e40; # capital m with dot above
+$chars{0xc74e}=0x1e44; # capital n with dot above
+$chars{0xc750}=0x1e56; # capital p with dot above
+$chars{0xc752}=0x1e58; # capital r with dot above
+$chars{0xc753}=0x1e60; # capital s with dot above
+$chars{0xc754}=0x1e6a; # capital t with dot above
+$chars{0xc757}=0x1e86; # capital w with dot above
+$chars{0xc758}=0x1e8a; # capital x with dot above
+$chars{0xc759}=0x1e8e; # capital y with dot above
+$chars{0xc75a}=0x017b; # capital z with dot above
+$chars{0xc761}=0x0227; # small b with dot above
+$chars{0xc762}=0x1e03; # small b with dot above
+$chars{0xc763}=0x010b; # small c with dot above
+$chars{0xc764}=0x1e0b; # small d with dot above
+$chars{0xc765}=0x0117; # small e with dot above
+$chars{0xc766}=0x1e1f; # small f with dot above
+$chars{0xc767}=0x0121; # small g with dot above
+$chars{0xc768}=0x1e23; # small h with dot above
+$chars{0xc76d}=0x1e41; # small m with dot above
+$chars{0xc76e}=0x1e45; # small n with dot above
+$chars{0xc770}=0x1e57; # small p with dot above
+$chars{0xc772}=0x1e59; # small r with dot above
+$chars{0xc773}=0x1e61; # small s with dot above
+$chars{0xc774}=0x1e6b; # small t with dot above
+$chars{0xc777}=0x1e87; # small w with dot above
+$chars{0xc778}=0x1e8b; # small x with dot above
+$chars{0xc779}=0x1e8f; # small y with dot above
+$chars{0xc77a}=0x017c; # small z with dot above
+ # 4/8 trema, diaresis
+$chars{0xc820}=0x00a8; # diaeresis
+$chars{0xc841}=0x00c4; # capital a with diaeresis
+$chars{0xc845}=0x00cb; # capital e with diaeresis
+$chars{0xc848}=0x1e26; # capital h with diaeresis
+$chars{0xc849}=0x00cf; # capital i with diaeresis
+$chars{0xc84f}=0x00d6; # capital o with diaeresis
+$chars{0xc855}=0x00dc; # capital u with diaeresis
+$chars{0xc857}=0x1e84; # capital w with diaeresis
+$chars{0xc858}=0x1e8c; # capital x with diaeresis
+$chars{0xc859}=0x0178; # capital y with diaeresis
+$chars{0xc861}=0x00e4; # small a with diaeresis
+$chars{0xc865}=0x00eb; # small e with diaeresis
+$chars{0xc868}=0x1e27; # small h with diaeresis
+$chars{0xc869}=0x00ef; # small i with diaeresis
+$chars{0xc86f}=0x00f6; # small o with diaeresis
+$chars{0xc874}=0x1e97; # small t with diaeresis
+$chars{0xc875}=0x00fc; # small u with diaeresis
+$chars{0xc877}=0x1e85; # small w with diaeresis
+$chars{0xc878}=0x1e8d; # small x with diaeresis
+$chars{0xc879}=0x00ff; # small y with diaeresis
+ # 4/9 umlaut
+$chars{0xc920}=0x00a8; # [diaeresis]
+$chars{0xc961}=0x00e4; # a with umlaut
+$chars{0xc965}=0x00eb; # e with umlaut
+$chars{0xc969}=0x00ef; # i with umlaut
+$chars{0xc96f}=0x00f6; # o with umlaut
+$chars{0xc975}=0x00fc; # u with umlaut
+ # 4/10 circle above
+$chars{0xca41}=0x00c5; # capital a with ring above
+$chars{0xcaad}=0x016e; # capital u with ring above
+$chars{0xca61}=0x00e5; # small a with ring above
+$chars{0xca75}=0x016f; # small u with ring above
+$chars{0xca77}=0x1e98; # small w with ring above
+$chars{0xca79}=0x1e99; # small y with ring above
+ # 4/11 high comma off centre
+ # 4/12 inverted high comma centred
+ # 4/13 double acute accent
+$chars{0xcd4f}=0x0150; # capital o with double acute
+$chars{0xcd55}=0x0170; # capital u with double acute
+$chars{0xcd6f}=0x0151; # small o with double acute
+$chars{0xcd75}=0x0171; # small u with double acute
+ # 4/14 horn
+$chars{0xce54}=0x01a0; # latin capital letter o with horn
+$chars{0xce55}=0x01af; # latin capital letter u with horn
+$chars{0xce74}=0x01a1; # latin small letter o with horn
+$chars{0xce75}=0x01b0; # latin small letter u with horn
+ # 4/15 caron (hacek
+$chars{0xcf41}=0x01cd; # capital a with caron
+$chars{0xcf43}=0x010c; # capital c with caron
+$chars{0xcf44}=0x010e; # capital d with caron
+$chars{0xcf45}=0x011a; # capital e with caron
+$chars{0xcf47}=0x01e6; # capital g with caron
+$chars{0xcf49}=0x01cf; # capital i with caron
+$chars{0xcf4b}=0x01e8; # capital k with caron
+$chars{0xcf4c}=0x013d; # capital l with caron
+$chars{0xcf4e}=0x0147; # capital n with caron
+$chars{0xcf4f}=0x01d1; # capital o with caron
+$chars{0xcf52}=0x0158; # capital r with caron
+$chars{0xcf53}=0x0160; # capital s with caron
+$chars{0xcf54}=0x0164; # capital t with caron
+$chars{0xcf55}=0x01d3; # capital u with caron
+$chars{0xcf5a}=0x017d; # capital z with caron
+$chars{0xcf61}=0x01ce; # small a with caron
+$chars{0xcf63}=0x010d; # small c with caron
+$chars{0xcf64}=0x010f; # small d with caron
+$chars{0xcf65}=0x011b; # small e with caron
+$chars{0xcf67}=0x01e7; # small g with caron
+$chars{0xcf69}=0x01d0; # small i with caron
+$chars{0xcf6a}=0x01f0; # small j with caron
+$chars{0xcf6b}=0x01e9; # small k with caron
+$chars{0xcf6c}=0x013e; # small l with caron
+$chars{0xcf6e}=0x0148; # small n with caron
+$chars{0xcf6f}=0x01d2; # small o with caron
+$chars{0xcf72}=0x0159; # small r with caron
+$chars{0xcf73}=0x0161; # small s with caron
+$chars{0xcf74}=0x0165; # small t with caron
+$chars{0xcf75}=0x01d4; # small u with caron
+$chars{0xcf7a}=0x017e; # small z with caron
+ # 5/0 cedilla
+$chars{0xd020}=0x00b8; # cedilla
+$chars{0xd043}=0x00c7; # capital c with cedilla
+$chars{0xd044}=0x1e10; # capital d with cedilla
+$chars{0xd047}=0x0122; # capital g with cedilla
+$chars{0xd048}=0x1e28; # capital h with cedilla
+$chars{0xd04b}=0x0136; # capital k with cedilla
+$chars{0xd04c}=0x013b; # capital l with cedilla
+$chars{0xd04e}=0x0145; # capital n with cedilla
+$chars{0xd052}=0x0156; # capital r with cedilla
+$chars{0xd053}=0x015e; # capital s with cedilla
+$chars{0xd054}=0x0162; # capital t with cedilla
+$chars{0xd063}=0x00e7; # small c with cedilla
+$chars{0xd064}=0x1e11; # small d with cedilla
+$chars{0xd065}=0x0119; # small e with cedilla
+$chars{0xd067}=0x0123; # small g with cedilla
+$chars{0xd068}=0x1e29; # small h with cedilla
+$chars{0xd06b}=0x0137; # small k with cedilla
+$chars{0xd06c}=0x013c; # small l with cedilla
+$chars{0xd06e}=0x0146; # small n with cedilla
+$chars{0xd072}=0x0157; # small r with cedilla
+$chars{0xd073}=0x015f; # small s with cedilla
+$chars{0xd074}=0x0163; # small t with cedilla
+ # 5/1 rude
+ # 5/2 hook to left
+ # 5/3 ogonek (hook to right
+$chars{0xd320}=0x02db; # ogonek
+$chars{0xd341}=0x0104; # capital a with ogonek
+$chars{0xd345}=0x0118; # capital e with ogonek
+$chars{0xd349}=0x012e; # capital i with ogonek
+$chars{0xd34f}=0x01ea; # capital o with ogonek
+$chars{0xd355}=0x0172; # capital u with ogonek
+$chars{0xd361}=0x0105; # small a with ogonek
+$chars{0xd365}=0x0119; # small e with ogonek
+$chars{0xd369}=0x012f; # small i with ogonek
+$chars{0xd36f}=0x01eb; # small o with ogonek
+$chars{0xd375}=0x0173; # small u with ogonek
+ # 5/4 circle below
+$chars{0xd441}=0x1e00; # capital a with ring below
+$chars{0xd461}=0x1e01; # small a with ring below
+ # 5/5 half circle below
+$chars{0xf948}=0x1e2a; # capital h with breve below
+$chars{0xf968}=0x1e2b; # small h with breve below
+ # 5/6 dot below
+$chars{0xd641}=0x1ea0; # capital a with dot below
+$chars{0xd642}=0x1e04; # capital b with dot below
+$chars{0xd644}=0x1e0c; # capital d with dot below
+$chars{0xd645}=0x1eb8; # capital e with dot below
+$chars{0xd648}=0x1e24; # capital h with dot below
+$chars{0xd649}=0x1eca; # capital i with dot below
+$chars{0xd64b}=0x1e32; # capital k with dot below
+$chars{0xd64c}=0x1e36; # capital l with dot below
+$chars{0xd64d}=0x1e42; # capital m with dot below
+$chars{0xd64e}=0x1e46; # capital n with dot below
+$chars{0xd64f}=0x1ecc; # capital o with dot below
+$chars{0xd652}=0x1e5a; # capital r with dot below
+$chars{0xd653}=0x1e62; # capital s with dot below
+$chars{0xd654}=0x1e6c; # capital t with dot below
+$chars{0xd655}=0x1ee4; # capital u with dot below
+$chars{0xd656}=0x1e7e; # capital v with dot below
+$chars{0xd657}=0x1e88; # capital w with dot below
+$chars{0xd659}=0x1ef4; # capital y with dot below
+$chars{0xd65a}=0x1e92; # capital z with dot below
+$chars{0xd661}=0x1ea1; # small a with dot below
+$chars{0xd662}=0x1e05; # small b with dot below
+$chars{0xd664}=0x1e0d; # small d with dot below
+$chars{0xd665}=0x1eb9; # small e with dot below
+$chars{0xd668}=0x1e25; # small h with dot below
+$chars{0xd669}=0x1ecb; # small i with dot below
+$chars{0xd66b}=0x1e33; # small k with dot below
+$chars{0xd66c}=0x1e37; # small l with dot below
+$chars{0xd66d}=0x1e43; # small m with dot below
+$chars{0xd66e}=0x1e47; # small n with dot below
+$chars{0xd66f}=0x1ecd; # small o with dot below
+$chars{0xd672}=0x1e5b; # small r with dot below
+$chars{0xd673}=0x1e63; # small s with dot below
+$chars{0xd674}=0x1e6d; # small t with dot below
+$chars{0xd675}=0x1ee5; # small u with dot below
+$chars{0xd676}=0x1e7f; # small v with dot below
+$chars{0xd677}=0x1e89; # small w with dot below
+$chars{0xd679}=0x1ef5; # small y with dot below
+$chars{0xd67a}=0x1e93; # small z with dot below
+ # 5/7 double dot below
+$chars{0xd755}=0x1e72; # capital u with diaeresis below
+$chars{0xd775}=0x1e73; # small u with diaeresis below
+ # 5/8 underline
+$chars{0xd820}=0x005f; # underline
+ # 5/9 double underline
+$chars{0xd920}=0x2017; # double underline
+ # 5/10 small low vertical bar
+$chars{0xda20}=0x02cc; #
+ # 5/11 circumflex below
+ # 5/12 (this position shall not be used)
+ # 5/13 left half of ligature sign and of double tilde
+ # 5/14 right half of ligature sign
+ # 5/15 right half of double tilde
+# map {printf "%x :%x\n",$_,$chars{$_};}keys %chars;
+ my @data = unpack("C*", $string);
+ my @characters;
+ my $length=scalar(@data);
+ for (my $i = 0; $i < scalar(@data); $i++) {
+ my $char= $data[$i];
+ if ($char >= 0x00 && $char <= 0x7F){
+ #IsAscii
+
+ push @characters,$char unless ($char<0x02 ||$char== 0x0F);
+ }elsif (($char >= 0xC0 && $char <= 0xDF)) {
+ #Combined Char
+ my $convchar ;
+ if ($chars{$char*256+$data[$i+1]}) {
+ $convchar= $chars{$char * 256 + $data[$i+1]};
+ $i++;
+# printf "char %x $char, char to convert %x , converted %x\n",$char,$char * 256 + $data[$i - 1],$convchar;
+ } elsif ($chars{$char}) {
+ $convchar= $chars{$char};
+# printf "0xC char %x, converted %x\n",$char,$chars{$char};
+ }else {
+ $convchar=$char;
+ }
+ push @characters,$convchar;
+ } else {
+ my $convchar;
+ if ($chars{$char}) {
+ $convchar= $chars{$char};
+# printf "char %x, converted %x\n",$char,$chars{$char};
+ }else {
+# printf "char %x $char\n",$char;
+ $convchar=$char;
+ }
+ push @characters,$convchar;
+ }
}
- }
- return \%values;
+ $result=pack "U*",@characters;
+# $result=~s/\x01//;
+# $result=~s/\x00//;
+ $result=~s/\x0f//;
+ $result=~s/\x1b.//;
+ $result=~s/\x0e//;
+ $result=~s/\x1b\x5b//;
+# map{printf "%x",$_} @characters;
+# printf "\n";
+ return $result;
}
-
1;
__END__
-=back
-
=head1 AUTHOR
Koha Team