X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FKoha.pm;h=4239fa6cba8934c69265119dec82327961c88bf2;hb=8db4bc73a05a867e93da5bef3fe3f137d2501265;hp=94cb2f26b19e1b4ef6dd7a0d20ede19fa7489de8;hpb=1b0620652e4df16b040807948e64a9804eb2b1c6;p=koha.git

diff --git a/C4/Koha.pm b/C4/Koha.pm
index 94cb2f26b1..4239fa6cba 100644
--- a/C4/Koha.pm
+++ b/C4/Koha.pm
@@ -17,250 +17,1396 @@ package C4::Koha;
 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
 # Suite 330, Boston, MA  02111-1307 USA
 
+
 use strict;
-require Exporter;
 use C4::Context;
+use C4::Output;
+use vars qw($VERSION @ISA @EXPORT $DEBUG);
 
-use vars qw($VERSION @ISA @EXPORT);
+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
 
-$VERSION = 0.01;
+		$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
 
   use C4::Koha;
 
 
-  $date = slashifyDate("01-01-2002")
-  $ethnicity = fixEthnicity('asian');
-  ($categories, $labels) = borrowercategories();
-  ($categories, $labels) = ethnicitycategories();
-
 =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
-	     &fixEthnicity
-	     &borrowercategories
-	     &ethnicitycategories
-	     &subfield_is_koha_internal_p
-		&getbranches &getprinters
-		&getbranch &getprinter
-	     $DEBUG);
-
-use vars qw();
-
-my $DEBUG = 0;
-
-=item slashifyDate
+=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
 
 sub slashifyDate {
+
     # accepts a date of the form xx-xx-xx[xx] and returns it in the
     # form xx/xx/xx[xx]
-    my @dateOut = split('-', shift);
-    return("$dateOut[2]/$dateOut[1]/$dateOut[0]")
+    my @dateOut = split( '-', shift );
+    return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
 }
 
-=item fixEthnicity
 
-  $ethn_name = &fixEthnicity($ethn_code);
+=head2 DisplayISBN
 
-Takes an ethnicity code (e.g., "european" or "pi") and returns the
-corresponding descriptive name from the C<ethnicity> table in the
-Koha database ("European" or "Pacific Islander").
+    my $string = DisplayISBN( $isbn );
 
 =cut
-#'
 
-sub fixEthnicity($) {
+sub DisplayISBN {
+    my ($isbn) = @_;
+    if (length ($isbn)<13){
+    my $seg1;
+    if ( substr( $isbn, 0, 1 ) <= 7 ) {
+        $seg1 = substr( $isbn, 0, 1 );
+    }
+    elsif ( substr( $isbn, 0, 2 ) <= 94 ) {
+        $seg1 = substr( $isbn, 0, 2 );
+    }
+    elsif ( substr( $isbn, 0, 3 ) <= 995 ) {
+        $seg1 = substr( $isbn, 0, 3 );
+    }
+    elsif ( substr( $isbn, 0, 4 ) <= 9989 ) {
+        $seg1 = substr( $isbn, 0, 4 );
+    }
+    else {
+        $seg1 = substr( $isbn, 0, 5 );
+    }
+    my $x = substr( $isbn, length($seg1) );
+    my $seg2;
+    if ( substr( $x, 0, 2 ) <= 19 ) {
 
-    my $ethnicity = shift;
-    my $dbh = C4::Context->dbh;
-    my $sth=$dbh->prepare("Select name from ethnicity where code = ?");
-    $sth->execute($ethnicity);
-    my $data=$sth->fetchrow_hashref;
-    $sth->finish;
-    return $data->{'name'};
+        # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
+        $seg2 = substr( $x, 0, 2 );
+    }
+    elsif ( substr( $x, 0, 3 ) <= 699 ) {
+        $seg2 = substr( $x, 0, 3 );
+    }
+    elsif ( substr( $x, 0, 4 ) <= 8399 ) {
+        $seg2 = substr( $x, 0, 4 );
+    }
+    elsif ( substr( $x, 0, 5 ) <= 89999 ) {
+        $seg2 = substr( $x, 0, 5 );
+    }
+    elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
+        $seg2 = substr( $x, 0, 6 );
+    }
+    else {
+        $seg2 = substr( $x, 0, 7 );
+    }
+    my $seg3 = substr( $x, length($seg2) );
+    $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
+sub subfield_is_koha_internal_p ($) {
+    my ($subfield) = @_;
+
+    # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
+    # But real MARC subfields are always single-character
+    # so it really is safer just to check the length
+
+    return length $subfield != 1;
 }
 
-=item borrowercategories
+=head2 GetItemTypes
+
+  $itemtypes = &GetItemTypes();
+
+Returns information about existing itemtypes.
+
+build a HTML select with the following code :
 
-  ($codes_arrayref, $labels_hashref) = &borrowercategories();
+=head3 in PERL SCRIPT
 
-Looks up the different types of borrowers in the database. Returns two
-elements: a reference-to-array, which lists the borrower category
-codes, and a reference-to-hash, which maps the borrower category codes
-to category descriptions.
+    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
+
+    <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
+        <select name="itemtype">
+            <option value="">Default</option>
+        <!-- TMPL_LOOP name="itemtypeloop" -->
+            <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
+        <!-- /TMPL_LOOP -->
+        </select>
+        <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
+        <input type="submit" value="OK" class="button">
+    </form>
 
 =cut
-#'
 
-sub borrowercategories {
+sub GetItemTypes {
+
+    # returns a reference to a hash of references to branches...
+    my %itemtypes;
+    my $dbh   = C4::Context->dbh;
+    my $query = qq|
+        SELECT *
+        FROM   itemtypes
+    |;
+    my $sth = $dbh->prepare($query);
+    $sth->execute;
+    while ( my $IT = $sth->fetchrow_hashref ) {
+        $itemtypes{ $IT->{'itemtype'} } = $IT;
+    }
+    return ( \%itemtypes );
+}
+
+sub get_itemtypeinfos_of {
+    my @itemtypes = @_;
+
+    my $query = '
+SELECT itemtype,
+       description,
+       imageurl,
+       notforloan
+  FROM itemtypes
+  WHERE itemtype IN (' . join( ',', map( { "'" . $_ . "'" } @itemtypes ) ) . ')
+';
+
+    return get_infos_of( $query, 'itemtype' );
+}
+
+# this is temporary until we separate collection codes and item types
+sub GetCcodes {
+    my $count = 0;
+    my @results;
     my $dbh = C4::Context->dbh;
-    my $sth=$dbh->prepare("Select categorycode,description from categories order by description");
+    my $sth =
+      $dbh->prepare(
+        "SELECT * FROM authorised_values ORDER BY authorised_value");
     $sth->execute;
-    my %labels;
-    my @codes;
-    while (my $data=$sth->fetchrow_hashref){
-      push @codes,$data->{'categorycode'};
-      $labels{$data->{'categorycode'}}=$data->{'description'};
+    while ( my $data = $sth->fetchrow_hashref ) {
+        if ( $data->{category} eq "CCODE" ) {
+            $count++;
+            $results[$count] = $data;
+
+            #warn "data: $data";
+        }
     }
     $sth->finish;
-    return(\@codes,\%labels);
+    return ( $count, @results );
+}
+
+=head2 getauthtypes
+
+  $authtypes = &getauthtypes();
+
+Returns information about existing authtypes.
+
+build a HTML select with the following code :
+
+=head3 in PERL SCRIPT
+
+my $authtypes = getauthtypes;
+my @authtypesloop;
+foreach my $thisauthtype (keys %$authtypes) {
+    my $selected = 1 if $thisauthtype eq $authtype;
+    my %row =(value => $thisauthtype,
+                selected => $selected,
+                authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
+            );
+    push @authtypesloop, \%row;
 }
+$template->param(itemtypeloop => \@itemtypesloop);
 
-=item ethnicitycategories
+=head3 in TEMPLATE
 
-  ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
+<form action='<!-- TMPL_VAR name="script_name" -->' method=post>
+    <select name="authtype">
+    <!-- TMPL_LOOP name="authtypeloop" -->
+        <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
+    <!-- /TMPL_LOOP -->
+    </select>
+    <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
+    <input type="submit" value="OK" class="button">
+</form>
 
-Looks up the different ethnic types in the database. Returns two
-elements: a reference-to-array, which lists the ethnicity codes, and a
-reference-to-hash, which maps the ethnicity codes to ethnicity
-descriptions.
 
 =cut
-#'
 
-sub ethnicitycategories {
+sub getauthtypes {
+
+    # returns a reference to a hash of references to authtypes...
+    my %authtypes;
     my $dbh = C4::Context->dbh;
-    my $sth=$dbh->prepare("Select code,name from ethnicity order by name");
+    my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
     $sth->execute;
-    my %labels;
-    my @codes;
-    while (my $data=$sth->fetchrow_hashref){
-      push @codes,$data->{'code'};
-      $labels{$data->{'code'}}=$data->{'name'};
+    while ( my $IT = $sth->fetchrow_hashref ) {
+        $authtypes{ $IT->{'authtypecode'} } = $IT;
     }
-    $sth->finish;
-    return(\@codes,\%labels);
+    return ( \%authtypes );
 }
 
-# FIXME.. this should be moved to a MARC-specific module
-sub subfield_is_koha_internal_p ($) {
-    my($subfield) = @_;
+sub getauthtype {
+    my ($authtypecode) = @_;
 
-    # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
-    # But real MARC subfields are always single-character
-    # so it really is safer just to check the length
+    # returns a reference to a hash of references to authtypes...
+    my %authtypes;
+    my $dbh = C4::Context->dbh;
+    my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
+    $sth->execute($authtypecode);
+    my $res = $sth->fetchrow_hashref;
+    return $res;
+}
 
-    return length $subfield != 1;
+=head2 getframework
+
+  $frameworks = &getframework();
+
+Returns information about existing frameworks
+
+build a HTML select with the following code :
+
+=head3 in PERL SCRIPT
+
+my $frameworks = frameworks();
+my @frameworkloop;
+foreach my $thisframework (keys %$frameworks) {
+    my $selected = 1 if $thisframework eq $frameworkcode;
+    my %row =(value => $thisframework,
+                selected => $selected,
+                description => $frameworks->{$thisframework}->{'frameworktext'},
+            );
+    push @frameworksloop, \%row;
 }
+$template->param(frameworkloop => \@frameworksloop);
+
+=head3 in TEMPLATE
 
-=item getbranches
+<form action='<!-- TMPL_VAR name="script_name" -->' method=post>
+    <select name="frameworkcode">
+        <option value="">Default</option>
+    <!-- TMPL_LOOP name="frameworkloop" -->
+        <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
+    <!-- /TMPL_LOOP -->
+    </select>
+    <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
+    <input type="submit" value="OK" class="button">
+</form>
 
-  $branches = &getbranches();
-  @branch_codes = keys %$branches;
-  %main_branch_info = %{$branches->{"MAIN"}};
 
-Returns information about existing library branches.
+=cut
 
-C<$branches> is a reference-to-hash. Its keys are the branch codes for
-all of the existing library branches, and its values are
-references-to-hash describing that particular branch.
+sub getframeworks {
 
-In each branch description (C<%main_branch_info>, above), there is a
-key for each field in the branches table of the Koha database. In
-addition, there is a key for each branch category code to which the
-branch belongs (the category codes are taken from the branchrelations
-table).
+    # returns a reference to a hash of references to branches...
+    my %itemtypes;
+    my $dbh = C4::Context->dbh;
+    my $sth = $dbh->prepare("select * from biblio_framework");
+    $sth->execute;
+    while ( my $IT = $sth->fetchrow_hashref ) {
+        $itemtypes{ $IT->{'frameworkcode'} } = $IT;
+    }
+    return ( \%itemtypes );
+}
+
+=head2 getframeworkinfo
+
+  $frameworkinfo = &getframeworkinfo($frameworkcode);
+
+Returns information about an frameworkcode.
 
 =cut
 
-sub getbranches {
-# returns a reference to a hash of references to branches...
-	my %branches;
-	my $dbh = C4::Context->dbh;
-	my $sth=$dbh->prepare("select * from branches");
-	$sth->execute;
-	while (my $branch=$sth->fetchrow_hashref) {
-		my $query = "select categorycode from branchrelations where branchcode = ?";
-		my $nsth = $dbh->prepare($query);
-		$nsth->execute($branch->{'branchcode'});
-		while (my ($cat) = $nsth->fetchrow_array) {
-			# FIXME - This seems wrong. It ought to be
-			# $branch->{categorycodes}{$cat} = 1;
-			# otherwise, there's a namespace collision if there's a
-			# category with the same name as a field in the 'branches'
-			# table (i.e., don't create a category called "issuing").
-			# In addition, the current structure doesn't really allow
-			# you to list the categories that a branch belongs to:
-			# you'd have to list keys %$branch, and remove those keys
-			# that aren't fields in the "branches" table.
-			$branch->{$cat} = 1;
-			}
-			$branches{$branch->{'branchcode'}}=$branch;
-	}
-	return (\%branches);
+sub getframeworkinfo {
+    my ($frameworkcode) = @_;
+    my $dbh             = C4::Context->dbh;
+    my $sth             =
+      $dbh->prepare("select * from biblio_framework where frameworkcode=?");
+    $sth->execute($frameworkcode);
+    my $res = $sth->fetchrow_hashref;
+    return $res;
+}
+
+=head2 getitemtypeinfo
+
+  $itemtype = &getitemtype($itemtype);
+
+Returns information about an itemtype.
+
+=cut
+
+sub getitemtypeinfo {
+    my ($itemtype) = @_;
+    my $dbh        = C4::Context->dbh;
+    my $sth        = $dbh->prepare("select * from itemtypes where itemtype=?");
+    $sth->execute($itemtype);
+    my $res = $sth->fetchrow_hashref;
+
+    $res->{imageurl} = getitemtypeimagesrcfromurl( $res->{imageurl} );
+
+    return $res;
 }
 
-=item getprinters
+sub getitemtypeimagesrcfromurl {
+    my ($imageurl) = @_;
+
+    if ( defined $imageurl and $imageurl !~ m/^http/ ) {
+        $imageurl = getitemtypeimagesrc() . '/' . $imageurl;
+    }
+
+    return $imageurl;
+}
+
+sub getitemtypeimagedir {
+    return C4::Context->opachtdocs . '/'
+      . C4::Context->preference('template')
+      . '/itemtypeimg';
+}
 
-  $printers = &getprinters($env);
+sub getitemtypeimagesrc {
+    return '/opac-tmpl' . '/'
+      . C4::Context->preference('template')
+      . '/itemtypeimg';
+}
+
+=head2 GetPrinters
+
+  $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.
 
 =cut
 
-sub getprinters {
-    my ($env) = @_;
+sub GetPrinters {
     my %printers;
     my $dbh = C4::Context->dbh;
-    my $sth=$dbh->prepare("select * from printers");
+    my $sth = $dbh->prepare("select * from printers");
     $sth->execute;
-    while (my $printer=$sth->fetchrow_hashref) {
-	$printers{$printer->{'printqueue'}}=$printer;
+    while ( my $printer = $sth->fetchrow_hashref ) {
+        $printers{ $printer->{'printqueue'} } = $printer;
     }
-    return (\%printers);
-}
-sub getbranch ($$) {
-    my($query, $branches) = @_; # get branch for this query from branches
-    my $branch = $query->param('branch');
-    ($branch) || ($branch = $query->cookie('branch'));
-    ($branches->{$branch}) || ($branch=(keys %$branches)[0]);
-    return $branch;
+    return ( \%printers );
 }
 
-sub getprinter ($$) {
-    my($query, $printers) = @_; # get printer for this query from printers
+=head2 GetPrinter
+
+$printer = GetPrinter( $query, $printers );
+
+=cut
+
+sub GetPrinter ($$) {
+    my ( $query, $printers ) = @_;    # get printer for this query from printers
     my $printer = $query->param('printer');
-    ($printer) || ($printer = $query->cookie('printer'));
-    ($printers->{$printer}) || ($printer = (keys %$printers)[0]);
+    my %cookie = $query->cookie('userenv');
+    ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
+    ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
     return $printer;
 }
 
+=item getnbpages
 
-1;
-__END__
+Returns the number of pages to display in a pagination bar, given the number
+of items and the number of items per page.
+
+=cut
+
+sub getnbpages {
+    my ( $nb_items, $nb_items_per_page ) = @_;
+
+    return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
+}
+
+=item getallthemes
+
+  (@themes) = &getallthemes('opac');
+  (@themes) = &getallthemes('intranet');
+
+Returns an array of all available themes.
+
+=cut
+
+sub getallthemes {
+    my $type = shift;
+    my $htdocs;
+    my @themes;
+    if ( $type eq 'intranet' ) {
+        $htdocs = C4::Context->config('intrahtdocs');
+    }
+    else {
+        $htdocs = C4::Context->config('opachtdocs');
+    }
+    opendir D, "$htdocs";
+    my @dirlist = readdir D;
+    foreach my $directory (@dirlist) {
+        -d "$htdocs/$directory/en" and push @themes, $directory;
+    }
+    return @themes;
+}
+
+sub getFacets {
+    my $facets;
+    if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
+        $facets = [
+            {
+                link_value  => 'su-to',
+                label_value => 'Topics',
+                tags        =>
+                  [ '600', '601', '602', '603', '604', '605', '606', '610' ],
+                subfield => 'a',
+            },
+            {
+                link_value  => 'su-geo',
+                label_value => 'Places',
+                tags        => ['651'],
+                subfield    => 'a',
+            },
+            {
+                link_value  => 'su-ut',
+                label_value => 'Titles',
+                tags        => [ '500', '501', '502', '503', '504', ],
+                subfield    => 'a',
+            },
+            {
+                link_value  => 'au',
+                label_value => 'Authors',
+                tags        => [ '700', '701', '702', ],
+                subfield    => 'a',
+            },
+            {
+                link_value  => 'se',
+                label_value => 'Series',
+                tags        => ['225'],
+                subfield    => 'a',
+            },
+            {
+                link_value  => 'branch',
+                label_value => 'Libraries',
+                tags        => [ '995', ],
+                subfield    => 'b',
+                expanded    => '1',
+            },
+        ];
+    }
+    else {
+        $facets = [
+            {
+                link_value  => 'su-to',
+                label_value => 'Topics',
+                tags        => ['650'],
+                subfield    => 'a',
+            },
+
+            #        {
+            #        link_value => 'su-na',
+            #        label_value => 'People and Organizations',
+            #        tags => ['600', '610', '611'],
+            #        subfield => 'a',
+            #        },
+            {
+                link_value  => 'su-geo',
+                label_value => 'Places',
+                tags        => ['651'],
+                subfield    => 'a',
+            },
+            {
+                link_value  => 'su-ut',
+                label_value => 'Titles',
+                tags        => ['630'],
+                subfield    => 'a',
+            },
+            {
+                link_value  => 'au',
+                label_value => 'Authors',
+                tags        => [ '100', '110', '700', ],
+                subfield    => 'a',
+            },
+            {
+                link_value  => 'se',
+                label_value => 'Series',
+                tags        => [ '440', '490', ],
+                subfield    => 'a',
+            },
+            {
+                link_value  => 'branch',
+                label_value => 'Libraries',
+                tags        => [ '952', ],
+                subfield    => 'b',
+                expanded    => '1',
+            },
+        ];
+    }
+    return $facets;
+}
+
+=head2 get_infos_of
+
+Return a href where a key is associated to a href. You give a query, the
+name of the key among the fields returned by the query. If you also give as
+third argument the name of the value, the function returns a href of scalar.
+
+  my $query = '
+SELECT itemnumber,
+       notforloan,
+       barcode
+  FROM items
+';
+
+  # generic href of any information on the item, href of href.
+  my $iteminfos_of = get_infos_of($query, 'itemnumber');
+  print $iteminfos_of->{$itemnumber}{barcode};
+
+  # specific information, href of scalar
+  my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
+  print $barcode_of_item->{$itemnumber};
+
+=cut
+
+sub get_infos_of {
+    my ( $query, $key_name, $value_name ) = @_;
+
+    my $dbh = C4::Context->dbh;
+
+    my $sth = $dbh->prepare($query);
+    $sth->execute();
+
+    my %infos_of;
+    while ( my $row = $sth->fetchrow_hashref ) {
+        if ( defined $value_name ) {
+            $infos_of{ $row->{$key_name} } = $row->{$value_name};
+        }
+        else {
+            $infos_of{ $row->{$key_name} } = $row;
+        }
+    }
+    $sth->finish;
+
+    return \%infos_of;
+}
+
+=head2 get_notforloan_label_of
+
+  my $notforloan_label_of = get_notforloan_label_of();
+
+Each authorised value of notforloan (information available in items and
+itemtypes) is link to a single label.
+
+Returns a href where keys are authorised values and values are corresponding
+labels.
+
+  foreach my $authorised_value (keys %{$notforloan_label_of}) {
+    printf(
+        "authorised_value: %s => %s\n",
+        $authorised_value,
+        $notforloan_label_of->{$authorised_value}
+    );
+  }
+
+=cut
+
+# FIXME - why not use GetAuthorisedValues ??
+#
+sub get_notforloan_label_of {
+    my $dbh = C4::Context->dbh;
+
+    my $query = '
+SELECT authorised_value
+  FROM marc_subfield_structure
+  WHERE kohafield = \'items.notforloan\'
+  LIMIT 0, 1
+';
+    my $sth = $dbh->prepare($query);
+    $sth->execute();
+    my ($statuscode) = $sth->fetchrow_array();
+
+    $query = '
+SELECT lib,
+       authorised_value
+  FROM authorised_values
+  WHERE category = ?
+';
+    $sth = $dbh->prepare($query);
+    $sth->execute($statuscode);
+    my %notforloan_label_of;
+    while ( my $row = $sth->fetchrow_hashref ) {
+        $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
+    }
+    $sth->finish;
+
+    return \%notforloan_label_of;
+}
+
+sub displayServers {
+    my ( $position, $type ) = @_;
+    my $dbh    = C4::Context->dbh;
+    my $strsth = "SELECT * FROM z3950servers where 1";
+    $strsth .= " AND position=\"$position\"" if ($position);
+    $strsth .= " AND type=\"$type\""         if ($type);
+    my $rq = $dbh->prepare($strsth);
+    $rq->execute;
+    my @primaryserverloop;
+
+    while ( my $data = $rq->fetchrow_hashref ) {
+        my %cell;
+        $cell{label} = $data->{'description'};
+        $cell{id}    = $data->{'name'};
+        $cell{value} =
+            $data->{host}
+          . ( $data->{port} ? ":" . $data->{port} : "" ) . "/"
+          . $data->{database}
+          if ( $data->{host} );
+        $cell{checked} = $data->{checked};
+        push @primaryserverloop,
+          {
+            label => $data->{description},
+            id    => $data->{name},
+            name  => "server",
+            value => $data->{host} . ":"
+              . $data->{port} . "/"
+              . $data->{database},
+            checked    => "checked",
+            icon       => $data->{icon},
+            zed        => $data->{type} eq 'zed',
+            opensearch => $data->{type} eq 'opensearch'
+          };
+    }
+    return \@primaryserverloop;
+}
+
+sub displaySecondaryServers {
+
+# 	my $secondary_servers_loop = [
+# 		{ inner_sup_servers_loop => [
+#         	{label => "Google", id=>"GOOG", value=>"google",icon => "google.ico",opensearch => "1"},
+#         	{label => "Yahoo", id=>"YAH", value=>"yahoo", icon =>"yahoo.ico", zed => "1"},
+#         	{label => "Worldcat", id=>"WCT", value=>"worldcat", icon => "worldcat.gif", zed => "1"},
+#         	{label => "Library of Congress", id=>"LOC", name=> "server", value=>"z3950.loc.gov:7090/Voyager", icon =>"loc.ico", zed => "1"},
+#     	],
+#     	},
+# 	];
+    return;    #$secondary_servers_loop;
+}
+
+=head2 GetAuthValCode
+
+$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
+
+$authvalues = GetAuthorisedValues($category);
+
+this function get all authorised values from 'authosied_value' table into a reference to array which
+each value containt an hashref.
+
+Set C<$category> on input args if you want to limits your query to this one. This params is not mandatory.
+
+=cut
+
+sub GetAuthorisedValues {
+    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;
+	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);
+
+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"){
+    my $targetcharset="utf8";
+    if ($encoding  && $targetcharset ne $encoding){   
+        my $newRecord=MARC::Record->new();
+        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);
+                }
+            }        
+        }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;            
+     }
+     return $record;  
+  }
+  return $record;
+}
+
+
+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;    
+      }        
+    }
+    $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__
+
 =head1 AUTHOR
 
-Pat Eyler, pate@gnu.org
+Koha Team
 
 =cut