C4/Koha.pm

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