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