# along with Koha; if not, see <http://www.gnu.org/licenses>.
-use strict;
-#use warnings; FIXME - Bug 2505
+use Modern::Perl;
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);
+our (@ISA, @EXPORT_OK);
BEGIN {
- require Exporter;
- @ISA = qw(Exporter);
- @EXPORT = qw(
- &GetPrinters &GetPrinter
- &GetItemTypes &getitemtypeinfo
- &GetItemTypesCategorized &GetItemTypesByCategory
- &getframeworkinfo
- &getallthemes
- &getFacets
- &getnbpages
- &get_infos_of
- &get_notforloan_label_of
- &getitemtypeimagedir
- &getitemtypeimagesrc
- &getitemtypeimagelocation
- &GetAuthorisedValues
- &GetAuthorisedValueCategories
- &GetNormalizedUPC
- &GetNormalizedISBN
- &GetNormalizedEAN
- &GetNormalizedOCLCNumber
- &xml_escape
-
- &GetVariationsOfISBN
- &GetVariationsOfISBNs
- &NormalizeISBN
- &GetVariationsOfISSN
- &GetVariationsOfISSNs
- &NormalizeISSN
-
- $DEBUG
- );
- $DEBUG = 0;
-@EXPORT_OK = qw( GetDailyQuote );
+ require Exporter;
+ @ISA = qw(Exporter);
+ @EXPORT_OK = qw(
+ GetItemTypesCategorized
+ getallthemes
+ getFacets
+ getImageSets
+ getnbpages
+ getitemtypeimagedir
+ getitemtypeimagesrc
+ getitemtypeimagelocation
+ GetAuthorisedValues
+ GetNormalizedUPC
+ GetNormalizedISBN
+ GetNormalizedEAN
+ GetNormalizedOCLCNumber
+ xml_escape
+
+ GetVariationsOfISBN
+ GetVariationsOfISBNs
+ NormalizeISBN
+ GetVariationsOfISSN
+ GetVariationsOfISSNs
+ NormalizeISSN
+
+ );
}
=head1 NAME
=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
-
- <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
- <select name="itemtype">
- <option value="">Default</option>
- <!-- TMPL_LOOP name="itemtypeloop" -->
- <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
- <!-- /TMPL_LOOP -->
- </select>
- <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
- <input type="submit" value="OK" class="button">
- </form>
-
-=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();
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,
+ COALESCE(authorised_values.lib_opac,authorised_values.lib) AS description,
authorised_values.imageurl AS imageurl,
hideinopac, 1 as 'iscat'
FROM itemtypes
WHERE searchcategory > '' and hideinopac=1
UNION
SELECT DISTINCT searchcategory AS `itemtype`,
- authorised_values.lib_opac AS description,
+ COALESCE(authorised_values.lib_opac,authorised_values.lib) AS description,
authorised_values.imageurl AS imageurl,
hideinopac, 1 as 'iscat'
FROM itemtypes
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 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' );
my @imagesets = (); # list of hasrefs of image set data to pass to template
my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
foreach my $imagesubdir ( @subdirectories ) {
- warn $imagesubdir if $DEBUG;
my @imagelist = (); # hashrefs of image info
my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
my $imagesetactive = 0;
return \@imagesets;
}
-=head2 GetPrinters
-
- $printers = &GetPrinters();
- @queues = keys %$printers;
-
-Returns information about existing printer queues.
-
-C<$printers> is a reference-to-hash whose keys are the print queues
-defined in the printers table of the Koha database. The values are
-references-to-hash, whose keys are the fields in the printers table.
-
-=cut
-
-sub GetPrinters {
- my %printers;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("select * from printers");
- $sth->execute;
- while ( my $printer = $sth->fetchrow_hashref ) {
- $printers{ $printer->{'printqueue'} } = $printer;
- }
- return ( \%printers );
-}
-
-=head2 GetPrinter
-
- $printer = GetPrinter( $query, $printers );
-
-=cut
-
-sub GetPrinter {
- my ( $query, $printers ) = @_; # get printer for this query from printers
- my $printer = $query->param('printer');
- my %cookie = $query->cookie('userenv');
- ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
- ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
- return $printer;
-}
-
=head2 getnbpages
Returns the number of pages to display in a pagination bar, given the number
sep => ' - ',
},
{
- idx => 'su-ut',
- label => 'Titles',
- tags => [ qw/ 500a 501a 503a / ],
- sep => ', ',
- },
- {
idx => 'au',
label => 'Authors',
tags => [ qw/ 700ab 701ab 702ab / ],
idx => 'location',
label => 'Location',
tags => [ qw/ 995e / ],
+ },
+ {
+ idx => 'ccode',
+ label => 'CollectionCodes',
+ tags => [ qw / 099t 955h / ],
}
];
label => 'Location',
tags => [ qw / 952c / ],
},
+ {
+ idx => 'ccode',
+ label => 'CollectionCodes',
+ tags => [ qw / 9528 / ],
+ }
];
unless ( Koha::Libraries->search->count == 1 )
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<execute()> 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 GetAuthorisedValues
$authvalues = GetAuthorisedValues([$category]);
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 xml_escape
my $escaped_string = C4::Koha::xml_escape($string);
my @fields = $marcrecord->field('035');
foreach my $field (@fields) {
my $oclc = $field->subfield('a');
- if ($oclc =~ /OCoLC/) {
+ if ($oclc && $oclc =~ /OCoLC/) {
$oclc =~ s/\(OCoLC\)//;
return $oclc;
}
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
-
-Currently supported options are:
-
-'id' An exact quote id
-'random' Select a random quote
-noop When no option is passed in, this sub will return the quote timestamped for the current day
-
-The function returns an anonymous hash following this format:
-
- {
- 'source' => 'source-of-quote',
- 'timestamp' => 'timestamp-value',
- 'text' => 'text-of-quote',
- 'id' => 'quote-id'
- };
-
-=cut
-
-# This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
-# at least for default option
-
-sub GetDailyQuote {
- my %opts = @_;
- my $dbh = C4::Context->dbh;
- my $query = '';
- my $sth = undef;
- my $quote = undef;
- if ($opts{'id'}) {
- $query = 'SELECT * FROM quotes WHERE id = ?';
- $sth = $dbh->prepare($query);
- $sth->execute($opts{'id'});
- $quote = $sth->fetchrow_hashref();
- }
- elsif ($opts{'random'}) {
- # Fall through... we also return a random quote as a catch-all if all else fails
- }
- else {
- $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
- $sth = $dbh->prepare($query);
- $sth->execute();
- $quote = $sth->fetchrow_hashref();
- }
- unless ($quote) { # if there are not matches, choose a random quote
- # get a list of all available quote ids
- $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
- $sth->execute;
- my $range = ($sth->fetchrow_array)[0];
- # chose a random id within that range if there is more than one quote
- my $offset = int(rand($range));
- # grab it
- $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
- $sth = C4::Context->dbh->prepare($query);
- # see http://www.perlmonks.org/?node_id=837422 for why
- # we're being verbose and using bind_param
- $sth->bind_param(1, $offset, SQL_INTEGER);
- $sth->execute();
- $quote = $sth->fetchrow_hashref();
- # update the timestamp for that quote
- $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
- $sth = C4::Context->dbh->prepare($query);
- $sth->execute(
- DateTime::Format::MySQL->format_datetime( dt_from_string() ),
- $quote->{'id'}
- );
- }
- return $quote;
-}
-
sub _normalize_match_point {
my $match_point = shift;
(my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
) if $isbn;
}
-=head2 NormalizedISBN
+=head2 NormalizeISBN
- my $isbns = NormalizedISBN({
+ my $isbns = NormalizeISBN({
isbn => $isbn,
strip_hyphens => [0,1],
format => ['ISBN-10', 'ISBN-13']
to be of the specified format.
If the string cannot be validated as an isbn,
- it returns nothing.
+ it returns nothing unless return_invalid param is passed.
+
+ #FIXME This routine (and others?) should be moved to Koha::Util::Normalize
=cut
my $string = $params->{isbn};
my $strip_hyphens = $params->{strip_hyphens};
- my $format = $params->{format};
+ my $format = $params->{format} || q{};
+ my $return_invalid = $params->{return_invalid};
return unless $string;
if ( $isbn && $isbn->is_valid() ) {
if ( $format eq 'ISBN-10' ) {
- $isbn = $isbn->as_isbn10();
+ $isbn = $isbn->as_isbn10();
}
elsif ( $format eq 'ISBN-13' ) {
$isbn = $isbn->as_isbn13();
}
return $string;
+ } elsif ( $return_invalid ) {
+ return $string;
}
+
}
=head2 GetVariationsOfISBN
my @isbns;
- push( @isbns, NormalizeISBN({ isbn => $isbn }) );
+ push( @isbns, NormalizeISBN({ isbn => $isbn, return_invalid => 1 }) );
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 }) );
return wantarray ? @issns : join( " | ", @issns );
}
-
-=head2 IsKohaFieldLinked
-
- my $is_linked = IsKohaFieldLinked({
- kohafield => $kohafield,
- frameworkcode => $frameworkcode,
- });
-
- Return 1 if the field is linked
-
-=cut
-
-sub IsKohaFieldLinked {
- my ( $params ) = @_;
- my $kohafield = $params->{kohafield};
- my $frameworkcode = $params->{frameworkcode} || '';
- my $dbh = C4::Context->dbh;
- my $is_linked = $dbh->selectcol_arrayref( q|
- SELECT COUNT(*)
- FROM marc_subfield_structure
- WHERE frameworkcode = ?
- AND kohafield = ?
- |,{}, $frameworkcode, $kohafield );
- return $is_linked->[0];
-}
-
1;
__END__
projects / srvgit / blobdiff