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