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