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');
304 opendir D, "$htdocs";
305 my @dirlist = readdir D;
306 foreach my $directory (@dirlist) {
307 next if $directory eq 'lib';
308 -d "$htdocs/$directory/en" and push @themes, $directory;
315 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
320 tags => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
326 tags => [ qw/ 607a / ],
332 tags => [ qw/ 700ab 701ab 702ab / ],
333 sep => C4::Context->preference("UNIMARCAuthorsFacetsSeparator"),
338 tags => [ qw/ 225a / ],
344 tags => [ qw/ 995e / ],
348 label => 'CollectionCodes',
349 tags => [ qw / 099t 955h / ],
353 unless ( Koha::Libraries->search->count == 1 )
355 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
356 if ( $DisplayLibraryFacets eq 'both'
357 || $DisplayLibraryFacets eq 'holding' )
362 idx => 'holdingbranch',
363 label => 'HoldingLibrary',
364 tags => [qw / 995c /],
369 if ( $DisplayLibraryFacets eq 'both'
370 || $DisplayLibraryFacets eq 'home' )
376 label => 'HomeLibrary',
377 tags => [qw / 995b /],
388 tags => [ qw/ 650a / ],
393 # label => 'People and Organizations',
394 # tags => [ qw/ 600a 610a 611a / ],
400 tags => [ qw/ 651a / ],
406 tags => [ qw/ 630a / ],
412 tags => [ qw/ 100a 110a 700a / ],
418 tags => [ qw/ 440a 490a / ],
423 label => 'ItemTypes',
424 tags => [ qw/ 952y 942c / ],
430 tags => [ qw / 952c / ],
434 label => 'CollectionCodes',
435 tags => [ qw / 9528 / ],
439 unless ( Koha::Libraries->search->count == 1 )
441 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
442 if ( $DisplayLibraryFacets eq 'both'
443 || $DisplayLibraryFacets eq 'holding' )
448 idx => 'holdingbranch',
449 label => 'HoldingLibrary',
450 tags => [qw / 952b /],
455 if ( $DisplayLibraryFacets eq 'both'
456 || $DisplayLibraryFacets eq 'home' )
462 label => 'HomeLibrary',
463 tags => [qw / 952a /],
472 =head2 GetAuthorisedValues
474 $authvalues = GetAuthorisedValues([$category]);
476 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
478 C<$category> returns authorised values for just one category (optional).
480 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
484 sub GetAuthorisedValues {
485 my $category = shift // ''; # optional parameter
486 my $opac = shift ? 1 : 0; # normalise to be safe
488 # Is this cached already?
490 C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
492 "AuthorisedValues-$category-$opac-$branch_limit";
493 my $cache = Koha::Caches->get_instance();
494 my $result = $cache->get_from_cache($cache_key);
495 return $result if $result;
498 my $dbh = C4::Context->dbh;
501 FROM authorised_values av
504 LEFT JOIN authorised_values_branches ON ( id = av_id )
509 push @where_strings, "category = ?";
510 push @where_args, $category;
513 push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
514 push @where_args, $branch_limit;
516 if(@where_strings > 0) {
517 $query .= " WHERE " . join(" AND ", @where_strings);
519 $query .= ' ORDER BY category, ' . (
520 $opac ? 'COALESCE(lib_opac, lib)'
524 my $sth = $dbh->prepare($query);
526 $sth->execute( @where_args );
527 while (my $data=$sth->fetchrow_hashref) {
528 if ($opac && $data->{lib_opac}) {
529 $data->{lib} = $data->{lib_opac};
531 push @results, $data;
535 $cache->set_in_cache( $cache_key, \@results, { expiry => 5 } );
541 my $escaped_string = C4::Koha::xml_escape($string);
543 Convert &, <, >, ', and " in a string to XML entities
549 return '' unless defined $str;
553 $str =~ s/'/'/g;
554 $str =~ s/"/"/g;
558 =head2 display_marc_indicators
560 my $display_form = C4::Koha::display_marc_indicators($field);
562 C<$field> is a MARC::Field object
564 Generate a display form of the indicators of a variable
565 MARC field, replacing any blanks with '#'.
569 sub display_marc_indicators {
572 if ($field && $field->tag() >= 10) {
573 $indicators = $field->indicator(1) . $field->indicator(2);
574 $indicators =~ s/ /#/g;
579 sub GetNormalizedUPC {
580 my ($marcrecord,$marcflavour) = @_;
582 return unless $marcrecord;
583 if ($marcflavour eq 'UNIMARC') {
584 my @fields = $marcrecord->field('072');
585 foreach my $field (@fields) {
586 my $upc = _normalize_match_point($field->subfield('a'));
593 else { # assume marc21 if not unimarc
594 my @fields = $marcrecord->field('024');
595 foreach my $field (@fields) {
596 my $indicator = $field->indicator(1);
597 my $upc = _normalize_match_point($field->subfield('a'));
598 if ($upc && $indicator == 1 ) {
605 # Normalizes and returns the first valid ISBN found in the record
606 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
607 sub GetNormalizedISBN {
608 my ($isbn,$marcrecord,$marcflavour) = @_;
610 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
611 # anything after " | " should be removed, along with the delimiter
612 ($isbn) = split(/\|/, $isbn );
613 return _isbn_cleanup($isbn);
616 return unless $marcrecord;
618 if ($marcflavour eq 'UNIMARC') {
619 my @fields = $marcrecord->field('010');
620 foreach my $field (@fields) {
621 my $isbn = $field->subfield('a');
623 return _isbn_cleanup($isbn);
627 else { # assume marc21 if not unimarc
628 my @fields = $marcrecord->field('020');
629 foreach my $field (@fields) {
630 $isbn = $field->subfield('a');
632 return _isbn_cleanup($isbn);
638 sub GetNormalizedEAN {
639 my ($marcrecord,$marcflavour) = @_;
641 return unless $marcrecord;
643 if ($marcflavour eq 'UNIMARC') {
644 my @fields = $marcrecord->field('073');
645 foreach my $field (@fields) {
646 my $ean = _normalize_match_point($field->subfield('a'));
652 else { # assume marc21 if not unimarc
653 my @fields = $marcrecord->field('024');
654 foreach my $field (@fields) {
655 my $indicator = $field->indicator(1);
656 my $ean = _normalize_match_point($field->subfield('a'));
657 if ( $ean && $indicator == 3 ) {
664 sub GetNormalizedOCLCNumber {
665 my ($marcrecord,$marcflavour) = @_;
666 return unless $marcrecord;
668 if ($marcflavour ne 'UNIMARC' ) {
669 my @fields = $marcrecord->field('035');
670 foreach my $field (@fields) {
671 my $oclc = $field->subfield('a');
672 if ($oclc && $oclc =~ /OCoLC/) {
673 $oclc =~ s/\(OCoLC\)//;
683 sub _normalize_match_point {
684 my $match_point = shift;
685 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
686 $normalized_match_point =~ s/-//g;
688 return $normalized_match_point;
693 return NormalizeISBN(
704 my $isbns = NormalizeISBN({
706 strip_hyphens => [0,1],
707 format => ['ISBN-10', 'ISBN-13']
710 Returns an isbn validated by Business::ISBN.
711 Optionally strips hyphens and/or forces the isbn
712 to be of the specified format.
714 If the string cannot be validated as an isbn,
715 it returns nothing unless return_invalid param is passed.
717 #FIXME This routine (and others?) should be moved to Koha::Util::Normalize
724 my $string = $params->{isbn};
725 my $strip_hyphens = $params->{strip_hyphens};
726 my $format = $params->{format} || q{};
727 my $return_invalid = $params->{return_invalid};
729 return unless $string;
731 my $isbn = Business::ISBN->new($string);
733 if ( $isbn && $isbn->is_valid() ) {
735 if ( $format eq 'ISBN-10' ) {
736 $isbn = $isbn->as_isbn10();
738 elsif ( $format eq 'ISBN-13' ) {
739 $isbn = $isbn->as_isbn13();
743 if ($strip_hyphens) {
744 $string = $isbn->as_string( [] );
746 $string = $isbn->as_string();
750 } elsif ( $return_invalid ) {
756 =head2 GetVariationsOfISBN
758 my @isbns = GetVariationsOfISBN( $isbn );
760 Returns a list of variations of the given isbn in
761 both ISBN-10 and ISBN-13 formats, with and without
764 In a scalar context, the isbns are returned as a
765 string delimited by ' | '.
769 sub GetVariationsOfISBN {
776 push( @isbns, NormalizeISBN({ isbn => $isbn, return_invalid => 1 }) );
777 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) );
778 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) );
779 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) );
780 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
782 # Strip out any "empty" strings from the array
783 @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
785 return wantarray ? @isbns : join( " | ", @isbns );
788 =head2 GetVariationsOfISBNs
790 my @isbns = GetVariationsOfISBNs( @isbns );
792 Returns a list of variations of the given isbns in
793 both ISBN-10 and ISBN-13 formats, with and without
796 In a scalar context, the isbns are returned as a
797 string delimited by ' | '.
801 sub GetVariationsOfISBNs {
804 @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
806 return wantarray ? @isbns : join( " | ", @isbns );
809 =head2 NormalizedISSN
811 my $issns = NormalizedISSN({
813 strip_hyphen => [0,1]
816 Returns an issn validated by Business::ISSN.
817 Optionally strips hyphen.
819 If the string cannot be validated as an issn,
827 my $string = $params->{issn};
828 my $strip_hyphen = $params->{strip_hyphen};
830 my $issn = Business::ISSN->new($string);
832 if ( $issn && $issn->is_valid ){
835 $string = $issn->_issn;
838 $string = $issn->as_string;
845 =head2 GetVariationsOfISSN
847 my @issns = GetVariationsOfISSN( $issn );
849 Returns a list of variations of the given issn in
850 with and without a hyphen.
852 In a scalar context, the issns are returned as a
853 string delimited by ' | '.
857 sub GetVariationsOfISSN {
863 my $str = NormalizeISSN({ issn => $issn });
866 push @issns, NormalizeISSN({ issn => $issn, strip_hyphen => 1 });
871 # Strip out any "empty" strings from the array
872 @issns = grep { defined($_) && $_ =~ /\S/ } @issns;
874 return wantarray ? @issns : join( " | ", @issns );
877 =head2 GetVariationsOfISSNs
879 my @issns = GetVariationsOfISSNs( @issns );
881 Returns a list of variations of the given issns in
882 with and without a hyphen.
884 In a scalar context, the issns are returned as a
885 string delimited by ' | '.
889 sub GetVariationsOfISSNs {
892 @issns = map { GetVariationsOfISSN( $_ ) } @issns;
894 return wantarray ? @issns : join( " | ", @issns );