X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FKoha.pm;h=36e81dad192b63064c40f8d726ae449595c1a799;hb=eb04d174d91201b05b6e348dc672f9351dc0aaf0;hp=1b6160a76e3ce02e7b9aca5c46b6e5c4cebfde46;hpb=532b41934c7a573727a4700ed0975a2426d955bb;p=koha.git diff --git a/C4/Koha.pm b/C4/Koha.pm index 1b6160a76e..36e81dad19 100644 --- a/C4/Koha.pm +++ b/C4/Koha.pm @@ -6,51 +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 C4::Branch; # Can be removed? use Koha::Cache; use Koha::DateUtils qw(dt_from_string); +use Koha::Libraries; use DateTime::Format::MySQL; use Business::ISBN; -use autouse 'Data::Dumper' => qw(Dumper); +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 + &GetItemTypesCategorized &GetItemTypesByCategory &GetSupportName &GetSupportList - &get_itemtypeinfos_of &getframeworks &getframeworkinfo &GetFrameworksLoop - &getauthtypes &getauthtype &getallthemes &getFacets - &displayServers &getnbpages &get_infos_of &get_notforloan_label_of @@ -59,14 +54,12 @@ BEGIN { &getitemtypeimagelocation &GetAuthorisedValues &GetAuthorisedValueCategories - &IsAuthorisedValueCategory &GetKohaAuthorisedValues &GetKohaAuthorisedValuesFromField + &GetKohaAuthorisedValuesMapping &GetKohaAuthorisedValueLib &GetAuthorisedValueByCode - &GetKohaImageurlFromAuthorisedValues &GetAuthValCode - &AddAuthorisedValue &GetNormalizedUPC &GetNormalizedISBN &GetNormalizedEAN @@ -99,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); @@ -193,14 +158,7 @@ build a HTML select with the following code : 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({}); + return GetItemTypes( style => 'array' ); } else { my $advsearchtypes = GetAuthorisedValues($advanced_search_types); my @results= map {{itemtype=>$$_{authorised_value},description=>$$_{lib},imageurl=>$$_{imageurl}}} @$advsearchtypes; @@ -253,102 +211,96 @@ 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; + $sth->execute( $language ); if ( $style eq 'hash' ) { + my %itemtypes; while ( my $IT = $sth->fetchrow_hashref ) { $itemtypes{ $IT->{'itemtype'} } = $IT; } return ( \%itemtypes ); } else { - return $sth->fetchall_arrayref({}); + return [ sort { lc $a->{translated_description} cmp lc $b->{translated_description} } @{ $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(); +=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; +sub GetItemTypesByCategory { + my ($category) = @_; + my $count = 0; + my @results; 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; + my $query = qq|SELECT itemtype FROM itemtypes WHERE searchcategory=?|; + my $tmp=$dbh->selectcol_arrayref($query,undef,$category); + return @$tmp; } =head2 getframework @@ -485,14 +437,31 @@ Defaults to intranet. 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; + 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( ( ( defined $interface && $interface eq 'opac' ) ? 'opac' : 'intranet' ), $res->{imageurl} ); + $it->{imageurl} = getitemtypeimagelocation( ( ( defined $interface && $interface eq 'opac' ) ? 'opac' : 'intranet' ), $it->{imageurl} ); - return $res; + return $it; } =head2 getitemtypeimagedir @@ -773,8 +742,7 @@ sub getFacets { } ]; - unless ( C4::Context->preference("singleBranchMode") - || GetBranchesCount() == 1 ) + unless ( Koha::Libraries->search->count == 1 ) { my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets'); if ( $DisplayLibraryFacets eq 'both' @@ -855,8 +823,7 @@ sub getFacets { }, ]; - unless ( C4::Context->preference("singleBranchMode") - || GetBranchesCount() == 1 ) + unless ( Koha::Libraries->search->count == 1 ) { my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets'); if ( $DisplayLibraryFacets eq 'both' @@ -989,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' => '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); @@ -1223,28 +1104,6 @@ sub GetAuthorisedValueCategories { 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 ); @@ -1327,6 +1186,50 @@ sub GetKohaAuthorisedValuesFromField { } } +=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); @@ -1367,26 +1270,6 @@ sub GetKohaAuthorisedValueLib { 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 +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; } @@ -1409,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; } } @@ -1437,83 +1320,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 } sub GetAuthvalueDropbox { @@ -1680,6 +1559,7 @@ sub NormalizeISBN { elsif ( $format eq 'ISBN-13' ) { $isbn = $isbn->as_isbn13(); } + return unless $isbn; if ($strip_hyphens) { $string = $isbn->as_string( [] ); @@ -1695,7 +1575,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 +1607,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.