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 $marcflavour ||= C4::Context->preference('marcflavour');
586 return unless $marcrecord;
587 if ($marcflavour eq 'UNIMARC') {
588 my @fields = $marcrecord->field('072');
589 foreach my $field (@fields) {
590 my $upc = _normalize_match_point($field->subfield('a'));
597 else { # assume marc21 if not unimarc
598 my @fields = $marcrecord->field('024');
599 foreach my $field (@fields) {
600 my $indicator = $field->indicator(1);
601 my $upc = _normalize_match_point($field->subfield('a'));
602 if ($upc && $indicator == 1 ) {
609 # Normalizes and returns the first valid ISBN found in the record
610 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
611 sub GetNormalizedISBN {
612 my ($isbn,$marcrecord,$marcflavour) = @_;
614 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
615 # anything after " | " should be removed, along with the delimiter
616 ($isbn) = split(/\|/, $isbn );
617 return _isbn_cleanup($isbn);
620 return unless $marcrecord;
622 if ($marcflavour eq 'UNIMARC') {
623 my @fields = $marcrecord->field('010');
624 foreach my $field (@fields) {
625 my $isbn = $field->subfield('a');
627 return _isbn_cleanup($isbn);
631 else { # assume marc21 if not unimarc
632 my @fields = $marcrecord->field('020');
633 foreach my $field (@fields) {
634 $isbn = $field->subfield('a');
636 return _isbn_cleanup($isbn);
642 sub GetNormalizedEAN {
643 my ($marcrecord,$marcflavour) = @_;
645 return unless $marcrecord;
647 if ($marcflavour eq 'UNIMARC') {
648 my @fields = $marcrecord->field('073');
649 foreach my $field (@fields) {
650 my $ean = _normalize_match_point($field->subfield('a'));
656 else { # assume marc21 if not unimarc
657 my @fields = $marcrecord->field('024');
658 foreach my $field (@fields) {
659 my $indicator = $field->indicator(1);
660 my $ean = _normalize_match_point($field->subfield('a'));
661 if ( $ean && $indicator == 3 ) {
668 sub GetNormalizedOCLCNumber {
669 my ($marcrecord,$marcflavour) = @_;
670 return unless $marcrecord;
672 $marcflavour ||= C4::Context->preference('marcflavour');
674 if ($marcflavour ne 'UNIMARC' ) {
675 my @fields = $marcrecord->field('035');
676 foreach my $field (@fields) {
677 my $oclc = $field->subfield('a');
678 if ($oclc && $oclc =~ /OCoLC/) {
679 $oclc =~ s/\(OCoLC\)//;
688 sub _normalize_match_point {
689 my $match_point = shift;
690 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
691 $normalized_match_point =~ s/-//g;
693 return $normalized_match_point;
698 return NormalizeISBN(
709 my $isbns = NormalizeISBN({
711 strip_hyphens => [0,1],
712 format => ['ISBN-10', 'ISBN-13']
715 Returns an isbn validated by Business::ISBN.
716 Optionally strips hyphens and/or forces the isbn
717 to be of the specified format.
719 If the string cannot be validated as an isbn,
720 it returns nothing unless return_invalid param is passed.
722 #FIXME This routine (and others?) should be moved to Koha::Util::Normalize
729 my $string = $params->{isbn};
730 my $strip_hyphens = $params->{strip_hyphens};
731 my $format = $params->{format} || q{};
732 my $return_invalid = $params->{return_invalid};
734 return unless $string;
736 my $isbn = Business::ISBN->new($string);
738 if ( $isbn && $isbn->is_valid() ) {
740 if ( $format eq 'ISBN-10' ) {
741 $isbn = $isbn->as_isbn10();
743 elsif ( $format eq 'ISBN-13' ) {
744 $isbn = $isbn->as_isbn13();
748 if ($strip_hyphens) {
749 $string = $isbn->as_string( [] );
751 $string = $isbn->as_string();
755 } elsif ( $return_invalid ) {
761 =head2 GetVariationsOfISBN
763 my @isbns = GetVariationsOfISBN( $isbn );
765 Returns a list of variations of the given isbn in
766 both ISBN-10 and ISBN-13 formats, with and without
769 In a scalar context, the isbns are returned as a
770 string delimited by ' | '.
774 sub GetVariationsOfISBN {
781 push( @isbns, NormalizeISBN({ isbn => $isbn, return_invalid => 1 }) );
782 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) );
783 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) );
784 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) );
785 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
787 # Strip out any "empty" strings from the array
788 @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
790 return wantarray ? @isbns : join( " | ", @isbns );
793 =head2 GetVariationsOfISBNs
795 my @isbns = GetVariationsOfISBNs( @isbns );
797 Returns a list of variations of the given isbns in
798 both ISBN-10 and ISBN-13 formats, with and without
801 In a scalar context, the isbns are returned as a
802 string delimited by ' | '.
806 sub GetVariationsOfISBNs {
809 @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
811 return wantarray ? @isbns : join( " | ", @isbns );
814 =head2 NormalizedISSN
816 my $issns = NormalizedISSN({
818 strip_hyphen => [0,1]
821 Returns an issn validated by Business::ISSN.
822 Optionally strips hyphen.
824 If the string cannot be validated as an issn,
832 my $string = $params->{issn};
833 my $strip_hyphen = $params->{strip_hyphen};
835 my $issn = Business::ISSN->new($string);
837 if ( $issn && $issn->is_valid ){
840 $string = $issn->_issn;
843 $string = $issn->as_string;
850 =head2 GetVariationsOfISSN
852 my @issns = GetVariationsOfISSN( $issn );
854 Returns a list of variations of the given issn in
855 with and without a hyphen.
857 In a scalar context, the issns are returned as a
858 string delimited by ' | '.
862 sub GetVariationsOfISSN {
868 my $str = NormalizeISSN({ issn => $issn });
871 push @issns, NormalizeISSN({ issn => $issn, strip_hyphen => 1 });
876 # Strip out any "empty" strings from the array
877 @issns = grep { defined($_) && $_ =~ /\S/ } @issns;
879 return wantarray ? @issns : join( " | ", @issns );
882 =head2 GetVariationsOfISSNs
884 my @issns = GetVariationsOfISSNs( @issns );
886 Returns a list of variations of the given issns in
887 with and without a hyphen.
889 In a scalar context, the issns are returned as a
890 string delimited by ' | '.
894 sub GetVariationsOfISSNs {
897 @issns = map { GetVariationsOfISSN( $_ ) } @issns;
899 return wantarray ? @issns : join( " | ", @issns );