Jonathan Druart
41a8005d10
We should remove the debug statements or use Koha::Logger when we want to keep it. Test plan: Confirm that occurrences of remaining occurrences of DEBUG need to be kept (historical scripts for instance) Confirm that the occurrences removed by this patch can be removed Confirm that the occurrences replaced by Koha::Logger are correct Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com> Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl> Looks good to me, noting a few minor points on BZ. JD amended patch: replace "warn #Finished" with "#warn Finished", and put the statement on a single line Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
904 lines
24 KiB
Perl
904 lines
24 KiB
Perl
package C4::Koha;
|
|
|
|
# Copyright 2000-2002 Katipo Communications
|
|
# Parts Copyright 2010 Nelsonville Public Library
|
|
# Parts copyright 2010 BibLibre
|
|
#
|
|
# This file is part of Koha.
|
|
#
|
|
# Koha is free software; you can redistribute it and/or modify it
|
|
# under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 3 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# Koha is distributed in the hope that it will be useful, but
|
|
# WITHOUT ANY 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, see <http://www.gnu.org/licenses>.
|
|
|
|
|
|
use Modern::Perl;
|
|
|
|
use C4::Context;
|
|
use Koha::Caches;
|
|
use Koha::AuthorisedValues;
|
|
use Koha::Libraries;
|
|
use Koha::MarcSubfieldStructures;
|
|
use Business::ISBN;
|
|
use Business::ISSN;
|
|
use autouse 'Data::cselectall_arrayref' => qw(Dumper);
|
|
use vars qw(@ISA @EXPORT @EXPORT_OK);
|
|
|
|
BEGIN {
|
|
require Exporter;
|
|
@ISA = qw(Exporter);
|
|
@EXPORT = qw(
|
|
&GetItemTypesCategorized
|
|
&getallthemes
|
|
&getFacets
|
|
&getnbpages
|
|
&getitemtypeimagedir
|
|
&getitemtypeimagesrc
|
|
&getitemtypeimagelocation
|
|
&GetAuthorisedValues
|
|
&GetNormalizedUPC
|
|
&GetNormalizedISBN
|
|
&GetNormalizedEAN
|
|
&GetNormalizedOCLCNumber
|
|
&xml_escape
|
|
|
|
&GetVariationsOfISBN
|
|
&GetVariationsOfISBNs
|
|
&NormalizeISBN
|
|
&GetVariationsOfISSN
|
|
&GetVariationsOfISSNs
|
|
&NormalizeISSN
|
|
|
|
);
|
|
}
|
|
|
|
=head1 NAME
|
|
|
|
C4::Koha - Perl Module containing convenience functions for Koha scripts
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use C4::Koha;
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Koha.pm provides many functions for Koha scripts.
|
|
|
|
=head1 FUNCTIONS
|
|
|
|
=cut
|
|
|
|
=head2 GetItemTypesCategorized
|
|
|
|
$categories = GetItemTypesCategorized();
|
|
|
|
Returns a hashref containing search categories.
|
|
A search category will be put in the hash if at least one of its itemtypes is visible in OPAC.
|
|
The categories must be part of Authorized Values (ITEMTYPECAT)
|
|
|
|
=cut
|
|
|
|
sub GetItemTypesCategorized {
|
|
my $dbh = C4::Context->dbh;
|
|
# Order is important, so that partially hidden (some items are not visible in OPAC) search
|
|
# categories will be visible. hideinopac=0 must be last.
|
|
my $query = q|
|
|
SELECT itemtype, description, imageurl, hideinopac, 0 as 'iscat' FROM itemtypes WHERE ISNULL(searchcategory) or length(searchcategory) = 0
|
|
UNION
|
|
SELECT DISTINCT searchcategory AS `itemtype`,
|
|
COALESCE(authorised_values.lib_opac,authorised_values.lib) AS description,
|
|
authorised_values.imageurl AS imageurl,
|
|
hideinopac, 1 as 'iscat'
|
|
FROM itemtypes
|
|
LEFT JOIN authorised_values ON searchcategory = authorised_value
|
|
WHERE searchcategory > '' and hideinopac=1
|
|
UNION
|
|
SELECT DISTINCT searchcategory AS `itemtype`,
|
|
COALESCE(authorised_values.lib_opac,authorised_values.lib) AS description,
|
|
authorised_values.imageurl AS imageurl,
|
|
hideinopac, 1 as 'iscat'
|
|
FROM itemtypes
|
|
LEFT JOIN authorised_values ON searchcategory = authorised_value
|
|
WHERE searchcategory > '' and hideinopac=0
|
|
|;
|
|
return ($dbh->selectall_hashref($query,'itemtype'));
|
|
}
|
|
|
|
=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('opacthemes') . '/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('opacthemes') . '/itemtypeimg';
|
|
}
|
|
}
|
|
|
|
sub getitemtypeimagelocation {
|
|
my ( $src, $image ) = @_;
|
|
|
|
return '' if ( !$image );
|
|
require URI::Split;
|
|
|
|
my $scheme = ( URI::Split::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'} );
|
|
foreach my $imagesubdir ( @subdirectories ) {
|
|
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 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) {
|
|
next if $directory eq 'lib';
|
|
-d "$htdocs/$directory/en" and push @themes, $directory;
|
|
}
|
|
return @themes;
|
|
}
|
|
|
|
sub getFacets {
|
|
my $facets;
|
|
if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
|
|
$facets = [
|
|
{
|
|
idx => 'su-to',
|
|
label => 'Topics',
|
|
tags => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
|
|
sep => ' - ',
|
|
},
|
|
{
|
|
idx => 'su-geo',
|
|
label => 'Places',
|
|
tags => [ qw/ 607a / ],
|
|
sep => ' - ',
|
|
},
|
|
{
|
|
idx => 'au',
|
|
label => 'Authors',
|
|
tags => [ qw/ 700ab 701ab 702ab / ],
|
|
sep => C4::Context->preference("UNIMARCAuthorsFacetsSeparator"),
|
|
},
|
|
{
|
|
idx => 'se',
|
|
label => 'Series',
|
|
tags => [ qw/ 225a / ],
|
|
sep => ', ',
|
|
},
|
|
{
|
|
idx => 'location',
|
|
label => 'Location',
|
|
tags => [ qw/ 995e / ],
|
|
},
|
|
{
|
|
idx => 'ccode',
|
|
label => 'CollectionCodes',
|
|
tags => [ qw / 099t 955h / ],
|
|
}
|
|
];
|
|
|
|
unless ( Koha::Libraries->search->count == 1 )
|
|
{
|
|
my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
|
|
if ( $DisplayLibraryFacets eq 'both'
|
|
|| $DisplayLibraryFacets eq 'holding' )
|
|
{
|
|
push(
|
|
@$facets,
|
|
{
|
|
idx => 'holdingbranch',
|
|
label => 'HoldingLibrary',
|
|
tags => [qw / 995c /],
|
|
}
|
|
);
|
|
}
|
|
|
|
if ( $DisplayLibraryFacets eq 'both'
|
|
|| $DisplayLibraryFacets eq 'home' )
|
|
{
|
|
push(
|
|
@$facets,
|
|
{
|
|
idx => 'homebranch',
|
|
label => 'HomeLibrary',
|
|
tags => [qw / 995b /],
|
|
}
|
|
);
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
$facets = [
|
|
{
|
|
idx => 'su-to',
|
|
label => 'Topics',
|
|
tags => [ qw/ 650a / ],
|
|
sep => '--',
|
|
},
|
|
# {
|
|
# idx => 'su-na',
|
|
# label => 'People and Organizations',
|
|
# tags => [ qw/ 600a 610a 611a / ],
|
|
# sep => 'a',
|
|
# },
|
|
{
|
|
idx => 'su-geo',
|
|
label => 'Places',
|
|
tags => [ qw/ 651a / ],
|
|
sep => '--',
|
|
},
|
|
{
|
|
idx => 'su-ut',
|
|
label => 'Titles',
|
|
tags => [ qw/ 630a / ],
|
|
sep => '--',
|
|
},
|
|
{
|
|
idx => 'au',
|
|
label => 'Authors',
|
|
tags => [ qw/ 100a 110a 700a / ],
|
|
sep => ', ',
|
|
},
|
|
{
|
|
idx => 'se',
|
|
label => 'Series',
|
|
tags => [ qw/ 440a 490a / ],
|
|
sep => ', ',
|
|
},
|
|
{
|
|
idx => 'itype',
|
|
label => 'ItemTypes',
|
|
tags => [ qw/ 952y 942c / ],
|
|
sep => ', ',
|
|
},
|
|
{
|
|
idx => 'location',
|
|
label => 'Location',
|
|
tags => [ qw / 952c / ],
|
|
},
|
|
{
|
|
idx => 'ccode',
|
|
label => 'CollectionCodes',
|
|
tags => [ qw / 9528 / ],
|
|
}
|
|
];
|
|
|
|
unless ( Koha::Libraries->search->count == 1 )
|
|
{
|
|
my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
|
|
if ( $DisplayLibraryFacets eq 'both'
|
|
|| $DisplayLibraryFacets eq 'holding' )
|
|
{
|
|
push(
|
|
@$facets,
|
|
{
|
|
idx => 'holdingbranch',
|
|
label => 'HoldingLibrary',
|
|
tags => [qw / 952b /],
|
|
}
|
|
);
|
|
}
|
|
|
|
if ( $DisplayLibraryFacets eq 'both'
|
|
|| $DisplayLibraryFacets eq 'home' )
|
|
{
|
|
push(
|
|
@$facets,
|
|
{
|
|
idx => 'homebranch',
|
|
label => 'HomeLibrary',
|
|
tags => [qw / 952a /],
|
|
}
|
|
);
|
|
}
|
|
}
|
|
}
|
|
return $facets;
|
|
}
|
|
|
|
=head2 GetAuthorisedValues
|
|
|
|
$authvalues = GetAuthorisedValues([$category]);
|
|
|
|
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, $opac ) = @_;
|
|
|
|
# Is this cached already?
|
|
$opac = $opac ? 1 : 0; # normalise to be safe
|
|
my $branch_limit =
|
|
C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
|
|
my $cache_key =
|
|
"AuthorisedValues-$category-$opac-$branch_limit";
|
|
my $cache = Koha::Caches->get_instance();
|
|
my $result = $cache->get_from_cache($cache_key);
|
|
return $result if $result;
|
|
|
|
my @results;
|
|
my $dbh = C4::Context->dbh;
|
|
my $query = qq{
|
|
SELECT DISTINCT av.*
|
|
FROM authorised_values av
|
|
};
|
|
$query .= qq{
|
|
LEFT JOIN authorised_values_branches ON ( id = av_id )
|
|
} if $branch_limit;
|
|
my @where_strings;
|
|
my @where_args;
|
|
if($category) {
|
|
push @where_strings, "category = ?";
|
|
push @where_args, $category;
|
|
}
|
|
if($branch_limit) {
|
|
push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
|
|
push @where_args, $branch_limit;
|
|
}
|
|
if(@where_strings > 0) {
|
|
$query .= " WHERE " . join(" AND ", @where_strings);
|
|
}
|
|
$query .= ' ORDER BY category, ' . (
|
|
$opac ? 'COALESCE(lib_opac, lib)'
|
|
: 'lib, lib_opac'
|
|
);
|
|
|
|
my $sth = $dbh->prepare($query);
|
|
|
|
$sth->execute( @where_args );
|
|
while (my $data=$sth->fetchrow_hashref) {
|
|
if ($opac && $data->{lib_opac}) {
|
|
$data->{lib} = $data->{lib_opac};
|
|
}
|
|
push @results, $data;
|
|
}
|
|
$sth->finish;
|
|
|
|
$cache->set_in_cache( $cache_key, \@results, { expiry => 5 } );
|
|
return \@results;
|
|
}
|
|
|
|
=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 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 && $field->tag() >= 10) {
|
|
$indicators = $field->indicator(1) . $field->indicator(2);
|
|
$indicators =~ s/ /#/g;
|
|
}
|
|
return $indicators;
|
|
}
|
|
|
|
sub GetNormalizedUPC {
|
|
my ($marcrecord,$marcflavour) = @_;
|
|
|
|
return unless $marcrecord;
|
|
if ($marcflavour eq 'UNIMARC') {
|
|
my @fields = $marcrecord->field('072');
|
|
foreach my $field (@fields) {
|
|
my $upc = _normalize_match_point($field->subfield('a'));
|
|
if ($upc) {
|
|
return $upc;
|
|
}
|
|
}
|
|
|
|
}
|
|
else { # assume marc21 if not unimarc
|
|
my @fields = $marcrecord->field('024');
|
|
foreach my $field (@fields) {
|
|
my $indicator = $field->indicator(1);
|
|
my $upc = _normalize_match_point($field->subfield('a'));
|
|
if ($upc && $indicator == 1 ) {
|
|
return $upc;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# Normalizes and returns the first valid ISBN found in the record
|
|
# ISBN13 are converted into ISBN10. This is required to get some book cover images.
|
|
sub GetNormalizedISBN {
|
|
my ($isbn,$marcrecord,$marcflavour) = @_;
|
|
if ($isbn) {
|
|
# Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
|
|
# anything after " | " should be removed, along with the delimiter
|
|
($isbn) = split(/\|/, $isbn );
|
|
return _isbn_cleanup($isbn);
|
|
}
|
|
|
|
return unless $marcrecord;
|
|
|
|
if ($marcflavour eq 'UNIMARC') {
|
|
my @fields = $marcrecord->field('010');
|
|
foreach my $field (@fields) {
|
|
my $isbn = $field->subfield('a');
|
|
if ($isbn) {
|
|
return _isbn_cleanup($isbn);
|
|
}
|
|
}
|
|
}
|
|
else { # assume marc21 if not unimarc
|
|
my @fields = $marcrecord->field('020');
|
|
foreach my $field (@fields) {
|
|
$isbn = $field->subfield('a');
|
|
if ($isbn) {
|
|
return _isbn_cleanup($isbn);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub GetNormalizedEAN {
|
|
my ($marcrecord,$marcflavour) = @_;
|
|
|
|
return unless $marcrecord;
|
|
|
|
if ($marcflavour eq 'UNIMARC') {
|
|
my @fields = $marcrecord->field('073');
|
|
foreach my $field (@fields) {
|
|
my $ean = _normalize_match_point($field->subfield('a'));
|
|
if ( $ean ) {
|
|
return $ean;
|
|
}
|
|
}
|
|
}
|
|
else { # assume marc21 if not unimarc
|
|
my @fields = $marcrecord->field('024');
|
|
foreach my $field (@fields) {
|
|
my $indicator = $field->indicator(1);
|
|
my $ean = _normalize_match_point($field->subfield('a'));
|
|
if ( $ean && $indicator == 3 ) {
|
|
return $ean;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub GetNormalizedOCLCNumber {
|
|
my ($marcrecord,$marcflavour) = @_;
|
|
return unless $marcrecord;
|
|
|
|
if ($marcflavour ne 'UNIMARC' ) {
|
|
my @fields = $marcrecord->field('035');
|
|
foreach my $field (@fields) {
|
|
my $oclc = $field->subfield('a');
|
|
if ($oclc && $oclc =~ /OCoLC/) {
|
|
$oclc =~ s/\(OCoLC\)//;
|
|
return $oclc;
|
|
}
|
|
}
|
|
} else {
|
|
# TODO for UNIMARC
|
|
}
|
|
return
|
|
}
|
|
|
|
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) = @_;
|
|
return NormalizeISBN(
|
|
{
|
|
isbn => $isbn,
|
|
format => 'ISBN-10',
|
|
strip_hyphens => 1,
|
|
}
|
|
) if $isbn;
|
|
}
|
|
|
|
=head2 NormalizeISBN
|
|
|
|
my $isbns = NormalizeISBN({
|
|
isbn => $isbn,
|
|
strip_hyphens => [0,1],
|
|
format => ['ISBN-10', 'ISBN-13']
|
|
});
|
|
|
|
Returns an isbn validated by Business::ISBN.
|
|
Optionally strips hyphens and/or forces the isbn
|
|
to be of the specified format.
|
|
|
|
If the string cannot be validated as an isbn,
|
|
it returns nothing unless return_invalid param is passed.
|
|
|
|
#FIXME This routine (and others?) should be moved to Koha::Util::Normalize
|
|
|
|
=cut
|
|
|
|
sub NormalizeISBN {
|
|
my ($params) = @_;
|
|
|
|
my $string = $params->{isbn};
|
|
my $strip_hyphens = $params->{strip_hyphens};
|
|
my $format = $params->{format} || q{};
|
|
my $return_invalid = $params->{return_invalid};
|
|
|
|
return unless $string;
|
|
|
|
my $isbn = Business::ISBN->new($string);
|
|
|
|
if ( $isbn && $isbn->is_valid() ) {
|
|
|
|
if ( $format eq 'ISBN-10' ) {
|
|
$isbn = $isbn->as_isbn10();
|
|
}
|
|
elsif ( $format eq 'ISBN-13' ) {
|
|
$isbn = $isbn->as_isbn13();
|
|
}
|
|
return unless $isbn;
|
|
|
|
if ($strip_hyphens) {
|
|
$string = $isbn->as_string( [] );
|
|
} else {
|
|
$string = $isbn->as_string();
|
|
}
|
|
|
|
return $string;
|
|
} elsif ( $return_invalid ) {
|
|
return $string;
|
|
}
|
|
|
|
}
|
|
|
|
=head2 GetVariationsOfISBN
|
|
|
|
my @isbns = GetVariationsOfISBN( $isbn );
|
|
|
|
Returns a list of variations of the given isbn in
|
|
both ISBN-10 and ISBN-13 formats, with and without
|
|
hyphens.
|
|
|
|
In a scalar context, the isbns are returned as a
|
|
string delimited by ' | '.
|
|
|
|
=cut
|
|
|
|
sub GetVariationsOfISBN {
|
|
my ($isbn) = @_;
|
|
|
|
return unless $isbn;
|
|
|
|
my @isbns;
|
|
|
|
push( @isbns, NormalizeISBN({ isbn => $isbn, return_invalid => 1 }) );
|
|
push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) );
|
|
push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) );
|
|
push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) );
|
|
push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
|
|
|
|
# Strip out any "empty" strings from the array
|
|
@isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
|
|
|
|
return wantarray ? @isbns : join( " | ", @isbns );
|
|
}
|
|
|
|
=head2 GetVariationsOfISBNs
|
|
|
|
my @isbns = GetVariationsOfISBNs( @isbns );
|
|
|
|
Returns a list of variations of the given isbns in
|
|
both ISBN-10 and ISBN-13 formats, with and without
|
|
hyphens.
|
|
|
|
In a scalar context, the isbns are returned as a
|
|
string delimited by ' | '.
|
|
|
|
=cut
|
|
|
|
sub GetVariationsOfISBNs {
|
|
my (@isbns) = @_;
|
|
|
|
@isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
|
|
|
|
return wantarray ? @isbns : join( " | ", @isbns );
|
|
}
|
|
|
|
=head2 NormalizedISSN
|
|
|
|
my $issns = NormalizedISSN({
|
|
issn => $issn,
|
|
strip_hyphen => [0,1]
|
|
});
|
|
|
|
Returns an issn validated by Business::ISSN.
|
|
Optionally strips hyphen.
|
|
|
|
If the string cannot be validated as an issn,
|
|
it returns nothing.
|
|
|
|
=cut
|
|
|
|
sub NormalizeISSN {
|
|
my ($params) = @_;
|
|
|
|
my $string = $params->{issn};
|
|
my $strip_hyphen = $params->{strip_hyphen};
|
|
|
|
my $issn = Business::ISSN->new($string);
|
|
|
|
if ( $issn && $issn->is_valid ){
|
|
|
|
if ($strip_hyphen) {
|
|
$string = $issn->_issn;
|
|
}
|
|
else {
|
|
$string = $issn->as_string;
|
|
}
|
|
return $string;
|
|
}
|
|
|
|
}
|
|
|
|
=head2 GetVariationsOfISSN
|
|
|
|
my @issns = GetVariationsOfISSN( $issn );
|
|
|
|
Returns a list of variations of the given issn in
|
|
with and without a hyphen.
|
|
|
|
In a scalar context, the issns are returned as a
|
|
string delimited by ' | '.
|
|
|
|
=cut
|
|
|
|
sub GetVariationsOfISSN {
|
|
my ( $issn ) = @_;
|
|
|
|
return unless $issn;
|
|
|
|
my @issns;
|
|
my $str = NormalizeISSN({ issn => $issn });
|
|
if( $str ) {
|
|
push @issns, $str;
|
|
push @issns, NormalizeISSN({ issn => $issn, strip_hyphen => 1 });
|
|
} else {
|
|
push @issns, $issn;
|
|
}
|
|
|
|
# Strip out any "empty" strings from the array
|
|
@issns = grep { defined($_) && $_ =~ /\S/ } @issns;
|
|
|
|
return wantarray ? @issns : join( " | ", @issns );
|
|
}
|
|
|
|
=head2 GetVariationsOfISSNs
|
|
|
|
my @issns = GetVariationsOfISSNs( @issns );
|
|
|
|
Returns a list of variations of the given issns in
|
|
with and without a hyphen.
|
|
|
|
In a scalar context, the issns are returned as a
|
|
string delimited by ' | '.
|
|
|
|
=cut
|
|
|
|
sub GetVariationsOfISSNs {
|
|
my (@issns) = @_;
|
|
|
|
@issns = map { GetVariationsOfISSN( $_ ) } @issns;
|
|
|
|
return wantarray ? @issns : join( " | ", @issns );
|
|
}
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=head1 AUTHOR
|
|
|
|
Koha Team
|
|
|
|
=cut
|