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