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::Libraries;
  30 use Koha::MarcSubfieldStructures;
  31 use DateTime::Format::MySQL;
  32 use Business::ISBN;
  33 use autouse 'Data::cselectall_arrayref' => qw(Dumper);
  34 use DBI qw(:sql_types);
  35 use vars qw(@ISA @EXPORT @EXPORT_OK $DEBUG);
  36
  37 BEGIN {
  38         require Exporter;
  39         @ISA    = qw(Exporter);
  40         @EXPORT = qw(
  41                 &GetPrinters &GetPrinter
  42                 &GetItemTypes &getitemtypeinfo
  43                 &GetItemTypesCategorized &GetItemTypesByCategory
  44                 &getframeworks &getframeworkinfo
  45         &GetFrameworksLoop
  46                 &getallthemes
  47                 &getFacets
  48                 &getnbpages
  49                 &get_infos_of
  50                 &get_notforloan_label_of
  51                 &getitemtypeimagedir
  52                 &getitemtypeimagesrc
  53                 &getitemtypeimagelocation
  54                 &GetAuthorisedValues
  55                 &GetAuthorisedValueCategories
  56                 &GetKohaAuthorisedValues
  57     &GetKohaAuthorisedValuesMapping
  58     &GetAuthorisedValueByCode
  59                 &GetAuthValCode
  60                 &GetNormalizedUPC
  61                 &GetNormalizedISBN
  62                 &GetNormalizedEAN
  63                 &GetNormalizedOCLCNumber
  64         &xml_escape
  65
  66         &GetVariationsOfISBN
  67         &GetVariationsOfISBNs
  68         &NormalizeISBN
  69
  70                 $DEBUG
  71         );
  72         $DEBUG = 0;
  73 @EXPORT_OK = qw( GetDailyQuote );
  74 }
  75
  76 =head1 NAME
  77
  78 C4::Koha - Perl Module containing convenience functions for Koha scripts
  79
  80 =head1 SYNOPSIS
  81
  82 use C4::Koha;
  83
  84 =head1 DESCRIPTION
  85
  86 Koha.pm provides many functions for Koha scripts.
  87
  88 =head1 FUNCTIONS
  89
  90 =cut
  91
  92 =head2 GetItemTypes
  93
  94   $itemtypes = &GetItemTypes( style => $style );
  95
  96 Returns information about existing itemtypes.
  97
  98 Params:
  99     style: either 'array' or 'hash', defaults to 'hash'.
 100            'array' returns an arrayref,
 101            'hash' return a hashref with the itemtype value as the key
 102
 103 build a HTML select with the following code :
 104
 105 =head3 in PERL SCRIPT
 106
 107     my $itemtypes = GetItemTypes;
 108     my @itemtypesloop;
 109     foreach my $thisitemtype (sort keys %$itemtypes) {
 110         my $selected = 1 if $thisitemtype eq $itemtype;
 111         my %row =(value => $thisitemtype,
 112                     selected => $selected,
 113                     description => $itemtypes->{$thisitemtype}->{'description'},
 114                 );
 115         push @itemtypesloop, \%row;
 116     }
 117     $template->param(itemtypeloop => \@itemtypesloop);
 118
 119 =head3 in TEMPLATE
 120
 121     <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 122         <select name="itemtype">
 123             <option value="">Default</option>
 124         <!-- TMPL_LOOP name="itemtypeloop" -->
 125             <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
 126         <!-- /TMPL_LOOP -->
 127         </select>
 128         <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 129         <input type="submit" value="OK" class="button">
 130     </form>
 131
 132 =cut
 133
 134 sub GetItemTypes {
 135     my ( %params ) = @_;
 136     my $style = defined( $params{'style'} ) ? $params{'style'} : 'hash';
 137
 138     require C4::Languages;
 139     my $language = C4::Languages::getlanguage();
 140     # returns a reference to a hash of references to itemtypes...
 141     my $dbh   = C4::Context->dbh;
 142     my $query = q|
 143         SELECT
 144                itemtypes.itemtype,
 145                itemtypes.description,
 146                itemtypes.rentalcharge,
 147                itemtypes.notforloan,
 148                itemtypes.imageurl,
 149                itemtypes.summary,
 150                itemtypes.checkinmsg,
 151                itemtypes.checkinmsgtype,
 152                itemtypes.sip_media_type,
 153                itemtypes.hideinopac,
 154                itemtypes.searchcategory,
 155                COALESCE( localization.translation, itemtypes.description ) AS translated_description
 156         FROM   itemtypes
 157         LEFT JOIN localization ON itemtypes.itemtype = localization.code
 158             AND localization.entity = 'itemtypes'
 159             AND localization.lang = ?
 160         ORDER BY itemtype
 161     |;
 162     my $sth = $dbh->prepare($query);
 163     $sth->execute( $language );
 164
 165     if ( $style eq 'hash' ) {
 166         my %itemtypes;
 167         while ( my $IT = $sth->fetchrow_hashref ) {
 168             $itemtypes{ $IT->{'itemtype'} } = $IT;
 169         }
 170         return ( \%itemtypes );
 171     } else {
 172         return [ sort { lc $a->{translated_description} cmp lc $b->{translated_description} } @{ $sth->fetchall_arrayref( {} ) } ];
 173     }
 174 }
 175
 176 =head2 GetItemTypesCategorized
 177
 178     $categories = GetItemTypesCategorized();
 179
 180 Returns a hashref containing search categories.
 181 A search category will be put in the hash if at least one of its itemtypes is visible in OPAC.
 182 The categories must be part of Authorized Values (ITEMTYPECAT)
 183
 184 =cut
 185
 186 sub GetItemTypesCategorized {
 187     my $dbh   = C4::Context->dbh;
 188     # Order is important, so that partially hidden (some items are not visible in OPAC) search
 189     # categories will be visible. hideinopac=0 must be last.
 190     my $query = q|
 191         SELECT itemtype, description, imageurl, hideinopac, 0 as 'iscat' FROM itemtypes WHERE ISNULL(searchcategory) or length(searchcategory) = 0
 192         UNION
 193         SELECT DISTINCT searchcategory AS `itemtype`,
 194                         authorised_values.lib_opac AS description,
 195                         authorised_values.imageurl AS imageurl,
 196                         hideinopac, 1 as 'iscat'
 197         FROM itemtypes
 198         LEFT JOIN authorised_values ON searchcategory = authorised_value
 199         WHERE searchcategory > '' and hideinopac=1
 200         UNION
 201         SELECT DISTINCT searchcategory AS `itemtype`,
 202                         authorised_values.lib_opac AS description,
 203                         authorised_values.imageurl AS imageurl,
 204                         hideinopac, 1 as 'iscat'
 205         FROM itemtypes
 206         LEFT JOIN authorised_values ON searchcategory = authorised_value
 207         WHERE searchcategory > '' and hideinopac=0
 208         |;
 209 return ($dbh->selectall_hashref($query,'itemtype'));
 210 }
 211
 212 =head2 GetItemTypesByCategory
 213
 214     @results = GetItemTypesByCategory( $searchcategory );
 215
 216 Returns the itemtype code of all itemtypes included in a searchcategory.
 217
 218 =cut
 219
 220 sub GetItemTypesByCategory {
 221     my ($category) = @_;
 222     my $count = 0;
 223     my @results;
 224     my $dbh = C4::Context->dbh;
 225     my $query = qq|SELECT itemtype FROM itemtypes WHERE searchcategory=?|;
 226     my $tmp=$dbh->selectcol_arrayref($query,undef,$category);
 227     return @$tmp;
 228 }
 229
 230 =head2 getframework
 231
 232   $frameworks = &getframework();
 233
 234 Returns information about existing frameworks
 235
 236 build a HTML select with the following code :
 237
 238 =head3 in PERL SCRIPT
 239
 240   my $frameworks = getframeworks();
 241   my @frameworkloop;
 242   foreach my $thisframework (keys %$frameworks) {
 243     my $selected = 1 if $thisframework eq $frameworkcode;
 244     my %row =(
 245                 value       => $thisframework,
 246                 selected    => $selected,
 247                 description => $frameworks->{$thisframework}->{'frameworktext'},
 248             );
 249     push @frameworksloop, \%row;
 250   }
 251   $template->param(frameworkloop => \@frameworksloop);
 252
 253 =head3 in TEMPLATE
 254
 255   <form action="[% script_name %] method=post>
 256     <select name="frameworkcode">
 257         <option value="">Default</option>
 258         [% FOREACH framework IN frameworkloop %]
 259         [% IF ( framework.selected ) %]
 260         <option value="[% framework.value %]" selected="selected">[% framework.description %]</option>
 261         [% ELSE %]
 262         <option value="[% framework.value %]">[% framework.description %]</option>
 263         [% END %]
 264         [% END %]
 265     </select>
 266     <input type=text name=searchfield value="[% searchfield %]">
 267     <input type="submit" value="OK" class="button">
 268   </form>
 269
 270 =cut
 271
 272 sub getframeworks {
 273
 274     # returns a reference to a hash of references to branches...
 275     my %itemtypes;
 276     my $dbh = C4::Context->dbh;
 277     my $sth = $dbh->prepare("select * from biblio_framework");
 278     $sth->execute;
 279     while ( my $IT = $sth->fetchrow_hashref ) {
 280         $itemtypes{ $IT->{'frameworkcode'} } = $IT;
 281     }
 282     return ( \%itemtypes );
 283 }
 284
 285 =head2 GetFrameworksLoop
 286
 287   $frameworks = GetFrameworksLoop( $frameworkcode );
 288
 289 Returns the loop suggested on getframework(), but ordered by framework description.
 290
 291 build a HTML select with the following code :
 292
 293 =head3 in PERL SCRIPT
 294
 295   $template->param( frameworkloop => GetFrameworksLoop( $frameworkcode ) );
 296
 297 =head3 in TEMPLATE
 298
 299   Same as getframework()
 300
 301   <form action="[% script_name %] method=post>
 302     <select name="frameworkcode">
 303         <option value="">Default</option>
 304         [% FOREACH framework IN frameworkloop %]
 305         [% IF ( framework.selected ) %]
 306         <option value="[% framework.value %]" selected="selected">[% framework.description %]</option>
 307         [% ELSE %]
 308         <option value="[% framework.value %]">[% framework.description %]</option>
 309         [% END %]
 310         [% END %]
 311     </select>
 312     <input type=text name=searchfield value="[% searchfield %]">
 313     <input type="submit" value="OK" class="button">
 314   </form>
 315
 316 =cut
 317
 318 sub GetFrameworksLoop {
 319     my $frameworkcode = shift;
 320     my $frameworks = getframeworks();
 321     my @frameworkloop;
 322     foreach my $thisframework (sort { uc($frameworks->{$a}->{'frameworktext'}) cmp uc($frameworks->{$b}->{'frameworktext'}) } keys %$frameworks) {
 323         my $selected = ( $thisframework eq $frameworkcode ) ? 1 : undef;
 324         my %row = (
 325                 value       => $thisframework,
 326                 selected    => $selected,
 327                 description => $frameworks->{$thisframework}->{'frameworktext'},
 328             );
 329         push @frameworkloop, \%row;
 330   }
 331   return \@frameworkloop;
 332 }
 333
 334 =head2 getframeworkinfo
 335
 336   $frameworkinfo = &getframeworkinfo($frameworkcode);
 337
 338 Returns information about an frameworkcode.
 339
 340 =cut
 341
 342 sub getframeworkinfo {
 343     my ($frameworkcode) = @_;
 344     my $dbh             = C4::Context->dbh;
 345     my $sth             =
 346       $dbh->prepare("select * from biblio_framework where frameworkcode=?");
 347     $sth->execute($frameworkcode);
 348     my $res = $sth->fetchrow_hashref;
 349     return $res;
 350 }
 351
 352 =head2 getitemtypeinfo
 353
 354   $itemtype = &getitemtypeinfo($itemtype, [$interface]);
 355
 356 Returns information about an itemtype. The optional $interface argument
 357 sets which interface ('opac' or 'intranet') to return the imageurl for.
 358 Defaults to intranet.
 359
 360 =cut
 361
 362 sub getitemtypeinfo {
 363     my ($itemtype, $interface) = @_;
 364     my $dbh      = C4::Context->dbh;
 365     require C4::Languages;
 366     my $language = C4::Languages::getlanguage();
 367     my $it = $dbh->selectrow_hashref(q|
 368         SELECT
 369                itemtypes.itemtype,
 370                itemtypes.description,
 371                itemtypes.rentalcharge,
 372                itemtypes.notforloan,
 373                itemtypes.imageurl,
 374                itemtypes.summary,
 375                itemtypes.checkinmsg,
 376                itemtypes.checkinmsgtype,
 377                itemtypes.sip_media_type,
 378                COALESCE( localization.translation, itemtypes.description ) AS translated_description
 379         FROM   itemtypes
 380         LEFT JOIN localization ON itemtypes.itemtype = localization.code
 381             AND localization.entity = 'itemtypes'
 382             AND localization.lang = ?
 383         WHERE itemtypes.itemtype = ?
 384     |, undef, $language, $itemtype );
 385
 386     $it->{imageurl} = getitemtypeimagelocation( ( ( defined $interface && $interface eq 'opac' ) ? 'opac' : 'intranet' ), $it->{imageurl} );
 387
 388     return $it;
 389 }
 390
 391 =head2 getitemtypeimagedir
 392
 393   my $directory = getitemtypeimagedir( 'opac' );
 394
 395 pass in 'opac' or 'intranet'. Defaults to 'opac'.
 396
 397 returns the full path to the appropriate directory containing images.
 398
 399 =cut
 400
 401 sub getitemtypeimagedir {
 402         my $src = shift || 'opac';
 403         if ($src eq 'intranet') {
 404                 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
 405         } else {
 406                 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
 407         }
 408 }
 409
 410 sub getitemtypeimagesrc {
 411         my $src = shift || 'opac';
 412         if ($src eq 'intranet') {
 413                 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
 414         } else {
 415                 return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
 416         }
 417 }
 418
 419 sub getitemtypeimagelocation {
 420         my ( $src, $image ) = @_;
 421
 422         return '' if ( !$image );
 423     require URI::Split;
 424
 425         my $scheme = ( URI::Split::uri_split( $image ) )[0];
 426
 427         return $image if ( $scheme );
 428
 429         return getitemtypeimagesrc( $src ) . '/' . $image;
 430 }
 431
 432 =head3 _getImagesFromDirectory
 433
 434 Find all of the image files in a directory in the filesystem
 435
 436 parameters: a directory name
 437
 438 returns: a list of images in that directory.
 439
 440 Notes: this does not traverse into subdirectories. See
 441 _getSubdirectoryNames for help with that.
 442 Images are assumed to be files with .gif or .png file extensions.
 443 The image names returned do not have the directory name on them.
 444
 445 =cut
 446
 447 sub _getImagesFromDirectory {
 448     my $directoryname = shift;
 449     return unless defined $directoryname;
 450     return unless -d $directoryname;
 451
 452     if ( opendir ( my $dh, $directoryname ) ) {
 453         my @images = grep { /\.(gif|png)$/i } readdir( $dh );
 454         closedir $dh;
 455         @images = sort(@images);
 456         return @images;
 457     } else {
 458         warn "unable to opendir $directoryname: $!";
 459         return;
 460     }
 461 }
 462
 463 =head3 _getSubdirectoryNames
 464
 465 Find all of the directories in a directory in the filesystem
 466
 467 parameters: a directory name
 468
 469 returns: a list of subdirectories in that directory.
 470
 471 Notes: this does not traverse into subdirectories. Only the first
 472 level of subdirectories are returned.
 473 The directory names returned don't have the parent directory name on them.
 474
 475 =cut
 476
 477 sub _getSubdirectoryNames {
 478     my $directoryname = shift;
 479     return unless defined $directoryname;
 480     return unless -d $directoryname;
 481
 482     if ( opendir ( my $dh, $directoryname ) ) {
 483         my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
 484         closedir $dh;
 485         return @directories;
 486     } else {
 487         warn "unable to opendir $directoryname: $!";
 488         return;
 489     }
 490 }
 491
 492 =head3 getImageSets
 493
 494 returns: a listref of hashrefs. Each hash represents another collection of images.
 495
 496  { imagesetname => 'npl', # the name of the image set (npl is the original one)
 497          images => listref of image hashrefs
 498  }
 499
 500 each image is represented by a hashref like this:
 501
 502  { KohaImage     => 'npl/image.gif',
 503    StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
 504    OpacImageURL  => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
 505    checked       => 0 or 1: was this the image passed to this method?
 506                     Note: I'd like to remove this somehow.
 507  }
 508
 509 =cut
 510
 511 sub getImageSets {
 512     my %params = @_;
 513     my $checked = $params{'checked'} || '';
 514
 515     my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
 516                              url        => getitemtypeimagesrc('intranet'),
 517                         },
 518                   opac => { filesystem => getitemtypeimagedir('opac'),
 519                              url       => getitemtypeimagesrc('opac'),
 520                         }
 521                   };
 522
 523     my @imagesets = (); # list of hasrefs of image set data to pass to template
 524     my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
 525     foreach my $imagesubdir ( @subdirectories ) {
 526     warn $imagesubdir if $DEBUG;
 527         my @imagelist     = (); # hashrefs of image info
 528         my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
 529         my $imagesetactive = 0;
 530         foreach my $thisimage ( @imagenames ) {
 531             push( @imagelist,
 532                   { KohaImage     => "$imagesubdir/$thisimage",
 533                     StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
 534                     OpacImageUrl  => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
 535                     checked       => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
 536                }
 537              );
 538              $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
 539         }
 540         push @imagesets, { imagesetname => $imagesubdir,
 541                            imagesetactive => $imagesetactive,
 542                            images       => \@imagelist };
 543
 544     }
 545     return \@imagesets;
 546 }
 547
 548 =head2 GetPrinters
 549
 550   $printers = &GetPrinters();
 551   @queues = keys %$printers;
 552
 553 Returns information about existing printer queues.
 554
 555 C<$printers> is a reference-to-hash whose keys are the print queues
 556 defined in the printers table of the Koha database. The values are
 557 references-to-hash, whose keys are the fields in the printers table.
 558
 559 =cut
 560
 561 sub GetPrinters {
 562     my %printers;
 563     my $dbh = C4::Context->dbh;
 564     my $sth = $dbh->prepare("select * from printers");
 565     $sth->execute;
 566     while ( my $printer = $sth->fetchrow_hashref ) {
 567         $printers{ $printer->{'printqueue'} } = $printer;
 568     }
 569     return ( \%printers );
 570 }
 571
 572 =head2 GetPrinter
 573
 574   $printer = GetPrinter( $query, $printers );
 575
 576 =cut
 577
 578 sub GetPrinter {
 579     my ( $query, $printers ) = @_;    # get printer for this query from printers
 580     my $printer = $query->param('printer');
 581     my %cookie = $query->cookie('userenv');
 582     ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
 583     ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
 584     return $printer;
 585 }
 586
 587 =head2 getnbpages
 588
 589 Returns the number of pages to display in a pagination bar, given the number
 590 of items and the number of items per page.
 591
 592 =cut
 593
 594 sub getnbpages {
 595     my ( $nb_items, $nb_items_per_page ) = @_;
 596
 597     return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
 598 }
 599
 600 =head2 getallthemes
 601
 602   (@themes) = &getallthemes('opac');
 603   (@themes) = &getallthemes('intranet');
 604
 605 Returns an array of all available themes.
 606
 607 =cut
 608
 609 sub getallthemes {
 610     my $type = shift;
 611     my $htdocs;
 612     my @themes;
 613     if ( $type eq 'intranet' ) {
 614         $htdocs = C4::Context->config('intrahtdocs');
 615     }
 616     else {
 617         $htdocs = C4::Context->config('opachtdocs');
 618     }
 619     opendir D, "$htdocs";
 620     my @dirlist = readdir D;
 621     foreach my $directory (@dirlist) {
 622         next if $directory eq 'lib';
 623         -d "$htdocs/$directory/en" and push @themes, $directory;
 624     }
 625     return @themes;
 626 }
 627
 628 sub getFacets {
 629     my $facets;
 630     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
 631         $facets = [
 632             {
 633                 idx   => 'su-to',
 634                 label => 'Topics',
 635                 tags  => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
 636                 sep   => ' - ',
 637             },
 638             {
 639                 idx   => 'su-geo',
 640                 label => 'Places',
 641                 tags  => [ qw/ 607a / ],
 642                 sep   => ' - ',
 643             },
 644             {
 645                 idx   => 'su-ut',
 646                 label => 'Titles',
 647                 tags  => [ qw/ 500a 501a 503a / ],
 648                 sep   => ', ',
 649             },
 650             {
 651                 idx   => 'au',
 652                 label => 'Authors',
 653                 tags  => [ qw/ 700ab 701ab 702ab / ],
 654                 sep   => C4::Context->preference("UNIMARCAuthorsFacetsSeparator"),
 655             },
 656             {
 657                 idx   => 'se',
 658                 label => 'Series',
 659                 tags  => [ qw/ 225a / ],
 660                 sep   => ', ',
 661             },
 662             {
 663                 idx  => 'location',
 664                 label => 'Location',
 665                 tags        => [ qw/ 995e / ],
 666             }
 667             ];
 668
 669             unless ( Koha::Libraries->search->count == 1 )
 670             {
 671                 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
 672                 if (   $DisplayLibraryFacets eq 'both'
 673                     || $DisplayLibraryFacets eq 'holding' )
 674                 {
 675                     push(
 676                         @$facets,
 677                         {
 678                             idx   => 'holdingbranch',
 679                             label => 'HoldingLibrary',
 680                             tags  => [qw / 995c /],
 681                         }
 682                     );
 683                 }
 684
 685                 if (   $DisplayLibraryFacets eq 'both'
 686                     || $DisplayLibraryFacets eq 'home' )
 687                 {
 688                 push(
 689                     @$facets,
 690                     {
 691                         idx   => 'homebranch',
 692                         label => 'HomeLibrary',
 693                         tags  => [qw / 995b /],
 694                     }
 695                 );
 696                 }
 697             }
 698     }
 699     else {
 700         $facets = [
 701             {
 702                 idx   => 'su-to',
 703                 label => 'Topics',
 704                 tags  => [ qw/ 650a / ],
 705                 sep   => '--',
 706             },
 707             #        {
 708             #        idx   => 'su-na',
 709             #        label => 'People and Organizations',
 710             #        tags  => [ qw/ 600a 610a 611a / ],
 711             #        sep   => 'a',
 712             #        },
 713             {
 714                 idx   => 'su-geo',
 715                 label => 'Places',
 716                 tags  => [ qw/ 651a / ],
 717                 sep   => '--',
 718             },
 719             {
 720                 idx   => 'su-ut',
 721                 label => 'Titles',
 722                 tags  => [ qw/ 630a / ],
 723                 sep   => '--',
 724             },
 725             {
 726                 idx   => 'au',
 727                 label => 'Authors',
 728                 tags  => [ qw/ 100a 110a 700a / ],
 729                 sep   => ', ',
 730             },
 731             {
 732                 idx   => 'se',
 733                 label => 'Series',
 734                 tags  => [ qw/ 440a 490a / ],
 735                 sep   => ', ',
 736             },
 737             {
 738                 idx   => 'itype',
 739                 label => 'ItemTypes',
 740                 tags  => [ qw/ 952y 942c / ],
 741                 sep   => ', ',
 742             },
 743             {
 744                 idx => 'location',
 745                 label => 'Location',
 746                 tags => [ qw / 952c / ],
 747             },
 748             ];
 749
 750             unless ( Koha::Libraries->search->count == 1 )
 751             {
 752                 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
 753                 if (   $DisplayLibraryFacets eq 'both'
 754                     || $DisplayLibraryFacets eq 'holding' )
 755                 {
 756                     push(
 757                         @$facets,
 758                         {
 759                             idx   => 'holdingbranch',
 760                             label => 'HoldingLibrary',
 761                             tags  => [qw / 952b /],
 762                         }
 763                     );
 764                 }
 765
 766                 if (   $DisplayLibraryFacets eq 'both'
 767                     || $DisplayLibraryFacets eq 'home' )
 768                 {
 769                 push(
 770                     @$facets,
 771                     {
 772                         idx   => 'homebranch',
 773                         label => 'HomeLibrary',
 774                         tags  => [qw / 952a /],
 775                     }
 776                 );
 777                 }
 778             }
 779     }
 780     return $facets;
 781 }
 782
 783 =head2 get_infos_of
 784
 785 Return a href where a key is associated to a href. You give a query,
 786 the name of the key among the fields returned by the query. If you
 787 also give as third argument the name of the value, the function
 788 returns a href of scalar. The optional 4th argument is an arrayref of
 789 items passed to the C<execute()> call. It is designed to bind
 790 parameters to any placeholders in your SQL.
 791
 792   my $query = '
 793 SELECT itemnumber,
 794        notforloan,
 795        barcode
 796   FROM items
 797 ';
 798
 799   # generic href of any information on the item, href of href.
 800   my $iteminfos_of = get_infos_of($query, 'itemnumber');
 801   print $iteminfos_of->{$itemnumber}{barcode};
 802
 803   # specific information, href of scalar
 804   my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
 805   print $barcode_of_item->{$itemnumber};
 806
 807 =cut
 808
 809 sub get_infos_of {
 810     my ( $query, $key_name, $value_name, $bind_params ) = @_;
 811
 812     my $dbh = C4::Context->dbh;
 813
 814     my $sth = $dbh->prepare($query);
 815     $sth->execute( @$bind_params );
 816
 817     my %infos_of;
 818     while ( my $row = $sth->fetchrow_hashref ) {
 819         if ( defined $value_name ) {
 820             $infos_of{ $row->{$key_name} } = $row->{$value_name};
 821         }
 822         else {
 823             $infos_of{ $row->{$key_name} } = $row;
 824         }
 825     }
 826     $sth->finish;
 827
 828     return \%infos_of;
 829 }
 830
 831 =head2 get_notforloan_label_of
 832
 833   my $notforloan_label_of = get_notforloan_label_of();
 834
 835 Each authorised value of notforloan (information available in items and
 836 itemtypes) is link to a single label.
 837
 838 Returns a href where keys are authorised values and values are corresponding
 839 labels.
 840
 841   foreach my $authorised_value (keys %{$notforloan_label_of}) {
 842     printf(
 843         "authorised_value: %s => %s\n",
 844         $authorised_value,
 845         $notforloan_label_of->{$authorised_value}
 846     );
 847   }
 848
 849 =cut
 850
 851 # FIXME - why not use GetAuthorisedValues ??
 852 #
 853 sub get_notforloan_label_of {
 854     my $dbh = C4::Context->dbh;
 855
 856     my $query = '
 857 SELECT authorised_value
 858   FROM marc_subfield_structure
 859   WHERE kohafield = \'items.notforloan\'
 860   LIMIT 0, 1
 861 ';
 862     my $sth = $dbh->prepare($query);
 863     $sth->execute();
 864     my ($statuscode) = $sth->fetchrow_array();
 865
 866     $query = '
 867 SELECT lib,
 868        authorised_value
 869   FROM authorised_values
 870   WHERE category = ?
 871 ';
 872     $sth = $dbh->prepare($query);
 873     $sth->execute($statuscode);
 874     my %notforloan_label_of;
 875     while ( my $row = $sth->fetchrow_hashref ) {
 876         $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
 877     }
 878     $sth->finish;
 879
 880     return \%notforloan_label_of;
 881 }
 882
 883 =head2 GetAuthValCode
 884
 885   $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
 886
 887 =cut
 888
 889 sub GetAuthValCode {
 890         my ($kohafield,$fwcode) = @_;
 891         my $dbh = C4::Context->dbh;
 892         $fwcode='' unless $fwcode;
 893         my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
 894         $sth->execute($kohafield,$fwcode);
 895         my ($authvalcode) = $sth->fetchrow_array;
 896         return $authvalcode;
 897 }
 898
 899 =head2 GetAuthValCodeFromField
 900
 901   $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
 902
 903 C<$subfield> can be undefined
 904
 905 =cut
 906
 907 sub GetAuthValCodeFromField {
 908         my ($field,$subfield,$fwcode) = @_;
 909         my $dbh = C4::Context->dbh;
 910         $fwcode='' unless $fwcode;
 911         my $sth;
 912         if (defined $subfield) {
 913             $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
 914             $sth->execute($field,$subfield,$fwcode);
 915         } else {
 916             $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
 917             $sth->execute($field,$fwcode);
 918         }
 919         my ($authvalcode) = $sth->fetchrow_array;
 920         return $authvalcode;
 921 }
 922
 923 =head2 GetAuthorisedValues
 924
 925   $authvalues = GetAuthorisedValues([$category]);
 926
 927 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
 928
 929 C<$category> returns authorised values for just one category (optional).
 930
 931 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
 932
 933 =cut
 934
 935 sub GetAuthorisedValues {
 936     my ( $category, $opac ) = @_;
 937
 938     # Is this cached already?
 939     $opac = $opac ? 1 : 0;    # normalise to be safe
 940     my $branch_limit =
 941       C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
 942     my $cache_key =
 943       "AuthorisedValues-$category-$opac-$branch_limit";
 944     my $cache  = Koha::Caches->get_instance();
 945     my $result = $cache->get_from_cache($cache_key);
 946     return $result if $result;
 947
 948     my @results;
 949     my $dbh      = C4::Context->dbh;
 950     my $query = qq{
 951         SELECT DISTINCT av.*
 952         FROM authorised_values av
 953     };
 954     $query .= qq{
 955           LEFT JOIN authorised_values_branches ON ( id = av_id )
 956     } if $branch_limit;
 957     my @where_strings;
 958     my @where_args;
 959     if($category) {
 960         push @where_strings, "category = ?";
 961         push @where_args, $category;
 962     }
 963     if($branch_limit) {
 964         push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
 965         push @where_args, $branch_limit;
 966     }
 967     if(@where_strings > 0) {
 968         $query .= " WHERE " . join(" AND ", @where_strings);
 969     }
 970     $query .= ' ORDER BY category, ' . (
 971                 $opac ? 'COALESCE(lib_opac, lib)'
 972                       : 'lib, lib_opac'
 973               );
 974
 975     my $sth = $dbh->prepare($query);
 976
 977     $sth->execute( @where_args );
 978     while (my $data=$sth->fetchrow_hashref) {
 979         if ($opac && $data->{lib_opac}) {
 980             $data->{lib} = $data->{lib_opac};
 981         }
 982         push @results, $data;
 983     }
 984     $sth->finish;
 985
 986     $cache->set_in_cache( $cache_key, \@results, { expiry => 5 } );
 987     return \@results;
 988 }
 989
 990 =head2 GetAuthorisedValueCategories
 991
 992   $auth_categories = GetAuthorisedValueCategories();
 993
 994 Return an arrayref of all of the available authorised
 995 value categories.
 996
 997 =cut
 998
 999 sub GetAuthorisedValueCategories {
1000     my $dbh = C4::Context->dbh;
1001     my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1002     $sth->execute;
1003     my @results;
1004     while (defined (my $category  = $sth->fetchrow_array) ) {
1005         push @results, $category;
1006     }
1007     return \@results;
1008 }
1009
1010 =head2 GetAuthorisedValueByCode
1011
1012 $authorised_value = GetAuthorisedValueByCode( $category, $authvalcode, $opac );
1013
1014 Return the lib attribute from authorised_values from the row identified
1015 by the passed category and code
1016
1017 =cut
1018
1019 sub GetAuthorisedValueByCode {
1020     my ( $category, $authvalcode, $opac ) = @_;
1021
1022     my $field = $opac ? 'lib_opac' : 'lib';
1023     my $dbh = C4::Context->dbh;
1024     my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
1025     $sth->execute( $category, $authvalcode );
1026     while ( my $data = $sth->fetchrow_hashref ) {
1027         return $data->{ $field };
1028     }
1029 }
1030
1031 =head2 GetKohaAuthorisedValues
1032
1033 Takes $kohafield, $fwcode as parameters.
1034
1035 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1036
1037 Returns hashref of Code => description
1038
1039 Returns undef if no authorised value category is defined for the kohafield.
1040
1041 =cut
1042
1043 sub GetKohaAuthorisedValues {
1044   my ($kohafield,$fwcode,$opac) = @_;
1045   $fwcode='' unless $fwcode;
1046   my %values;
1047   my $dbh = C4::Context->dbh;
1048   my $avcode = GetAuthValCode($kohafield,$fwcode);
1049   if ($avcode) {
1050         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1051         $sth->execute($avcode);
1052         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1053                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1054         }
1055         return \%values;
1056   } else {
1057         return;
1058   }
1059 }
1060
1061 =head2 GetKohaAuthorisedValuesMapping
1062
1063 Takes a hash as a parameter. The interface key indicates the
1064 description to use in the mapping.
1065
1066 Returns hashref of:
1067  "{kohafield},{frameworkcode},{authorised_value}" => "{description}"
1068 for all the kohafields, frameworkcodes, and authorised values.
1069
1070 Returns undef if nothing is found.
1071
1072 =cut
1073
1074 sub GetKohaAuthorisedValuesMapping {
1075     my ($parameter) = @_;
1076     my $interface = $parameter->{'interface'} // '';
1077
1078     my $query_mapping = q{
1079 SELECT TA.kohafield,TA.authorised_value AS category,
1080        TA.frameworkcode,TB.authorised_value,
1081        IF(TB.lib_opac>'',TB.lib_opac,TB.lib) AS OPAC,
1082        TB.lib AS Intranet,TB.lib_opac
1083 FROM marc_subfield_structure AS TA JOIN
1084      authorised_values as TB ON
1085      TA.authorised_value=TB.category
1086 WHERE TA.kohafield>'' AND TA.authorised_value>'';
1087     };
1088     my $dbh = C4::Context->dbh;
1089     my $sth = $dbh->prepare($query_mapping);
1090     $sth->execute();
1091     my $avmapping;
1092     if ($interface eq 'opac') {
1093         while (my $row = $sth->fetchrow_hashref) {
1094             $avmapping->{$row->{kohafield}.",".$row->{frameworkcode}.",".$row->{authorised_value}} = $row->{OPAC};
1095         }
1096     }
1097     else {
1098         while (my $row = $sth->fetchrow_hashref) {
1099             $avmapping->{$row->{kohafield}.",".$row->{frameworkcode}.",".$row->{authorised_value}} = $row->{Intranet};
1100         }
1101     }
1102     return $avmapping;
1103 }
1104
1105 =head2 xml_escape
1106
1107   my $escaped_string = C4::Koha::xml_escape($string);
1108
1109 Convert &, <, >, ', and " in a string to XML entities
1110
1111 =cut
1112
1113 sub xml_escape {
1114     my $str = shift;
1115     return '' unless defined $str;
1116     $str =~ s/&/&amp;/g;
1117     $str =~ s/</&lt;/g;
1118     $str =~ s/>/&gt;/g;
1119     $str =~ s/'/&apos;/g;
1120     $str =~ s/"/&quot;/g;
1121     return $str;
1122 }
1123
1124 =head2 display_marc_indicators
1125
1126   my $display_form = C4::Koha::display_marc_indicators($field);
1127
1128 C<$field> is a MARC::Field object
1129
1130 Generate a display form of the indicators of a variable
1131 MARC field, replacing any blanks with '#'.
1132
1133 =cut
1134
1135 sub display_marc_indicators {
1136     my $field = shift;
1137     my $indicators = '';
1138     if ($field && $field->tag() >= 10) {
1139         $indicators = $field->indicator(1) . $field->indicator(2);
1140         $indicators =~ s/ /#/g;
1141     }
1142     return $indicators;
1143 }
1144
1145 sub GetNormalizedUPC {
1146     my ($marcrecord,$marcflavour) = @_;
1147
1148     return unless $marcrecord;
1149     if ($marcflavour eq 'UNIMARC') {
1150         my @fields = $marcrecord->field('072');
1151         foreach my $field (@fields) {
1152             my $upc = _normalize_match_point($field->subfield('a'));
1153             if ($upc) {
1154                 return $upc;
1155             }
1156         }
1157
1158     }
1159     else { # assume marc21 if not unimarc
1160         my @fields = $marcrecord->field('024');
1161         foreach my $field (@fields) {
1162             my $indicator = $field->indicator(1);
1163             my $upc = _normalize_match_point($field->subfield('a'));
1164             if ($upc && $indicator == 1 ) {
1165                 return $upc;
1166             }
1167         }
1168     }
1169 }
1170
1171 # Normalizes and returns the first valid ISBN found in the record
1172 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1173 sub GetNormalizedISBN {
1174     my ($isbn,$marcrecord,$marcflavour) = @_;
1175     if ($isbn) {
1176         # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1177         # anything after " | " should be removed, along with the delimiter
1178         ($isbn) = split(/\|/, $isbn );
1179         return _isbn_cleanup($isbn);
1180     }
1181
1182     return unless $marcrecord;
1183
1184     if ($marcflavour eq 'UNIMARC') {
1185         my @fields = $marcrecord->field('010');
1186         foreach my $field (@fields) {
1187             my $isbn = $field->subfield('a');
1188             if ($isbn) {
1189                 return _isbn_cleanup($isbn);
1190             }
1191         }
1192     }
1193     else { # assume marc21 if not unimarc
1194         my @fields = $marcrecord->field('020');
1195         foreach my $field (@fields) {
1196             $isbn = $field->subfield('a');
1197             if ($isbn) {
1198                 return _isbn_cleanup($isbn);
1199             }
1200         }
1201     }
1202 }
1203
1204 sub GetNormalizedEAN {
1205     my ($marcrecord,$marcflavour) = @_;
1206
1207     return unless $marcrecord;
1208
1209     if ($marcflavour eq 'UNIMARC') {
1210         my @fields = $marcrecord->field('073');
1211         foreach my $field (@fields) {
1212             my $ean = _normalize_match_point($field->subfield('a'));
1213             if ( $ean ) {
1214                 return $ean;
1215             }
1216         }
1217     }
1218     else { # assume marc21 if not unimarc
1219         my @fields = $marcrecord->field('024');
1220         foreach my $field (@fields) {
1221             my $indicator = $field->indicator(1);
1222             my $ean = _normalize_match_point($field->subfield('a'));
1223             if ( $ean && $indicator == 3  ) {
1224                 return $ean;
1225             }
1226         }
1227     }
1228 }
1229
1230 sub GetNormalizedOCLCNumber {
1231     my ($marcrecord,$marcflavour) = @_;
1232     return unless $marcrecord;
1233
1234     if ($marcflavour ne 'UNIMARC' ) {
1235         my @fields = $marcrecord->field('035');
1236         foreach my $field (@fields) {
1237             my $oclc = $field->subfield('a');
1238             if ($oclc =~ /OCoLC/) {
1239                 $oclc =~ s/\(OCoLC\)//;
1240                 return $oclc;
1241             }
1242         }
1243     } else {
1244         # TODO for UNIMARC
1245     }
1246     return
1247 }
1248
1249 sub GetAuthvalueDropbox {
1250     my ( $authcat, $default ) = @_;
1251     my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1252     my $dbh = C4::Context->dbh;
1253
1254     my $query = qq{
1255         SELECT *
1256         FROM authorised_values
1257     };
1258     $query .= qq{
1259           LEFT JOIN authorised_values_branches ON ( id = av_id )
1260     } if $branch_limit;
1261     $query .= qq{
1262         WHERE category = ?
1263     };
1264     $query .= " AND ( branchcode = ? OR branchcode IS NULL )" if $branch_limit;
1265     $query .= " GROUP BY lib ORDER BY category, lib, lib_opac";
1266     my $sth = $dbh->prepare($query);
1267     $sth->execute( $authcat, $branch_limit ? $branch_limit : () );
1268
1269
1270     my $option_list = [];
1271     my @authorised_values = ( q{} );
1272     while (my $av = $sth->fetchrow_hashref) {
1273         push @{$option_list}, {
1274             value => $av->{authorised_value},
1275             label => $av->{lib},
1276             default => ($default eq $av->{authorised_value}),
1277         };
1278     }
1279
1280     if ( @{$option_list} ) {
1281         return $option_list;
1282     }
1283     return;
1284 }
1285
1286
1287 =head2 GetDailyQuote($opts)
1288
1289 Takes a hashref of options
1290
1291 Currently supported options are:
1292
1293 'id'        An exact quote id
1294 'random'    Select a random quote
1295 noop        When no option is passed in, this sub will return the quote timestamped for the current day
1296
1297 The function returns an anonymous hash following this format:
1298
1299         {
1300           'source' => 'source-of-quote',
1301           'timestamp' => 'timestamp-value',
1302           'text' => 'text-of-quote',
1303           'id' => 'quote-id'
1304         };
1305
1306 =cut
1307
1308 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1309 # at least for default option
1310
1311 sub GetDailyQuote {
1312     my %opts = @_;
1313     my $dbh = C4::Context->dbh;
1314     my $query = '';
1315     my $sth = undef;
1316     my $quote = undef;
1317     if ($opts{'id'}) {
1318         $query = 'SELECT * FROM quotes WHERE id = ?';
1319         $sth = $dbh->prepare($query);
1320         $sth->execute($opts{'id'});
1321         $quote = $sth->fetchrow_hashref();
1322     }
1323     elsif ($opts{'random'}) {
1324         # Fall through... we also return a random quote as a catch-all if all else fails
1325     }
1326     else {
1327         $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1328         $sth = $dbh->prepare($query);
1329         $sth->execute();
1330         $quote = $sth->fetchrow_hashref();
1331     }
1332     unless ($quote) {        # if there are not matches, choose a random quote
1333         # get a list of all available quote ids
1334         $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1335         $sth->execute;
1336         my $range = ($sth->fetchrow_array)[0];
1337         # chose a random id within that range if there is more than one quote
1338         my $offset = int(rand($range));
1339         # grab it
1340         $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
1341         $sth = C4::Context->dbh->prepare($query);
1342         # see http://www.perlmonks.org/?node_id=837422 for why
1343         # we're being verbose and using bind_param
1344         $sth->bind_param(1, $offset, SQL_INTEGER);
1345         $sth->execute();
1346         $quote = $sth->fetchrow_hashref();
1347         # update the timestamp for that quote
1348         $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1349         $sth = C4::Context->dbh->prepare($query);
1350         $sth->execute(
1351             DateTime::Format::MySQL->format_datetime( dt_from_string() ),
1352             $quote->{'id'}
1353         );
1354     }
1355     return $quote;
1356 }
1357
1358 sub _normalize_match_point {
1359     my $match_point = shift;
1360     (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1361     $normalized_match_point =~ s/-//g;
1362
1363     return $normalized_match_point;
1364 }
1365
1366 sub _isbn_cleanup {
1367     my ($isbn) = @_;
1368     return NormalizeISBN(
1369         {
1370             isbn          => $isbn,
1371             format        => 'ISBN-10',
1372             strip_hyphens => 1,
1373         }
1374     ) if $isbn;
1375 }
1376
1377 =head2 NormalizedISBN
1378
1379   my $isbns = NormalizedISBN({
1380     isbn => $isbn,
1381     strip_hyphens => [0,1],
1382     format => ['ISBN-10', 'ISBN-13']
1383   });
1384
1385   Returns an isbn validated by Business::ISBN.
1386   Optionally strips hyphens and/or forces the isbn
1387   to be of the specified format.
1388
1389   If the string cannot be validated as an isbn,
1390   it returns nothing.
1391
1392 =cut
1393
1394 sub NormalizeISBN {
1395     my ($params) = @_;
1396
1397     my $string        = $params->{isbn};
1398     my $strip_hyphens = $params->{strip_hyphens};
1399     my $format        = $params->{format};
1400
1401     return unless $string;
1402
1403     my $isbn = Business::ISBN->new($string);
1404
1405     if ( $isbn && $isbn->is_valid() ) {
1406
1407         if ( $format eq 'ISBN-10' ) {
1408             $isbn = $isbn->as_isbn10();
1409         }
1410         elsif ( $format eq 'ISBN-13' ) {
1411             $isbn = $isbn->as_isbn13();
1412         }
1413         return unless $isbn;
1414
1415         if ($strip_hyphens) {
1416             $string = $isbn->as_string( [] );
1417         } else {
1418             $string = $isbn->as_string();
1419         }
1420
1421         return $string;
1422     }
1423 }
1424
1425 =head2 GetVariationsOfISBN
1426
1427   my @isbns = GetVariationsOfISBN( $isbn );
1428
1429   Returns a list of variations of the given isbn in
1430   both ISBN-10 and ISBN-13 formats, with and without
1431   hyphens.
1432
1433   In a scalar context, the isbns are returned as a
1434   string delimited by ' | '.
1435
1436 =cut
1437
1438 sub GetVariationsOfISBN {
1439     my ($isbn) = @_;
1440
1441     return unless $isbn;
1442
1443     my @isbns;
1444
1445     push( @isbns, NormalizeISBN({ isbn => $isbn }) );
1446     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) );
1447     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) );
1448     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) );
1449     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
1450
1451     # Strip out any "empty" strings from the array
1452     @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
1453
1454     return wantarray ? @isbns : join( " | ", @isbns );
1455 }
1456
1457 =head2 GetVariationsOfISBNs
1458
1459   my @isbns = GetVariationsOfISBNs( @isbns );
1460
1461   Returns a list of variations of the given isbns in
1462   both ISBN-10 and ISBN-13 formats, with and without
1463   hyphens.
1464
1465   In a scalar context, the isbns are returned as a
1466   string delimited by ' | '.
1467
1468 =cut
1469
1470 sub GetVariationsOfISBNs {
1471     my (@isbns) = @_;
1472
1473     @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
1474
1475     return wantarray ? @isbns : join( " | ", @isbns );
1476 }
1477
1478 =head2 IsKohaFieldLinked
1479
1480     my $is_linked = IsKohaFieldLinked({
1481         kohafield => $kohafield,
1482         frameworkcode => $frameworkcode,
1483     });
1484
1485     Return 1 if the field is linked
1486
1487 =cut
1488
1489 sub IsKohaFieldLinked {
1490     my ( $params ) = @_;
1491     my $kohafield = $params->{kohafield};
1492     my $frameworkcode = $params->{frameworkcode} || '';
1493     my $dbh = C4::Context->dbh;
1494     my $is_linked = $dbh->selectcol_arrayref( q|
1495         SELECT COUNT(*)
1496         FROM marc_subfield_structure
1497         WHERE frameworkcode = ?
1498         AND kohafield = ?
1499     |,{}, $frameworkcode, $kohafield );
1500     return $is_linked->[0];
1501 }
1502
1503 1;
1504
1505 __END__
1506
1507 =head1 AUTHOR
1508
1509 Koha Team
1510
1511 =cut