3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright 2010 Nelsonville Public Library
5 # Parts copyright 2010 BibLibre
7 # This file is part of Koha.
9 # Koha is free software; you can redistribute it and/or modify it
10 # under the terms of the GNU General Public License as published by
11 # the Free Software Foundation; either version 3 of the License, or
12 # (at your option) any later version.
14 # Koha is distributed in the hope that it will be useful, but
15 # WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 # GNU General Public License for more details.
19 # You should have received a copy of the GNU General Public License
20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
27 use Koha::AuthorisedValues;
29 use Koha::MarcSubfieldStructures;
32 use autouse 'Data::cselectall_arrayref' => qw(Dumper);
33 use vars qw(@ISA @EXPORT @EXPORT_OK);
39 &GetItemTypesCategorized
45 &getitemtypeimagelocation
50 &GetNormalizedOCLCNumber
65 C4::Koha - Perl Module containing convenience functions for Koha scripts
73 Koha.pm provides many functions for Koha scripts.
79 =head2 GetItemTypesCategorized
81 $categories = GetItemTypesCategorized();
83 Returns a hashref containing search categories.
84 A search category will be put in the hash if at least one of its itemtypes is visible in OPAC.
85 The categories must be part of Authorized Values (ITEMTYPECAT)
89 sub GetItemTypesCategorized {
90 my $dbh = C4::Context->dbh;
91 # Order is important, so that partially hidden (some items are not visible in OPAC) search
92 # categories will be visible. hideinopac=0 must be last.
94 SELECT itemtype, description, imageurl, hideinopac, 0 as 'iscat' FROM itemtypes WHERE ISNULL(searchcategory) or length(searchcategory) = 0
96 SELECT DISTINCT searchcategory AS `itemtype`,
97 COALESCE(authorised_values.lib_opac,authorised_values.lib) AS description,
98 authorised_values.imageurl AS imageurl,
99 hideinopac, 1 as 'iscat'
101 LEFT JOIN authorised_values ON searchcategory = authorised_value
102 WHERE searchcategory > '' and hideinopac=1
104 SELECT DISTINCT searchcategory AS `itemtype`,
105 COALESCE(authorised_values.lib_opac,authorised_values.lib) AS description,
106 authorised_values.imageurl AS imageurl,
107 hideinopac, 1 as 'iscat'
109 LEFT JOIN authorised_values ON searchcategory = authorised_value
110 WHERE searchcategory > '' and hideinopac=0
112 return ($dbh->selectall_hashref($query,'itemtype'));
115 =head2 getitemtypeimagedir
117 my $directory = getitemtypeimagedir( 'opac' );
119 pass in 'opac' or 'intranet'. Defaults to 'opac'.
121 returns the full path to the appropriate directory containing images.
125 sub getitemtypeimagedir {
126 my $src = shift || 'opac';
127 if ($src eq 'intranet') {
128 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
130 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
134 sub getitemtypeimagesrc {
135 my $src = shift || 'opac';
136 if ($src eq 'intranet') {
137 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
139 return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
143 sub getitemtypeimagelocation {
144 my ( $src, $image ) = @_;
146 return '' if ( !$image );
149 my $scheme = ( URI::Split::uri_split( $image ) )[0];
151 return $image if ( $scheme );
153 return getitemtypeimagesrc( $src ) . '/' . $image;
156 =head3 _getImagesFromDirectory
158 Find all of the image files in a directory in the filesystem
160 parameters: a directory name
162 returns: a list of images in that directory.
164 Notes: this does not traverse into subdirectories. See
165 _getSubdirectoryNames for help with that.
166 Images are assumed to be files with .gif or .png file extensions.
167 The image names returned do not have the directory name on them.
171 sub _getImagesFromDirectory {
172 my $directoryname = shift;
173 return unless defined $directoryname;
174 return unless -d $directoryname;
176 if ( opendir ( my $dh, $directoryname ) ) {
177 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
179 @images = sort(@images);
182 warn "unable to opendir $directoryname: $!";
187 =head3 _getSubdirectoryNames
189 Find all of the directories in a directory in the filesystem
191 parameters: a directory name
193 returns: a list of subdirectories in that directory.
195 Notes: this does not traverse into subdirectories. Only the first
196 level of subdirectories are returned.
197 The directory names returned don't have the parent directory name on them.
201 sub _getSubdirectoryNames {
202 my $directoryname = shift;
203 return unless defined $directoryname;
204 return unless -d $directoryname;
206 if ( opendir ( my $dh, $directoryname ) ) {
207 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
211 warn "unable to opendir $directoryname: $!";
218 returns: a listref of hashrefs. Each hash represents another collection of images.
220 { imagesetname => 'npl', # the name of the image set (npl is the original one)
221 images => listref of image hashrefs
224 each image is represented by a hashref like this:
226 { KohaImage => 'npl/image.gif',
227 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
228 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
229 checked => 0 or 1: was this the image passed to this method?
230 Note: I'd like to remove this somehow.
237 my $checked = $params{'checked'} || '';
239 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
240 url => getitemtypeimagesrc('intranet'),
242 opac => { filesystem => getitemtypeimagedir('opac'),
243 url => getitemtypeimagesrc('opac'),
247 my @imagesets = (); # list of hasrefs of image set data to pass to template
248 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
249 foreach my $imagesubdir ( @subdirectories ) {
250 my @imagelist = (); # hashrefs of image info
251 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
252 my $imagesetactive = 0;
253 foreach my $thisimage ( @imagenames ) {
255 { KohaImage => "$imagesubdir/$thisimage",
256 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
257 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
258 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
261 $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
263 push @imagesets, { imagesetname => $imagesubdir,
264 imagesetactive => $imagesetactive,
265 images => \@imagelist };
273 Returns the number of pages to display in a pagination bar, given the number
274 of items and the number of items per page.
279 my ( $nb_items, $nb_items_per_page ) = @_;
281 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
286 (@themes) = &getallthemes('opac');
287 (@themes) = &getallthemes('intranet');
289 Returns an array of all available themes.
297 if ( $type eq 'intranet' ) {
298 $htdocs = C4::Context->config('intrahtdocs');
301 $htdocs = C4::Context->config('opachtdocs');
303 opendir D, "$htdocs";
304 my @dirlist = readdir D;
305 foreach my $directory (@dirlist) {
306 next if $directory eq 'lib';
307 -d "$htdocs/$directory/en" and push @themes, $directory;
314 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
319 tags => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
325 tags => [ qw/ 607a / ],
331 tags => [ qw/ 700ab 701ab 702ab / ],
332 sep => C4::Context->preference("UNIMARCAuthorsFacetsSeparator"),
337 tags => [ qw/ 225a / ],
343 tags => [ qw/ 995e / ],
347 label => 'CollectionCodes',
348 tags => [ qw / 099t 955h / ],
352 unless ( Koha::Libraries->search->count == 1 )
354 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
355 if ( $DisplayLibraryFacets eq 'both'
356 || $DisplayLibraryFacets eq 'holding' )
361 idx => 'holdingbranch',
362 label => 'HoldingLibrary',
363 tags => [qw / 995c /],
368 if ( $DisplayLibraryFacets eq 'both'
369 || $DisplayLibraryFacets eq 'home' )
375 label => 'HomeLibrary',
376 tags => [qw / 995b /],
387 tags => [ qw/ 650a / ],
392 # label => 'People and Organizations',
393 # tags => [ qw/ 600a 610a 611a / ],
399 tags => [ qw/ 651a / ],
405 tags => [ qw/ 630a / ],
411 tags => [ qw/ 100a 110a 700a / ],
417 tags => [ qw/ 440a 490a / ],
422 label => 'ItemTypes',
423 tags => [ qw/ 952y 942c / ],
429 tags => [ qw / 952c / ],
433 label => 'CollectionCodes',
434 tags => [ qw / 9528 / ],
438 unless ( Koha::Libraries->search->count == 1 )
440 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
441 if ( $DisplayLibraryFacets eq 'both'
442 || $DisplayLibraryFacets eq 'holding' )
447 idx => 'holdingbranch',
448 label => 'HoldingLibrary',
449 tags => [qw / 952b /],
454 if ( $DisplayLibraryFacets eq 'both'
455 || $DisplayLibraryFacets eq 'home' )
461 label => 'HomeLibrary',
462 tags => [qw / 952a /],
471 =head2 GetAuthorisedValues
473 $authvalues = GetAuthorisedValues([$category]);
475 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
477 C<$category> returns authorised values for just one category (optional).
479 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
483 sub GetAuthorisedValues {
484 my ( $category, $opac ) = @_;
486 # Is this cached already?
487 $opac = $opac ? 1 : 0; # normalise to be safe
489 C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
491 "AuthorisedValues-$category-$opac-$branch_limit";
492 my $cache = Koha::Caches->get_instance();
493 my $result = $cache->get_from_cache($cache_key);
494 return $result if $result;
497 my $dbh = C4::Context->dbh;
500 FROM authorised_values av
503 LEFT JOIN authorised_values_branches ON ( id = av_id )
508 push @where_strings, "category = ?";
509 push @where_args, $category;
512 push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
513 push @where_args, $branch_limit;
515 if(@where_strings > 0) {
516 $query .= " WHERE " . join(" AND ", @where_strings);
518 $query .= ' ORDER BY category, ' . (
519 $opac ? 'COALESCE(lib_opac, lib)'
523 my $sth = $dbh->prepare($query);
525 $sth->execute( @where_args );
526 while (my $data=$sth->fetchrow_hashref) {
527 if ($opac && $data->{lib_opac}) {
528 $data->{lib} = $data->{lib_opac};
530 push @results, $data;
534 $cache->set_in_cache( $cache_key, \@results, { expiry => 5 } );
540 my $escaped_string = C4::Koha::xml_escape($string);
542 Convert &, <, >, ', and " in a string to XML entities
548 return '' unless defined $str;
552 $str =~ s/'/'/g;
553 $str =~ s/"/"/g;
557 =head2 display_marc_indicators
559 my $display_form = C4::Koha::display_marc_indicators($field);
561 C<$field> is a MARC::Field object
563 Generate a display form of the indicators of a variable
564 MARC field, replacing any blanks with '#'.
568 sub display_marc_indicators {
571 if ($field && $field->tag() >= 10) {
572 $indicators = $field->indicator(1) . $field->indicator(2);
573 $indicators =~ s/ /#/g;
578 sub GetNormalizedUPC {
579 my ($marcrecord,$marcflavour) = @_;
581 return unless $marcrecord;
582 if ($marcflavour eq 'UNIMARC') {
583 my @fields = $marcrecord->field('072');
584 foreach my $field (@fields) {
585 my $upc = _normalize_match_point($field->subfield('a'));
592 else { # assume marc21 if not unimarc
593 my @fields = $marcrecord->field('024');
594 foreach my $field (@fields) {
595 my $indicator = $field->indicator(1);
596 my $upc = _normalize_match_point($field->subfield('a'));
597 if ($upc && $indicator == 1 ) {
604 # Normalizes and returns the first valid ISBN found in the record
605 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
606 sub GetNormalizedISBN {
607 my ($isbn,$marcrecord,$marcflavour) = @_;
609 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
610 # anything after " | " should be removed, along with the delimiter
611 ($isbn) = split(/\|/, $isbn );
612 return _isbn_cleanup($isbn);
615 return unless $marcrecord;
617 if ($marcflavour eq 'UNIMARC') {
618 my @fields = $marcrecord->field('010');
619 foreach my $field (@fields) {
620 my $isbn = $field->subfield('a');
622 return _isbn_cleanup($isbn);
626 else { # assume marc21 if not unimarc
627 my @fields = $marcrecord->field('020');
628 foreach my $field (@fields) {
629 $isbn = $field->subfield('a');
631 return _isbn_cleanup($isbn);
637 sub GetNormalizedEAN {
638 my ($marcrecord,$marcflavour) = @_;
640 return unless $marcrecord;
642 if ($marcflavour eq 'UNIMARC') {
643 my @fields = $marcrecord->field('073');
644 foreach my $field (@fields) {
645 my $ean = _normalize_match_point($field->subfield('a'));
651 else { # assume marc21 if not unimarc
652 my @fields = $marcrecord->field('024');
653 foreach my $field (@fields) {
654 my $indicator = $field->indicator(1);
655 my $ean = _normalize_match_point($field->subfield('a'));
656 if ( $ean && $indicator == 3 ) {
663 sub GetNormalizedOCLCNumber {
664 my ($marcrecord,$marcflavour) = @_;
665 return unless $marcrecord;
667 if ($marcflavour ne 'UNIMARC' ) {
668 my @fields = $marcrecord->field('035');
669 foreach my $field (@fields) {
670 my $oclc = $field->subfield('a');
671 if ($oclc && $oclc =~ /OCoLC/) {
672 $oclc =~ s/\(OCoLC\)//;
682 sub _normalize_match_point {
683 my $match_point = shift;
684 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
685 $normalized_match_point =~ s/-//g;
687 return $normalized_match_point;
692 return NormalizeISBN(
703 my $isbns = NormalizeISBN({
705 strip_hyphens => [0,1],
706 format => ['ISBN-10', 'ISBN-13']
709 Returns an isbn validated by Business::ISBN.
710 Optionally strips hyphens and/or forces the isbn
711 to be of the specified format.
713 If the string cannot be validated as an isbn,
714 it returns nothing unless return_invalid param is passed.
716 #FIXME This routine (and others?) should be moved to Koha::Util::Normalize
723 my $string = $params->{isbn};
724 my $strip_hyphens = $params->{strip_hyphens};
725 my $format = $params->{format} || q{};
726 my $return_invalid = $params->{return_invalid};
728 return unless $string;
730 my $isbn = Business::ISBN->new($string);
732 if ( $isbn && $isbn->is_valid() ) {
734 if ( $format eq 'ISBN-10' ) {
735 $isbn = $isbn->as_isbn10();
737 elsif ( $format eq 'ISBN-13' ) {
738 $isbn = $isbn->as_isbn13();
742 if ($strip_hyphens) {
743 $string = $isbn->as_string( [] );
745 $string = $isbn->as_string();
749 } elsif ( $return_invalid ) {
755 =head2 GetVariationsOfISBN
757 my @isbns = GetVariationsOfISBN( $isbn );
759 Returns a list of variations of the given isbn in
760 both ISBN-10 and ISBN-13 formats, with and without
763 In a scalar context, the isbns are returned as a
764 string delimited by ' | '.
768 sub GetVariationsOfISBN {
775 push( @isbns, NormalizeISBN({ isbn => $isbn, return_invalid => 1 }) );
776 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) );
777 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) );
778 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) );
779 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
781 # Strip out any "empty" strings from the array
782 @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
784 return wantarray ? @isbns : join( " | ", @isbns );
787 =head2 GetVariationsOfISBNs
789 my @isbns = GetVariationsOfISBNs( @isbns );
791 Returns a list of variations of the given isbns in
792 both ISBN-10 and ISBN-13 formats, with and without
795 In a scalar context, the isbns are returned as a
796 string delimited by ' | '.
800 sub GetVariationsOfISBNs {
803 @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
805 return wantarray ? @isbns : join( " | ", @isbns );
808 =head2 NormalizedISSN
810 my $issns = NormalizedISSN({
812 strip_hyphen => [0,1]
815 Returns an issn validated by Business::ISSN.
816 Optionally strips hyphen.
818 If the string cannot be validated as an issn,
826 my $string = $params->{issn};
827 my $strip_hyphen = $params->{strip_hyphen};
829 my $issn = Business::ISSN->new($string);
831 if ( $issn && $issn->is_valid ){
834 $string = $issn->_issn;
837 $string = $issn->as_string;
844 =head2 GetVariationsOfISSN
846 my @issns = GetVariationsOfISSN( $issn );
848 Returns a list of variations of the given issn in
849 with and without a hyphen.
851 In a scalar context, the issns are returned as a
852 string delimited by ' | '.
856 sub GetVariationsOfISSN {
862 my $str = NormalizeISSN({ issn => $issn });
865 push @issns, NormalizeISSN({ issn => $issn, strip_hyphen => 1 });
870 # Strip out any "empty" strings from the array
871 @issns = grep { defined($_) && $_ =~ /\S/ } @issns;
873 return wantarray ? @issns : join( " | ", @issns );
876 =head2 GetVariationsOfISSNs
878 my @issns = GetVariationsOfISSNs( @issns );
880 Returns a list of variations of the given issns in
881 with and without a hyphen.
883 In a scalar context, the issns are returned as a
884 string delimited by ' | '.
888 sub GetVariationsOfISSNs {
891 @issns = map { GetVariationsOfISSN( $_ ) } @issns;
893 return wantarray ? @issns : join( " | ", @issns );