#
# 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 2 of the License, or (at your option) any later
-# version.
+# 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.
+# 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, write to the Free Software Foundation, Inc.,
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+# 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 C4::Branch qw(GetBranchesCount);
+use Koha::Caches;
use Koha::DateUtils qw(dt_from_string);
-use Memoize;
+use Koha::AuthorisedValues;
+use Koha::Libraries;
+use Koha::MarcSubfieldStructures;
use DateTime::Format::MySQL;
-use autouse 'Data::Dumper' => qw(Dumper);
-
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $DEBUG);
+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 {
- $VERSION = 3.07.00.049;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(
- &slashifyDate
- &subfield_is_koha_internal_p
- &GetPrinters &GetPrinter
- &GetItemTypes &getitemtypeinfo
- &GetSupportName &GetSupportList
- &get_itemtypeinfos_of
- &getframeworks &getframeworkinfo
- &getauthtypes &getauthtype
- &getallthemes
- &getFacets
- &displayServers
- &getnbpages
- &get_infos_of
- &get_notforloan_label_of
+ &GetPrinters &GetPrinter
+ &GetItemTypesCategorized
+ &getallthemes
+ &getFacets
+ &getnbpages
&getitemtypeimagedir
&getitemtypeimagesrc
&getitemtypeimagelocation
&GetAuthorisedValues
- &GetAuthorisedValueCategories
- &IsAuthorisedValueCategory
- &GetKohaAuthorisedValues
- &GetKohaAuthorisedValuesFromField
- &GetKohaAuthorisedValueLib
- &GetAuthorisedValueByCode
- &GetKohaImageurlFromAuthorisedValues
- &GetAuthValCode
- &AddAuthorisedValue
&GetNormalizedUPC
&GetNormalizedISBN
&GetNormalizedEAN
&GetNormalizedOCLCNumber
&xml_escape
+ &GetVariationsOfISBN
+ &GetVariationsOfISBNs
+ &NormalizeISBN
+ &GetVariationsOfISSN
+ &GetVariationsOfISSNs
+ &NormalizeISSN
+
$DEBUG
);
$DEBUG = 0;
@EXPORT_OK = qw( GetDailyQuote );
}
-# expensive functions
-memoize('GetAuthorisedValues');
-
=head1 NAME
C4::Koha - Perl Module containing convenience functions for Koha scripts
=cut
-=head2 slashifyDate
-
- $slash_date = &slashifyDate($dash_date);
-
-Takes a string of the form "DD-MM-YYYY" (or anything separated by
-dashes), converts it to the form "YYYY/MM/DD", and returns the result.
-
-=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]");
-}
-
-# FIXME.. this should be moved to a MARC-specific module
-sub subfield_is_koha_internal_p {
- my ($subfield) = @_;
-
- # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
- # But real MARC subfields are always single-character
- # so it really is safer just to check the length
-
- return length $subfield != 1;
-}
-
-=head2 GetSupportName
-
- $itemtypename = &GetSupportName($codestring);
-
-Returns a string with the name of the itemtype.
-
-=cut
-
-sub GetSupportName{
- my ($codestring)=@_;
- return if (! $codestring);
- my $resultstring;
- my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
- if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
- my $query = qq|
- SELECT description
- FROM itemtypes
- WHERE itemtype=?
- order by description
- |;
- my $sth = C4::Context->dbh->prepare($query);
- $sth->execute($codestring);
- ($resultstring)=$sth->fetchrow;
- return $resultstring;
- } else {
- my $sth =
- C4::Context->dbh->prepare(
- "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
- );
- $sth->execute( $advanced_search_types, $codestring );
- my $data = $sth->fetchrow_hashref;
- return $$data{'lib'};
- }
-
-}
-=head2 GetSupportList
-
- $itemtypes = &GetSupportList();
-
-Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used).
-
-build a HTML select with the following code :
-
-=head3 in PERL SCRIPT
-
- my $itemtypes = GetSupportList();
- $template->param(itemtypeloop => $itemtypes);
-
-=head3 in TEMPLATE
-
- <select name="itemtype" id="itemtype">
- <option value=""></option>
- [% FOREACH itemtypeloo IN itemtypeloop %]
- [% IF ( itemtypeloo.selected ) %]
- <option value="[% itemtypeloo.itemtype %]" selected="selected">[% itemtypeloo.description %]</option>
- [% ELSE %]
- <option value="[% itemtypeloo.itemtype %]">[% itemtypeloo.description %]</option>
- [% END %]
- [% END %]
- </select>
-
-=cut
-
-sub GetSupportList{
- my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
- if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
- my $query = qq|
- SELECT *
- FROM itemtypes
- order by description
- |;
- my $sth = C4::Context->dbh->prepare($query);
- $sth->execute;
- return $sth->fetchall_arrayref({});
- } else {
- my $advsearchtypes = GetAuthorisedValues($advanced_search_types);
- my @results= map {{itemtype=>$$_{authorised_value},description=>$$_{lib},imageurl=>$$_{imageurl}}} @$advsearchtypes;
- return \@results;
- }
-}
-=head2 GetItemTypes
-
- $itemtypes = &GetItemTypes( style => $style );
-
-Returns information about existing itemtypes.
-
-Params:
- style: either 'array' or 'hash', defaults to 'hash'.
- 'array' returns an arrayref,
- 'hash' return a hashref with the itemtype value as the key
-
-build a HTML select with the following code :
-
-=head3 in PERL SCRIPT
-
- 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);
+=head2 GetItemTypesCategorized
-=head3 in TEMPLATE
+ $categories = GetItemTypesCategorized();
- <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>
+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 GetItemTypes {
- my ( %params ) = @_;
- my $style = defined( $params{'style'} ) ? $params{'style'} : 'hash';
-
- # returns a reference to a hash of references to itemtypes...
- my %itemtypes;
+sub GetItemTypesCategorized {
my $dbh = C4::Context->dbh;
- my $query = qq|
- SELECT *
- FROM itemtypes
- |;
- my $sth = $dbh->prepare($query);
- $sth->execute;
-
- if ( $style eq 'hash' ) {
- while ( my $IT = $sth->fetchrow_hashref ) {
- $itemtypes{ $IT->{'itemtype'} } = $IT;
- }
- return ( \%itemtypes );
- } else {
- return $sth->fetchall_arrayref({});
- }
-}
-
-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 );
-}
-
-=head2 getauthtypes
-
- $authtypes = &getauthtypes();
-
-Returns information about existing authtypes.
-
-build a HTML select with the following code :
-
-=head3 in PERL SCRIPT
-
- my $authtypes = getauthtypes;
- my @authtypesloop;
- foreach my $thisauthtype (keys %$authtypes) {
- my $selected = 1 if $thisauthtype eq $authtype;
- my %row =(value => $thisauthtype,
- selected => $selected,
- authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
- );
- push @authtypesloop, \%row;
- }
- $template->param(itemtypeloop => \@itemtypesloop);
-
-=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>
-
-
-=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 );
-}
-
-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
-
- $frameworks = &getframework();
-
-Returns information about existing frameworks
-
-build a HTML select with the following code :
-
-=head3 in PERL SCRIPT
-
- my $frameworks = frameworks();
- my @frameworkloop;
- foreach my $thisframework (keys %$frameworks) {
- my $selected = 1 if $thisframework eq $frameworkcode;
- my %row =(value => $thisframework,
- selected => $selected,
- description => $frameworks->{$thisframework}->{'frameworktext'},
- );
- push @frameworksloop, \%row;
- }
- $template->param(frameworkloop => \@frameworksloop);
-
-=head3 in TEMPLATE
-
- <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 );
-}
-
-=head2 getframeworkinfo
-
- $frameworkinfo = &getframeworkinfo($frameworkcode);
-
-Returns information about an 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;
-}
-
-=head2 getitemtypeinfo
-
- $itemtype = &getitemtypeinfo($itemtype, [$interface]);
-
-Returns information about an itemtype. The optional $interface argument
-sets which interface ('opac' or 'intranet') to return the imageurl for.
-Defaults to intranet.
-
-=cut
-
-sub getitemtypeinfo {
- my ($itemtype, $interface) = @_;
- 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( ( ( defined $interface && $interface eq 'opac' ) ? 'opac' : 'intranet' ), $res->{imageurl} );
-
- return $res;
+ # 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
{
idx => 'location',
label => 'Location',
- tags => [ qw/ 995c / ],
+ tags => [ qw/ 995e / ],
+ },
+ {
+ idx => 'ccode',
+ label => 'CollectionCodes',
+ tags => [ qw / 099t 955h / ],
}
];
- my $library_facet;
- unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
- $library_facet = {
- idx => 'branch',
- label => 'Libraries',
- tags => [ qw/ 995b / ],
- };
+ 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 /],
+ }
+ );
+ }
}
- push( @$facets, $library_facet );
}
else {
$facets = [
label => 'Location',
tags => [ qw / 952c / ],
},
+ {
+ idx => 'ccode',
+ label => 'CollectionCodes',
+ tags => [ qw / 9528 / ],
+ }
];
- my $library_facet;
- unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
- $library_facet = {
- idx => 'branch',
- label => 'Libraries',
- tags => [ qw / 952b / ],
- };
+ 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 /],
+ }
+ );
+ }
}
- push( @$facets, $library_facet );
}
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' => 'utf8',
- 'icon' => undef,
- 'id' => 'LIBRARY OF CONGRESS',
- 'label' => '',
- 'name' => 'server',
- 'opensearch' => '',
- 'value' => 'lx2.loc.gov:210/',
- '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]);
+ $authvalues = GetAuthorisedValues([$category]);
This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
=cut
sub GetAuthorisedValues {
- my ( $category, $selected, $opac ) = @_;
- my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
+ 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 *
- FROM authorised_values
+ SELECT DISTINCT av.*
+ FROM authorised_values av
};
$query .= qq{
LEFT JOIN authorised_values_branches ON ( id = av_id )
if(@where_strings > 0) {
$query .= " WHERE " . join(" AND ", @where_strings);
}
- $query .= " GROUP BY lib";
$query .= ' ORDER BY category, ' . (
$opac ? 'COALESCE(lib_opac, lib)'
: 'lib, lib_opac'
$sth->execute( @where_args );
while (my $data=$sth->fetchrow_hashref) {
- if ( defined $selected and $selected eq $data->{authorised_value} ) {
- $data->{selected} = 1;
- }
- else {
- $data->{selected} = 0;
- }
-
if ($opac && $data->{lib_opac}) {
$data->{lib} = $data->{lib_opac};
}
push @results, $data;
}
$sth->finish;
- return \@results;
-}
-
-=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;
- }
+ $cache->set_in_cache( $cache_key, \@results, { expiry => 5 } );
return \@results;
}
-=head2 IsAuthorisedValueCategory
-
- $is_auth_val_category = IsAuthorisedValueCategory($category);
-
-Returns whether a given category name is a valid one
-
-=cut
-
-sub IsAuthorisedValueCategory {
- my $category = shift;
- my $query = '
- SELECT category
- FROM authorised_values
- WHERE BINARY category=?
- LIMIT 1
- ';
- my $sth = C4::Context->dbh->prepare($query);
- $sth->execute($category);
- $sth->fetchrow ? return 1
- : return 0;
-}
-
-=head2 GetAuthorisedValueByCode
-
-$authorised_value = GetAuthorisedValueByCode( $category, $authvalcode, $opac );
-
-Return the lib attribute from authorised_values from the row identified
-by the passed category and code
-
-=cut
-
-sub GetAuthorisedValueByCode {
- my ( $category, $authvalcode, $opac ) = @_;
-
- my $field = $opac ? 'lib_opac' : 'lib';
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
- $sth->execute( $category, $authvalcode );
- while ( my $data = $sth->fetchrow_hashref ) {
- return $data->{ $field };
- }
-}
-
-=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;
- }
-}
-
-=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;
- }
-}
-
=head2 xml_escape
my $escaped_string = C4::Koha::xml_escape($string);
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 AddAuthorisedValue
-
- AddAuthorisedValue($category, $authorised_value, $lib, $lib_opac, $imageurl);
-
-Create a new authorised value.
-
-=cut
-
-sub AddAuthorisedValue {
- my ($category, $authorised_value, $lib, $lib_opac, $imageurl) = @_;
-
- my $dbh = C4::Context->dbh;
- my $query = qq{
- INSERT INTO authorised_values (category, authorised_value, lib, lib_opac, imageurl)
- VALUES (?,?,?,?,?)
- };
- my $sth = $dbh->prepare($query);
- $sth->execute($category, $authorised_value, $lib, $lib_opac, $imageurl);
-}
-
=head2 display_marc_indicators
my $display_form = C4::Koha::display_marc_indicators($field);
sub display_marc_indicators {
my $field = shift;
my $indicators = '';
- if ($field->tag() >= 10) {
+ if ($field && $field->tag() >= 10) {
$indicators = $field->indicator(1) . $field->indicator(2);
$indicators =~ s/ /#/g;
}
}
sub GetNormalizedUPC {
- my ($record,$marcflavour) = @_;
- my (@fields,$upc);
+ my ($marcrecord,$marcflavour) = @_;
+ return unless $marcrecord;
if ($marcflavour eq 'UNIMARC') {
- @fields = $record->field('072');
+ my @fields = $marcrecord->field('072');
foreach my $field (@fields) {
my $upc = _normalize_match_point($field->subfield('a'));
- if ($upc ne '') {
+ if ($upc) {
return $upc;
}
}
}
else { # assume marc21 if not unimarc
- @fields = $record->field('024');
+ my @fields = $marcrecord->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 '') {
+ 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,$record,$marcflavour) = @_;
- my @fields;
+ 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 =~ s/(.*)( \| )(.*)/$1/;
+ ($isbn) = split(/\|/, $isbn );
return _isbn_cleanup($isbn);
}
- return unless $record;
+
+ return unless $marcrecord;
if ($marcflavour eq 'UNIMARC') {
- @fields = $record->field('010');
+ my @fields = $marcrecord->field('010');
foreach my $field (@fields) {
my $isbn = $field->subfield('a');
if ($isbn) {
return _isbn_cleanup($isbn);
- } else {
- return;
}
}
}
else { # assume marc21 if not unimarc
- @fields = $record->field('020');
+ my @fields = $marcrecord->field('020');
foreach my $field (@fields) {
$isbn = $field->subfield('a');
if ($isbn) {
return _isbn_cleanup($isbn);
- } else {
- return;
}
}
}
}
sub GetNormalizedEAN {
- my ($record,$marcflavour) = @_;
- my (@fields,$ean);
+ my ($marcrecord,$marcflavour) = @_;
+
+ return unless $marcrecord;
if ($marcflavour eq 'UNIMARC') {
- @fields = $record->field('073');
+ my @fields = $marcrecord->field('073');
foreach my $field (@fields) {
- $ean = _normalize_match_point($field->subfield('a'));
- if ($ean ne '') {
+ my $ean = _normalize_match_point($field->subfield('a'));
+ if ( $ean ) {
return $ean;
}
}
}
else { # assume marc21 if not unimarc
- @fields = $record->field('024');
+ my @fields = $marcrecord->field('024');
foreach my $field (@fields) {
my $indicator = $field->indicator(1);
- $ean = _normalize_match_point($field->subfield('a'));
- if ($indicator == 3 and $ean ne '') {
+ my $ean = _normalize_match_point($field->subfield('a'));
+ if ( $ean && $indicator == 3 ) {
return $ean;
}
}
}
}
+
sub GetNormalizedOCLCNumber {
- my ($record,$marcflavour) = @_;
- my (@fields,$oclc);
+ my ($marcrecord,$marcflavour) = @_;
+ return unless $marcrecord;
- if ($marcflavour eq 'UNIMARC') {
- # TODO: add UNIMARC fields
- }
- else { # assume marc21 if not unimarc
- @fields = $record->field('035');
+ if ($marcflavour ne 'UNIMARC' ) {
+ my @fields = $marcrecord->field('035');
foreach my $field (@fields) {
- $oclc = $field->subfield('a');
+ my $oclc = $field->subfield('a');
if ($oclc =~ /OCoLC/) {
$oclc =~ s/\(OCoLC\)//;
return $oclc;
- } else {
- return;
}
}
+ } else {
+ # TODO for UNIMARC
}
+ return
}
=head2 GetDailyQuote($opts)
$sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
$sth->execute;
my $range = ($sth->fetchrow_array)[0];
- if ($range > 1) {
- # chose a random id within that range if there is more than one quote
- my $id = int(rand($range));
- # grab it
- $query = 'SELECT * FROM quotes WHERE id = ?;';
- $sth = C4::Context->dbh->prepare($query);
- $sth->execute($id);
- }
- else {
- $query = 'SELECT * FROM quotes;';
- $sth = C4::Context->dbh->prepare($query);
- $sth->execute();
- }
+ # 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 = ?';
}
sub _isbn_cleanup {
- require Business::ISBN;
- my $isbn = Business::ISBN->new( $_[0] );
- if ( $isbn ) {
- $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
- if (defined $isbn) {
- return $isbn->as_string([]);
+ 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;
}
- return;
+
+ # Strip out any "empty" strings from the array
+ @issns = grep { defined($_) && $_ =~ /\S/ } @issns;
+
+ return wantarray ? @issns : join( " | ", @issns );
}
-=head2 Log( $message );
+=head2 GetVariationsOfISSNs
+
+ my @issns = GetVariationsOfISSNs( @issns );
- Writes data to /tmp/koha.log.
+ Returns a list of variations of the given issns in
+ with and without a hyphen.
- This is useful for debugging forked processes
- that do not write to the apache error log
+ In a scalar context, the issns are returned as a
+ string delimited by ' | '.
=cut
-sub Log {
- my ($data) = @_;
- warn $data;
- open my $fh, '>>/tmp/koha.log';
- print $fh "$data\n";
- close $fh;
+sub GetVariationsOfISSNs {
+ my (@issns) = @_;
+
+ @issns = map { GetVariationsOfISSN( $_ ) } @issns;
+
+ return wantarray ? @issns : join( " | ", @issns );
}
+
1;
__END__
projects / koha.git / blobdiff