X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FKoha.pm;h=f547fe018ee08b0a4822f9bb98f6da8dd312de1f;hb=f839955db707415368d23ae81bdb14505dd058ee;hp=a455039540d8b08c2d5569804d9ba0bdbda92f79;hpb=15506a7569145cf566aab28e1b7639be56058a26;p=koha.git
diff --git a/C4/Koha.pm b/C4/Koha.pm
index a455039540..f547fe018e 100644
--- a/C4/Koha.pm
+++ b/C4/Koha.pm
@@ -26,10 +26,12 @@ use strict;
use C4::Context;
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 Business::ISSN;
use autouse 'Data::cselectall_arrayref' => qw(Dumper);
use DBI qw(:sql_types);
use vars qw(@ISA @EXPORT @EXPORT_OK $DEBUG);
@@ -38,25 +40,15 @@ BEGIN {
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(
- &GetPrinters &GetPrinter
- &GetItemTypes &getitemtypeinfo
- &GetItemTypesCategorized &GetItemTypesByCategory
- &getframeworks &getframeworkinfo
- &GetFrameworksLoop
- &getallthemes
- &getFacets
- &getnbpages
- &get_infos_of
- &get_notforloan_label_of
+ &GetPrinters &GetPrinter
+ &GetItemTypesCategorized
+ &getallthemes
+ &getFacets
+ &getnbpages
&getitemtypeimagedir
&getitemtypeimagesrc
&getitemtypeimagelocation
&GetAuthorisedValues
- &GetAuthorisedValueCategories
- &GetKohaAuthorisedValues
- &GetKohaAuthorisedValuesMapping
- &GetAuthorisedValueByCode
- &GetAuthValCode
&GetNormalizedUPC
&GetNormalizedISBN
&GetNormalizedEAN
@@ -66,6 +58,9 @@ BEGIN {
&GetVariationsOfISBN
&GetVariationsOfISBNs
&NormalizeISBN
+ &GetVariationsOfISSN
+ &GetVariationsOfISSNs
+ &NormalizeISSN
$DEBUG
);
@@ -89,90 +84,6 @@ Koha.pm provides many functions for Koha scripts.
=cut
-=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';
-
- require C4::Languages;
- my $language = C4::Languages::getlanguage();
- # returns a reference to a hash of references to itemtypes...
- my $dbh = C4::Context->dbh;
- 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( $language );
-
- 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( {} ) } ];
- }
-}
-
=head2 GetItemTypesCategorized
$categories = GetItemTypesCategorized();
@@ -209,185 +120,6 @@ sub GetItemTypesCategorized {
return ($dbh->selectall_hashref($query,'itemtype'));
}
-=head2 GetItemTypesByCategory
-
- @results = GetItemTypesByCategory( $searchcategory );
-
-Returns the itemtype code of all itemtypes included in a searchcategory.
-
-=cut
-
-sub GetItemTypesByCategory {
- my ($category) = @_;
- my $count = 0;
- my @results;
- my $dbh = C4::Context->dbh;
- my $query = qq|SELECT itemtype FROM itemtypes WHERE searchcategory=?|;
- my $tmp=$dbh->selectcol_arrayref($query,undef,$category);
- return @$tmp;
-}
-
-=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
-
-
-
-=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()
-
-
-
-=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;
- 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 );
-
- $it->{imageurl} = getitemtypeimagelocation( ( ( defined $interface && $interface eq 'opac' ) ? 'opac' : 'intranet' ), $it->{imageurl} );
-
- return $it;
-}
-
=head2 getitemtypeimagedir
my $directory = getitemtypeimagedir( 'opac' );
@@ -780,122 +512,6 @@ 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 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 GetAuthorisedValues
$authvalues = GetAuthorisedValues([$category]);
@@ -963,121 +579,6 @@ sub GetAuthorisedValues {
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;
- }
- return \@results;
-}
-
-=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 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);
@@ -1222,44 +723,6 @@ sub GetNormalizedOCLCNumber {
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
@@ -1451,6 +914,95 @@ sub GetVariationsOfISBNs {
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 );
+}
+
+
=head2 IsKohaFieldLinked
my $is_linked = IsKohaFieldLinked({