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