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