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