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 DateTime::Format::MySQL;
  31 use Business::ISBN;
  32 use autouse 'Data::cselectall_arrayref' => qw(Dumper);
  33 use DBI qw(:sql_types);
  34 use vars qw(@ISA @EXPORT @EXPORT_OK $DEBUG);
  35
  36 BEGIN {
  37         require Exporter;
  38         @ISA    = qw(Exporter);
  39         @EXPORT = qw(
  40                 &GetPrinters &GetPrinter
  41                 &GetItemTypes &getitemtypeinfo
  42                 &GetItemTypesCategorized &GetItemTypesByCategory
  43                 &getframeworks &getframeworkinfo
  44         &GetFrameworksLoop
  45                 &getallthemes
  46                 &getFacets
  47                 &getnbpages
  48                 &get_infos_of
  49                 &get_notforloan_label_of
  50                 &getitemtypeimagedir
  51                 &getitemtypeimagesrc
  52                 &getitemtypeimagelocation
  53                 &GetAuthorisedValues
  54                 &GetAuthorisedValueCategories
  55                 &GetKohaAuthorisedValues
  56                 &GetKohaAuthorisedValuesFromField
  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 GetKohaAuthorisedValuesFromField
1062
1063 Takes $field, $subfield, $fwcode as parameters.
1064
1065 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1066 $subfield can be undefined
1067
1068 Returns hashref of Code => description
1069
1070 Returns undef if no authorised value category is defined for the given field and subfield
1071
1072 =cut
1073
1074 sub GetKohaAuthorisedValuesFromField {
1075   my ($field, $subfield, $fwcode,$opac) = @_;
1076   $fwcode='' unless $fwcode;
1077   my %values;
1078   my $dbh = C4::Context->dbh;
1079   my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1080   if ($avcode) {
1081         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1082         $sth->execute($avcode);
1083         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1084                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1085         }
1086         return \%values;
1087   } else {
1088         return;
1089   }
1090 }
1091
1092 =head2 GetKohaAuthorisedValuesMapping
1093
1094 Takes a hash as a parameter. The interface key indicates the
1095 description to use in the mapping.
1096
1097 Returns hashref of:
1098  "{kohafield},{frameworkcode},{authorised_value}" => "{description}"
1099 for all the kohafields, frameworkcodes, and authorised values.
1100
1101 Returns undef if nothing is found.
1102
1103 =cut
1104
1105 sub GetKohaAuthorisedValuesMapping {
1106     my ($parameter) = @_;
1107     my $interface = $parameter->{'interface'} // '';
1108
1109     my $query_mapping = q{
1110 SELECT TA.kohafield,TA.authorised_value AS category,
1111        TA.frameworkcode,TB.authorised_value,
1112        IF(TB.lib_opac>'',TB.lib_opac,TB.lib) AS OPAC,
1113        TB.lib AS Intranet,TB.lib_opac
1114 FROM marc_subfield_structure AS TA JOIN
1115      authorised_values as TB ON
1116      TA.authorised_value=TB.category
1117 WHERE TA.kohafield>'' AND TA.authorised_value>'';
1118     };
1119     my $dbh = C4::Context->dbh;
1120     my $sth = $dbh->prepare($query_mapping);
1121     $sth->execute();
1122     my $avmapping;
1123     if ($interface eq 'opac') {
1124         while (my $row = $sth->fetchrow_hashref) {
1125             $avmapping->{$row->{kohafield}.",".$row->{frameworkcode}.",".$row->{authorised_value}} = $row->{OPAC};
1126         }
1127     }
1128     else {
1129         while (my $row = $sth->fetchrow_hashref) {
1130             $avmapping->{$row->{kohafield}.",".$row->{frameworkcode}.",".$row->{authorised_value}} = $row->{Intranet};
1131         }
1132     }
1133     return $avmapping;
1134 }
1135
1136 =head2 xml_escape
1137
1138   my $escaped_string = C4::Koha::xml_escape($string);
1139
1140 Convert &, <, >, ', and " in a string to XML entities
1141
1142 =cut
1143
1144 sub xml_escape {
1145     my $str = shift;
1146     return '' unless defined $str;
1147     $str =~ s/&/&amp;/g;
1148     $str =~ s/</&lt;/g;
1149     $str =~ s/>/&gt;/g;
1150     $str =~ s/'/&apos;/g;
1151     $str =~ s/"/&quot;/g;
1152     return $str;
1153 }
1154
1155 =head2 display_marc_indicators
1156
1157   my $display_form = C4::Koha::display_marc_indicators($field);
1158
1159 C<$field> is a MARC::Field object
1160
1161 Generate a display form of the indicators of a variable
1162 MARC field, replacing any blanks with '#'.
1163
1164 =cut
1165
1166 sub display_marc_indicators {
1167     my $field = shift;
1168     my $indicators = '';
1169     if ($field && $field->tag() >= 10) {
1170         $indicators = $field->indicator(1) . $field->indicator(2);
1171         $indicators =~ s/ /#/g;
1172     }
1173     return $indicators;
1174 }
1175
1176 sub GetNormalizedUPC {
1177     my ($marcrecord,$marcflavour) = @_;
1178
1179     return unless $marcrecord;
1180     if ($marcflavour eq 'UNIMARC') {
1181         my @fields = $marcrecord->field('072');
1182         foreach my $field (@fields) {
1183             my $upc = _normalize_match_point($field->subfield('a'));
1184             if ($upc) {
1185                 return $upc;
1186             }
1187         }
1188
1189     }
1190     else { # assume marc21 if not unimarc
1191         my @fields = $marcrecord->field('024');
1192         foreach my $field (@fields) {
1193             my $indicator = $field->indicator(1);
1194             my $upc = _normalize_match_point($field->subfield('a'));
1195             if ($upc && $indicator == 1 ) {
1196                 return $upc;
1197             }
1198         }
1199     }
1200 }
1201
1202 # Normalizes and returns the first valid ISBN found in the record
1203 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1204 sub GetNormalizedISBN {
1205     my ($isbn,$marcrecord,$marcflavour) = @_;
1206     if ($isbn) {
1207         # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1208         # anything after " | " should be removed, along with the delimiter
1209         ($isbn) = split(/\|/, $isbn );
1210         return _isbn_cleanup($isbn);
1211     }
1212
1213     return unless $marcrecord;
1214
1215     if ($marcflavour eq 'UNIMARC') {
1216         my @fields = $marcrecord->field('010');
1217         foreach my $field (@fields) {
1218             my $isbn = $field->subfield('a');
1219             if ($isbn) {
1220                 return _isbn_cleanup($isbn);
1221             }
1222         }
1223     }
1224     else { # assume marc21 if not unimarc
1225         my @fields = $marcrecord->field('020');
1226         foreach my $field (@fields) {
1227             $isbn = $field->subfield('a');
1228             if ($isbn) {
1229                 return _isbn_cleanup($isbn);
1230             }
1231         }
1232     }
1233 }
1234
1235 sub GetNormalizedEAN {
1236     my ($marcrecord,$marcflavour) = @_;
1237
1238     return unless $marcrecord;
1239
1240     if ($marcflavour eq 'UNIMARC') {
1241         my @fields = $marcrecord->field('073');
1242         foreach my $field (@fields) {
1243             my $ean = _normalize_match_point($field->subfield('a'));
1244             if ( $ean ) {
1245                 return $ean;
1246             }
1247         }
1248     }
1249     else { # assume marc21 if not unimarc
1250         my @fields = $marcrecord->field('024');
1251         foreach my $field (@fields) {
1252             my $indicator = $field->indicator(1);
1253             my $ean = _normalize_match_point($field->subfield('a'));
1254             if ( $ean && $indicator == 3  ) {
1255                 return $ean;
1256             }
1257         }
1258     }
1259 }
1260
1261 sub GetNormalizedOCLCNumber {
1262     my ($marcrecord,$marcflavour) = @_;
1263     return unless $marcrecord;
1264
1265     if ($marcflavour ne 'UNIMARC' ) {
1266         my @fields = $marcrecord->field('035');
1267         foreach my $field (@fields) {
1268             my $oclc = $field->subfield('a');
1269             if ($oclc =~ /OCoLC/) {
1270                 $oclc =~ s/\(OCoLC\)//;
1271                 return $oclc;
1272             }
1273         }
1274     } else {
1275         # TODO for UNIMARC
1276     }
1277     return
1278 }
1279
1280 sub GetAuthvalueDropbox {
1281     my ( $authcat, $default ) = @_;
1282     my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1283     my $dbh = C4::Context->dbh;
1284
1285     my $query = qq{
1286         SELECT *
1287         FROM authorised_values
1288     };
1289     $query .= qq{
1290           LEFT JOIN authorised_values_branches ON ( id = av_id )
1291     } if $branch_limit;
1292     $query .= qq{
1293         WHERE category = ?
1294     };
1295     $query .= " AND ( branchcode = ? OR branchcode IS NULL )" if $branch_limit;
1296     $query .= " GROUP BY lib ORDER BY category, lib, lib_opac";
1297     my $sth = $dbh->prepare($query);
1298     $sth->execute( $authcat, $branch_limit ? $branch_limit : () );
1299
1300
1301     my $option_list = [];
1302     my @authorised_values = ( q{} );
1303     while (my $av = $sth->fetchrow_hashref) {
1304         push @{$option_list}, {
1305             value => $av->{authorised_value},
1306             label => $av->{lib},
1307             default => ($default eq $av->{authorised_value}),
1308         };
1309     }
1310
1311     if ( @{$option_list} ) {
1312         return $option_list;
1313     }
1314     return;
1315 }
1316
1317
1318 =head2 GetDailyQuote($opts)
1319
1320 Takes a hashref of options
1321
1322 Currently supported options are:
1323
1324 'id'        An exact quote id
1325 'random'    Select a random quote
1326 noop        When no option is passed in, this sub will return the quote timestamped for the current day
1327
1328 The function returns an anonymous hash following this format:
1329
1330         {
1331           'source' => 'source-of-quote',
1332           'timestamp' => 'timestamp-value',
1333           'text' => 'text-of-quote',
1334           'id' => 'quote-id'
1335         };
1336
1337 =cut
1338
1339 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1340 # at least for default option
1341
1342 sub GetDailyQuote {
1343     my %opts = @_;
1344     my $dbh = C4::Context->dbh;
1345     my $query = '';
1346     my $sth = undef;
1347     my $quote = undef;
1348     if ($opts{'id'}) {
1349         $query = 'SELECT * FROM quotes WHERE id = ?';
1350         $sth = $dbh->prepare($query);
1351         $sth->execute($opts{'id'});
1352         $quote = $sth->fetchrow_hashref();
1353     }
1354     elsif ($opts{'random'}) {
1355         # Fall through... we also return a random quote as a catch-all if all else fails
1356     }
1357     else {
1358         $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1359         $sth = $dbh->prepare($query);
1360         $sth->execute();
1361         $quote = $sth->fetchrow_hashref();
1362     }
1363     unless ($quote) {        # if there are not matches, choose a random quote
1364         # get a list of all available quote ids
1365         $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1366         $sth->execute;
1367         my $range = ($sth->fetchrow_array)[0];
1368         # chose a random id within that range if there is more than one quote
1369         my $offset = int(rand($range));
1370         # grab it
1371         $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
1372         $sth = C4::Context->dbh->prepare($query);
1373         # see http://www.perlmonks.org/?node_id=837422 for why
1374         # we're being verbose and using bind_param
1375         $sth->bind_param(1, $offset, SQL_INTEGER);
1376         $sth->execute();
1377         $quote = $sth->fetchrow_hashref();
1378         # update the timestamp for that quote
1379         $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1380         $sth = C4::Context->dbh->prepare($query);
1381         $sth->execute(
1382             DateTime::Format::MySQL->format_datetime( dt_from_string() ),
1383             $quote->{'id'}
1384         );
1385     }
1386     return $quote;
1387 }
1388
1389 sub _normalize_match_point {
1390     my $match_point = shift;
1391     (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1392     $normalized_match_point =~ s/-//g;
1393
1394     return $normalized_match_point;
1395 }
1396
1397 sub _isbn_cleanup {
1398     my ($isbn) = @_;
1399     return NormalizeISBN(
1400         {
1401             isbn          => $isbn,
1402             format        => 'ISBN-10',
1403             strip_hyphens => 1,
1404         }
1405     ) if $isbn;
1406 }
1407
1408 =head2 NormalizedISBN
1409
1410   my $isbns = NormalizedISBN({
1411     isbn => $isbn,
1412     strip_hyphens => [0,1],
1413     format => ['ISBN-10', 'ISBN-13']
1414   });
1415
1416   Returns an isbn validated by Business::ISBN.
1417   Optionally strips hyphens and/or forces the isbn
1418   to be of the specified format.
1419
1420   If the string cannot be validated as an isbn,
1421   it returns nothing.
1422
1423 =cut
1424
1425 sub NormalizeISBN {
1426     my ($params) = @_;
1427
1428     my $string        = $params->{isbn};
1429     my $strip_hyphens = $params->{strip_hyphens};
1430     my $format        = $params->{format};
1431
1432     return unless $string;
1433
1434     my $isbn = Business::ISBN->new($string);
1435
1436     if ( $isbn && $isbn->is_valid() ) {
1437
1438         if ( $format eq 'ISBN-10' ) {
1439             $isbn = $isbn->as_isbn10();
1440         }
1441         elsif ( $format eq 'ISBN-13' ) {
1442             $isbn = $isbn->as_isbn13();
1443         }
1444         return unless $isbn;
1445
1446         if ($strip_hyphens) {
1447             $string = $isbn->as_string( [] );
1448         } else {
1449             $string = $isbn->as_string();
1450         }
1451
1452         return $string;
1453     }
1454 }
1455
1456 =head2 GetVariationsOfISBN
1457
1458   my @isbns = GetVariationsOfISBN( $isbn );
1459
1460   Returns a list of variations of the given isbn in
1461   both ISBN-10 and ISBN-13 formats, with and without
1462   hyphens.
1463
1464   In a scalar context, the isbns are returned as a
1465   string delimited by ' | '.
1466
1467 =cut
1468
1469 sub GetVariationsOfISBN {
1470     my ($isbn) = @_;
1471
1472     return unless $isbn;
1473
1474     my @isbns;
1475
1476     push( @isbns, NormalizeISBN({ isbn => $isbn }) );
1477     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) );
1478     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) );
1479     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) );
1480     push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
1481
1482     # Strip out any "empty" strings from the array
1483     @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
1484
1485     return wantarray ? @isbns : join( " | ", @isbns );
1486 }
1487
1488 =head2 GetVariationsOfISBNs
1489
1490   my @isbns = GetVariationsOfISBNs( @isbns );
1491
1492   Returns a list of variations of the given isbns in
1493   both ISBN-10 and ISBN-13 formats, with and without
1494   hyphens.
1495
1496   In a scalar context, the isbns are returned as a
1497   string delimited by ' | '.
1498
1499 =cut
1500
1501 sub GetVariationsOfISBNs {
1502     my (@isbns) = @_;
1503
1504     @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
1505
1506     return wantarray ? @isbns : join( " | ", @isbns );
1507 }
1508
1509 =head2 IsKohaFieldLinked
1510
1511     my $is_linked = IsKohaFieldLinked({
1512         kohafield => $kohafield,
1513         frameworkcode => $frameworkcode,
1514     });
1515
1516     Return 1 if the field is linked
1517
1518 =cut
1519
1520 sub IsKohaFieldLinked {
1521     my ( $params ) = @_;
1522     my $kohafield = $params->{kohafield};
1523     my $frameworkcode = $params->{frameworkcode} || '';
1524     my $dbh = C4::Context->dbh;
1525     my $is_linked = $dbh->selectcol_arrayref( q|
1526         SELECT COUNT(*)
1527         FROM marc_subfield_structure
1528         WHERE frameworkcode = ?
1529         AND kohafield = ?
1530     |,{}, $frameworkcode, $kohafield );
1531     return $is_linked->[0];
1532 }
1533
1534 1;
1535
1536 __END__
1537
1538 =head1 AUTHOR
1539
1540 Koha Team
1541
1542 =cut