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