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);
34 our (@ISA, @EXPORT_OK);
39 GetItemTypesCategorized
46 getitemtypeimagelocation
51 GetNormalizedOCLCNumber
66 C4::Koha - Perl Module containing convenience functions for Koha scripts
74 Koha.pm provides many functions for Koha scripts.
80 =head2 GetItemTypesCategorized
82 $categories = GetItemTypesCategorized();
84 Returns a hashref containing search categories.
85 A search category will be put in the hash if at least one of its itemtypes is visible in OPAC.
86 The categories must be part of Authorized Values (ITEMTYPECAT)
90 sub GetItemTypesCategorized {
91 my $dbh = C4::Context->dbh;
92 # Order is important, so that partially hidden (some items are not visible in OPAC) search
93 # categories will be visible. hideinopac=0 must be last.
95 SELECT itemtype, description, imageurl, hideinopac, 0 as 'iscat' FROM itemtypes WHERE ISNULL(searchcategory) or length(searchcategory) = 0
97 SELECT DISTINCT searchcategory AS `itemtype`,
98 COALESCE(authorised_values.lib_opac,authorised_values.lib) AS description,
99 authorised_values.imageurl AS imageurl,
100 hideinopac, 1 as 'iscat'
102 LEFT JOIN authorised_values ON searchcategory = authorised_value
103 WHERE searchcategory > '' and hideinopac=1
105 SELECT DISTINCT searchcategory AS `itemtype`,
106 COALESCE(authorised_values.lib_opac,authorised_values.lib) AS description,
107 authorised_values.imageurl AS imageurl,
108 hideinopac, 1 as 'iscat'
110 LEFT JOIN authorised_values ON searchcategory = authorised_value
111 WHERE searchcategory > '' and hideinopac=0
113 return ($dbh->selectall_hashref($query,'itemtype'));
116 =head2 getitemtypeimagedir
118 my $directory = getitemtypeimagedir( 'opac' );
120 pass in 'opac' or 'intranet'. Defaults to 'opac'.
122 returns the full path to the appropriate directory containing images.
126 sub getitemtypeimagedir {
127 my $src = shift || 'opac';
128 if ($src eq 'intranet') {
129 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
131 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
135 sub getitemtypeimagesrc {
136 my $src = shift || 'opac';
137 if ($src eq 'intranet') {
138 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
140 return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
144 sub getitemtypeimagelocation {
145 my ( $src, $image ) = @_;
147 return '' if ( !$image );
150 my $scheme = ( URI::Split::uri_split( $image ) )[0];
152 return $image if ( $scheme );
154 return getitemtypeimagesrc( $src ) . '/' . $image;
157 =head3 _getImagesFromDirectory
159 Find all of the image files in a directory in the filesystem
161 parameters: a directory name
163 returns: a list of images in that directory.
165 Notes: this does not traverse into subdirectories. See
166 _getSubdirectoryNames for help with that.
167 Images are assumed to be files with .gif or .png file extensions.
168 The image names returned do not have the directory name on them.
172 sub _getImagesFromDirectory {
173 my $directoryname = shift;
174 return unless defined $directoryname;
175 return unless -d $directoryname;
177 if ( opendir ( my $dh, $directoryname ) ) {
178 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
180 @images = sort(@images);
183 warn "unable to opendir $directoryname: $!";
188 =head3 _getSubdirectoryNames
190 Find all of the directories in a directory in the filesystem
192 parameters: a directory name
194 returns: a list of subdirectories in that directory.
196 Notes: this does not traverse into subdirectories. Only the first
197 level of subdirectories are returned.
198 The directory names returned don't have the parent directory name on them.
202 sub _getSubdirectoryNames {
203 my $directoryname = shift;
204 return unless defined $directoryname;
205 return unless -d $directoryname;
207 if ( opendir ( my $dh, $directoryname ) ) {
208 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
212 warn "unable to opendir $directoryname: $!";
219 returns: a listref of hashrefs. Each hash represents another collection of images.
221 { imagesetname => 'npl', # the name of the image set (npl is the original one)
222 images => listref of image hashrefs
225 each image is represented by a hashref like this:
227 { KohaImage => 'npl/image.gif',
228 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
229 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
230 checked => 0 or 1: was this the image passed to this method?
231 Note: I'd like to remove this somehow.
238 my $checked = $params{'checked'} || '';
240 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
241 url => getitemtypeimagesrc('intranet'),
243 opac => { filesystem => getitemtypeimagedir('opac'),
244 url => getitemtypeimagesrc('opac'),
248 my @imagesets = (); # list of hasrefs of image set data to pass to template
249 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
250 foreach my $imagesubdir ( @subdirectories ) {
251 my @imagelist = (); # hashrefs of image info
252 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
253 my $imagesetactive = 0;
254 foreach my $thisimage ( @imagenames ) {
256 { KohaImage => "$imagesubdir/$thisimage",
257 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
258 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
259 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
262 $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
264 push @imagesets, { imagesetname => $imagesubdir,
265 imagesetactive => $imagesetactive,
266 images => \@imagelist };
274 Returns the number of pages to display in a pagination bar, given the number
275 of items and the number of items per page.
280 my ( $nb_items, $nb_items_per_page ) = @_;
282 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
287 (@themes) = &getallthemes('opac');
288 (@themes) = &getallthemes('intranet');
290 Returns an array of all available themes.
298 if ( $type eq 'intranet' ) {
299 $htdocs = C4::Context->config('intrahtdocs');
302 $htdocs = C4::Context->config('opachtdocs');
305 opendir $dir_h, "$htdocs";
306 my @dirlist = readdir $dir_h;
307 foreach my $directory (@dirlist) {
308 next if $directory eq 'lib';
309 -d "$htdocs/$directory/en" and push @themes, $directory;
317 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
322 tags => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
328 tags => [ qw/ 607a / ],
334 tags => [ qw/ 700ab 701ab 702ab / ],
335 sep => C4::Context->preference("UNIMARCAuthorsFacetsSeparator"),
340 tags => [ qw/ 225a / ],
346 tags => [ qw/ 995e / ],
350 label => 'CollectionCodes',
351 tags => [ qw / 099t 955h / ],
355 unless ( Koha::Libraries->search->count == 1 )
357 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
358 if ( $DisplayLibraryFacets eq 'both'
359 || $DisplayLibraryFacets eq 'holding' )
364 idx => 'holdingbranch',
365 label => 'HoldingLibrary',
366 tags => [qw / 995c /],
371 if ( $DisplayLibraryFacets eq 'both'
372 || $DisplayLibraryFacets eq 'home' )
378 label => 'HomeLibrary',
379 tags => [qw / 995b /],
390 tags => [ qw/ 650a / ],
395 # label => 'People and Organizations',
396 # tags => [ qw/ 600a 610a 611a / ],
402 tags => [ qw/ 651a / ],
408 tags => [ qw/ 630a / ],
414 tags => [ qw/ 100a 110a 700a / ],
420 tags => [ qw/ 440a 490a / ],
425 label => 'ItemTypes',
426 tags => [ qw/ 952y 942c / ],
432 tags => [ qw / 952c / ],
436 label => 'CollectionCodes',
437 tags => [ qw / 9528 / ],
441 unless ( Koha::Libraries->search->count == 1 )
443 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
444 if ( $DisplayLibraryFacets eq 'both'
445 || $DisplayLibraryFacets eq 'holding' )
450 idx => 'holdingbranch',
451 label => 'HoldingLibrary',
452 tags => [qw / 952b /],
457 if ( $DisplayLibraryFacets eq 'both'
458 || $DisplayLibraryFacets eq 'home' )
464 label => 'HomeLibrary',
465 tags => [qw / 952a /],
474 =head2 GetAuthorisedValues
476 $authvalues = GetAuthorisedValues([$category]);
478 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
480 C<$category> returns authorised values for just one category (optional).
482 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
486 sub GetAuthorisedValues {
487 my $category = shift // ''; # optional parameter
488 my $opac = shift ? 1 : 0; # normalise to be safe
490 # Is this cached already?
492 C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
494 "AuthorisedValues-$category-$opac-$branch_limit";
495 my $cache = Koha::Caches->get_instance();
496 my $result = $cache->get_from_cache($cache_key);
497 return $result if $result;
500 my $dbh = C4::Context->dbh;
503 FROM authorised_values av
506 LEFT JOIN authorised_values_branches ON ( id = av_id )
511 push @where_strings, "category = ?";
512 push @where_args, $category;
515 push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
516 push @where_args, $branch_limit;
518 if(@where_strings > 0) {
519 $query .= " WHERE " . join(" AND ", @where_strings);
521 $query .= ' ORDER BY category, ' . (
522 $opac ? 'COALESCE(lib_opac, lib)'
526 my $sth = $dbh->prepare($query);
528 $sth->execute( @where_args );
529 while (my $data=$sth->fetchrow_hashref) {
530 if ($opac && $data->{lib_opac}) {
531 $data->{lib} = $data->{lib_opac};
533 push @results, $data;
537 $cache->set_in_cache( $cache_key, \@results, { expiry => 5 } );
543 my $escaped_string = C4::Koha::xml_escape($string);
545 Convert &, <, >, ', and " in a string to XML entities
551 return '' unless defined $str;
555 $str =~ s/'/'/g;
556 $str =~ s/"/"/g;
560 =head2 display_marc_indicators
562 my $display_form = C4::Koha::display_marc_indicators($field);
564 C<$field> is a MARC::Field object
566 Generate a display form of the indicators of a variable
567 MARC field, replacing any blanks with '#'.
571 sub display_marc_indicators {
574 if ($field && $field->tag() >= 10) {
575 $indicators = $field->indicator(1) . $field->indicator(2);
576 $indicators =~ s/ /#/g;
581 sub GetNormalizedUPC {
582 my ($marcrecord,$marcflavour) = @_;
584 return unless $marcrecord;
585 if ($marcflavour eq 'UNIMARC') {
586 my @fields = $marcrecord->field('072');
587 foreach my $field (@fields) {
588 my $upc = _normalize_match_point($field->subfield('a'));
595 else { # assume marc21 if not unimarc
596 my @fields = $marcrecord->field('024');
597 foreach my $field (@fields) {
598 my $indicator = $field->indicator(1);
599 my $upc = _normalize_match_point($field->subfield('a'));
600 if ($upc && $indicator == 1 ) {
607 # Normalizes and returns the first valid ISBN found in the record
608 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
609 sub GetNormalizedISBN {
610 my ($isbn,$marcrecord,$marcflavour) = @_;
612 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
613 # anything after " | " should be removed, along with the delimiter
614 ($isbn) = split(/\|/, $isbn );
615 return _isbn_cleanup($isbn);
618 return unless $marcrecord;
620 if ($marcflavour eq 'UNIMARC') {
621 my @fields = $marcrecord->field('010');
622 foreach my $field (@fields) {
623 my $isbn = $field->subfield('a');
625 return _isbn_cleanup($isbn);
629 else { # assume marc21 if not unimarc
630 my @fields = $marcrecord->field('020');
631 foreach my $field (@fields) {
632 $isbn = $field->subfield('a');
634 return _isbn_cleanup($isbn);
640 sub GetNormalizedEAN {
641 my ($marcrecord,$marcflavour) = @_;
643 return unless $marcrecord;
645 if ($marcflavour eq 'UNIMARC') {
646 my @fields = $marcrecord->field('073');
647 foreach my $field (@fields) {
648 my $ean = _normalize_match_point($field->subfield('a'));
654 else { # assume marc21 if not unimarc
655 my @fields = $marcrecord->field('024');
656 foreach my $field (@fields) {
657 my $indicator = $field->indicator(1);
658 my $ean = _normalize_match_point($field->subfield('a'));
659 if ( $ean && $indicator == 3 ) {
666 sub GetNormalizedOCLCNumber {
667 my ($marcrecord,$marcflavour) = @_;
668 return unless $marcrecord;
670 if ($marcflavour ne 'UNIMARC' ) {
671 my @fields = $marcrecord->field('035');
672 foreach my $field (@fields) {
673 my $oclc = $field->subfield('a');
674 if ($oclc && $oclc =~ /OCoLC/) {
675 $oclc =~ s/\(OCoLC\)//;
685 sub _normalize_match_point {
686 my $match_point = shift;
687 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
688 $normalized_match_point =~ s/-//g;
690 return $normalized_match_point;
695 return NormalizeISBN(
706 my $isbns = NormalizeISBN({
708 strip_hyphens => [0,1],
709 format => ['ISBN-10', 'ISBN-13']
712 Returns an isbn validated by Business::ISBN.
713 Optionally strips hyphens and/or forces the isbn
714 to be of the specified format.
716 If the string cannot be validated as an isbn,
717 it returns nothing unless return_invalid param is passed.
719 #FIXME This routine (and others?) should be moved to Koha::Util::Normalize
726 my $string = $params->{isbn};
727 my $strip_hyphens = $params->{strip_hyphens};
728 my $format = $params->{format} || q{};
729 my $return_invalid = $params->{return_invalid};
731 return unless $string;
733 my $isbn = Business::ISBN->new($string);
735 if ( $isbn && $isbn->is_valid() ) {
737 if ( $format eq 'ISBN-10' ) {
738 $isbn = $isbn->as_isbn10();
740 elsif ( $format eq 'ISBN-13' ) {
741 $isbn = $isbn->as_isbn13();
745 if ($strip_hyphens) {
746 $string = $isbn->as_string( [] );
748 $string = $isbn->as_string();
752 } elsif ( $return_invalid ) {
758 =head2 GetVariationsOfISBN
760 my @isbns = GetVariationsOfISBN( $isbn );
762 Returns a list of variations of the given isbn in
763 both ISBN-10 and ISBN-13 formats, with and without
766 In a scalar context, the isbns are returned as a
767 string delimited by ' | '.
771 sub GetVariationsOfISBN {
778 push( @isbns, NormalizeISBN({ isbn => $isbn, return_invalid => 1 }) );
779 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) );
780 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) );
781 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) );
782 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
784 # Strip out any "empty" strings from the array
785 @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
787 return wantarray ? @isbns : join( " | ", @isbns );
790 =head2 GetVariationsOfISBNs
792 my @isbns = GetVariationsOfISBNs( @isbns );
794 Returns a list of variations of the given isbns in
795 both ISBN-10 and ISBN-13 formats, with and without
798 In a scalar context, the isbns are returned as a
799 string delimited by ' | '.
803 sub GetVariationsOfISBNs {
806 @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
808 return wantarray ? @isbns : join( " | ", @isbns );
811 =head2 NormalizedISSN
813 my $issns = NormalizedISSN({
815 strip_hyphen => [0,1]
818 Returns an issn validated by Business::ISSN.
819 Optionally strips hyphen.
821 If the string cannot be validated as an issn,
829 my $string = $params->{issn};
830 my $strip_hyphen = $params->{strip_hyphen};
832 my $issn = Business::ISSN->new($string);
834 if ( $issn && $issn->is_valid ){
837 $string = $issn->_issn;
840 $string = $issn->as_string;
847 =head2 GetVariationsOfISSN
849 my @issns = GetVariationsOfISSN( $issn );
851 Returns a list of variations of the given issn in
852 with and without a hyphen.
854 In a scalar context, the issns are returned as a
855 string delimited by ' | '.
859 sub GetVariationsOfISSN {
865 my $str = NormalizeISSN({ issn => $issn });
868 push @issns, NormalizeISSN({ issn => $issn, strip_hyphen => 1 });
873 # Strip out any "empty" strings from the array
874 @issns = grep { defined($_) && $_ =~ /\S/ } @issns;
876 return wantarray ? @issns : join( " | ", @issns );
879 =head2 GetVariationsOfISSNs
881 my @issns = GetVariationsOfISSNs( @issns );
883 Returns a list of variations of the given issns in
884 with and without a hyphen.
886 In a scalar context, the issns are returned as a
887 string delimited by ' | '.
891 sub GetVariationsOfISSNs {
894 @issns = map { GetVariationsOfISSN( $_ ) } @issns;
896 return wantarray ? @issns : join( " | ", @issns );