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                 idx => 'ccode',
 401                 label => 'CollectionCodes',
 402                 tags => [ qw / 099t 955h / ],
 403             }
 404             ];
 405
 406             unless ( Koha::Libraries->search->count == 1 )
 407             {
 408                 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
 409                 if (   $DisplayLibraryFacets eq 'both'
 410                     || $DisplayLibraryFacets eq 'holding' )
 411                 {
 412                     push(
 413                         @$facets,
 414                         {
 415                             idx   => 'holdingbranch',
 416                             label => 'HoldingLibrary',
 417                             tags  => [qw / 995c /],
 418                         }
 419                     );
 420                 }
 421
 422                 if (   $DisplayLibraryFacets eq 'both'
 423                     || $DisplayLibraryFacets eq 'home' )
 424                 {
 425                 push(
 426                     @$facets,
 427                     {
 428                         idx   => 'homebranch',
 429                         label => 'HomeLibrary',
 430                         tags  => [qw / 995b /],
 431                     }
 432                 );
 433                 }
 434             }
 435     }
 436     else {
 437         $facets = [
 438             {
 439                 idx   => 'su-to',
 440                 label => 'Topics',
 441                 tags  => [ qw/ 650a / ],
 442                 sep   => '--',
 443             },
 444             #        {
 445             #        idx   => 'su-na',
 446             #        label => 'People and Organizations',
 447             #        tags  => [ qw/ 600a 610a 611a / ],
 448             #        sep   => 'a',
 449             #        },
 450             {
 451                 idx   => 'su-geo',
 452                 label => 'Places',
 453                 tags  => [ qw/ 651a / ],
 454                 sep   => '--',
 455             },
 456             {
 457                 idx   => 'su-ut',
 458                 label => 'Titles',
 459                 tags  => [ qw/ 630a / ],
 460                 sep   => '--',
 461             },
 462             {
 463                 idx   => 'au',
 464                 label => 'Authors',
 465                 tags  => [ qw/ 100a 110a 700a / ],
 466                 sep   => ', ',
 467             },
 468             {
 469                 idx   => 'se',
 470                 label => 'Series',
 471                 tags  => [ qw/ 440a 490a / ],
 472                 sep   => ', ',
 473             },
 474             {
 475                 idx   => 'itype',
 476                 label => 'ItemTypes',
 477                 tags  => [ qw/ 952y 942c / ],
 478                 sep   => ', ',
 479             },
 480             {
 481                 idx => 'location',
 482                 label => 'Location',
 483                 tags => [ qw / 952c / ],
 484             },
 485             {
 486                 idx => 'ccode',
 487                 label => 'CollectionCodes',
 488                 tags => [ qw / 9528 / ],
 489             }
 490             ];
 491
 492             unless ( Koha::Libraries->search->count == 1 )
 493             {
 494                 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
 495                 if (   $DisplayLibraryFacets eq 'both'
 496                     || $DisplayLibraryFacets eq 'holding' )
 497                 {
 498                     push(
 499                         @$facets,
 500                         {
 501                             idx   => 'holdingbranch',
 502                             label => 'HoldingLibrary',
 503                             tags  => [qw / 952b /],
 504                         }
 505                     );
 506                 }
 507
 508                 if (   $DisplayLibraryFacets eq 'both'
 509                     || $DisplayLibraryFacets eq 'home' )
 510                 {
 511                 push(
 512                     @$facets,
 513                     {
 514                         idx   => 'homebranch',
 515                         label => 'HomeLibrary',
 516                         tags  => [qw / 952a /],
 517                     }
 518                 );
 519                 }
 520             }
 521     }
 522     return $facets;
 523 }
 524
 525 =head2 GetAuthorisedValues
 526
 527   $authvalues = GetAuthorisedValues([$category]);
 528
 529 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
 530
 531 C<$category> returns authorised values for just one category (optional).
 532
 533 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
 534
 535 =cut
 536
 537 sub GetAuthorisedValues {
 538     my ( $category, $opac ) = @_;
 539
 540     # Is this cached already?
 541     $opac = $opac ? 1 : 0;    # normalise to be safe
 542     my $branch_limit =
 543       C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
 544     my $cache_key =
 545       "AuthorisedValues-$category-$opac-$branch_limit";
 546     my $cache  = Koha::Caches->get_instance();
 547     my $result = $cache->get_from_cache($cache_key);
 548     return $result if $result;
 549
 550     my @results;
 551     my $dbh      = C4::Context->dbh;
 552     my $query = qq{
 553         SELECT DISTINCT av.*
 554         FROM authorised_values av
 555     };
 556     $query .= qq{
 557           LEFT JOIN authorised_values_branches ON ( id = av_id )
 558     } if $branch_limit;
 559     my @where_strings;
 560     my @where_args;
 561     if($category) {
 562         push @where_strings, "category = ?";
 563         push @where_args, $category;
 564     }
 565     if($branch_limit) {
 566         push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
 567         push @where_args, $branch_limit;
 568     }
 569     if(@where_strings > 0) {
 570         $query .= " WHERE " . join(" AND ", @where_strings);
 571     }
 572     $query .= ' ORDER BY category, ' . (
 573                 $opac ? 'COALESCE(lib_opac, lib)'
 574                       : 'lib, lib_opac'
 575               );
 576
 577     my $sth = $dbh->prepare($query);
 578
 579     $sth->execute( @where_args );
 580     while (my $data=$sth->fetchrow_hashref) {
 581         if ($opac && $data->{lib_opac}) {
 582             $data->{lib} = $data->{lib_opac};
 583         }
 584         push @results, $data;
 585     }
 586     $sth->finish;
 587
 588     $cache->set_in_cache( $cache_key, \@results, { expiry => 5 } );
 589     return \@results;
 590 }
 591
 592 =head2 xml_escape
 593
 594   my $escaped_string = C4::Koha::xml_escape($string);
 595
 596 Convert &, <, >, ', and " in a string to XML entities
 597
 598 =cut
 599
 600 sub xml_escape {
 601     my $str = shift;
 602     return '' unless defined $str;
 603     $str =~ s/&/&amp;/g;
 604     $str =~ s/</&lt;/g;
 605     $str =~ s/>/&gt;/g;
 606     $str =~ s/'/&apos;/g;
 607     $str =~ s/"/&quot;/g;
 608     return $str;
 609 }
 610
 611 =head2 display_marc_indicators
 612
 613   my $display_form = C4::Koha::display_marc_indicators($field);
 614
 615 C<$field> is a MARC::Field object
 616
 617 Generate a display form of the indicators of a variable
 618 MARC field, replacing any blanks with '#'.
 619
 620 =cut
 621
 622 sub display_marc_indicators {
 623     my $field = shift;
 624     my $indicators = '';
 625     if ($field && $field->tag() >= 10) {
 626         $indicators = $field->indicator(1) . $field->indicator(2);
 627         $indicators =~ s/ /#/g;
 628     }
 629     return $indicators;
 630 }
 631
 632 sub GetNormalizedUPC {
 633     my ($marcrecord,$marcflavour) = @_;
 634
 635     return unless $marcrecord;
 636     if ($marcflavour eq 'UNIMARC') {
 637         my @fields = $marcrecord->field('072');
 638         foreach my $field (@fields) {
 639             my $upc = _normalize_match_point($field->subfield('a'));
 640             if ($upc) {
 641                 return $upc;
 642             }
 643         }
 644
 645     }
 646     else { # assume marc21 if not unimarc
 647         my @fields = $marcrecord->field('024');
 648         foreach my $field (@fields) {
 649             my $indicator = $field->indicator(1);
 650             my $upc = _normalize_match_point($field->subfield('a'));
 651             if ($upc && $indicator == 1 ) {
 652                 return $upc;
 653             }
 654         }
 655     }
 656 }
 657
 658 # Normalizes and returns the first valid ISBN found in the record
 659 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
 660 sub GetNormalizedISBN {
 661     my ($isbn,$marcrecord,$marcflavour) = @_;
 662     if ($isbn) {
 663         # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
 664         # anything after " | " should be removed, along with the delimiter
 665         ($isbn) = split(/\|/, $isbn );
 666         return _isbn_cleanup($isbn);
 667     }
 668
 669     return unless $marcrecord;
 670
 671     if ($marcflavour eq 'UNIMARC') {
 672         my @fields = $marcrecord->field('010');
 673         foreach my $field (@fields) {
 674             my $isbn = $field->subfield('a');
 675             if ($isbn) {
 676                 return _isbn_cleanup($isbn);
 677             }
 678         }
 679     }
 680     else { # assume marc21 if not unimarc
 681         my @fields = $marcrecord->field('020');
 682         foreach my $field (@fields) {
 683             $isbn = $field->subfield('a');
 684             if ($isbn) {
 685                 return _isbn_cleanup($isbn);
 686             }
 687         }
 688     }
 689 }
 690
 691 sub GetNormalizedEAN {
 692     my ($marcrecord,$marcflavour) = @_;
 693
 694     return unless $marcrecord;
 695
 696     if ($marcflavour eq 'UNIMARC') {
 697         my @fields = $marcrecord->field('073');
 698         foreach my $field (@fields) {
 699             my $ean = _normalize_match_point($field->subfield('a'));
 700             if ( $ean ) {
 701                 return $ean;
 702             }
 703         }
 704     }
 705     else { # assume marc21 if not unimarc
 706         my @fields = $marcrecord->field('024');
 707         foreach my $field (@fields) {
 708             my $indicator = $field->indicator(1);
 709             my $ean = _normalize_match_point($field->subfield('a'));
 710             if ( $ean && $indicator == 3  ) {
 711                 return $ean;
 712             }
 713         }
 714     }
 715 }
 716
 717 sub GetNormalizedOCLCNumber {
 718     my ($marcrecord,$marcflavour) = @_;
 719     return unless $marcrecord;
 720
 721     if ($marcflavour ne 'UNIMARC' ) {
 722         my @fields = $marcrecord->field('035');
 723         foreach my $field (@fields) {
 724             my $oclc = $field->subfield('a');
 725             if ($oclc =~ /OCoLC/) {
 726                 $oclc =~ s/\(OCoLC\)//;
 727                 return $oclc;
 728             }
 729         }
 730     } else {
 731         # TODO for UNIMARC
 732     }
 733     return
 734 }
 735
 736 =head2 GetDailyQuote($opts)
 737
 738 Takes a hashref of options
 739
 740 Currently supported options are:
 741
 742 'id'        An exact quote id
 743 'random'    Select a random quote
 744 noop        When no option is passed in, this sub will return the quote timestamped for the current day
 745
 746 The function returns an anonymous hash following this format:
 747
 748         {
 749           'source' => 'source-of-quote',
 750           'timestamp' => 'timestamp-value',
 751           'text' => 'text-of-quote',
 752           'id' => 'quote-id'
 753         };
 754
 755 =cut
 756
 757 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
 758 # at least for default option
 759
 760 sub GetDailyQuote {
 761     my %opts = @_;
 762     my $dbh = C4::Context->dbh;
 763     my $query = '';
 764     my $sth = undef;
 765     my $quote = undef;
 766     if ($opts{'id'}) {
 767         $query = 'SELECT * FROM quotes WHERE id = ?';
 768         $sth = $dbh->prepare($query);
 769         $sth->execute($opts{'id'});
 770         $quote = $sth->fetchrow_hashref();
 771     }
 772     elsif ($opts{'random'}) {
 773         # Fall through... we also return a random quote as a catch-all if all else fails
 774     }
 775     else {
 776         $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
 777         $sth = $dbh->prepare($query);
 778         $sth->execute();
 779         $quote = $sth->fetchrow_hashref();
 780     }
 781     unless ($quote) {        # if there are not matches, choose a random quote
 782         # get a list of all available quote ids
 783         $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
 784         $sth->execute;
 785         my $range = ($sth->fetchrow_array)[0];
 786         # chose a random id within that range if there is more than one quote
 787         my $offset = int(rand($range));
 788         # grab it
 789         $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
 790         $sth = C4::Context->dbh->prepare($query);
 791         # see http://www.perlmonks.org/?node_id=837422 for why
 792         # we're being verbose and using bind_param
 793         $sth->bind_param(1, $offset, SQL_INTEGER);
 794         $sth->execute();
 795         $quote = $sth->fetchrow_hashref();
 796         # update the timestamp for that quote
 797         $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
 798         $sth = C4::Context->dbh->prepare($query);
 799         $sth->execute(
 800             DateTime::Format::MySQL->format_datetime( dt_from_string() ),
 801             $quote->{'id'}
 802         );
 803     }
 804     return $quote;
 805 }
 806
 807 sub _normalize_match_point {
 808     my $match_point = shift;
 809     (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
 810     $normalized_match_point =~ s/-//g;
 811
 812     return $normalized_match_point;
 813 }
 814
 815 sub _isbn_cleanup {
 816     my ($isbn) = @_;
 817     return NormalizeISBN(
 818         {
 819             isbn          => $isbn,
 820             format        => 'ISBN-10',
 821             strip_hyphens => 1,
 822         }
 823     ) if $isbn;
 824 }
 825
 826 =head2 NormalizedISBN
 827
 828   my $isbns = NormalizedISBN({
 829     isbn => $isbn,
 830     strip_hyphens => [0,1],
 831     format => ['ISBN-10', 'ISBN-13']
 832   });
 833
 834   Returns an isbn validated by Business::ISBN.
 835   Optionally strips hyphens and/or forces the isbn
 836   to be of the specified format.
 837
 838   If the string cannot be validated as an isbn,
 839   it returns nothing.
 840
 841 =cut
 842
 843 sub NormalizeISBN {
 844     my ($params) = @_;
 845
 846     my $string        = $params->{isbn};
 847     my $strip_hyphens = $params->{strip_hyphens};
 848     my $format        = $params->{format};
 849
 850     return unless $string;
 851
 852     my $isbn = Business::ISBN->new($string);
 853
 854     if ( $isbn && $isbn->is_valid() ) {
 855
 856         if ( $format eq 'ISBN-10' ) {
 857             $isbn = $isbn->as_isbn10();
 858         }
 859         elsif ( $format eq 'ISBN-13' ) {
 860             $isbn = $isbn->as_isbn13();
 861         }
 862         return unless $isbn;
 863
 864         if ($strip_hyphens) {
 865             $string = $isbn->as_string( [] );
 866         } else {
 867             $string = $isbn->as_string();
 868         }
 869
 870         return $string;
 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 }) );
 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