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