Bug 23597: Add missing reserved query parameters to GET /holds
[koha.git] / C4 / Koha.pm
blob9894a060cfed487ee476381340ece6184ad50d33
1 package C4::Koha;
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>.
23 use strict;
24 #use warnings; FIXME - Bug 2505
26 use C4::Context;
27 use Koha::Caches;
28 use Koha::DateUtils qw(dt_from_string);
29 use Koha::AuthorisedValues;
30 use Koha::Libraries;
31 use Koha::MarcSubfieldStructures;
32 use DateTime::Format::MySQL;
33 use Business::ISBN;
34 use Business::ISSN;
35 use autouse 'Data::cselectall_arrayref' => qw(Dumper);
36 use DBI qw(:sql_types);
37 use vars qw(@ISA @EXPORT @EXPORT_OK $DEBUG);
39 BEGIN {
40 require Exporter;
41 @ISA = qw(Exporter);
42 @EXPORT = qw(
43 &GetPrinters &GetPrinter
44 &GetItemTypesCategorized
45 &getallthemes
46 &getFacets
47 &getnbpages
48 &getitemtypeimagedir
49 &getitemtypeimagesrc
50 &getitemtypeimagelocation
51 &GetAuthorisedValues
52 &GetNormalizedUPC
53 &GetNormalizedISBN
54 &GetNormalizedEAN
55 &GetNormalizedOCLCNumber
56 &xml_escape
58 &GetVariationsOfISBN
59 &GetVariationsOfISBNs
60 &NormalizeISBN
61 &GetVariationsOfISSN
62 &GetVariationsOfISSNs
63 &NormalizeISSN
65 $DEBUG
67 $DEBUG = 0;
68 @EXPORT_OK = qw( GetDailyQuote );
71 =head1 NAME
73 C4::Koha - Perl Module containing convenience functions for Koha scripts
75 =head1 SYNOPSIS
77 use C4::Koha;
79 =head1 DESCRIPTION
81 Koha.pm provides many functions for Koha scripts.
83 =head1 FUNCTIONS
85 =cut
87 =head2 GetItemTypesCategorized
89 $categories = GetItemTypesCategorized();
91 Returns a hashref containing search categories.
92 A search category will be put in the hash if at least one of its itemtypes is visible in OPAC.
93 The categories must be part of Authorized Values (ITEMTYPECAT)
95 =cut
97 sub GetItemTypesCategorized {
98 my $dbh = C4::Context->dbh;
99 # Order is important, so that partially hidden (some items are not visible in OPAC) search
100 # categories will be visible. hideinopac=0 must be last.
101 my $query = q|
102 SELECT itemtype, description, imageurl, hideinopac, 0 as 'iscat' FROM itemtypes WHERE ISNULL(searchcategory) or length(searchcategory) = 0
103 UNION
104 SELECT DISTINCT searchcategory AS `itemtype`,
105 authorised_values.lib_opac AS description,
106 authorised_values.imageurl AS imageurl,
107 hideinopac, 1 as 'iscat'
108 FROM itemtypes
109 LEFT JOIN authorised_values ON searchcategory = authorised_value
110 WHERE searchcategory > '' and hideinopac=1
111 UNION
112 SELECT DISTINCT searchcategory AS `itemtype`,
113 authorised_values.lib_opac AS description,
114 authorised_values.imageurl AS imageurl,
115 hideinopac, 1 as 'iscat'
116 FROM itemtypes
117 LEFT JOIN authorised_values ON searchcategory = authorised_value
118 WHERE searchcategory > '' and hideinopac=0
120 return ($dbh->selectall_hashref($query,'itemtype'));
123 =head2 getitemtypeimagedir
125 my $directory = getitemtypeimagedir( 'opac' );
127 pass in 'opac' or 'intranet'. Defaults to 'opac'.
129 returns the full path to the appropriate directory containing images.
131 =cut
133 sub getitemtypeimagedir {
134 my $src = shift || 'opac';
135 if ($src eq 'intranet') {
136 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
137 } else {
138 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
142 sub getitemtypeimagesrc {
143 my $src = shift || 'opac';
144 if ($src eq 'intranet') {
145 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
146 } else {
147 return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
151 sub getitemtypeimagelocation {
152 my ( $src, $image ) = @_;
154 return '' if ( !$image );
155 require URI::Split;
157 my $scheme = ( URI::Split::uri_split( $image ) )[0];
159 return $image if ( $scheme );
161 return getitemtypeimagesrc( $src ) . '/' . $image;
164 =head3 _getImagesFromDirectory
166 Find all of the image files in a directory in the filesystem
168 parameters: a directory name
170 returns: a list of images in that directory.
172 Notes: this does not traverse into subdirectories. See
173 _getSubdirectoryNames for help with that.
174 Images are assumed to be files with .gif or .png file extensions.
175 The image names returned do not have the directory name on them.
177 =cut
179 sub _getImagesFromDirectory {
180 my $directoryname = shift;
181 return unless defined $directoryname;
182 return unless -d $directoryname;
184 if ( opendir ( my $dh, $directoryname ) ) {
185 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
186 closedir $dh;
187 @images = sort(@images);
188 return @images;
189 } else {
190 warn "unable to opendir $directoryname: $!";
191 return;
195 =head3 _getSubdirectoryNames
197 Find all of the directories in a directory in the filesystem
199 parameters: a directory name
201 returns: a list of subdirectories in that directory.
203 Notes: this does not traverse into subdirectories. Only the first
204 level of subdirectories are returned.
205 The directory names returned don't have the parent directory name on them.
207 =cut
209 sub _getSubdirectoryNames {
210 my $directoryname = shift;
211 return unless defined $directoryname;
212 return unless -d $directoryname;
214 if ( opendir ( my $dh, $directoryname ) ) {
215 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
216 closedir $dh;
217 return @directories;
218 } else {
219 warn "unable to opendir $directoryname: $!";
220 return;
224 =head3 getImageSets
226 returns: a listref of hashrefs. Each hash represents another collection of images.
228 { imagesetname => 'npl', # the name of the image set (npl is the original one)
229 images => listref of image hashrefs
232 each image is represented by a hashref like this:
234 { KohaImage => 'npl/image.gif',
235 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
236 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
237 checked => 0 or 1: was this the image passed to this method?
238 Note: I'd like to remove this somehow.
241 =cut
243 sub getImageSets {
244 my %params = @_;
245 my $checked = $params{'checked'} || '';
247 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
248 url => getitemtypeimagesrc('intranet'),
250 opac => { filesystem => getitemtypeimagedir('opac'),
251 url => getitemtypeimagesrc('opac'),
255 my @imagesets = (); # list of hasrefs of image set data to pass to template
256 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
257 foreach my $imagesubdir ( @subdirectories ) {
258 warn $imagesubdir if $DEBUG;
259 my @imagelist = (); # hashrefs of image info
260 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
261 my $imagesetactive = 0;
262 foreach my $thisimage ( @imagenames ) {
263 push( @imagelist,
264 { KohaImage => "$imagesubdir/$thisimage",
265 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
266 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
267 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
270 $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
272 push @imagesets, { imagesetname => $imagesubdir,
273 imagesetactive => $imagesetactive,
274 images => \@imagelist };
277 return \@imagesets;
280 =head2 GetPrinters
282 $printers = &GetPrinters();
283 @queues = keys %$printers;
285 Returns information about existing printer queues.
287 C<$printers> is a reference-to-hash whose keys are the print queues
288 defined in the printers table of the Koha database. The values are
289 references-to-hash, whose keys are the fields in the printers table.
291 =cut
293 sub GetPrinters {
294 my %printers;
295 my $dbh = C4::Context->dbh;
296 my $sth = $dbh->prepare("select * from printers");
297 $sth->execute;
298 while ( my $printer = $sth->fetchrow_hashref ) {
299 $printers{ $printer->{'printqueue'} } = $printer;
301 return ( \%printers );
304 =head2 GetPrinter
306 $printer = GetPrinter( $query, $printers );
308 =cut
310 sub GetPrinter {
311 my ( $query, $printers ) = @_; # get printer for this query from printers
312 my $printer = $query->param('printer');
313 my %cookie = $query->cookie('userenv');
314 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
315 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
316 return $printer;
319 =head2 getnbpages
321 Returns the number of pages to display in a pagination bar, given the number
322 of items and the number of items per page.
324 =cut
326 sub getnbpages {
327 my ( $nb_items, $nb_items_per_page ) = @_;
329 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
332 =head2 getallthemes
334 (@themes) = &getallthemes('opac');
335 (@themes) = &getallthemes('intranet');
337 Returns an array of all available themes.
339 =cut
341 sub getallthemes {
342 my $type = shift;
343 my $htdocs;
344 my @themes;
345 if ( $type eq 'intranet' ) {
346 $htdocs = C4::Context->config('intrahtdocs');
348 else {
349 $htdocs = C4::Context->config('opachtdocs');
351 opendir D, "$htdocs";
352 my @dirlist = readdir D;
353 foreach my $directory (@dirlist) {
354 next if $directory eq 'lib';
355 -d "$htdocs/$directory/en" and push @themes, $directory;
357 return @themes;
360 sub getFacets {
361 my $facets;
362 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
363 $facets = [
365 idx => 'su-to',
366 label => 'Topics',
367 tags => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
368 sep => ' - ',
371 idx => 'su-geo',
372 label => 'Places',
373 tags => [ qw/ 607a / ],
374 sep => ' - ',
377 idx => 'su-ut',
378 label => 'Titles',
379 tags => [ qw/ 500a 501a 503a / ],
380 sep => ', ',
383 idx => 'au',
384 label => 'Authors',
385 tags => [ qw/ 700ab 701ab 702ab / ],
386 sep => C4::Context->preference("UNIMARCAuthorsFacetsSeparator"),
389 idx => 'se',
390 label => 'Series',
391 tags => [ qw/ 225a / ],
392 sep => ', ',
395 idx => 'location',
396 label => 'Location',
397 tags => [ qw/ 995e / ],
400 idx => 'ccode',
401 label => 'CollectionCodes',
402 tags => [ qw / 099t 955h / ],
406 unless ( Koha::Libraries->search->count == 1 )
408 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
409 if ( $DisplayLibraryFacets eq 'both'
410 || $DisplayLibraryFacets eq 'holding' )
412 push(
413 @$facets,
415 idx => 'holdingbranch',
416 label => 'HoldingLibrary',
417 tags => [qw / 995c /],
422 if ( $DisplayLibraryFacets eq 'both'
423 || $DisplayLibraryFacets eq 'home' )
425 push(
426 @$facets,
428 idx => 'homebranch',
429 label => 'HomeLibrary',
430 tags => [qw / 995b /],
436 else {
437 $facets = [
439 idx => 'su-to',
440 label => 'Topics',
441 tags => [ qw/ 650a / ],
442 sep => '--',
445 # idx => 'su-na',
446 # label => 'People and Organizations',
447 # tags => [ qw/ 600a 610a 611a / ],
448 # sep => 'a',
449 # },
451 idx => 'su-geo',
452 label => 'Places',
453 tags => [ qw/ 651a / ],
454 sep => '--',
457 idx => 'su-ut',
458 label => 'Titles',
459 tags => [ qw/ 630a / ],
460 sep => '--',
463 idx => 'au',
464 label => 'Authors',
465 tags => [ qw/ 100a 110a 700a / ],
466 sep => ', ',
469 idx => 'se',
470 label => 'Series',
471 tags => [ qw/ 440a 490a / ],
472 sep => ', ',
475 idx => 'itype',
476 label => 'ItemTypes',
477 tags => [ qw/ 952y 942c / ],
478 sep => ', ',
481 idx => 'location',
482 label => 'Location',
483 tags => [ qw / 952c / ],
486 idx => 'ccode',
487 label => 'CollectionCodes',
488 tags => [ qw / 9528 / ],
492 unless ( Koha::Libraries->search->count == 1 )
494 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
495 if ( $DisplayLibraryFacets eq 'both'
496 || $DisplayLibraryFacets eq 'holding' )
498 push(
499 @$facets,
501 idx => 'holdingbranch',
502 label => 'HoldingLibrary',
503 tags => [qw / 952b /],
508 if ( $DisplayLibraryFacets eq 'both'
509 || $DisplayLibraryFacets eq 'home' )
511 push(
512 @$facets,
514 idx => 'homebranch',
515 label => 'HomeLibrary',
516 tags => [qw / 952a /],
522 return $facets;
525 =head2 GetAuthorisedValues
527 $authvalues = GetAuthorisedValues([$category]);
529 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
531 C<$category> returns authorised values for just one category (optional).
533 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
535 =cut
537 sub GetAuthorisedValues {
538 my ( $category, $opac ) = @_;
540 # Is this cached already?
541 $opac = $opac ? 1 : 0; # normalise to be safe
542 my $branch_limit =
543 C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
544 my $cache_key =
545 "AuthorisedValues-$category-$opac-$branch_limit";
546 my $cache = Koha::Caches->get_instance();
547 my $result = $cache->get_from_cache($cache_key);
548 return $result if $result;
550 my @results;
551 my $dbh = C4::Context->dbh;
552 my $query = qq{
553 SELECT DISTINCT av.*
554 FROM authorised_values av
556 $query .= qq{
557 LEFT JOIN authorised_values_branches ON ( id = av_id )
558 } if $branch_limit;
559 my @where_strings;
560 my @where_args;
561 if($category) {
562 push @where_strings, "category = ?";
563 push @where_args, $category;
565 if($branch_limit) {
566 push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
567 push @where_args, $branch_limit;
569 if(@where_strings > 0) {
570 $query .= " WHERE " . join(" AND ", @where_strings);
572 $query .= ' ORDER BY category, ' . (
573 $opac ? 'COALESCE(lib_opac, lib)'
574 : 'lib, lib_opac'
577 my $sth = $dbh->prepare($query);
579 $sth->execute( @where_args );
580 while (my $data=$sth->fetchrow_hashref) {
581 if ($opac && $data->{lib_opac}) {
582 $data->{lib} = $data->{lib_opac};
584 push @results, $data;
586 $sth->finish;
588 $cache->set_in_cache( $cache_key, \@results, { expiry => 5 } );
589 return \@results;
592 =head2 xml_escape
594 my $escaped_string = C4::Koha::xml_escape($string);
596 Convert &, <, >, ', and " in a string to XML entities
598 =cut
600 sub xml_escape {
601 my $str = shift;
602 return '' unless defined $str;
603 $str =~ s/&/&amp;/g;
604 $str =~ s/</&lt;/g;
605 $str =~ s/>/&gt;/g;
606 $str =~ s/'/&apos;/g;
607 $str =~ s/"/&quot;/g;
608 return $str;
611 =head2 display_marc_indicators
613 my $display_form = C4::Koha::display_marc_indicators($field);
615 C<$field> is a MARC::Field object
617 Generate a display form of the indicators of a variable
618 MARC field, replacing any blanks with '#'.
620 =cut
622 sub display_marc_indicators {
623 my $field = shift;
624 my $indicators = '';
625 if ($field && $field->tag() >= 10) {
626 $indicators = $field->indicator(1) . $field->indicator(2);
627 $indicators =~ s/ /#/g;
629 return $indicators;
632 sub GetNormalizedUPC {
633 my ($marcrecord,$marcflavour) = @_;
635 return unless $marcrecord;
636 if ($marcflavour eq 'UNIMARC') {
637 my @fields = $marcrecord->field('072');
638 foreach my $field (@fields) {
639 my $upc = _normalize_match_point($field->subfield('a'));
640 if ($upc) {
641 return $upc;
646 else { # assume marc21 if not unimarc
647 my @fields = $marcrecord->field('024');
648 foreach my $field (@fields) {
649 my $indicator = $field->indicator(1);
650 my $upc = _normalize_match_point($field->subfield('a'));
651 if ($upc && $indicator == 1 ) {
652 return $upc;
658 # Normalizes and returns the first valid ISBN found in the record
659 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
660 sub GetNormalizedISBN {
661 my ($isbn,$marcrecord,$marcflavour) = @_;
662 if ($isbn) {
663 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
664 # anything after " | " should be removed, along with the delimiter
665 ($isbn) = split(/\|/, $isbn );
666 return _isbn_cleanup($isbn);
669 return unless $marcrecord;
671 if ($marcflavour eq 'UNIMARC') {
672 my @fields = $marcrecord->field('010');
673 foreach my $field (@fields) {
674 my $isbn = $field->subfield('a');
675 if ($isbn) {
676 return _isbn_cleanup($isbn);
680 else { # assume marc21 if not unimarc
681 my @fields = $marcrecord->field('020');
682 foreach my $field (@fields) {
683 $isbn = $field->subfield('a');
684 if ($isbn) {
685 return _isbn_cleanup($isbn);
691 sub GetNormalizedEAN {
692 my ($marcrecord,$marcflavour) = @_;
694 return unless $marcrecord;
696 if ($marcflavour eq 'UNIMARC') {
697 my @fields = $marcrecord->field('073');
698 foreach my $field (@fields) {
699 my $ean = _normalize_match_point($field->subfield('a'));
700 if ( $ean ) {
701 return $ean;
705 else { # assume marc21 if not unimarc
706 my @fields = $marcrecord->field('024');
707 foreach my $field (@fields) {
708 my $indicator = $field->indicator(1);
709 my $ean = _normalize_match_point($field->subfield('a'));
710 if ( $ean && $indicator == 3 ) {
711 return $ean;
717 sub GetNormalizedOCLCNumber {
718 my ($marcrecord,$marcflavour) = @_;
719 return unless $marcrecord;
721 if ($marcflavour ne 'UNIMARC' ) {
722 my @fields = $marcrecord->field('035');
723 foreach my $field (@fields) {
724 my $oclc = $field->subfield('a');
725 if ($oclc =~ /OCoLC/) {
726 $oclc =~ s/\(OCoLC\)//;
727 return $oclc;
730 } else {
731 # TODO for UNIMARC
733 return
736 =head2 GetDailyQuote($opts)
738 Takes a hashref of options
740 Currently supported options are:
742 'id' An exact quote id
743 'random' Select a random quote
744 noop When no option is passed in, this sub will return the quote timestamped for the current day
746 The function returns an anonymous hash following this format:
749 'source' => 'source-of-quote',
750 'timestamp' => 'timestamp-value',
751 'text' => 'text-of-quote',
752 'id' => 'quote-id'
755 =cut
757 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
758 # at least for default option
760 sub GetDailyQuote {
761 my %opts = @_;
762 my $dbh = C4::Context->dbh;
763 my $query = '';
764 my $sth = undef;
765 my $quote = undef;
766 if ($opts{'id'}) {
767 $query = 'SELECT * FROM quotes WHERE id = ?';
768 $sth = $dbh->prepare($query);
769 $sth->execute($opts{'id'});
770 $quote = $sth->fetchrow_hashref();
772 elsif ($opts{'random'}) {
773 # Fall through... we also return a random quote as a catch-all if all else fails
775 else {
776 $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
777 $sth = $dbh->prepare($query);
778 $sth->execute();
779 $quote = $sth->fetchrow_hashref();
781 unless ($quote) { # if there are not matches, choose a random quote
782 # get a list of all available quote ids
783 $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
784 $sth->execute;
785 my $range = ($sth->fetchrow_array)[0];
786 # chose a random id within that range if there is more than one quote
787 my $offset = int(rand($range));
788 # grab it
789 $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
790 $sth = C4::Context->dbh->prepare($query);
791 # see http://www.perlmonks.org/?node_id=837422 for why
792 # we're being verbose and using bind_param
793 $sth->bind_param(1, $offset, SQL_INTEGER);
794 $sth->execute();
795 $quote = $sth->fetchrow_hashref();
796 # update the timestamp for that quote
797 $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
798 $sth = C4::Context->dbh->prepare($query);
799 $sth->execute(
800 DateTime::Format::MySQL->format_datetime( dt_from_string() ),
801 $quote->{'id'}
804 return $quote;
807 sub _normalize_match_point {
808 my $match_point = shift;
809 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
810 $normalized_match_point =~ s/-//g;
812 return $normalized_match_point;
815 sub _isbn_cleanup {
816 my ($isbn) = @_;
817 return NormalizeISBN(
819 isbn => $isbn,
820 format => 'ISBN-10',
821 strip_hyphens => 1,
823 ) if $isbn;
826 =head2 NormalizeISBN
828 my $isbns = NormalizeISBN({
829 isbn => $isbn,
830 strip_hyphens => [0,1],
831 format => ['ISBN-10', 'ISBN-13']
834 Returns an isbn validated by Business::ISBN.
835 Optionally strips hyphens and/or forces the isbn
836 to be of the specified format.
838 If the string cannot be validated as an isbn,
839 it returns nothing unless return_invalid param is passed.
841 #FIXME This routine (and others?) should be moved to Koha::Util::Normalize
843 =cut
845 sub NormalizeISBN {
846 my ($params) = @_;
848 my $string = $params->{isbn};
849 my $strip_hyphens = $params->{strip_hyphens};
850 my $format = $params->{format};
851 my $return_invalid = $params->{return_invalid};
853 return unless $string;
855 my $isbn = Business::ISBN->new($string);
857 if ( $isbn && $isbn->is_valid() ) {
859 if ( $format eq 'ISBN-10' ) {
860 $isbn = $isbn->as_isbn10();
862 elsif ( $format eq 'ISBN-13' ) {
863 $isbn = $isbn->as_isbn13();
865 return unless $isbn;
867 if ($strip_hyphens) {
868 $string = $isbn->as_string( [] );
869 } else {
870 $string = $isbn->as_string();
873 return $string;
874 } elsif ( $return_invalid ) {
875 return $string;
880 =head2 GetVariationsOfISBN
882 my @isbns = GetVariationsOfISBN( $isbn );
884 Returns a list of variations of the given isbn in
885 both ISBN-10 and ISBN-13 formats, with and without
886 hyphens.
888 In a scalar context, the isbns are returned as a
889 string delimited by ' | '.
891 =cut
893 sub GetVariationsOfISBN {
894 my ($isbn) = @_;
896 return unless $isbn;
898 my @isbns;
900 push( @isbns, NormalizeISBN({ isbn => $isbn }) );
901 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) );
902 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) );
903 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) );
904 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
906 # Strip out any "empty" strings from the array
907 @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
909 return wantarray ? @isbns : join( " | ", @isbns );
912 =head2 GetVariationsOfISBNs
914 my @isbns = GetVariationsOfISBNs( @isbns );
916 Returns a list of variations of the given isbns in
917 both ISBN-10 and ISBN-13 formats, with and without
918 hyphens.
920 In a scalar context, the isbns are returned as a
921 string delimited by ' | '.
923 =cut
925 sub GetVariationsOfISBNs {
926 my (@isbns) = @_;
928 @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
930 return wantarray ? @isbns : join( " | ", @isbns );
933 =head2 NormalizedISSN
935 my $issns = NormalizedISSN({
936 issn => $issn,
937 strip_hyphen => [0,1]
940 Returns an issn validated by Business::ISSN.
941 Optionally strips hyphen.
943 If the string cannot be validated as an issn,
944 it returns nothing.
946 =cut
948 sub NormalizeISSN {
949 my ($params) = @_;
951 my $string = $params->{issn};
952 my $strip_hyphen = $params->{strip_hyphen};
954 my $issn = Business::ISSN->new($string);
956 if ( $issn && $issn->is_valid ){
958 if ($strip_hyphen) {
959 $string = $issn->_issn;
961 else {
962 $string = $issn->as_string;
964 return $string;
969 =head2 GetVariationsOfISSN
971 my @issns = GetVariationsOfISSN( $issn );
973 Returns a list of variations of the given issn in
974 with and without a hyphen.
976 In a scalar context, the issns are returned as a
977 string delimited by ' | '.
979 =cut
981 sub GetVariationsOfISSN {
982 my ( $issn ) = @_;
984 return unless $issn;
986 my @issns;
987 my $str = NormalizeISSN({ issn => $issn });
988 if( $str ) {
989 push @issns, $str;
990 push @issns, NormalizeISSN({ issn => $issn, strip_hyphen => 1 });
991 } else {
992 push @issns, $issn;
995 # Strip out any "empty" strings from the array
996 @issns = grep { defined($_) && $_ =~ /\S/ } @issns;
998 return wantarray ? @issns : join( " | ", @issns );
1001 =head2 GetVariationsOfISSNs
1003 my @issns = GetVariationsOfISSNs( @issns );
1005 Returns a list of variations of the given issns in
1006 with and without a hyphen.
1008 In a scalar context, the issns are returned as a
1009 string delimited by ' | '.
1011 =cut
1013 sub GetVariationsOfISSNs {
1014 my (@issns) = @_;
1016 @issns = map { GetVariationsOfISSN( $_ ) } @issns;
1018 return wantarray ? @issns : join( " | ", @issns );
1023 __END__
1025 =head1 AUTHOR
1027 Koha Team
1029 =cut