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                         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=1
 111         UNION
 112         SELECT DISTINCT searchcategory AS `itemtype`,
 113                         COALESCE(authorised_values.lib_opac,authorised_values.lib) 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   => 'au',
 378                 label => 'Authors',
 379                 tags  => [ qw/ 700ab 701ab 702ab / ],
 380                 sep   => C4::Context->preference("UNIMARCAuthorsFacetsSeparator"),
 381             },
 382             {
 383                 idx   => 'se',
 384                 label => 'Series',
 385                 tags  => [ qw/ 225a / ],
 386                 sep   => ', ',
 387             },
 388             {
 389                 idx  => 'location',
 390                 label => 'Location',
 391                 tags        => [ qw/ 995e / ],
 392             },
 393             {
 394                 idx => 'ccode',
 395                 label => 'CollectionCodes',
 396                 tags => [ qw / 099t 955h / ],
 397             }
 398             ];
 399
 400             unless ( Koha::Libraries->search->count == 1 )
 401             {
 402                 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
 403                 if (   $DisplayLibraryFacets eq 'both'
 404                     || $DisplayLibraryFacets eq 'holding' )
 405                 {
 406                     push(
 407                         @$facets,
 408                         {
 409                             idx   => 'holdingbranch',
 410                             label => 'HoldingLibrary',
 411                             tags  => [qw / 995c /],
 412                         }
 413                     );
 414                 }
 415
 416                 if (   $DisplayLibraryFacets eq 'both'
 417                     || $DisplayLibraryFacets eq 'home' )
 418                 {
 419                 push(
 420                     @$facets,
 421                     {
 422                         idx   => 'homebranch',
 423                         label => 'HomeLibrary',
 424                         tags  => [qw / 995b /],
 425                     }
 426                 );
 427                 }
 428             }
 429     }
 430     else {
 431         $facets = [
 432             {
 433                 idx   => 'su-to',
 434                 label => 'Topics',
 435                 tags  => [ qw/ 650a / ],
 436                 sep   => '--',
 437             },
 438             #        {
 439             #        idx   => 'su-na',
 440             #        label => 'People and Organizations',
 441             #        tags  => [ qw/ 600a 610a 611a / ],
 442             #        sep   => 'a',
 443             #        },
 444             {
 445                 idx   => 'su-geo',
 446                 label => 'Places',
 447                 tags  => [ qw/ 651a / ],
 448                 sep   => '--',
 449             },
 450             {
 451                 idx   => 'su-ut',
 452                 label => 'Titles',
 453                 tags  => [ qw/ 630a / ],
 454                 sep   => '--',
 455             },
 456             {
 457                 idx   => 'au',
 458                 label => 'Authors',
 459                 tags  => [ qw/ 100a 110a 700a / ],
 460                 sep   => ', ',
 461             },
 462             {
 463                 idx   => 'se',
 464                 label => 'Series',
 465                 tags  => [ qw/ 440a 490a / ],
 466                 sep   => ', ',
 467             },
 468             {
 469                 idx   => 'itype',
 470                 label => 'ItemTypes',
 471                 tags  => [ qw/ 952y 942c / ],
 472                 sep   => ', ',
 473             },
 474             {
 475                 idx => 'location',
 476                 label => 'Location',
 477                 tags => [ qw / 952c / ],
 478             },
 479             {
 480                 idx => 'ccode',
 481                 label => 'CollectionCodes',
 482                 tags => [ qw / 9528 / ],
 483             }
 484             ];
 485
 486             unless ( Koha::Libraries->search->count == 1 )
 487             {
 488                 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
 489                 if (   $DisplayLibraryFacets eq 'both'
 490                     || $DisplayLibraryFacets eq 'holding' )
 491                 {
 492                     push(
 493                         @$facets,
 494                         {
 495                             idx   => 'holdingbranch',
 496                             label => 'HoldingLibrary',
 497                             tags  => [qw / 952b /],
 498                         }
 499                     );
 500                 }
 501
 502                 if (   $DisplayLibraryFacets eq 'both'
 503                     || $DisplayLibraryFacets eq 'home' )
 504                 {
 505                 push(
 506                     @$facets,
 507                     {
 508                         idx   => 'homebranch',
 509                         label => 'HomeLibrary',
 510                         tags  => [qw / 952a /],
 511                     }
 512                 );
 513                 }
 514             }
 515     }
 516     return $facets;
 517 }
 518
 519 =head2 GetAuthorisedValues
 520
 521   $authvalues = GetAuthorisedValues([$category]);
 522
 523 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
 524
 525 C<$category> returns authorised values for just one category (optional).
 526
 527 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
 528
 529 =cut
 530
 531 sub GetAuthorisedValues {
 532     my ( $category, $opac ) = @_;
 533
 534     # Is this cached already?
 535     $opac = $opac ? 1 : 0;    # normalise to be safe
 536     my $branch_limit =
 537       C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
 538     my $cache_key =
 539       "AuthorisedValues-$category-$opac-$branch_limit";
 540     my $cache  = Koha::Caches->get_instance();
 541     my $result = $cache->get_from_cache($cache_key);
 542     return $result if $result;
 543
 544     my @results;
 545     my $dbh      = C4::Context->dbh;
 546     my $query = qq{
 547         SELECT DISTINCT av.*
 548         FROM authorised_values av
 549     };
 550     $query .= qq{
 551           LEFT JOIN authorised_values_branches ON ( id = av_id )
 552     } if $branch_limit;
 553     my @where_strings;
 554     my @where_args;
 555     if($category) {
 556         push @where_strings, "category = ?";
 557         push @where_args, $category;
 558     }
 559     if($branch_limit) {
 560         push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
 561         push @where_args, $branch_limit;
 562     }
 563     if(@where_strings > 0) {
 564         $query .= " WHERE " . join(" AND ", @where_strings);
 565     }
 566     $query .= ' ORDER BY category, ' . (
 567                 $opac ? 'COALESCE(lib_opac, lib)'
 568                       : 'lib, lib_opac'
 569               );
 570
 571     my $sth = $dbh->prepare($query);
 572
 573     $sth->execute( @where_args );
 574     while (my $data=$sth->fetchrow_hashref) {
 575         if ($opac && $data->{lib_opac}) {
 576             $data->{lib} = $data->{lib_opac};
 577         }
 578         push @results, $data;
 579     }
 580     $sth->finish;
 581
 582     $cache->set_in_cache( $cache_key, \@results, { expiry => 5 } );
 583     return \@results;
 584 }
 585
 586 =head2 xml_escape
 587
 588   my $escaped_string = C4::Koha::xml_escape($string);
 589
 590 Convert &, <, >, ', and " in a string to XML entities
 591
 592 =cut
 593
 594 sub xml_escape {
 595     my $str = shift;
 596     return '' unless defined $str;
 597     $str =~ s/&/&amp;/g;
 598     $str =~ s/</&lt;/g;
 599     $str =~ s/>/&gt;/g;
 600     $str =~ s/'/&apos;/g;
 601     $str =~ s/"/&quot;/g;
 602     return $str;
 603 }
 604
 605 =head2 display_marc_indicators
 606
 607   my $display_form = C4::Koha::display_marc_indicators($field);
 608
 609 C<$field> is a MARC::Field object
 610
 611 Generate a display form of the indicators of a variable
 612 MARC field, replacing any blanks with '#'.
 613
 614 =cut
 615
 616 sub display_marc_indicators {
 617     my $field = shift;
 618     my $indicators = '';
 619     if ($field && $field->tag() >= 10) {
 620         $indicators = $field->indicator(1) . $field->indicator(2);
 621         $indicators =~ s/ /#/g;
 622     }
 623     return $indicators;
 624 }
 625
 626 sub GetNormalizedUPC {
 627     my ($marcrecord,$marcflavour) = @_;
 628
 629     return unless $marcrecord;
 630     if ($marcflavour eq 'UNIMARC') {
 631         my @fields = $marcrecord->field('072');
 632         foreach my $field (@fields) {
 633             my $upc = _normalize_match_point($field->subfield('a'));
 634             if ($upc) {
 635                 return $upc;
 636             }
 637         }
 638
 639     }
 640     else { # assume marc21 if not unimarc
 641         my @fields = $marcrecord->field('024');
 642         foreach my $field (@fields) {
 643             my $indicator = $field->indicator(1);
 644             my $upc = _normalize_match_point($field->subfield('a'));
 645             if ($upc && $indicator == 1 ) {
 646                 return $upc;
 647             }
 648         }
 649     }
 650 }
 651
 652 # Normalizes and returns the first valid ISBN found in the record
 653 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
 654 sub GetNormalizedISBN {
 655     my ($isbn,$marcrecord,$marcflavour) = @_;
 656     if ($isbn) {
 657         # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
 658         # anything after " | " should be removed, along with the delimiter
 659         ($isbn) = split(/\|/, $isbn );
 660         return _isbn_cleanup($isbn);
 661     }
 662
 663     return unless $marcrecord;
 664
 665     if ($marcflavour eq 'UNIMARC') {
 666         my @fields = $marcrecord->field('010');
 667         foreach my $field (@fields) {
 668             my $isbn = $field->subfield('a');
 669             if ($isbn) {
 670                 return _isbn_cleanup($isbn);
 671             }
 672         }
 673     }
 674     else { # assume marc21 if not unimarc
 675         my @fields = $marcrecord->field('020');
 676         foreach my $field (@fields) {
 677             $isbn = $field->subfield('a');
 678             if ($isbn) {
 679                 return _isbn_cleanup($isbn);
 680             }
 681         }
 682     }
 683 }
 684
 685 sub GetNormalizedEAN {
 686     my ($marcrecord,$marcflavour) = @_;
 687
 688     return unless $marcrecord;
 689
 690     if ($marcflavour eq 'UNIMARC') {
 691         my @fields = $marcrecord->field('073');
 692         foreach my $field (@fields) {
 693             my $ean = _normalize_match_point($field->subfield('a'));
 694             if ( $ean ) {
 695                 return $ean;
 696             }
 697         }
 698     }
 699     else { # assume marc21 if not unimarc
 700         my @fields = $marcrecord->field('024');
 701         foreach my $field (@fields) {
 702             my $indicator = $field->indicator(1);
 703             my $ean = _normalize_match_point($field->subfield('a'));
 704             if ( $ean && $indicator == 3  ) {
 705                 return $ean;
 706             }
 707         }
 708     }
 709 }
 710
 711 sub GetNormalizedOCLCNumber {
 712     my ($marcrecord,$marcflavour) = @_;
 713     return unless $marcrecord;
 714
 715     if ($marcflavour ne 'UNIMARC' ) {
 716         my @fields = $marcrecord->field('035');
 717         foreach my $field (@fields) {
 718             my $oclc = $field->subfield('a');
 719             if ($oclc =~ /OCoLC/) {
 720                 $oclc =~ s/\(OCoLC\)//;
 721                 return $oclc;
 722             }
 723         }
 724     } else {
 725         # TODO for UNIMARC
 726     }
 727     return
 728 }
 729
 730 =head2 GetDailyQuote($opts)
 731
 732 Takes a hashref of options
 733
 734 Currently supported options are:
 735
 736 'id'        An exact quote id
 737 'random'    Select a random quote
 738 noop        When no option is passed in, this sub will return the quote timestamped for the current day
 739
 740 The function returns an anonymous hash following this format:
 741
 742         {
 743           'source' => 'source-of-quote',
 744           'timestamp' => 'timestamp-value',
 745           'text' => 'text-of-quote',
 746           'id' => 'quote-id'
 747         };
 748
 749 =cut
 750
 751 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
 752 # at least for default option
 753
 754 sub GetDailyQuote {
 755     my %opts = @_;
 756     my $dbh = C4::Context->dbh;
 757     my $query = '';
 758     my $sth = undef;
 759     my $quote = undef;
 760     if ($opts{'id'}) {
 761         $query = 'SELECT * FROM quotes WHERE id = ?';
 762         $sth = $dbh->prepare($query);
 763         $sth->execute($opts{'id'});
 764         $quote = $sth->fetchrow_hashref();
 765     }
 766     elsif ($opts{'random'}) {
 767         # Fall through... we also return a random quote as a catch-all if all else fails
 768     }
 769     else {
 770         $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
 771         $sth = $dbh->prepare($query);
 772         $sth->execute();
 773         $quote = $sth->fetchrow_hashref();
 774     }
 775     unless ($quote) {        # if there are not matches, choose a random quote
 776         # get a list of all available quote ids
 777         $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
 778         $sth->execute;
 779         my $range = ($sth->fetchrow_array)[0];
 780         # chose a random id within that range if there is more than one quote
 781         my $offset = int(rand($range));
 782         # grab it
 783         $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
 784         $sth = C4::Context->dbh->prepare($query);
 785         # see http://www.perlmonks.org/?node_id=837422 for why
 786         # we're being verbose and using bind_param
 787         $sth->bind_param(1, $offset, SQL_INTEGER);
 788         $sth->execute();
 789         $quote = $sth->fetchrow_hashref();
 790         # update the timestamp for that quote
 791         $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
 792         $sth = C4::Context->dbh->prepare($query);
 793         $sth->execute(
 794             DateTime::Format::MySQL->format_datetime( dt_from_string() ),
 795             $quote->{'id'}
 796         );
 797     }
 798     return $quote;
 799 }
 800
 801 sub _normalize_match_point {
 802     my $match_point = shift;
 803     (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
 804     $normalized_match_point =~ s/-//g;
 805
 806     return $normalized_match_point;
 807 }
 808
 809 sub _isbn_cleanup {
 810     my ($isbn) = @_;
 811     return NormalizeISBN(
 812         {
 813             isbn          => $isbn,
 814             format        => 'ISBN-10',
 815             strip_hyphens => 1,
 816         }
 817     ) if $isbn;
 818 }
 819
 820 =head2 NormalizeISBN
 821
 822   my $isbns = NormalizeISBN({
 823     isbn => $isbn,
 824     strip_hyphens => [0,1],
 825     format => ['ISBN-10', 'ISBN-13']
 826   });
 827
 828   Returns an isbn validated by Business::ISBN.
 829   Optionally strips hyphens and/or forces the isbn
 830   to be of the specified format.
 831
 832   If the string cannot be validated as an isbn,
 833   it returns nothing unless return_invalid param is passed.
 834
 835   #FIXME This routine (and others?) should be moved to Koha::Util::Normalize
 836
 837 =cut
 838
 839 sub NormalizeISBN {
 840     my ($params) = @_;
 841
 842     my $string        = $params->{isbn};
 843     my $strip_hyphens = $params->{strip_hyphens};
 844     my $format        = $params->{format};
 845     my $return_invalid = $params->{return_invalid};
 846
 847     return unless $string;
 848
 849     my $isbn = Business::ISBN->new($string);
 850
 851     if ( $isbn && $isbn->is_valid() ) {
 852
 853         if ( $format eq 'ISBN-10' ) {
 854         $isbn = $isbn->as_isbn10();
 855         }
 856         elsif ( $format eq 'ISBN-13' ) {
 857             $isbn = $isbn->as_isbn13();
 858         }
 859         return unless $isbn;
 860
 861         if ($strip_hyphens) {
 862             $string = $isbn->as_string( [] );
 863         } else {
 864             $string = $isbn->as_string();
 865         }
 866
 867         return $string;
 868     } elsif ( $return_invalid ) {
 869         return $string;
 870     }
 871
 872 }
 873
 874 =head2 GetVariationsOfISBN
 875
 876   my @isbns = GetVariationsOfISBN( $isbn );
 877
 878   Returns a list of variations of the given isbn in
 879   both ISBN-10 and ISBN-13 formats, with and without
 880   hyphens.
 881
 882   In a scalar context, the isbns are returned as a
 883   string delimited by ' | '.
 884
 885 =cut
 886
 887 sub GetVariationsOfISBN {
 888     my ($isbn) = @_;
 889
 890     return unless $isbn;
 891
 892     my @isbns;
 893
 894     push( @isbns, NormalizeISBN({ isbn => $isbn, return_invalid => 1 }) );
 895     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) );
 896     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) );
 897     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) );
 898     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
 899
 900     # Strip out any "empty" strings from the array
 901     @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
 902
 903     return wantarray ? @isbns : join( " | ", @isbns );
 904 }
 905
 906 =head2 GetVariationsOfISBNs
 907
 908   my @isbns = GetVariationsOfISBNs( @isbns );
 909
 910   Returns a list of variations of the given isbns in
 911   both ISBN-10 and ISBN-13 formats, with and without
 912   hyphens.
 913
 914   In a scalar context, the isbns are returned as a
 915   string delimited by ' | '.
 916
 917 =cut
 918
 919 sub GetVariationsOfISBNs {
 920     my (@isbns) = @_;
 921
 922     @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
 923
 924     return wantarray ? @isbns : join( " | ", @isbns );
 925 }
 926
 927 =head2 NormalizedISSN
 928
 929   my $issns = NormalizedISSN({
 930           issn => $issn,
 931           strip_hyphen => [0,1]
 932           });
 933
 934   Returns an issn validated by Business::ISSN.
 935   Optionally strips hyphen.
 936
 937   If the string cannot be validated as an issn,
 938   it returns nothing.
 939
 940 =cut
 941
 942 sub NormalizeISSN {
 943     my ($params) = @_;
 944
 945     my $string        = $params->{issn};
 946     my $strip_hyphen  = $params->{strip_hyphen};
 947
 948     my $issn = Business::ISSN->new($string);
 949
 950     if ( $issn && $issn->is_valid ){
 951
 952         if ($strip_hyphen) {
 953             $string = $issn->_issn;
 954         }
 955         else {
 956             $string = $issn->as_string;
 957         }
 958         return $string;
 959     }
 960
 961 }
 962
 963 =head2 GetVariationsOfISSN
 964
 965   my @issns = GetVariationsOfISSN( $issn );
 966
 967   Returns a list of variations of the given issn in
 968   with and without a hyphen.
 969
 970   In a scalar context, the issns are returned as a
 971   string delimited by ' | '.
 972
 973 =cut
 974
 975 sub GetVariationsOfISSN {
 976     my ( $issn ) = @_;
 977
 978     return unless $issn;
 979
 980     my @issns;
 981     my $str = NormalizeISSN({ issn => $issn });
 982     if( $str ) {
 983         push @issns, $str;
 984         push @issns, NormalizeISSN({ issn => $issn, strip_hyphen => 1 });
 985     }  else {
 986         push @issns, $issn;
 987     }
 988
 989     # Strip out any "empty" strings from the array
 990     @issns = grep { defined($_) && $_ =~ /\S/ } @issns;
 991
 992     return wantarray ? @issns : join( " | ", @issns );
 993 }
 994
 995 =head2 GetVariationsOfISSNs
 996
 997   my @issns = GetVariationsOfISSNs( @issns );
 998
 999   Returns a list of variations of the given issns in
1000   with and without a hyphen.
1001
1002   In a scalar context, the issns are returned as a
1003   string delimited by ' | '.
1004
1005 =cut
1006
1007 sub GetVariationsOfISSNs {
1008     my (@issns) = @_;
1009
1010     @issns = map { GetVariationsOfISSN( $_ ) } @issns;
1011
1012     return wantarray ? @issns : join( " | ", @issns );
1013 }
1014
1015 1;
1016
1017 __END__
1018
1019 =head1 AUTHOR
1020
1021 Koha Team
1022
1023 =cut