Bug 30735: Fix filtering by patron attribute with AV in overdues report
[koha.git] / C4 / Koha.pm
1 package C4::Koha;
2
3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright 2010 Nelsonville Public Library
5 # Parts copyright 2010 BibLibre
6 #
7 # This file is part of Koha.
8 #
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.
13 #
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.
18 #
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>.
21
22
23 use Modern::Perl;
24
25 use C4::Context;
26 use Koha::Caches;
27 use Koha::AuthorisedValues;
28 use Koha::Libraries;
29 use Koha::MarcSubfieldStructures;
30 use Business::ISBN;
31 use Business::ISSN;
32 use autouse 'Data::cselectall_arrayref' => qw(Dumper);
33
34 our (@ISA, @EXPORT_OK);
35 BEGIN {
36     require Exporter;
37     @ISA       = qw(Exporter);
38     @EXPORT_OK = qw(
39       GetItemTypesCategorized
40       getallthemes
41       getFacets
42       getImageSets
43       getnbpages
44       getitemtypeimagedir
45       getitemtypeimagesrc
46       getitemtypeimagelocation
47       GetAuthorisedValues
48       GetNormalizedUPC
49       GetNormalizedISBN
50       GetNormalizedEAN
51       GetNormalizedOCLCNumber
52       xml_escape
53
54       GetVariationsOfISBN
55       GetVariationsOfISBNs
56       NormalizeISBN
57       GetVariationsOfISSN
58       GetVariationsOfISSNs
59       NormalizeISSN
60
61     );
62 }
63
64 =head1 NAME
65
66 C4::Koha - Perl Module containing convenience functions for Koha scripts
67
68 =head1 SYNOPSIS
69
70 use C4::Koha;
71
72 =head1 DESCRIPTION
73
74 Koha.pm provides many functions for Koha scripts.
75
76 =head1 FUNCTIONS
77
78 =cut
79
80 =head2 GetItemTypesCategorized
81
82     $categories = GetItemTypesCategorized();
83
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)
87
88 =cut
89
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.
94     my $query = q|
95         SELECT itemtype, description, imageurl, hideinopac, 0 as 'iscat' FROM itemtypes WHERE ISNULL(searchcategory) or length(searchcategory) = 0
96         UNION
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'
101         FROM itemtypes
102         LEFT JOIN authorised_values ON searchcategory = authorised_value
103         WHERE searchcategory > '' and hideinopac=1
104         UNION
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'
109         FROM itemtypes
110         LEFT JOIN authorised_values ON searchcategory = authorised_value
111         WHERE searchcategory > '' and hideinopac=0
112         |;
113 return ($dbh->selectall_hashref($query,'itemtype'));
114 }
115
116 =head2 getitemtypeimagedir
117
118   my $directory = getitemtypeimagedir( 'opac' );
119
120 pass in 'opac' or 'intranet'. Defaults to 'opac'.
121
122 returns the full path to the appropriate directory containing images.
123
124 =cut
125
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';
130         } else {
131                 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
132         }
133 }
134
135 sub getitemtypeimagesrc {
136         my $src = shift || 'opac';
137         if ($src eq 'intranet') {
138                 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
139         } else {
140                 return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
141         }
142 }
143
144 sub getitemtypeimagelocation {
145         my ( $src, $image ) = @_;
146
147         return '' if ( !$image );
148     require URI::Split;
149
150         my $scheme = ( URI::Split::uri_split( $image ) )[0];
151
152         return $image if ( $scheme );
153
154         return getitemtypeimagesrc( $src ) . '/' . $image;
155 }
156
157 =head3 _getImagesFromDirectory
158
159 Find all of the image files in a directory in the filesystem
160
161 parameters: a directory name
162
163 returns: a list of images in that directory.
164
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.
169
170 =cut
171
172 sub _getImagesFromDirectory {
173     my $directoryname = shift;
174     return unless defined $directoryname;
175     return unless -d $directoryname;
176
177     if ( opendir ( my $dh, $directoryname ) ) {
178         my @images = grep { /\.(gif|png)$/i } readdir( $dh );
179         closedir $dh;
180         @images = sort(@images);
181         return @images;
182     } else {
183         warn "unable to opendir $directoryname: $!";
184         return;
185     }
186 }
187
188 =head3 _getSubdirectoryNames
189
190 Find all of the directories in a directory in the filesystem
191
192 parameters: a directory name
193
194 returns: a list of subdirectories in that directory.
195
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.
199
200 =cut
201
202 sub _getSubdirectoryNames {
203     my $directoryname = shift;
204     return unless defined $directoryname;
205     return unless -d $directoryname;
206
207     if ( opendir ( my $dh, $directoryname ) ) {
208         my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
209         closedir $dh;
210         return @directories;
211     } else {
212         warn "unable to opendir $directoryname: $!";
213         return;
214     }
215 }
216
217 =head3 getImageSets
218
219 returns: a listref of hashrefs. Each hash represents another collection of images.
220
221  { imagesetname => 'npl', # the name of the image set (npl is the original one)
222          images => listref of image hashrefs
223  }
224
225 each image is represented by a hashref like this:
226
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.
232  }
233
234 =cut
235
236 sub getImageSets {
237     my %params = @_;
238     my $checked = $params{'checked'} || '';
239
240     my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
241                              url        => getitemtypeimagesrc('intranet'),
242                         },
243                   opac => { filesystem => getitemtypeimagedir('opac'),
244                              url       => getitemtypeimagesrc('opac'),
245                         }
246                   };
247
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 ) {
255             push( @imagelist,
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,
260                }
261              );
262              $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
263         }
264         push @imagesets, { imagesetname => $imagesubdir,
265                            imagesetactive => $imagesetactive,
266                            images       => \@imagelist };
267         
268     }
269     return \@imagesets;
270 }
271
272 =head2 getnbpages
273
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.
276
277 =cut
278
279 sub getnbpages {
280     my ( $nb_items, $nb_items_per_page ) = @_;
281
282     return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
283 }
284
285 =head2 getallthemes
286
287   (@themes) = &getallthemes('opac');
288   (@themes) = &getallthemes('intranet');
289
290 Returns an array of all available themes.
291
292 =cut
293
294 sub getallthemes {
295     my $type = shift;
296     my $htdocs;
297     my @themes;
298     if ( $type eq 'intranet' ) {
299         $htdocs = C4::Context->config('intrahtdocs');
300     }
301     else {
302         $htdocs = C4::Context->config('opachtdocs');
303     }
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;
309     }
310     return @themes;
311 }
312
313 sub getFacets {
314     my $facets;
315     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
316         $facets = [
317             {
318                 idx   => 'su-to',
319                 label => 'Topics',
320                 tags  => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
321                 sep   => ' - ',
322             },
323             {
324                 idx   => 'su-geo',
325                 label => 'Places',
326                 tags  => [ qw/ 607a / ],
327                 sep   => ' - ',
328             },
329             {
330                 idx   => 'au',
331                 label => 'Authors',
332                 tags  => [ qw/ 700ab 701ab 702ab / ],
333                 sep   => C4::Context->preference("UNIMARCAuthorsFacetsSeparator"),
334             },
335             {
336                 idx   => 'se',
337                 label => 'Series',
338                 tags  => [ qw/ 225a / ],
339                 sep   => ', ',
340             },
341             {
342                 idx  => 'location',
343                 label => 'Location',
344                 tags        => [ qw/ 995e / ],
345             },
346             {
347                 idx => 'ccode',
348                 label => 'CollectionCodes',
349                 tags => [ qw / 099t 955h / ],
350             }
351             ];
352
353             unless ( Koha::Libraries->search->count == 1 )
354             {
355                 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
356                 if (   $DisplayLibraryFacets eq 'both'
357                     || $DisplayLibraryFacets eq 'holding' )
358                 {
359                     push(
360                         @$facets,
361                         {
362                             idx   => 'holdingbranch',
363                             label => 'HoldingLibrary',
364                             tags  => [qw / 995c /],
365                         }
366                     );
367                 }
368
369                 if (   $DisplayLibraryFacets eq 'both'
370                     || $DisplayLibraryFacets eq 'home' )
371                 {
372                 push(
373                     @$facets,
374                     {
375                         idx   => 'homebranch',
376                         label => 'HomeLibrary',
377                         tags  => [qw / 995b /],
378                     }
379                 );
380                 }
381             }
382     }
383     else {
384         $facets = [
385             {
386                 idx   => 'su-to',
387                 label => 'Topics',
388                 tags  => [ qw/ 650a / ],
389                 sep   => '--',
390             },
391             #        {
392             #        idx   => 'su-na',
393             #        label => 'People and Organizations',
394             #        tags  => [ qw/ 600a 610a 611a / ],
395             #        sep   => 'a',
396             #        },
397             {
398                 idx   => 'su-geo',
399                 label => 'Places',
400                 tags  => [ qw/ 651a / ],
401                 sep   => '--',
402             },
403             {
404                 idx   => 'su-ut',
405                 label => 'Titles',
406                 tags  => [ qw/ 630a / ],
407                 sep   => '--',
408             },
409             {
410                 idx   => 'au',
411                 label => 'Authors',
412                 tags  => [ qw/ 100a 110a 700a / ],
413                 sep   => ', ',
414             },
415             {
416                 idx   => 'se',
417                 label => 'Series',
418                 tags  => [ qw/ 440a 490a / ],
419                 sep   => ', ',
420             },
421             {
422                 idx   => 'itype',
423                 label => 'ItemTypes',
424                 tags  => [ qw/ 952y 942c / ],
425                 sep   => ', ',
426             },
427             {
428                 idx => 'location',
429                 label => 'Location',
430                 tags => [ qw / 952c / ],
431             },
432             {
433                 idx => 'ccode',
434                 label => 'CollectionCodes',
435                 tags => [ qw / 9528 / ],
436             }
437             ];
438
439             unless ( Koha::Libraries->search->count == 1 )
440             {
441                 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
442                 if (   $DisplayLibraryFacets eq 'both'
443                     || $DisplayLibraryFacets eq 'holding' )
444                 {
445                     push(
446                         @$facets,
447                         {
448                             idx   => 'holdingbranch',
449                             label => 'HoldingLibrary',
450                             tags  => [qw / 952b /],
451                         }
452                     );
453                 }
454
455                 if (   $DisplayLibraryFacets eq 'both'
456                     || $DisplayLibraryFacets eq 'home' )
457                 {
458                 push(
459                     @$facets,
460                     {
461                         idx   => 'homebranch',
462                         label => 'HomeLibrary',
463                         tags  => [qw / 952a /],
464                     }
465                 );
466                 }
467             }
468     }
469     return $facets;
470 }
471
472 =head2 GetAuthorisedValues
473
474   $authvalues = GetAuthorisedValues([$category]);
475
476 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
477
478 C<$category> returns authorised values for just one category (optional).
479
480 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
481
482 =cut
483
484 sub GetAuthorisedValues {
485     my ( $category, $opac ) = @_;
486
487     # Is this cached already?
488     $opac = $opac ? 1 : 0;    # normalise to be safe
489     my $branch_limit =
490       C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
491     my $cache_key =
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;
496
497     my @results;
498     my $dbh      = C4::Context->dbh;
499     my $query = qq{
500         SELECT DISTINCT av.*
501         FROM authorised_values av
502     };
503     $query .= qq{
504           LEFT JOIN authorised_values_branches ON ( id = av_id )
505     } if $branch_limit;
506     my @where_strings;
507     my @where_args;
508     if($category) {
509         push @where_strings, "category = ?";
510         push @where_args, $category;
511     }
512     if($branch_limit) {
513         push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
514         push @where_args, $branch_limit;
515     }
516     if(@where_strings > 0) {
517         $query .= " WHERE " . join(" AND ", @where_strings);
518     }
519     $query .= ' ORDER BY category, ' . (
520                 $opac ? 'COALESCE(lib_opac, lib)'
521                       : 'lib, lib_opac'
522               );
523
524     my $sth = $dbh->prepare($query);
525
526     $sth->execute( @where_args );
527     while (my $data=$sth->fetchrow_hashref) {
528         if ($opac && $data->{lib_opac}) {
529             $data->{lib} = $data->{lib_opac};
530         }
531         push @results, $data;
532     }
533     $sth->finish;
534
535     $cache->set_in_cache( $cache_key, \@results, { expiry => 5 } );
536     return \@results;
537 }
538
539 =head2 xml_escape
540
541   my $escaped_string = C4::Koha::xml_escape($string);
542
543 Convert &, <, >, ', and " in a string to XML entities
544
545 =cut
546
547 sub xml_escape {
548     my $str = shift;
549     return '' unless defined $str;
550     $str =~ s/&/&amp;/g;
551     $str =~ s/</&lt;/g;
552     $str =~ s/>/&gt;/g;
553     $str =~ s/'/&apos;/g;
554     $str =~ s/"/&quot;/g;
555     return $str;
556 }
557
558 =head2 display_marc_indicators
559
560   my $display_form = C4::Koha::display_marc_indicators($field);
561
562 C<$field> is a MARC::Field object
563
564 Generate a display form of the indicators of a variable
565 MARC field, replacing any blanks with '#'.
566
567 =cut
568
569 sub display_marc_indicators {
570     my $field = shift;
571     my $indicators = '';
572     if ($field && $field->tag() >= 10) {
573         $indicators = $field->indicator(1) . $field->indicator(2);
574         $indicators =~ s/ /#/g;
575     }
576     return $indicators;
577 }
578
579 sub GetNormalizedUPC {
580     my ($marcrecord,$marcflavour) = @_;
581
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'));
587             if ($upc) {
588                 return $upc;
589             }
590         }
591
592     }
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 ) {
599                 return $upc;
600             }
601         }
602     }
603 }
604
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) = @_;
609     if ($isbn) {
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);
614     }
615
616     return unless $marcrecord;
617
618     if ($marcflavour eq 'UNIMARC') {
619         my @fields = $marcrecord->field('010');
620         foreach my $field (@fields) {
621             my $isbn = $field->subfield('a');
622             if ($isbn) {
623                 return _isbn_cleanup($isbn);
624             }
625         }
626     }
627     else { # assume marc21 if not unimarc
628         my @fields = $marcrecord->field('020');
629         foreach my $field (@fields) {
630             $isbn = $field->subfield('a');
631             if ($isbn) {
632                 return _isbn_cleanup($isbn);
633             }
634         }
635     }
636 }
637
638 sub GetNormalizedEAN {
639     my ($marcrecord,$marcflavour) = @_;
640
641     return unless $marcrecord;
642
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'));
647             if ( $ean ) {
648                 return $ean;
649             }
650         }
651     }
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  ) {
658                 return $ean;
659             }
660         }
661     }
662 }
663
664 sub GetNormalizedOCLCNumber {
665     my ($marcrecord,$marcflavour) = @_;
666     return unless $marcrecord;
667
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\)//;
674                 return $oclc;
675             }
676         }
677     } else {
678         # TODO for UNIMARC
679     }
680     return
681 }
682
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;
687
688     return $normalized_match_point;
689 }
690
691 sub _isbn_cleanup {
692     my ($isbn) = @_;
693     return NormalizeISBN(
694         {
695             isbn          => $isbn,
696             format        => 'ISBN-10',
697             strip_hyphens => 1,
698         }
699     ) if $isbn;
700 }
701
702 =head2 NormalizeISBN
703
704   my $isbns = NormalizeISBN({
705     isbn => $isbn,
706     strip_hyphens => [0,1],
707     format => ['ISBN-10', 'ISBN-13']
708   });
709
710   Returns an isbn validated by Business::ISBN.
711   Optionally strips hyphens and/or forces the isbn
712   to be of the specified format.
713
714   If the string cannot be validated as an isbn,
715   it returns nothing unless return_invalid param is passed.
716
717   #FIXME This routine (and others?) should be moved to Koha::Util::Normalize
718
719 =cut
720
721 sub NormalizeISBN {
722     my ($params) = @_;
723
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};
728
729     return unless $string;
730
731     my $isbn = Business::ISBN->new($string);
732
733     if ( $isbn && $isbn->is_valid() ) {
734
735         if ( $format eq 'ISBN-10' ) {
736         $isbn = $isbn->as_isbn10();
737         }
738         elsif ( $format eq 'ISBN-13' ) {
739             $isbn = $isbn->as_isbn13();
740         }
741         return unless $isbn;
742
743         if ($strip_hyphens) {
744             $string = $isbn->as_string( [] );
745         } else {
746             $string = $isbn->as_string();
747         }
748
749         return $string;
750     } elsif ( $return_invalid ) {
751         return $string;
752     }
753
754 }
755
756 =head2 GetVariationsOfISBN
757
758   my @isbns = GetVariationsOfISBN( $isbn );
759
760   Returns a list of variations of the given isbn in
761   both ISBN-10 and ISBN-13 formats, with and without
762   hyphens.
763
764   In a scalar context, the isbns are returned as a
765   string delimited by ' | '.
766
767 =cut
768
769 sub GetVariationsOfISBN {
770     my ($isbn) = @_;
771
772     return unless $isbn;
773
774     my @isbns;
775
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 }) );
781
782     # Strip out any "empty" strings from the array
783     @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
784
785     return wantarray ? @isbns : join( " | ", @isbns );
786 }
787
788 =head2 GetVariationsOfISBNs
789
790   my @isbns = GetVariationsOfISBNs( @isbns );
791
792   Returns a list of variations of the given isbns in
793   both ISBN-10 and ISBN-13 formats, with and without
794   hyphens.
795
796   In a scalar context, the isbns are returned as a
797   string delimited by ' | '.
798
799 =cut
800
801 sub GetVariationsOfISBNs {
802     my (@isbns) = @_;
803
804     @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
805
806     return wantarray ? @isbns : join( " | ", @isbns );
807 }
808
809 =head2 NormalizedISSN
810
811   my $issns = NormalizedISSN({
812           issn => $issn,
813           strip_hyphen => [0,1]
814           });
815
816   Returns an issn validated by Business::ISSN.
817   Optionally strips hyphen.
818
819   If the string cannot be validated as an issn,
820   it returns nothing.
821
822 =cut
823
824 sub NormalizeISSN {
825     my ($params) = @_;
826
827     my $string        = $params->{issn};
828     my $strip_hyphen  = $params->{strip_hyphen};
829
830     my $issn = Business::ISSN->new($string);
831
832     if ( $issn && $issn->is_valid ){
833
834         if ($strip_hyphen) {
835             $string = $issn->_issn;
836         }
837         else {
838             $string = $issn->as_string;
839         }
840         return $string;
841     }
842
843 }
844
845 =head2 GetVariationsOfISSN
846
847   my @issns = GetVariationsOfISSN( $issn );
848
849   Returns a list of variations of the given issn in
850   with and without a hyphen.
851
852   In a scalar context, the issns are returned as a
853   string delimited by ' | '.
854
855 =cut
856
857 sub GetVariationsOfISSN {
858     my ( $issn ) = @_;
859
860     return unless $issn;
861
862     my @issns;
863     my $str = NormalizeISSN({ issn => $issn });
864     if( $str ) {
865         push @issns, $str;
866         push @issns, NormalizeISSN({ issn => $issn, strip_hyphen => 1 });
867     }  else {
868         push @issns, $issn;
869     }
870
871     # Strip out any "empty" strings from the array
872     @issns = grep { defined($_) && $_ =~ /\S/ } @issns;
873
874     return wantarray ? @issns : join( " | ", @issns );
875 }
876
877 =head2 GetVariationsOfISSNs
878
879   my @issns = GetVariationsOfISSNs( @issns );
880
881   Returns a list of variations of the given issns in
882   with and without a hyphen.
883
884   In a scalar context, the issns are returned as a
885   string delimited by ' | '.
886
887 =cut
888
889 sub GetVariationsOfISSNs {
890     my (@issns) = @_;
891
892     @issns = map { GetVariationsOfISSN( $_ ) } @issns;
893
894     return wantarray ? @issns : join( " | ", @issns );
895 }
896
897 1;
898
899 __END__
900
901 =head1 AUTHOR
902
903 Koha Team
904
905 =cut