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