X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FKoha.pm;h=a15080998a1b9ca1d7459b909d657ffe6f8066e4;hb=9f5a1bc7ebbe3954607da88b87bab6e9c2689dad;hp=2e19bc08ba9a7c8bd2d89277ea387857e8833023;hpb=d85f29661b6455a4920c64a684de4eb3f0c06bcd;p=koha.git diff --git a/C4/Koha.pm b/C4/Koha.pm index 2e19bc08ba..a15080998a 100644 --- a/C4/Koha.pm +++ b/C4/Koha.pm @@ -6,67 +6,49 @@ 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::Cache; +use Koha::Caches; use Koha::DateUtils qw(dt_from_string); +use Koha::AuthorisedValues; +use Koha::Libraries; +use Koha::MarcSubfieldStructures; use DateTime::Format::MySQL; use Business::ISBN; -use autouse 'Data::Dumper' => qw(Dumper); +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 - &GetFrameworksLoop - &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 @@ -76,6 +58,9 @@ BEGIN { &GetVariationsOfISBN &GetVariationsOfISBNs &NormalizeISBN + &GetVariationsOfISSN + &GetVariationsOfISSNs + &NormalizeISSN $DEBUG ); @@ -99,400 +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 +=head2 GetItemTypesCategorized - $itemtypename = &GetSupportName($codestring); + $categories = GetItemTypesCategorized(); -Returns a string with the name of the itemtype. +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 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 =~ /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); - -=head3 in TEMPLATE - -
- - "> - -
- -=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 = getframeworks(); - 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 - -
- - [% FOREACH framework IN frameworkloop %] - [% IF ( framework.selected ) %] - - [% ELSE %] - - [% END %] - [% END %] - - - -
- -=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 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); - -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 @@ -770,11 +395,15 @@ sub getFacets { idx => 'location', label => 'Location', tags => [ qw/ 995e / ], + }, + { + idx => 'ccode', + label => 'CollectionCodes', + tags => [ qw / 099t 955h / ], } ]; - unless ( C4::Context->preference("singleBranchMode") - || GetBranchesCount() == 1 ) + unless ( Koha::Libraries->search->count == 1 ) { my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets'); if ( $DisplayLibraryFacets eq 'both' @@ -785,7 +414,7 @@ sub getFacets { { idx => 'holdingbranch', label => 'HoldingLibrary', - tags => [qw / 995b /], + tags => [qw / 995c /], } ); } @@ -798,7 +427,7 @@ sub getFacets { { idx => 'homebranch', label => 'HomeLibrary', - tags => [qw / 995a /], + tags => [qw / 995b /], } ); } @@ -853,10 +482,14 @@ sub getFacets { label => 'Location', tags => [ qw / 952c / ], }, + { + idx => 'ccode', + label => 'CollectionCodes', + tags => [ qw / 9528 / ], + } ]; - unless ( C4::Context->preference("singleBranchMode") - || GetBranchesCount() == 1 ) + unless ( Koha::Libraries->search->count == 1 ) { my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets'); if ( $DisplayLibraryFacets eq 'both' @@ -889,272 +522,36 @@ sub getFacets { 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. 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 ) = @_; - - # 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. + 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 $selected_key = defined($selected) ? $selected : ''; my $cache_key = - "AuthorisedValues-$category-$selected_key-$opac-$branch_limit"; - my $cache = Koha::Cache->get_instance(); + "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 ) @@ -1172,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' @@ -1182,13 +578,6 @@ 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}; } @@ -1196,137 +585,10 @@ sub GetAuthorisedValues { } $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 - - $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); @@ -1346,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); @@ -1401,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; } @@ -1409,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; } } @@ -1437,123 +658,81 @@ 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 } -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 @@ -1680,6 +859,7 @@ sub NormalizeISBN { elsif ( $format eq 'ISBN-13' ) { $isbn = $isbn->as_isbn13(); } + return unless $isbn; if ($strip_hyphens) { $string = $isbn->as_string( [] ); @@ -1695,7 +875,7 @@ sub NormalizeISBN { my @isbns = GetVariationsOfISBN( $isbn ); - Returns a list of varations of the given isbn in + Returns a list of variations of the given isbn in both ISBN-10 and ISBN-13 formats, with and without hyphens. @@ -1727,7 +907,7 @@ sub GetVariationsOfISBN { my @isbns = GetVariationsOfISBNs( @isbns ); - Returns a list of varations of the given isbns in + Returns a list of variations of the given isbns in both ISBN-10 and ISBN-13 formats, with and without hyphens. @@ -1744,29 +924,92 @@ sub GetVariationsOfISBNs { return wantarray ? @isbns : join( " | ", @isbns ); } -=head2 IsKohaFieldLinked +=head2 NormalizedISSN + + my $issns = NormalizedISSN({ + issn => $issn, + strip_hyphen => [0,1] + }); - my $is_linked = IsKohaFieldLinked({ - kohafield => $kohafield, - frameworkcode => $frameworkcode, - }); + Returns an issn validated by Business::ISSN. + Optionally strips hyphen. - Return 1 if the field is linked + If the string cannot be validated as an issn, + it returns nothing. =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]; +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;