X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FKoha.pm;h=a15080998a1b9ca1d7459b909d657ffe6f8066e4;hb=12a8dfb934bf3819d6581f9df82987475334a302;hp=f3ffcc3a0df93828bde697b9ac7ee8274f8abf99;hpb=5a3db23362eb076a2f6d5a87f87b29f4a436a14f;p=koha.git diff --git a/C4/Koha.pm b/C4/Koha.pm index f3ffcc3a0d..a15080998a 100644 --- a/C4/Koha.pm +++ b/C4/Koha.pm @@ -6,80 +6,68 @@ 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 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 Business::ISBN; +use Business::ISSN; +use autouse 'Data::cselectall_arrayref' => qw(Dumper); use DBI qw(:sql_types); - -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $DEBUG); +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 @@ -96,346 +84,40 @@ 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); - -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 - - - -=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(); -
- - "> - -
+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 - -
- - "> - -
- - -=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 - -
- - "> - -
- -=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 @@ -712,19 +394,44 @@ sub getFacets { { 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 = [ @@ -775,250 +482,49 @@ sub getFacets { 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 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. @@ -1029,13 +535,23 @@ C<$opac> If set to a true value, displays OPAC descriptions rather than normal o =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 ) @@ -1053,7 +569,6 @@ sub GetAuthorisedValues { 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' @@ -1063,146 +578,17 @@ sub GetAuthorisedValues { $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); @@ -1222,47 +608,6 @@ sub xml_escape { 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); @@ -1277,7 +622,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; } @@ -1285,25 +630,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; } } @@ -1313,83 +658,79 @@ 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 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) @@ -1442,22 +783,15 @@ 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 $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(); - } - 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 = ?'; @@ -1479,15 +813,203 @@ 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 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;