Marcel de Rooy
590cae04fd
After feedback from the dev mailing list, it seems appropriate here to
propose making the Default framework authoritative for Koha to MARC
mappings. This implies checking only the Default framework in the
routines:
[1] GetMarcFromKohaField: The parameter frameworkcode is removed. A
follow-up report (19097) will update the calls not adjusted here.
This is safe since the parameter is silently ignored.
[2] GetMarcSubfieldStructureFromKohaField: Framework parameter is removed
and calls are adjusted. Includes acquisitions_stats.pl.
[3] TransformKohaToMarc: The parameter is removed; all calls are verified
or adjusted.
[4] TransformMarcToKoha: The parameter is no longer used and will be
removed in a follow-up report (19097). It always goes to Default now.
[5] TransformMarcToKohaOneField: The parameter is removed and all calls
are adjusted. Including: Breeding, XISBN and MetadataRecord modules.
[6] C4::Koha::IsKohaFieldLinked: This routine was called only once (in
C4::Items::_build_default_values_for_mod_marc. It can be replaced by
calling GetMarcFromKohaField. If there is no kohafield linked, undef
is returned. (Corresponding unit test is removed here.)
[7] C4::Items::ModItemFromMarc: The helper routine
_build_default_values_for_mod_marc does no longer have a framework
parameter. The cache key default_value_for_mod_marc- is no longer
combined with a frameworkcode. Three admin scripts are adjusted
accordingly; some tests will be corrected in the next patch.
Test plan:
See next patch. That patch adjusts all tests involved.
Signed-off-by: Josef Moravec <josef.moravec@gmail.com>
Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>
Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
1013 lines
28 KiB
Perl
1013 lines
28 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 strict;
|
|
#use warnings; FIXME - Bug 2505
|
|
|
|
use C4::Context;
|
|
use Koha::Caches;
|
|
use Koha::DateUtils qw(dt_from_string);
|
|
use Koha::AuthorisedValues;
|
|
use Koha::Libraries;
|
|
use Koha::MarcSubfieldStructures;
|
|
use DateTime::Format::MySQL;
|
|
use Business::ISBN;
|
|
use Business::ISSN;
|
|
use autouse 'Data::cselectall_arrayref' => qw(Dumper);
|
|
use DBI qw(:sql_types);
|
|
use vars qw(@ISA @EXPORT @EXPORT_OK $DEBUG);
|
|
|
|
BEGIN {
|
|
require Exporter;
|
|
@ISA = qw(Exporter);
|
|
@EXPORT = qw(
|
|
&GetPrinters &GetPrinter
|
|
&GetItemTypesCategorized
|
|
&getallthemes
|
|
&getFacets
|
|
&getnbpages
|
|
&getitemtypeimagedir
|
|
&getitemtypeimagesrc
|
|
&getitemtypeimagelocation
|
|
&GetAuthorisedValues
|
|
&GetNormalizedUPC
|
|
&GetNormalizedISBN
|
|
&GetNormalizedEAN
|
|
&GetNormalizedOCLCNumber
|
|
&xml_escape
|
|
|
|
&GetVariationsOfISBN
|
|
&GetVariationsOfISBNs
|
|
&NormalizeISBN
|
|
&GetVariationsOfISSN
|
|
&GetVariationsOfISSNs
|
|
&NormalizeISSN
|
|
|
|
$DEBUG
|
|
);
|
|
$DEBUG = 0;
|
|
@EXPORT_OK = qw( GetDailyQuote );
|
|
}
|
|
|
|
=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`,
|
|
authorised_values.lib_opac 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`,
|
|
authorised_values.lib_opac 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 ) {
|
|
warn $imagesubdir if $DEBUG;
|
|
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();
|
|
@queues = keys %$printers;
|
|
|
|
Returns information about existing printer queues.
|
|
|
|
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 %printers;
|
|
my $dbh = C4::Context->dbh;
|
|
my $sth = $dbh->prepare("select * from printers");
|
|
$sth->execute;
|
|
while ( my $printer = $sth->fetchrow_hashref ) {
|
|
$printers{ $printer->{'printqueue'} } = $printer;
|
|
}
|
|
return ( \%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');
|
|
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) {
|
|
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 => 'su-ut',
|
|
label => 'Titles',
|
|
tags => [ qw/ 500a 501a 503a / ],
|
|
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 / ],
|
|
}
|
|
];
|
|
|
|
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 / ],
|
|
},
|
|
];
|
|
|
|
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 =~ /OCoLC/) {
|
|
$oclc =~ s/\(OCoLC\)//;
|
|
return $oclc;
|
|
}
|
|
}
|
|
} else {
|
|
# TODO for UNIMARC
|
|
}
|
|
return
|
|
}
|
|
|
|
=head2 GetDailyQuote($opts)
|
|
|
|
Takes a hashref of options
|
|
|
|
Currently supported options are:
|
|
|
|
'id' An exact quote id
|
|
'random' Select a random quote
|
|
noop When no option is passed in, this sub will return the quote timestamped for the current day
|
|
|
|
The function returns an anonymous hash following this format:
|
|
|
|
{
|
|
'source' => 'source-of-quote',
|
|
'timestamp' => 'timestamp-value',
|
|
'text' => 'text-of-quote',
|
|
'id' => 'quote-id'
|
|
};
|
|
|
|
=cut
|
|
|
|
# This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
|
|
# at least for default option
|
|
|
|
sub GetDailyQuote {
|
|
my %opts = @_;
|
|
my $dbh = C4::Context->dbh;
|
|
my $query = '';
|
|
my $sth = undef;
|
|
my $quote = undef;
|
|
if ($opts{'id'}) {
|
|
$query = 'SELECT * FROM quotes WHERE id = ?';
|
|
$sth = $dbh->prepare($query);
|
|
$sth->execute($opts{'id'});
|
|
$quote = $sth->fetchrow_hashref();
|
|
}
|
|
elsif ($opts{'random'}) {
|
|
# Fall through... we also return a random quote as a catch-all if all else fails
|
|
}
|
|
else {
|
|
$query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
|
|
$sth = $dbh->prepare($query);
|
|
$sth->execute();
|
|
$quote = $sth->fetchrow_hashref();
|
|
}
|
|
unless ($quote) { # if there are not matches, choose a random quote
|
|
# get a list of all available quote ids
|
|
$sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
|
|
$sth->execute;
|
|
my $range = ($sth->fetchrow_array)[0];
|
|
# chose a random id within that range if there is more than one quote
|
|
my $offset = int(rand($range));
|
|
# grab it
|
|
$query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
|
|
$sth = C4::Context->dbh->prepare($query);
|
|
# see http://www.perlmonks.org/?node_id=837422 for why
|
|
# we're being verbose and using bind_param
|
|
$sth->bind_param(1, $offset, SQL_INTEGER);
|
|
$sth->execute();
|
|
$quote = $sth->fetchrow_hashref();
|
|
# update the timestamp for that quote
|
|
$query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
|
|
$sth = C4::Context->dbh->prepare($query);
|
|
$sth->execute(
|
|
DateTime::Format::MySQL->format_datetime( dt_from_string() ),
|
|
$quote->{'id'}
|
|
);
|
|
}
|
|
return $quote;
|
|
}
|
|
|
|
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 NormalizedISBN
|
|
|
|
my $isbns = NormalizedISBN({
|
|
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.
|
|
|
|
=cut
|
|
|
|
sub NormalizeISBN {
|
|
my ($params) = @_;
|
|
|
|
my $string = $params->{isbn};
|
|
my $strip_hyphens = $params->{strip_hyphens};
|
|
my $format = $params->{format};
|
|
|
|
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;
|
|
}
|
|
}
|
|
|
|
=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 }) );
|
|
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
|