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     my $dir_h;
 305     opendir $dir_h, "$htdocs";
 306     my @dirlist = readdir $dir_h;
 307     foreach my $directory (@dirlist) {
 308         next if $directory eq 'lib';
 309         -d "$htdocs/$directory/en" and push @themes, $directory;
 310     }
 311     close $dir_h;
 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 = shift // '';  # optional parameter
 488     my $opac = shift ? 1 : 0;  # normalise to be safe
 489
 490     # Is this cached already?
 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     $marcflavour ||= C4::Context->preference('marcflavour');
 585
 586     return unless $marcrecord;
 587     if ($marcflavour eq 'UNIMARC') {
 588         my @fields = $marcrecord->field('072');
 589         foreach my $field (@fields) {
 590             my $upc = _normalize_match_point($field->subfield('a'));
 591             if ($upc) {
 592                 return $upc;
 593             }
 594         }
 595
 596     }
 597     else { # assume marc21 if not unimarc
 598         my @fields = $marcrecord->field('024');
 599         foreach my $field (@fields) {
 600             my $indicator = $field->indicator(1);
 601             my $upc = _normalize_match_point($field->subfield('a'));
 602             if ($upc && $indicator == 1 ) {
 603                 return $upc;
 604             }
 605         }
 606     }
 607 }
 608
 609 # Normalizes and returns the first valid ISBN found in the record
 610 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
 611 sub GetNormalizedISBN {
 612     my ($isbn,$marcrecord,$marcflavour) = @_;
 613     if ($isbn) {
 614         # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
 615         # anything after " | " should be removed, along with the delimiter
 616         ($isbn) = split(/\|/, $isbn );
 617         return _isbn_cleanup($isbn);
 618     }
 619
 620     return unless $marcrecord;
 621
 622     if ($marcflavour eq 'UNIMARC') {
 623         my @fields = $marcrecord->field('010');
 624         foreach my $field (@fields) {
 625             my $isbn = $field->subfield('a');
 626             if ($isbn) {
 627                 return _isbn_cleanup($isbn);
 628             }
 629         }
 630     }
 631     else { # assume marc21 if not unimarc
 632         my @fields = $marcrecord->field('020');
 633         foreach my $field (@fields) {
 634             $isbn = $field->subfield('a');
 635             if ($isbn) {
 636                 return _isbn_cleanup($isbn);
 637             }
 638         }
 639     }
 640 }
 641
 642 sub GetNormalizedEAN {
 643     my ($marcrecord,$marcflavour) = @_;
 644
 645     return unless $marcrecord;
 646
 647     if ($marcflavour eq 'UNIMARC') {
 648         my @fields = $marcrecord->field('073');
 649         foreach my $field (@fields) {
 650             my $ean = _normalize_match_point($field->subfield('a'));
 651             if ( $ean ) {
 652                 return $ean;
 653             }
 654         }
 655     }
 656     else { # assume marc21 if not unimarc
 657         my @fields = $marcrecord->field('024');
 658         foreach my $field (@fields) {
 659             my $indicator = $field->indicator(1);
 660             my $ean = _normalize_match_point($field->subfield('a'));
 661             if ( $ean && $indicator == 3  ) {
 662                 return $ean;
 663             }
 664         }
 665     }
 666 }
 667
 668 sub GetNormalizedOCLCNumber {
 669     my ($marcrecord,$marcflavour) = @_;
 670     return unless $marcrecord;
 671
 672     $marcflavour ||= C4::Context->preference('marcflavour');
 673
 674     if ($marcflavour ne 'UNIMARC' ) {
 675         my @fields = $marcrecord->field('035');
 676         foreach my $field (@fields) {
 677             my $oclc = $field->subfield('a');
 678             if ($oclc && $oclc =~ /OCoLC/) {
 679                 $oclc =~ s/\(OCoLC\)//;
 680                 return $oclc;
 681             }
 682         }
 683     } else {
 684         # TODO for UNIMARC
 685     }
 686 }
 687
 688 sub _normalize_match_point {
 689     my $match_point = shift;
 690     (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
 691     $normalized_match_point =~ s/-//g;
 692
 693     return $normalized_match_point;
 694 }
 695
 696 sub _isbn_cleanup {
 697     my ($isbn) = @_;
 698     return NormalizeISBN(
 699         {
 700             isbn          => $isbn,
 701             format        => 'ISBN-10',
 702             strip_hyphens => 1,
 703         }
 704     ) if $isbn;
 705 }
 706
 707 =head2 NormalizeISBN
 708
 709   my $isbns = NormalizeISBN({
 710     isbn => $isbn,
 711     strip_hyphens => [0,1],
 712     format => ['ISBN-10', 'ISBN-13']
 713   });
 714
 715   Returns an isbn validated by Business::ISBN.
 716   Optionally strips hyphens and/or forces the isbn
 717   to be of the specified format.
 718
 719   If the string cannot be validated as an isbn,
 720   it returns nothing unless return_invalid param is passed.
 721
 722   #FIXME This routine (and others?) should be moved to Koha::Util::Normalize
 723
 724 =cut
 725
 726 sub NormalizeISBN {
 727     my ($params) = @_;
 728
 729     my $string        = $params->{isbn};
 730     my $strip_hyphens = $params->{strip_hyphens};
 731     my $format        = $params->{format} || q{};
 732     my $return_invalid = $params->{return_invalid};
 733
 734     return unless $string;
 735
 736     my $isbn = Business::ISBN->new($string);
 737
 738     if ( $isbn && $isbn->is_valid() ) {
 739
 740         if ( $format eq 'ISBN-10' ) {
 741         $isbn = $isbn->as_isbn10();
 742         }
 743         elsif ( $format eq 'ISBN-13' ) {
 744             $isbn = $isbn->as_isbn13();
 745         }
 746         return unless $isbn;
 747
 748         if ($strip_hyphens) {
 749             $string = $isbn->as_string( [] );
 750         } else {
 751             $string = $isbn->as_string();
 752         }
 753
 754         return $string;
 755     } elsif ( $return_invalid ) {
 756         return $string;
 757     }
 758
 759 }
 760
 761 =head2 GetVariationsOfISBN
 762
 763   my @isbns = GetVariationsOfISBN( $isbn );
 764
 765   Returns a list of variations of the given isbn in
 766   both ISBN-10 and ISBN-13 formats, with and without
 767   hyphens.
 768
 769   In a scalar context, the isbns are returned as a
 770   string delimited by ' | '.
 771
 772 =cut
 773
 774 sub GetVariationsOfISBN {
 775     my ($isbn) = @_;
 776
 777     return unless $isbn;
 778
 779     my @isbns;
 780
 781     push( @isbns, NormalizeISBN({ isbn => $isbn, return_invalid => 1 }) );
 782     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) );
 783     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) );
 784     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) );
 785     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
 786
 787     # Strip out any "empty" strings from the array
 788     @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
 789
 790     return wantarray ? @isbns : join( " | ", @isbns );
 791 }
 792
 793 =head2 GetVariationsOfISBNs
 794
 795   my @isbns = GetVariationsOfISBNs( @isbns );
 796
 797   Returns a list of variations of the given isbns in
 798   both ISBN-10 and ISBN-13 formats, with and without
 799   hyphens.
 800
 801   In a scalar context, the isbns are returned as a
 802   string delimited by ' | '.
 803
 804 =cut
 805
 806 sub GetVariationsOfISBNs {
 807     my (@isbns) = @_;
 808
 809     @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
 810
 811     return wantarray ? @isbns : join( " | ", @isbns );
 812 }
 813
 814 =head2 NormalizedISSN
 815
 816   my $issns = NormalizedISSN({
 817           issn => $issn,
 818           strip_hyphen => [0,1]
 819           });
 820
 821   Returns an issn validated by Business::ISSN.
 822   Optionally strips hyphen.
 823
 824   If the string cannot be validated as an issn,
 825   it returns nothing.
 826
 827 =cut
 828
 829 sub NormalizeISSN {
 830     my ($params) = @_;
 831
 832     my $string        = $params->{issn};
 833     my $strip_hyphen  = $params->{strip_hyphen};
 834
 835     my $issn = Business::ISSN->new($string);
 836
 837     if ( $issn && $issn->is_valid ){
 838
 839         if ($strip_hyphen) {
 840             $string = $issn->_issn;
 841         }
 842         else {
 843             $string = $issn->as_string;
 844         }
 845         return $string;
 846     }
 847
 848 }
 849
 850 =head2 GetVariationsOfISSN
 851
 852   my @issns = GetVariationsOfISSN( $issn );
 853
 854   Returns a list of variations of the given issn in
 855   with and without a hyphen.
 856
 857   In a scalar context, the issns are returned as a
 858   string delimited by ' | '.
 859
 860 =cut
 861
 862 sub GetVariationsOfISSN {
 863     my ( $issn ) = @_;
 864
 865     return unless $issn;
 866
 867     my @issns;
 868     my $str = NormalizeISSN({ issn => $issn });
 869     if( $str ) {
 870         push @issns, $str;
 871         push @issns, NormalizeISSN({ issn => $issn, strip_hyphen => 1 });
 872     }  else {
 873         push @issns, $issn;
 874     }
 875
 876     # Strip out any "empty" strings from the array
 877     @issns = grep { defined($_) && $_ =~ /\S/ } @issns;
 878
 879     return wantarray ? @issns : join( " | ", @issns );
 880 }
 881
 882 =head2 GetVariationsOfISSNs
 883
 884   my @issns = GetVariationsOfISSNs( @issns );
 885
 886   Returns a list of variations of the given issns in
 887   with and without a hyphen.
 888
 889   In a scalar context, the issns are returned as a
 890   string delimited by ' | '.
 891
 892 =cut
 893
 894 sub GetVariationsOfISSNs {
 895     my (@issns) = @_;
 896
 897     @issns = map { GetVariationsOfISSN( $_ ) } @issns;
 898
 899     return wantarray ? @issns : join( " | ", @issns );
 900 }
 901
 902 1;
 903
 904 __END__
 905
 906 =head1 AUTHOR
 907
 908 Koha Team
 909
 910 =cut