package C4::Koha;
# Copyright 2000-2002 Katipo Communications
+# Parts Copyright 2010 Nelsonville Public Library
+# Parts copyright 2010 BibLibre
#
# This file is part of Koha.
#
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
#
-# You should have received a copy of the GNU General Public License along with
-# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
-# Suite 330, Boston, MA 02111-1307 USA
+# You should have received a copy of the GNU General Public License along
+# with Koha; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
use strict;
+#use warnings; FIXME - Bug 2505
use C4::Context;
use C4::Output;
+use URI::Split qw(uri_split);
+use Memoize;
+use Business::ISBN;
+
use vars qw($VERSION @ISA @EXPORT $DEBUG);
BEGIN {
@ISA = qw(Exporter);
@EXPORT = qw(
&slashifyDate
- &DisplayISBN
&subfield_is_koha_internal_p
&GetPrinters &GetPrinter
&GetItemTypes &getitemtypeinfo
&GetCcodes
+ &GetSupportName &GetSupportList
&get_itemtypeinfos_of
&getframeworks &getframeworkinfo
&getauthtypes &getauthtype
&getFacets
&displayServers
&getnbpages
- &getitemtypeimagesrcfromurl
&get_infos_of
&get_notforloan_label_of
&getitemtypeimagedir
&getitemtypeimagesrc
+ &getitemtypeimagelocation
&GetAuthorisedValues
- &FixEncoding
+ &GetAuthorisedValueCategories
&GetKohaAuthorisedValues
+ &GetKohaAuthorisedValuesFromField
+ &GetKohaAuthorisedValueLib
+ &GetAuthorisedValueByCode
+ &GetKohaImageurlFromAuthorisedValues
&GetAuthValCode
- &GetManagedTagSubfields
+ &GetNormalizedUPC
+ &GetNormalizedISBN
+ &GetNormalizedEAN
+ &GetNormalizedOCLCNumber
+ &xml_escape
$DEBUG
);
$DEBUG = 0;
}
+# expensive functions
+memoize('GetAuthorisedValues');
+
=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;
-
+use C4::Koha;
=head1 DESCRIPTION
- Koha.pm provides many functions for Koha scripts.
+Koha.pm provides many functions for Koha scripts.
=head1 FUNCTIONS
-=over 2
-
=cut
+
=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
return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
}
-
-=head2 DisplayISBN
-
- 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 );
- }
- 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 ) {
-
- # 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) = @_;
return length $subfield != 1;
}
+=head2 GetSupportName
+
+ $itemtypename = &GetSupportName($codestring);
+
+Returns a string with the name of the itemtype.
+
+=cut
+
+sub GetSupportName{
+ my ($codestring)=@_;
+ return if (! $codestring);
+ my $resultstring;
+ my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
+ if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
+ my $query = qq|
+ SELECT description
+ FROM itemtypes
+ WHERE itemtype=?
+ order by description
+ |;
+ my $sth = C4::Context->dbh->prepare($query);
+ $sth->execute($codestring);
+ ($resultstring)=$sth->fetchrow;
+ return $resultstring;
+ } else {
+ my $sth =
+ C4::Context->dbh->prepare(
+ "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
+ );
+ $sth->execute( $advanced_search_types, $codestring );
+ my $data = $sth->fetchrow_hashref;
+ return $$data{'lib'};
+ }
+
+}
+=head2 GetSupportList
+
+ $itemtypes = &GetSupportList();
+
+Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used).
+
+build a HTML select with the following code :
+
+=head3 in PERL SCRIPT
+
+ my $itemtypes = GetSupportList();
+ $template->param(itemtypeloop => $itemtypes);
+
+=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="itemtype" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->> <!--TMPL_IF Name="imageurl"--><img alt="<!-- TMPL_VAR name="description" -->" src="<!--TMPL_VAR Name="imageurl"-->><!--TMPL_ELSE-->"<!-- TMPL_VAR name="description" --><!--/TMPL_IF--></option>
+ <!-- /TMPL_LOOP -->
+ </select>
+ <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
+ <input type="submit" value="OK" class="button">
+ </form>
+
+=cut
+
+sub GetSupportList{
+ my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
+ if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
+ my $query = qq|
+ SELECT *
+ FROM itemtypes
+ order by description
+ |;
+ my $sth = C4::Context->dbh->prepare($query);
+ $sth->execute;
+ return $sth->fetchall_arrayref({});
+ } else {
+ my $advsearchtypes = GetAuthorisedValues($advanced_search_types);
+ my @results= map {{itemtype=>$$_{authorised_value},description=>$$_{lib},imageurl=>$$_{imageurl}}} @$advsearchtypes;
+ return \@results;
+ }
+}
=head2 GetItemTypes
$itemtypes = &GetItemTypes();
sub GetItemTypes {
- # returns a reference to a hash of references to branches...
+ # returns a reference to a hash of references to itemtypes...
my %itemtypes;
my $dbh = C4::Context->dbh;
my $query = qq|
sub get_itemtypeinfos_of {
my @itemtypes = @_;
- my $query = '
+ my $placeholders = join( ', ', map { '?' } @itemtypes );
+ my $query = <<"END_SQL";
SELECT itemtype,
description,
imageurl,
notforloan
FROM itemtypes
- WHERE itemtype IN (' . join( ',', map( { "'" . $_ . "'" } @itemtypes ) ) . ')
-';
+ WHERE itemtype IN ( $placeholders )
+END_SQL
- return get_infos_of( $query, 'itemtype' );
+ return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
}
# this is temporary until we separate collection codes and item types
=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,
+ 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);
+ push @authtypesloop, \%row;
+ }
+ $template->param(itemtypeloop => \@itemtypesloop);
=head3 in TEMPLATE
-<form action='<!-- TMPL_VAR name="script_name" -->' method=post>
+ <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>
</select>
<input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
<input type="submit" value="OK" class="button">
-</form>
+ </form>
=cut
=head3 in PERL SCRIPT
-my $frameworks = frameworks();
-my @frameworkloop;
-foreach my $thisframework (keys %$frameworks) {
+ 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);
+ }
+ $template->param(frameworkloop => \@frameworksloop);
=head3 in TEMPLATE
-<form action='<!-- TMPL_VAR name="script_name" -->' method=post>
+ <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
<select name="frameworkcode">
<option value="">Default</option>
<!-- TMPL_LOOP name="frameworkloop" -->
</select>
<input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
<input type="submit" value="OK" class="button">
-</form>
-
+ </form>
=cut
$sth->execute($itemtype);
my $res = $sth->fetchrow_hashref;
- $res->{imageurl} = getitemtypeimagesrcfromurl( $res->{imageurl} );
+ $res->{imageurl} = getitemtypeimagelocation( 'intranet', $res->{imageurl} );
return $res;
}
-sub getitemtypeimagesrcfromurl {
- my ($imageurl) = @_;
+=head2 getitemtypeimagedir
- if ( defined $imageurl and $imageurl !~ m/^http/ ) {
- $imageurl = getitemtypeimagesrc() . '/' . $imageurl;
- }
+ my $directory = getitemtypeimagedir( 'opac' );
- return $imageurl;
-}
+pass in 'opac' or 'intranet'. Defaults to 'opac'.
+
+returns the full path to the appropriate directory containing images.
+
+=cut
sub getitemtypeimagedir {
- my $src = shift;
+ my $src = shift || 'opac';
if ($src eq 'intranet') {
return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
- }
- else {
+ } else {
return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('template') . '/itemtypeimg';
}
}
sub getitemtypeimagesrc {
- my $src = shift;
+ my $src = shift || 'opac';
if ($src eq 'intranet') {
return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
- }
- else {
+ } else {
return '/opac-tmpl' . '/' . C4::Context->preference('template') . '/itemtypeimg';
}
}
+sub getitemtypeimagelocation($$) {
+ my ( $src, $image ) = @_;
+
+ return '' if ( !$image );
+
+ my $scheme = ( uri_split( $image ) )[0];
+
+ return $image if ( $scheme );
+
+ return getitemtypeimagesrc( $src ) . '/' . $image;
+}
+
+=head3 _getImagesFromDirectory
+
+Find all of the image files in a directory in the filesystem
+
+parameters: a directory name
+
+returns: a list of images in that directory.
+
+Notes: this does not traverse into subdirectories. See
+_getSubdirectoryNames for help with that.
+Images are assumed to be files with .gif or .png file extensions.
+The image names returned do not have the directory name on them.
+
+=cut
+
+sub _getImagesFromDirectory {
+ my $directoryname = shift;
+ return unless defined $directoryname;
+ return unless -d $directoryname;
+
+ if ( opendir ( my $dh, $directoryname ) ) {
+ my @images = grep { /\.(gif|png)$/i } readdir( $dh );
+ closedir $dh;
+ @images = sort(@images);
+ return @images;
+ } else {
+ warn "unable to opendir $directoryname: $!";
+ return;
+ }
+}
+
+=head3 _getSubdirectoryNames
+
+Find all of the directories in a directory in the filesystem
+
+parameters: a directory name
+
+returns: a list of subdirectories in that directory.
+
+Notes: this does not traverse into subdirectories. Only the first
+level of subdirectories are returned.
+The directory names returned don't have the parent directory name on them.
+
+=cut
+
+sub _getSubdirectoryNames {
+ my $directoryname = shift;
+ return unless defined $directoryname;
+ return unless -d $directoryname;
+
+ if ( opendir ( my $dh, $directoryname ) ) {
+ my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
+ closedir $dh;
+ return @directories;
+ } else {
+ warn "unable to opendir $directoryname: $!";
+ return;
+ }
+}
+
+=head3 getImageSets
+
+returns: a listref of hashrefs. Each hash represents another collection of images.
+
+ { imagesetname => 'npl', # the name of the image set (npl is the original one)
+ images => listref of image hashrefs
+ }
+
+each image is represented by a hashref like this:
+
+ { KohaImage => 'npl/image.gif',
+ StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
+ OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
+ checked => 0 or 1: was this the image passed to this method?
+ Note: I'd like to remove this somehow.
+ }
+
+=cut
+
+sub getImageSets {
+ my %params = @_;
+ my $checked = $params{'checked'} || '';
+
+ my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
+ url => getitemtypeimagesrc('intranet'),
+ },
+ opac => { filesystem => getitemtypeimagedir('opac'),
+ url => getitemtypeimagesrc('opac'),
+ }
+ };
+
+ my @imagesets = (); # list of hasrefs of image set data to pass to template
+ my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
+warn $paths->{'staff'}{'filesystem'};
+ foreach my $imagesubdir ( @subdirectories ) {
+ warn $imagesubdir;
+ my @imagelist = (); # hashrefs of image info
+ my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
+ my $imagesetactive = 0;
+ foreach my $thisimage ( @imagenames ) {
+ push( @imagelist,
+ { KohaImage => "$imagesubdir/$thisimage",
+ StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
+ OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
+ checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
+ }
+ );
+ $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
+ }
+ push @imagesets, { imagesetname => $imagesubdir,
+ imagesetactive => $imagesetactive,
+ images => \@imagelist };
+
+ }
+ return \@imagesets;
+}
+
=head2 GetPrinters
$printers = &GetPrinters();
=head2 GetPrinter
-$printer = GetPrinter( $query, $printers );
+ $printer = GetPrinter( $query, $printers );
=cut
return $printer;
}
-=item getnbpages
+=head2 getnbpages
Returns the number of pages to display in a pagination bar, given the number
of items and the number of items per page.
return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
}
-=item getallthemes
+=head2 getallthemes
(@themes) = &getallthemes('opac');
(@themes) = &getallthemes('intranet');
tags => ['225'],
subfield => 'a',
},
- {
+ ];
+
+ my $library_facet;
+
+ $library_facet = {
link_value => 'branch',
label_value => 'Libraries',
tags => [ '995', ],
subfield => 'b',
expanded => '1',
- },
- ];
+ };
+ push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
}
else {
$facets = [
tags => [ '440', '490', ],
subfield => 'a',
},
- {
+ ];
+ my $library_facet;
+ $library_facet = {
link_value => 'branch',
label_value => 'Libraries',
tags => [ '952', ],
subfield => 'b',
expanded => '1',
- },
- ];
+ };
+ push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
}
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.
+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. The optional 4th argument is an arrayref of
+items passed to the C<execute()> call. It is designed to bind
+parameters to any placeholders in your SQL.
my $query = '
SELECT itemnumber,
=cut
sub get_infos_of {
- my ( $query, $key_name, $value_name ) = @_;
+ my ( $query, $key_name, $value_name, $bind_params ) = @_;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare($query);
- $sth->execute();
+ $sth->execute( @$bind_params );
my %infos_of;
while ( my $row = $sth->fetchrow_hashref ) {
return \%notforloan_label_of;
}
+=head2 displayServers
+
+ my $servers = displayServers();
+ my $servers = displayServers( $position );
+ my $servers = displayServers( $position, $type );
+
+displayServers returns a listref of hashrefs, each containing
+information about available z3950 servers. Each hashref has a format
+like:
+
+ {
+ 'checked' => 'checked',
+ 'encoding' => 'MARC-8'
+ 'icon' => undef,
+ 'id' => 'LIBRARY OF CONGRESS',
+ 'label' => '',
+ 'name' => 'server',
+ 'opensearch' => '',
+ 'value' => 'z3950.loc.gov:7090/',
+ 'zed' => 1,
+ },
+
+=cut
+
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 $dbh = C4::Context->dbh;
+
+ my $strsth = 'SELECT * FROM z3950servers';
+ my @where_clauses;
+ my @bind_params;
+
+ if ($position) {
+ push @bind_params, $position;
+ push @where_clauses, ' position = ? ';
+ }
+
+ if ($type) {
+ push @bind_params, $type;
+ push @where_clauses, ' type = ? ';
+ }
+
+ # reassemble where clause from where clause pieces
+ if (@where_clauses) {
+ $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
+ }
+
my $rq = $dbh->prepare($strsth);
- $rq->execute;
+ $rq->execute(@bind_params);
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},
- encoding => ($data->{encoding}?$data->{encoding}:"iso-5426"),
- checked => "checked",
- icon => $data->{icon},
+ { label => $data->{description},
+ id => $data->{name},
+ name => "server",
+ value => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
+ encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
+ 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 GetKohaImageurlFromAuthorisedValues
+
+$authhorised_value = GetKohaImageurlFromAuthorisedValues( $category, $authvalcode );
+
+Return the first url of the authorised value image represented by $lib.
+
+=cut
+
+sub GetKohaImageurlFromAuthorisedValues {
+ my ( $category, $lib ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("SELECT imageurl FROM authorised_values WHERE category=? AND lib =?");
+ $sth->execute( $category, $lib );
+ while ( my $data = $sth->fetchrow_hashref ) {
+ return $data->{'imageurl'};
+ }
}
=head2 GetAuthValCode
-$authvalcode = GetAuthValCode($kohafield,$frameworkcode);
+ $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
=cut
return $authvalcode;
}
+=head2 GetAuthValCodeFromField
+
+ $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
+
+C<$subfield> can be undefined
+
+=cut
+
+sub GetAuthValCodeFromField {
+ my ($field,$subfield,$fwcode) = @_;
+ my $dbh = C4::Context->dbh;
+ $fwcode='' unless $fwcode;
+ my $sth;
+ if (defined $subfield) {
+ $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
+ $sth->execute($field,$subfield,$fwcode);
+ } else {
+ $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
+ $sth->execute($field,$fwcode);
+ }
+ my ($authvalcode) = $sth->fetchrow_array;
+ return $authvalcode;
+}
+
=head2 GetAuthorisedValues
-$authvalues = GetAuthorisedValues($category);
+ $authvalues = GetAuthorisedValues([$category], [$selected]);
-this function get all authorised values from 'authosied_value' table into a reference to array which
-each value containt an hashref.
+This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
-Set C<$category> on input args if you want to limits your query to this one. This params is not mandatory.
+C<$category> returns authorised values for just one category (optional).
+
+C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
=cut
sub GetAuthorisedValues {
- my ($category,$selected) = @_;
- my $count = 0;
+ my ($category,$selected,$opac) = @_;
my @results;
my $dbh = C4::Context->dbh;
my $query = "SELECT * FROM authorised_values";
$query .= " WHERE category = '" . $category . "'" if $category;
-
+ $query .= " ORDER BY category, lib, lib_opac";
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++;
+ if ($selected && $selected eq $data->{'authorised_value'} ) {
+ $data->{'selected'} = 1;
+ }
+ if ($opac && $data->{'lib_opac'}) {
+ $data->{'lib'} = $data->{'lib_opac'};
+ }
+ push @results, $data;
}
#my $data = $sth->fetchall_arrayref({});
return \@results; #$data;
}
+=head2 GetAuthorisedValueCategories
+
+ $auth_categories = GetAuthorisedValueCategories();
+
+Return an arrayref of all of the available authorised
+value categories.
+
+=cut
+
+sub GetAuthorisedValueCategories {
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
+ $sth->execute;
+ my @results;
+ while (defined (my $category = $sth->fetchrow_array) ) {
+ push @results, $category;
+ }
+ return \@results;
+}
+
+=head2 GetAuthorisedValueByCode
+
+$authhorised_value = GetAuthorisedValueByCode( $category, $authvalcode );
+
+Return the lib attribute from authorised_values from the row identified
+by the passed category and code
+
+=cut
+
+sub GetAuthorisedValueByCode {
+ my ( $category, $authvalcode ) = @_;
+
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("SELECT lib FROM authorised_values WHERE category=? AND authorised_value =?");
+ $sth->execute( $category, $authvalcode );
+ while ( my $data = $sth->fetchrow_hashref ) {
+ return $data->{'lib'};
+ }
+}
+
=head2 GetKohaAuthorisedValues
-
- Takes $dbh , $kohafield as parameters.
- returns hashref of authvalCode => liblibrarian
- or undef if no authvals defined for kohafield.
+
+Takes $kohafield, $fwcode as parameters.
+
+If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
+
+Returns hashref of Code => description
+
+Returns undef if no authorised value category is defined for the kohafield.
=cut
sub GetKohaAuthorisedValues {
- my ($kohafield,$fwcode) = @_;
+ my ($kohafield,$fwcode,$opac) = @_;
$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;
+ my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
+ $sth->execute($avcode);
+ while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
+ $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
}
+ return \%values;
+ } else {
+ return undef;
}
- return \%values;
}
-=head2 GetManagedTagSubfields
+=head2 GetKohaAuthorisedValuesFromField
-=over 4
+Takes $field, $subfield, $fwcode as parameters.
-$res = GetManagedTagSubfields();
+If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
+$subfield can be undefined
-=back
+Returns hashref of Code => description
-Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
+Returns undef if no authorised value category is defined for the given field and subfield
-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.
+=cut
-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.
+sub GetKohaAuthorisedValuesFromField {
+ my ($field, $subfield, $fwcode,$opac) = @_;
+ $fwcode='' unless $fwcode;
+ my %values;
+ my $dbh = C4::Context->dbh;
+ my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
+ if ($avcode) {
+ my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
+ $sth->execute($avcode);
+ while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
+ $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
+ }
+ return \%values;
+ } else {
+ return undef;
+ }
+}
+
+=head2 xml_escape
+
+ my $escaped_string = C4::Koha::xml_escape($string);
+
+Convert &, <, >, ', and " in a string to XML entities
+
+=cut
+
+sub xml_escape {
+ my $str = shift;
+ return '' unless defined $str;
+ $str =~ s/&/&/g;
+ $str =~ s/</</g;
+ $str =~ s/>/>/g;
+ $str =~ s/'/'/g;
+ $str =~ s/"/"/g;
+ return $str;
+}
+
+=head2 GetKohaAuthorisedValueLib
+
+Takes $category, $authorised_value as parameters.
+
+If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
+
+Returns authorised value description
=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;
+sub GetKohaAuthorisedValueLib {
+ my ($category,$authorised_value,$opac) = @_;
+ my $value;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
+ $sth->execute($category,$authorised_value);
+ my $data = $sth->fetchrow_hashref;
+ $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
+ return $value;
}
+=head2 display_marc_indicators
-=item fixEncoding
+ my $display_form = C4::Koha::display_marc_indicators($field);
- $marcrecord = &fixEncoding($marcblob);
+C<$field> is a MARC::Field object
-Returns a well encoded marcrecord.
+Generate a display form of the indicators of a variable
+MARC field, replacing any blanks with '#'.
=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 ((C4::Context->preference("marcflavour") eq "UNIMARC") && ($newField->tag eq '100')) {
- substr($subfield->[1],26,4,"5050") if ($targetcharset eq "utf8");
- } elsif (C4::Context->preference("marcflavour") eq "USMARC"){
- $newRecord->encoding("UTF-8");
- }
- 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 ((C4::Context->preference("marcflavour") eq "UNIMARC") && ($field->tag eq '100')) {
- substr($utf8,26,4,"5050");
- } elsif (C4::Context->preference("marcflavour") eq "USMARC"){
- $newRecord->encoding("UTF-8");
- }
- 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);
- }
- }
+
+sub display_marc_indicators {
+ my $field = shift;
+ my $indicators = '';
+ if ($field->tag() >= 10) {
+ $indicators = $field->indicator(1) . $field->indicator(2);
+ $indicators =~ s/ /#/g;
+ }
+ return $indicators;
+}
+
+sub GetNormalizedUPC {
+ my ($record,$marcflavour) = @_;
+ my (@fields,$upc);
+
+ if ($marcflavour eq 'UNIMARC') {
+ @fields = $record->field('072');
+ foreach my $field (@fields) {
+ my $upc = _normalize_match_point($field->subfield('a'));
+ if ($upc ne '') {
+ return $upc;
+ }
}
-# warn $newRecord->as_formatted();
- return $newRecord;
- }
- return $record;
-# }
-# return $record;
+
+ }
+ else { # assume marc21 if not unimarc
+ @fields = $record->field('024');
+ foreach my $field (@fields) {
+ my $indicator = $field->indicator(1);
+ my $upc = _normalize_match_point($field->subfield('a'));
+ if ($indicator == 1 and $upc ne '') {
+ return $upc;
+ }
+ }
+ }
}
+# Normalizes and returns the first valid ISBN found in the record
+# ISBN13 are converted into ISBN10. This is required to get Amazon cover book.
+sub GetNormalizedISBN {
+ my ($isbn,$record,$marcflavour) = @_;
+ my @fields;
+ if ($isbn) {
+ # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
+ # anything after " | " should be removed, along with the delimiter
+ $isbn =~ s/(.*)( \| )(.*)/$1/;
+ return _isbn_cleanup($isbn);
+ }
+ return undef unless $record;
+
+ if ($marcflavour eq 'UNIMARC') {
+ @fields = $record->field('010');
+ foreach my $field (@fields) {
+ my $isbn = $field->subfield('a');
+ if ($isbn) {
+ return _isbn_cleanup($isbn);
+ } else {
+ return undef;
+ }
+ }
+ }
+ else { # assume marc21 if not unimarc
+ @fields = $record->field('020');
+ foreach my $field (@fields) {
+ $isbn = $field->subfield('a');
+ if ($isbn) {
+ return _isbn_cleanup($isbn);
+ } else {
+ return undef;
+ }
+ }
+ }
+}
-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;
- }
+sub GetNormalizedEAN {
+ my ($record,$marcflavour) = @_;
+ my (@fields,$ean);
+
+ if ($marcflavour eq 'UNIMARC') {
+ @fields = $record->field('073');
+ foreach my $field (@fields) {
+ $ean = _normalize_match_point($field->subfield('a'));
+ if ($ean ne '') {
+ return $ean;
+ }
+ }
+ }
+ else { # assume marc21 if not unimarc
+ @fields = $record->field('024');
+ foreach my $field (@fields) {
+ my $indicator = $field->indicator(1);
+ $ean = _normalize_match_point($field->subfield('a'));
+ if ($indicator == 3 and $ean ne '') {
+ return $ean;
+ }
+ }
+ }
+}
+sub GetNormalizedOCLCNumber {
+ my ($record,$marcflavour) = @_;
+ my (@fields,$oclc);
+
+ if ($marcflavour eq 'UNIMARC') {
+ # TODO: add UNIMARC fields
+ }
+ else { # assume marc21 if not unimarc
+ @fields = $record->field('035');
+ foreach my $field (@fields) {
+ $oclc = $field->subfield('a');
+ if ($oclc =~ /OCoLC/) {
+ $oclc =~ s/\(OCoLC\)//;
+ return $oclc;
+ } else {
+ return undef;
+ }
+ }
+ }
+}
+
+sub _normalize_match_point {
+ my $match_point = shift;
+ (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
+ $normalized_match_point =~ s/-//g;
+
+ return $normalized_match_point;
+}
+
+sub _isbn_cleanup {
+ my $isbn = Business::ISBN->new( $_[0] );
+ if ( $isbn ) {
+ $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
+ if (defined $isbn) {
+ return $isbn->as_string([]);
+ }
}
- $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;
+ return;
}
1;
projects / koha_gimpoz / blobdiff