X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FKoha.pm;h=36e81dad192b63064c40f8d726ae449595c1a799;hb=eb04d174d91201b05b6e348dc672f9351dc0aaf0;hp=4d98fd519cbd1ac1b4697e7582512c19abcdc2d1;hpb=a42e5e6d3e21cfdd73554465229dd3801aacf017;p=koha.git diff --git a/C4/Koha.pm b/C4/Koha.pm index 4d98fd519c..36e81dad19 100644 --- a/C4/Koha.pm +++ b/C4/Koha.pm @@ -6,49 +6,46 @@ package C4::Koha; # # 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 . use strict; #use warnings; FIXME - Bug 2505 use C4::Context; -use C4::Branch qw(GetBranchesCount); -use Memoize; -use DateTime; +use C4::Branch; # Can be removed? +use Koha::Cache; +use Koha::DateUtils qw(dt_from_string); +use Koha::Libraries; use DateTime::Format::MySQL; -use autouse 'Data::Dumper' => qw(Dumper); - -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $DEBUG); +use Business::ISBN; +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 - &GetCcodes + &GetItemTypesCategorized &GetItemTypesByCategory &GetSupportName &GetSupportList - &get_itemtypeinfos_of &getframeworks &getframeworkinfo - &getauthtypes &getauthtype + &GetFrameworksLoop &getallthemes &getFacets - &displayServers &getnbpages &get_infos_of &get_notforloan_label_of @@ -59,9 +56,9 @@ BEGIN { &GetAuthorisedValueCategories &GetKohaAuthorisedValues &GetKohaAuthorisedValuesFromField + &GetKohaAuthorisedValuesMapping &GetKohaAuthorisedValueLib &GetAuthorisedValueByCode - &GetKohaImageurlFromAuthorisedValues &GetAuthValCode &GetNormalizedUPC &GetNormalizedISBN @@ -69,15 +66,16 @@ BEGIN { &GetNormalizedOCLCNumber &xml_escape + &GetVariationsOfISBN + &GetVariationsOfISBNs + &NormalizeISBN + $DEBUG ); $DEBUG = 0; @EXPORT_OK = qw( GetDailyQuote ); } -# expensive functions -memoize('GetAuthorisedValues'); - =head1 NAME C4::Koha - Perl Module containing convenience functions for Koha scripts @@ -94,34 +92,6 @@ Koha.pm provides many 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); @@ -172,30 +142,23 @@ build a HTML select with the following code : =head3 in TEMPLATE -
- - "> - -
+ =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({}); + if (!$advanced_search_types or $advanced_search_types =~ /itemtypes/) { + return GetItemTypes( style => 'array' ); } else { my $advsearchtypes = GetAuthorisedValues($advanced_search_types); my @results= map {{itemtype=>$$_{authorised_value},description=>$$_{lib},imageurl=>$$_{imageurl}}} @$advsearchtypes; @@ -204,10 +167,15 @@ sub GetSupportList{ } =head2 GetItemTypes - $itemtypes = &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 @@ -240,119 +208,99 @@ build a HTML select with the following code : =cut sub GetItemTypes { + my ( %params ) = @_; + my $style = defined( $params{'style'} ) ? $params{'style'} : 'hash'; + require C4::Languages; + my $language = C4::Languages::getlanguage(); # returns a reference to a hash of references to itemtypes... - my %itemtypes; my $dbh = C4::Context->dbh; - my $query = qq| - SELECT * + my $query = q| + SELECT + itemtypes.itemtype, + itemtypes.description, + itemtypes.rentalcharge, + itemtypes.notforloan, + itemtypes.imageurl, + itemtypes.summary, + itemtypes.checkinmsg, + itemtypes.checkinmsgtype, + itemtypes.sip_media_type, + itemtypes.hideinopac, + itemtypes.searchcategory, + COALESCE( localization.translation, itemtypes.description ) AS translated_description FROM itemtypes + LEFT JOIN localization ON itemtypes.itemtype = localization.code + AND localization.entity = 'itemtypes' + AND localization.lang = ? + ORDER BY itemtype |; 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 = @_; + $sth->execute( $language ); - 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"; + if ( $style eq 'hash' ) { + my %itemtypes; + while ( my $IT = $sth->fetchrow_hashref ) { + $itemtypes{ $IT->{'itemtype'} } = $IT; } + return ( \%itemtypes ); + } else { + return [ sort { lc $a->{translated_description} cmp lc $b->{translated_description} } @{ $sth->fetchall_arrayref( {} ) } ]; } - $sth->finish; - return ( $count, @results ); } -=head2 getauthtypes - - $authtypes = &getauthtypes(); +=head2 GetItemTypesCategorized -Returns information about existing authtypes. + $categories = GetItemTypesCategorized(); -build a HTML select with the following code : +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) -=head3 in PERL SCRIPT +=cut - 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); +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')); +} -=head3 in TEMPLATE +=head2 GetItemTypesByCategory -
- - "> - -
+ @results = GetItemTypesByCategory( $searchcategory ); +Returns the itemtype code of all itemtypes included in a searchcategory. =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; +sub GetItemTypesByCategory { + my ($category) = @_; + my $count = 0; + my @results; 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; + my $query = qq|SELECT itemtype FROM itemtypes WHERE searchcategory=?|; + my $tmp=$dbh->selectcol_arrayref($query,undef,$category); + return @$tmp; } =head2 getframework @@ -365,12 +313,13 @@ build a HTML select with the following code : =head3 in PERL SCRIPT - my $frameworks = frameworks(); + my $frameworks = getframeworks(); my @frameworkloop; foreach my $thisframework (keys %$frameworks) { my $selected = 1 if $thisframework eq $frameworkcode; - my %row =(value => $thisframework, - selected => $selected, + my %row =( + value => $thisframework, + selected => $selected, description => $frameworks->{$thisframework}->{'frameworktext'}, ); push @frameworksloop, \%row; @@ -379,14 +328,18 @@ build a HTML select with the following code : =head3 in TEMPLATE -
+ - - - + [% FOREACH framework IN frameworkloop %] + [% IF ( framework.selected ) %] + + [% ELSE %] + + [% END %] + [% END %] - "> +
@@ -405,6 +358,55 @@ sub getframeworks { return ( \%itemtypes ); } +=head2 GetFrameworksLoop + + $frameworks = GetFrameworksLoop( $frameworkcode ); + +Returns the loop suggested on getframework(), but ordered by framework description. + +build a HTML select with the following code : + +=head3 in PERL SCRIPT + + $template->param( frameworkloop => GetFrameworksLoop( $frameworkcode ) ); + +=head3 in TEMPLATE + + Same as getframework() + +
+ + [% FOREACH framework IN frameworkloop %] + [% IF ( framework.selected ) %] + + [% ELSE %] + + [% END %] + [% END %] + + + +
+ +=cut + +sub GetFrameworksLoop { + my $frameworkcode = shift; + my $frameworks = getframeworks(); + my @frameworkloop; + foreach my $thisframework (sort { uc($frameworks->{$a}->{'frameworktext'}) cmp uc($frameworks->{$b}->{'frameworktext'}) } keys %$frameworks) { + my $selected = ( $thisframework eq $frameworkcode ) ? 1 : undef; + my %row = ( + value => $thisframework, + selected => $selected, + description => $frameworks->{$thisframework}->{'frameworktext'}, + ); + push @frameworkloop, \%row; + } + return \@frameworkloop; +} + =head2 getframeworkinfo $frameworkinfo = &getframeworkinfo($frameworkcode); @@ -425,22 +427,41 @@ sub getframeworkinfo { =head2 getitemtypeinfo - $itemtype = &getitemtype($itemtype); + $itemtype = &getitemtypeinfo($itemtype, [$interface]); -Returns information about an itemtype. +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) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("select * from itemtypes where itemtype=?"); - $sth->execute($itemtype); - my $res = $sth->fetchrow_hashref; + my ($itemtype, $interface) = @_; + my $dbh = C4::Context->dbh; + require C4::Languages; + my $language = C4::Languages::getlanguage(); + my $it = $dbh->selectrow_hashref(q| + SELECT + itemtypes.itemtype, + itemtypes.description, + itemtypes.rentalcharge, + itemtypes.notforloan, + itemtypes.imageurl, + itemtypes.summary, + itemtypes.checkinmsg, + itemtypes.checkinmsgtype, + itemtypes.sip_media_type, + COALESCE( localization.translation, itemtypes.description ) AS translated_description + FROM itemtypes + LEFT JOIN localization ON itemtypes.itemtype = localization.code + AND localization.entity = 'itemtypes' + AND localization.lang = ? + WHERE itemtypes.itemtype = ? + |, undef, $language, $itemtype ); - $res->{imageurl} = getitemtypeimagelocation( 'intranet', $res->{imageurl} ); + $it->{imageurl} = getitemtypeimagelocation( ( ( defined $interface && $interface eq 'opac' ) ? 'opac' : 'intranet' ), $it->{imageurl} ); - return $res; + return $it; } =head2 getitemtypeimagedir @@ -471,7 +492,7 @@ sub getitemtypeimagesrc { } } -sub getitemtypeimagelocation($$) { +sub getitemtypeimagelocation { my ( $src, $image ) = @_; return '' if ( !$image ); @@ -630,7 +651,7 @@ sub GetPrinters { =cut -sub GetPrinter ($$) { +sub GetPrinter { my ( $query, $printers ) = @_; # get printer for this query from printers my $printer = $query->param('printer'); my %cookie = $query->cookie('userenv'); @@ -687,26 +708,26 @@ sub getFacets { { idx => 'su-to', label => 'Topics', - tags => [ qw/ 600a 601a 602a 603a 604a 605a 606ax 610a/ ], + tags => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ], sep => ' - ', }, { idx => 'su-geo', label => 'Places', - tags => [ qw/ 651a / ], + tags => [ qw/ 607a / ], sep => ' - ', }, { idx => 'su-ut', label => 'Titles', - tags => [ qw/ 500a 501a 502a 503a 504a / ], + tags => [ qw/ 500a 501a 503a / ], sep => ', ', }, { idx => 'au', label => 'Authors', tags => [ qw/ 700ab 701ab 702ab / ], - sep => ', ', + sep => C4::Context->preference("UNIMARCAuthorsFacetsSeparator"), }, { idx => 'se', @@ -714,23 +735,42 @@ sub getFacets { tags => [ qw/ 225a / ], sep => ', ', }, + { + idx => 'location', + label => 'Location', + tags => [ qw/ 995e / ], + } ]; - my $library_facet; - unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) { - $library_facet = { - idx => 'branch', - label => 'Libraries', - tags => [ qw/ 995b / ], - }; - } else { - $library_facet = { - idx => 'location', - label => 'Location', - tags => [ qw/ 995c / ], - }; + 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 = [ @@ -776,23 +816,42 @@ sub getFacets { tags => [ qw/ 952y 942c / ], sep => ', ', }, + { + idx => 'location', + label => 'Location', + tags => [ qw / 952c / ], + }, ]; - my $library_facet; - unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) { - $library_facet = { - idx => 'branch', - label => 'Libraries', - tags => [ qw / 952b / ], - }; - } else { - $library_facet = { - 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 /], + } + ); + } } - push( @$facets, $library_facet ); } return $facets; } @@ -897,92 +956,6 @@ SELECT lib, 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); @@ -1031,33 +1004,84 @@ This function returns all authorised values from the'authorised_value' table in C<$category> returns authorised values for just one category (optional). +C<$selected> adds a "selected => 1" entry to the hash if the +authorised_value matches it. B this feature should be considered +deprecated as it may be removed in the future. + 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 ( $category, $selected, $opac ) = @_; + + # TODO: the "selected" feature should be replaced by a utility function + # somewhere else, it doesn't belong in here. For starters it makes + # caching much more complicated. Or just let the UI logic handle it, it's + # what it's for. + + # Is this cached already? + $opac = $opac ? 1 : 0; # normalise to be safe + my $branch_limit = + C4::Context->userenv ? C4::Context->userenv->{"branch"} : ""; + my $selected_key = defined($selected) ? $selected : ''; + my $cache_key = + "AuthorisedValues-$category-$selected_key-$opac-$branch_limit"; + my $cache = Koha::Cache->get_instance(); + my $result = $cache->get_from_cache($cache_key); + return $result if $result; + 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 $query = qq{ + SELECT * + FROM authorised_values + }; + $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 .= " GROUP BY lib"; + $query .= ' ORDER BY category, ' . ( + $opac ? 'COALESCE(lib_opac, lib)' + : 'lib, lib_opac' + ); + my $sth = $dbh->prepare($query); - $sth->execute; + + $sth->execute( @where_args ); while (my $data=$sth->fetchrow_hashref) { - if ( (defined($selected)) && ($selected eq $data->{'authorised_value'}) ) { - $data->{'selected'} = 1; + if ( defined $selected and $selected eq $data->{authorised_value} ) { + $data->{selected} = 1; } else { - $data->{'selected'} = 0; + $data->{selected} = 0; } - if ($opac && $data->{'lib_opac'}) { - $data->{'lib'} = $data->{'lib_opac'}; + + if ($opac && $data->{lib_opac}) { + $data->{lib} = $data->{lib_opac}; } push @results, $data; } - #my $data = $sth->fetchall_arrayref({}); - return \@results; #$data; + $sth->finish; + + # We can't cache for long because of that "selected" thing which + # makes it impossible to clear the cache without iterating through every + # value, which sucks. This'll cover this request, and not a whole lot more. + $cache->set_in_cache( $cache_key, \@results, { deepcopy => 1, expiry => 5 } ); + return \@results; } =head2 GetAuthorisedValueCategories @@ -1082,7 +1106,7 @@ sub GetAuthorisedValueCategories { =head2 GetAuthorisedValueByCode -$authhorised_value = GetAuthorisedValueByCode( $category, $authvalcode ); +$authorised_value = GetAuthorisedValueByCode( $category, $authvalcode, $opac ); Return the lib attribute from authorised_values from the row identified by the passed category and code @@ -1127,7 +1151,7 @@ sub GetKohaAuthorisedValues { } return \%values; } else { - return undef; + return; } } @@ -1158,10 +1182,54 @@ sub GetKohaAuthorisedValuesFromField { } return \%values; } else { - return undef; + return; } } +=head2 GetKohaAuthorisedValuesMapping + +Takes a hash as a parameter. The interface key indicates the +description to use in the mapping. + +Returns hashref of: + "{kohafield},{frameworkcode},{authorised_value}" => "{description}" +for all the kohafields, frameworkcodes, and authorised values. + +Returns undef if nothing is found. + +=cut + +sub GetKohaAuthorisedValuesMapping { + my ($parameter) = @_; + my $interface = $parameter->{'interface'} // ''; + + my $query_mapping = q{ +SELECT TA.kohafield,TA.authorised_value AS category, + TA.frameworkcode,TB.authorised_value, + IF(TB.lib_opac>'',TB.lib_opac,TB.lib) AS OPAC, + TB.lib AS Intranet,TB.lib_opac +FROM marc_subfield_structure AS TA JOIN + authorised_values as TB ON + TA.authorised_value=TB.category +WHERE TA.kohafield>'' AND TA.authorised_value>''; + }; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare($query_mapping); + $sth->execute(); + my $avmapping; + if ($interface eq 'opac') { + while (my $row = $sth->fetchrow_hashref) { + $avmapping->{$row->{kohafield}.",".$row->{frameworkcode}.",".$row->{authorised_value}} = $row->{OPAC}; + } + } + else { + while (my $row = $sth->fetchrow_hashref) { + $avmapping->{$row->{kohafield}.",".$row->{frameworkcode}.",".$row->{authorised_value}} = $row->{Intranet}; + } + } + return $avmapping; +} + =head2 xml_escape my $escaped_string = C4::Koha::xml_escape($string); @@ -1216,7 +1284,7 @@ MARC field, replacing any blanks with '#'. 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; } @@ -1224,25 +1292,25 @@ sub display_marc_indicators { } 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; } } @@ -1252,85 +1320,119 @@ sub GetNormalizedUPC { # 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 undef 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 undef; } } } 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 undef; } } } } 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 undef; } } + } else { + # TODO for UNIMARC + } + return +} + +sub GetAuthvalueDropbox { + my ( $authcat, $default ) = @_; + my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : ""; + my $dbh = C4::Context->dbh; + + my $query = qq{ + SELECT * + FROM authorised_values + }; + $query .= qq{ + LEFT JOIN authorised_values_branches ON ( id = av_id ) + } if $branch_limit; + $query .= qq{ + WHERE category = ? + }; + $query .= " AND ( branchcode = ? OR branchcode IS NULL )" if $branch_limit; + $query .= " GROUP BY lib ORDER BY category, lib, lib_opac"; + my $sth = $dbh->prepare($query); + $sth->execute( $authcat, $branch_limit ? $branch_limit : () ); + + + my $option_list = []; + my @authorised_values = ( q{} ); + while (my $av = $sth->fetchrow_hashref) { + push @{$option_list}, { + value => $av->{authorised_value}, + label => $av->{lib}, + default => ($default eq $av->{authorised_value}), + }; + } + + if ( @{$option_list} ) { + return $option_list; } + return; } + =head2 GetDailyQuote($opts) Takes a hashref of options @@ -1381,24 +1483,23 @@ sub GetDailyQuote { $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 = ?'; $sth = C4::Context->dbh->prepare($query); - $sth->execute(DateTime::Format::MySQL->format_datetime(DateTime->now), $quote->{'id'}); + $sth->execute( + DateTime::Format::MySQL->format_datetime( dt_from_string() ), + $quote->{'id'} + ); } return $quote; } @@ -1412,15 +1513,140 @@ sub _normalize_match_point { } 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; } - return; +} + +=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 IsKohaFieldLinked + + my $is_linked = IsKohaFieldLinked({ + kohafield => $kohafield, + frameworkcode => $frameworkcode, + }); + + Return 1 if the field is linked + +=cut + +sub IsKohaFieldLinked { + my ( $params ) = @_; + my $kohafield = $params->{kohafield}; + my $frameworkcode = $params->{frameworkcode} || ''; + my $dbh = C4::Context->dbh; + my $is_linked = $dbh->selectcol_arrayref( q| + SELECT COUNT(*) + FROM marc_subfield_structure + WHERE frameworkcode = ? + AND kohafield = ? + |,{}, $frameworkcode, $kohafield ); + return $is_linked->[0]; } 1;