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