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;
-require Exporter;
+#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 {
+ $VERSION = 3.01;
+ require Exporter;
+ @ISA = qw(Exporter);
+ @EXPORT = qw(
+ &slashifyDate
+ &subfield_is_koha_internal_p
+ &GetPrinters &GetPrinter
+ &GetItemTypes &getitemtypeinfo
+ &GetCcodes
+ &GetSupportName &GetSupportList
+ &get_itemtypeinfos_of
+ &getframeworks &getframeworkinfo
+ &getauthtypes &getauthtype
+ &getallthemes
+ &getFacets
+ &displayServers
+ &getnbpages
+ &get_infos_of
+ &get_notforloan_label_of
+ &getitemtypeimagedir
+ &getitemtypeimagesrc
+ &getitemtypeimagelocation
+ &GetAuthorisedValues
+ &GetAuthorisedValueCategories
+ &GetKohaAuthorisedValues
+ &GetKohaAuthorisedValuesFromField
+ &GetKohaAuthorisedValueLib
+ &GetAuthorisedValueByCode
+ &GetKohaImageurlFromAuthorisedValues
+ &GetAuthValCode
+ &GetNormalizedUPC
+ &GetNormalizedISBN
+ &GetNormalizedEAN
+ &GetNormalizedOCLCNumber
+ &xml_escape
+
+ $DEBUG
+ );
+ $DEBUG = 0;
+}
-use vars qw($VERSION @ISA @EXPORT);
-
-$VERSION = 0.01;
+# expensive functions
+memoize('GetAuthorisedValues');
=head1 NAME
=head1 SYNOPSIS
- use C4::Koha;
-
-
- $date = slashifyDate("01-01-2002")
- $ethnicity = fixEthnicity('asian');
- ($categories, $labels) = borrowercategories();
- ($categories, $labels) = ethnicitycategories();
+use C4::Koha;
=head1 DESCRIPTION
=head1 FUNCTIONS
-=over 2
-
=cut
-@ISA = qw(Exporter);
-@EXPORT = qw(&slashifyDate
- &fixEthnicity
- &borrowercategories
- ðnicitycategories
- &subfield_is_koha_internal_p
- &getbranches &getbranch
- &getprinters &getprinter
- &getitemtypes &getitemtypeinfo
- &getframeworks &getframeworkinfo
- &getauthtypes
- $DEBUG);
-
-use vars qw();
-
-my $DEBUG = 0;
-
=head2 slashifyDate
$slash_date = &slashifyDate($dash_date);
=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]");
}
-=head2 fixEthnicity
-
- $ethn_name = &fixEthnicity($ethn_code);
-
-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").
-
-=cut
-#'
+# FIXME.. this should be moved to a MARC-specific module
+sub subfield_is_koha_internal_p ($) {
+ my ($subfield) = @_;
-sub fixEthnicity($) {
+ # 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
- 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'};
+ return length $subfield != 1;
}
-=head2 borrowercategories
+=head2 GetSupportName
- ($codes_arrayref, $labels_hashref) = &borrowercategories();
+ $itemtypename = &GetSupportName($codestring);
-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.
+Returns a string with the name of the itemtype.
=cut
-#'
-sub borrowercategories {
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("Select categorycode,description from categories order by description");
- $sth->execute;
- my %labels;
- my @codes;
- while (my $data=$sth->fetchrow_hashref){
- push @codes,$data->{'categorycode'};
- $labels{$data->{'categorycode'}}=$data->{'description'};
- }
- $sth->finish;
- return(\@codes,\%labels);
-}
-
-=head2 ethnicitycategories
-
- ($codes_arrayref, $labels_hashref) = ðnicitycategories();
-
-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 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'};
+ }
-sub ethnicitycategories {
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("Select code,name from ethnicity order by name");
- $sth->execute;
- my %labels;
- my @codes;
- while (my $data=$sth->fetchrow_hashref){
- push @codes,$data->{'code'};
- $labels{$data->{'code'}}=$data->{'name'};
- }
- $sth->finish;
- return(\@codes,\%labels);
}
+=head2 GetSupportList
-# 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
+ $itemtypes = &GetSupportList();
- return length $subfield != 1;
-}
+Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used).
-=head2 getbranches
+build a HTML select with the following code :
- $branches = &getbranches();
- returns informations about branches.
- Create a branch selector with the following code
-
=head3 in PERL SCRIPT
-my $branches = getbranches;
-my @branchloop;
-foreach my $thisbranch (keys %$branches) {
- my $selected = 1 if $thisbranch eq $branch;
- my %row =(value => $thisbranch,
- selected => $selected,
- branchname => $branches->{$thisbranch}->{'branchname'},
- );
- push @branchloop, \%row;
-}
+ my $itemtypes = GetSupportList();
+ $template->param(itemtypeloop => $itemtypes);
+=head3 in TEMPLATE
-=head3 in TEMPLATE
- <select name="branch">
- <option value="">Default</option>
- <!-- TMPL_LOOP name="branchloop" -->
- <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="branchname" --></option>
- <!-- /TMPL_LOOP -->
- </select>
+ <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 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 order by branchname");
- $sth->execute;
- while (my $branch=$sth->fetchrow_hashref) {
- my $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ?");
- $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;
+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;
}
- return (\%branches);
}
+=head2 GetItemTypes
-=head2 getitemtypes
-
- $itemtypes = &getitemtypes();
+ $itemtypes = &GetItemTypes();
Returns information about existing itemtypes.
=head3 in PERL SCRIPT
-my $itemtypes = getitemtypes;
-my @itemtypesloop;
-foreach my $thisitemtype (keys %$itemtypes) {
- my $selected = 1 if $thisitemtype eq $itemtype;
- my %row =(value => $thisitemtype,
- selected => $selected,
- description => $itemtypes->{$thisitemtype}->{'description'},
- );
- push @itemtypesloop, \%row;
-}
-$template->param(itemtypeloop => \@itemtypesloop);
+ my $itemtypes = GetItemTypes;
+ my @itemtypesloop;
+ foreach my $thisitemtype (sort keys %$itemtypes) {
+ my $selected = 1 if $thisitemtype eq $itemtype;
+ my %row =(value => $thisitemtype,
+ selected => $selected,
+ description => $itemtypes->{$thisitemtype}->{'description'},
+ );
+ push @itemtypesloop, \%row;
+ }
+ $template->param(itemtypeloop => \@itemtypesloop);
=head3 in TEMPLATE
-<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>
-
+ <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 getitemtypes {
-# returns a reference to a hash of references to branches...
- my %itemtypes;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from itemtypes order by description");
- $sth->execute;
- while (my $IT=$sth->fetchrow_hashref) {
- $itemtypes{$IT->{'itemtype'}}=$IT;
- }
- return (\%itemtypes);
+sub GetItemTypes {
+
+ # returns a reference to a hash of references to itemtypes...
+ 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 $placeholders = join( ', ', map { '?' } @itemtypes );
+ my $query = <<"END_SQL";
+SELECT itemtype,
+ description,
+ imageurl,
+ notforloan
+ FROM itemtypes
+ WHERE itemtype IN ( $placeholders )
+END_SQL
+
+ return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
+}
+
+# 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 * FROM authorised_values ORDER BY authorised_value");
+ $sth->execute;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ if ( $data->{category} eq "CCODE" ) {
+ $count++;
+ $results[$count] = $data;
+
+ #warn "data: $data";
+ }
+ }
+ $sth->finish;
+ return ( $count, @results );
}
=head2 getauthtypes
=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);
+ 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);
=head3 in TEMPLATE
-<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>
+ <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>
=cut
sub getauthtypes {
-# 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 order by authtypetext");
- $sth->execute;
- while (my $IT=$sth->fetchrow_hashref) {
- $authtypes{$IT->{'authtypecode'}}=$IT;
- }
- return (\%authtypes);
+
+ # 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 order by authtypetext");
+ $sth->execute;
+ while ( my $IT = $sth->fetchrow_hashref ) {
+ $authtypes{ $IT->{'authtypecode'} } = $IT;
+ }
+ return ( \%authtypes );
+}
+
+sub getauthtype {
+ my ($authtypecode) = @_;
+
+ # 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;
}
=head2 getframework
=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);
+ 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
-<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>
-
+ <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>
=cut
sub getframeworks {
-# 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);
+
+ # 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);
=cut
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;
+ 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);
=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;
- return $res;
+ 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} = getitemtypeimagelocation( 'intranet', $res->{imageurl} );
+
+ return $res;
+}
+
+=head2 getitemtypeimagedir
+
+ my $directory = getitemtypeimagedir( 'opac' );
+
+pass in 'opac' or 'intranet'. Defaults to 'opac'.
+
+returns the full path to the appropriate directory containing images.
+
+=cut
+
+sub getitemtypeimagedir {
+ my $src = shift || 'opac';
+ if ($src eq 'intranet') {
+ return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
+ } else {
+ return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('template') . '/itemtypeimg';
+ }
+}
+
+sub getitemtypeimagesrc {
+ my $src = shift || 'opac';
+ if ($src eq 'intranet') {
+ return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
+ } 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
+=head2 GetPrinters
- $printers = &getprinters($env);
+ $printers = &GetPrinters();
@queues = keys %$printers;
Returns information about existing printer queues.
-C<$env> is ignored.
-
C<$printers> is a reference-to-hash whose keys are the print queues
defined in the printers table of the Koha database. The values are
references-to-hash, whose keys are the fields in the printers table.
=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;
}
+=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.
+
+=cut
+
+sub getnbpages {
+ my ( $nb_items, $nb_items_per_page ) = @_;
+
+ return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
+}
+
+=head2 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',
+ },
+ ];
+
+ 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 = [
+ {
+ 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',
+ },
+ ];
+ 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. 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,
+ 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, $bind_params ) = @_;
+
+ my $dbh = C4::Context->dbh;
+
+ my $sth = $dbh->prepare($query);
+ $sth->execute( @$bind_params );
+
+ 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;
+}
+
+=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';
+ 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(@bind_params);
+ my @primaryserverloop;
+
+ while ( my $data = $rq->fetchrow_hashref ) {
+ 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},
+ zed => $data->{type} eq 'zed',
+ opensearch => $data->{type} eq 'opensearch'
+ };
+ }
+ return \@primaryserverloop;
+}
+
+
+=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);
+
+=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 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], [$selected]);
+
+This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
+
+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,$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 && $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 $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,$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, 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 GetKohaAuthorisedValuesFromField
+
+Takes $field, $subfield, $fwcode as parameters.
+
+If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
+$subfield can be undefined
+
+Returns hashref of Code => description
+
+Returns undef if no authorised value category is defined for the given field and subfield
+
+=cut
+
+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 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
+
+ my $display_form = C4::Koha::display_marc_indicators($field);
+
+C<$field> is a MARC::Field object
+
+Generate a display form of the indicators of a variable
+MARC field, replacing any blanks with '#'.
+
+=cut
+
+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;
+ }
+ }
+
+ }
+ 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 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([]);
+ }
+ }
+ return;
+}
1;
-__END__
-=back
+__END__
=head1 AUTHOR
projects / koha_gimpoz / blobdiff