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 # $Id$
  21
  22 use strict;
  23 require Exporter;
  24 use C4::Context;
  25 use C4::Biblio;
  26 use CGI;
  27 use vars qw($VERSION @ISA @EXPORT);
  28
  29 $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
  30
  31 =head1 NAME
  32
  33 C4::Koha - Perl Module containing convenience functions for Koha scripts
  34
  35 =head1 SYNOPSIS
  36
  37   use C4::Koha;
  38
  39
  40 =head1 DESCRIPTION
  41
  42 Koha.pm provides many functions for Koha scripts.
  43
  44 =head1 FUNCTIONS
  45
  46 =over 2
  47
  48 =cut
  49
  50 @ISA = qw(Exporter);
  51 @EXPORT = qw(
  52             &subfield_is_koha_internal_p
  53             &GetBranches &getbranch &getbranchdetail
  54             &getprinters &getprinter
  55             &GetItemTypes &getitemtypeinfo &ItemType
  56                         get_itemtypeinfos_of
  57             &getframeworks &getframeworkinfo
  58             &getauthtypes &getauthtype
  59             &getallthemes &getalllanguages
  60             &GetallBranches &getletters
  61             &getbranchname
  62                         getnbpages
  63                         getitemtypeimagedir
  64                         getitemtypeimagesrc
  65                         getitemtypeimagesrcfromurl
  66             &getcities
  67             &getroadtypes
  68                         get_branchinfos_of
  69                         get_notforloan_label_of
  70                         get_infos_of
  71                         &getFacets
  72
  73             $DEBUG);
  74
  75 use vars qw();
  76
  77 my $DEBUG = 0;
  78
  79 # FIXME.. this should be moved to a MARC-specific module
  80 sub subfield_is_koha_internal_p ($) {
  81     my($subfield) = @_;
  82
  83     # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
  84     # But real MARC subfields are always single-character
  85     # so it really is safer just to check the length
  86
  87     return length $subfield != 1;
  88 }
  89
  90 =head2 GetBranches
  91
  92   $branches = &GetBranches();
  93   returns informations about branches.
  94   Create a branch selector with the following code
  95   Is branchIndependant sensitive
  96    When IndependantBranches is set AND user is not superlibrarian, displays only user's branch
  97
  98 =head3 in PERL SCRIPT
  99
 100 my $branches = GetBranches;
 101 my @branchloop;
 102 foreach my $thisbranch (sort keys %$branches) {
 103     my $selected = 1 if $thisbranch eq $branch;
 104     my %row =(value => $thisbranch,
 105                 selected => $selected,
 106                 branchname => $branches->{$thisbranch}->{'branchname'},
 107             );
 108     push @branchloop, \%row;
 109 }
 110
 111
 112 =head3 in TEMPLATE
 113             <select name="branch">
 114                 <option value="">Default</option>
 115             <!-- TMPL_LOOP name="branchloop" -->
 116                 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="branchname" --></option>
 117             <!-- /TMPL_LOOP -->
 118             </select>
 119
 120 =cut
 121
 122 sub GetBranches {
 123 # returns a reference to a hash of references to branches...
 124     my ($type) = @_;
 125     my %branches;
 126     my $branch;
 127     my $dbh = C4::Context->dbh;
 128     my $sth;
 129     if (C4::Context->preference("IndependantBranches") && (C4::Context->userenv->{flags}!=1)){
 130         my $strsth ="Select * from branches ";
 131         $strsth.= " WHERE branchcode = ".$dbh->quote(C4::Context->userenv->{branch});
 132         $strsth.= " order by branchname";
 133         $sth=$dbh->prepare($strsth);
 134     } else {
 135         $sth = $dbh->prepare("Select * from branches order by branchname");
 136     }
 137     $sth->execute;
 138     while ($branch=$sth->fetchrow_hashref) {
 139         my $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ?");
 140             if ($type){
 141             $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ? and categorycode = ?");
 142             $nsth->execute($branch->{'branchcode'},$type);
 143           } else {
 144                     $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ? ");
 145
 146             $nsth->execute($branch->{'branchcode'});
 147           }
 148         while (my ($cat) = $nsth->fetchrow_array) {
 149             # FIXME - This seems wrong. It ought to be
 150             # $branch->{categorycodes}{$cat} = 1;
 151             # otherwise, there's a namespace collision if there's a
 152             # category with the same name as a field in the 'branches'
 153             # table (i.e., don't create a category called "issuing").
 154             # In addition, the current structure doesn't really allow
 155             # you to list the categories that a branch belongs to:
 156             # you'd have to list keys %$branch, and remove those keys
 157             # that aren't fields in the "branches" table.
 158             $branch->{$cat} = 1;
 159             }
 160         $branches{$branch->{'branchcode'}}=$branch;
 161 }
 162     return (\%branches);
 163 }
 164
 165 sub getbranchname {
 166     my ($branchcode)=@_;
 167     my $dbh = C4::Context->dbh;
 168     my $sth;
 169        $sth = $dbh->prepare("Select branchname from branches where branchcode=?");
 170     $sth->execute($branchcode);
 171     my $branchname = $sth->fetchrow_array;
 172     $sth->finish;
 173
 174     return($branchname);
 175 }
 176
 177 =head2 getallbranches
 178
 179   @branches = &GetallBranches();
 180   returns informations about ALL branches.
 181   Create a branch selector with the following code
 182   IndependantBranches Insensitive...
 183
 184
 185 =cut
 186
 187
 188 sub GetallBranches {
 189 # returns an array to ALL branches...
 190     my @branches;
 191     my $dbh = C4::Context->dbh;
 192     my $sth;
 193        $sth = $dbh->prepare("Select * from branches order by branchname");
 194     $sth->execute;
 195     while (my $branch=$sth->fetchrow_hashref) {
 196         push @branches,$branch;
 197     }
 198     return (@branches);
 199 }
 200
 201 =head2 getletters
 202
 203   $letters = &getletters($category);
 204   returns informations about letters.
 205   if needed, $category filters for letters given category
 206   Create a letter selector with the following code
 207
 208 =head3 in PERL SCRIPT
 209
 210 my $letters = getletters($cat);
 211 my @letterloop;
 212 foreach my $thisletter (keys %$letters) {
 213     my $selected = 1 if $thisletter eq $letter;
 214     my %row =(value => $thisletter,
 215                 selected => $selected,
 216                 lettername => $letters->{$thisletter},
 217             );
 218     push @letterloop, \%row;
 219 }
 220
 221
 222 =head3 in TEMPLATE
 223             <select name="letter">
 224                 <option value="">Default</option>
 225             <!-- TMPL_LOOP name="letterloop" -->
 226                 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="lettername" --></option>
 227             <!-- /TMPL_LOOP -->
 228             </select>
 229
 230 =cut
 231
 232 sub getletters {
 233 # returns a reference to a hash of references to ALL letters...
 234     my $cat =@_;
 235     my %letters;
 236     my $dbh = C4::Context->dbh;
 237     my $sth;
 238        if ($cat ne ""){
 239         $sth = $dbh->prepare("Select * from letter where module = \'".$cat."\' order by name");
 240     } else {
 241         $sth = $dbh->prepare("Select * from letter order by name");
 242     }
 243     $sth->execute;
 244     my $count;
 245     while (my $letter=$sth->fetchrow_hashref) {
 246             $letters{$letter->{'code'}}=$letter->{'name'};
 247             $count++;
 248     }
 249     return ($count,\%letters);
 250 }
 251
 252 =head2 GetItemTypes
 253
 254   $itemtypes = &GetItemTypes();
 255
 256 Returns information about existing itemtypes.
 257
 258 build a HTML select with the following code :
 259
 260 =head3 in PERL SCRIPT
 261
 262 my $itemtypes = GetItemTypes;
 263 my @itemtypesloop;
 264 foreach my $thisitemtype (sort keys %$itemtypes) {
 265     my $selected = 1 if $thisitemtype eq $itemtype;
 266     my %row =(value => $thisitemtype,
 267                 selected => $selected,
 268                 description => $itemtypes->{$thisitemtype}->{'description'},
 269             );
 270     push @itemtypesloop, \%row;
 271 }
 272 $template->param(itemtypeloop => \@itemtypesloop);
 273
 274 =head3 in TEMPLATE
 275
 276 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 277     <select name="itemtype">
 278         <option value="">Default</option>
 279     <!-- TMPL_LOOP name="itemtypeloop" -->
 280         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
 281     <!-- /TMPL_LOOP -->
 282     </select>
 283     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 284     <input type="submit" value="OK" class="button">
 285 </form>
 286
 287
 288 =cut
 289
 290 sub GetItemTypes {
 291 # returns a reference to a hash of references to branches...
 292     my %itemtypes;
 293     my $dbh = C4::Context->dbh;
 294     my $query = qq|
 295         SELECT *
 296         FROM   itemtypes
 297     |;
 298     my $sth=$dbh->prepare($query);
 299     $sth->execute;
 300     while (my $IT=$sth->fetchrow_hashref) {
 301             $itemtypes{$IT->{'itemtype'}}=$IT;
 302     }
 303     return (\%itemtypes);
 304 }
 305
 306 # FIXME this function is better and should replace GetItemTypes everywhere
 307 sub get_itemtypeinfos_of {
 308     my @itemtypes = @_;
 309
 310     my $query = '
 311 SELECT itemtype,
 312        description,
 313        notforloan
 314   FROM itemtypes
 315   WHERE itemtype IN ('.join(',', map({"'".$_."'"} @itemtypes)).')
 316 ';
 317
 318     return get_infos_of($query, 'itemtype');
 319 }
 320
 321 sub ItemType {
 322   my ($type)=@_;
 323   my $dbh = C4::Context->dbh;
 324   my $sth=$dbh->prepare("select description from itemtypes where itemtype=?");
 325   $sth->execute($type);
 326   my $dat=$sth->fetchrow_hashref;
 327   $sth->finish;
 328   return ($dat->{'description'});
 329 }
 330 =head2 getauthtypes
 331
 332   $authtypes = &getauthtypes();
 333
 334 Returns information about existing authtypes.
 335
 336 build a HTML select with the following code :
 337
 338 =head3 in PERL SCRIPT
 339
 340 my $authtypes = getauthtypes;
 341 my @authtypesloop;
 342 foreach my $thisauthtype (keys %$authtypes) {
 343     my $selected = 1 if $thisauthtype eq $authtype;
 344     my %row =(value => $thisauthtype,
 345                 selected => $selected,
 346                 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
 347             );
 348     push @authtypesloop, \%row;
 349 }
 350 $template->param(itemtypeloop => \@itemtypesloop);
 351
 352 =head3 in TEMPLATE
 353
 354 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 355     <select name="authtype">
 356     <!-- TMPL_LOOP name="authtypeloop" -->
 357         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
 358     <!-- /TMPL_LOOP -->
 359     </select>
 360     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 361     <input type="submit" value="OK" class="button">
 362 </form>
 363
 364
 365 =cut
 366
 367 sub getauthtypes {
 368 # returns a reference to a hash of references to authtypes...
 369     my %authtypes;
 370     my $dbh = C4::Context->dbh;
 371     my $sth=$dbh->prepare("select * from auth_types order by authtypetext");
 372     $sth->execute;
 373     while (my $IT=$sth->fetchrow_hashref) {
 374             $authtypes{$IT->{'authtypecode'}}=$IT;
 375     }
 376     return (\%authtypes);
 377 }
 378
 379 sub getauthtype {
 380     my ($authtypecode) = @_;
 381 # returns a reference to a hash of references to authtypes...
 382     my %authtypes;
 383     my $dbh = C4::Context->dbh;
 384     my $sth=$dbh->prepare("select * from auth_types where authtypecode=?");
 385     $sth->execute($authtypecode);
 386     my $res=$sth->fetchrow_hashref;
 387     return $res;
 388 }
 389
 390 =head2 getframework
 391
 392   $frameworks = &getframework();
 393
 394 Returns information about existing frameworks
 395
 396 build a HTML select with the following code :
 397
 398 =head3 in PERL SCRIPT
 399
 400 my $frameworks = frameworks();
 401 my @frameworkloop;
 402 foreach my $thisframework (keys %$frameworks) {
 403     my $selected = 1 if $thisframework eq $frameworkcode;
 404     my %row =(value => $thisframework,
 405                 selected => $selected,
 406                 description => $frameworks->{$thisframework}->{'frameworktext'},
 407             );
 408     push @frameworksloop, \%row;
 409 }
 410 $template->param(frameworkloop => \@frameworksloop);
 411
 412 =head3 in TEMPLATE
 413
 414 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 415     <select name="frameworkcode">
 416         <option value="">Default</option>
 417     <!-- TMPL_LOOP name="frameworkloop" -->
 418         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
 419     <!-- /TMPL_LOOP -->
 420     </select>
 421     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 422     <input type="submit" value="OK" class="button">
 423 </form>
 424
 425
 426 =cut
 427
 428 sub getframeworks {
 429 # returns a reference to a hash of references to branches...
 430     my %itemtypes;
 431     my $dbh = C4::Context->dbh;
 432     my $sth=$dbh->prepare("select * from biblios_framework");
 433     $sth->execute;
 434     while (my $IT=$sth->fetchrow_hashref) {
 435             $itemtypes{$IT->{'frameworkcode'}}=$IT;
 436     }
 437     return (\%itemtypes);
 438 }
 439 =head2 getframeworkinfo
 440
 441   $frameworkinfo = &getframeworkinfo($frameworkcode);
 442
 443 Returns information about an frameworkcode.
 444
 445 =cut
 446
 447 sub getframeworkinfo {
 448     my ($frameworkcode) = @_;
 449     my $dbh = C4::Context->dbh;
 450     my $sth=$dbh->prepare("select * from biblios_framework where frameworkcode=?");
 451     $sth->execute($frameworkcode);
 452     my $res = $sth->fetchrow_hashref;
 453     return $res;
 454 }
 455
 456
 457 =head2 getitemtypeinfo
 458
 459   $itemtype = &getitemtype($itemtype);
 460
 461 Returns information about an itemtype.
 462
 463 =cut
 464
 465 sub getitemtypeinfo {
 466     my ($itemtype) = @_;
 467     my $dbh = C4::Context->dbh;
 468     my $sth=$dbh->prepare("select * from itemtypes where itemtype=?");
 469     $sth->execute($itemtype);
 470     my $res = $sth->fetchrow_hashref;
 471
 472         $res->{imageurl} = getitemtypeimagesrcfromurl($res->{imageurl});
 473
 474     return $res;
 475 }
 476
 477 sub getitemtypeimagesrcfromurl {
 478     my ($imageurl) = @_;
 479
 480     if (defined $imageurl and $imageurl !~ m/^http/) {
 481         $imageurl =
 482             getitemtypeimagesrc()
 483             .'/'.$imageurl
 484             ;
 485     }
 486
 487     return $imageurl;
 488 }
 489
 490 sub getitemtypeimagedir {
 491     return
 492         C4::Context->intrahtdocs
 493         .'/'.C4::Context->preference('template')
 494         .'/itemtypeimg'
 495         ;
 496 }
 497
 498 sub getitemtypeimagesrc {
 499     return
 500         '/intranet-tmpl'
 501         .'/'.C4::Context->preference('template')
 502         .'/itemtypeimg'
 503         ;
 504 }
 505
 506 =head2 getprinters
 507
 508   $printers = &getprinters($env);
 509   @queues = keys %$printers;
 510
 511 Returns information about existing printer queues.
 512
 513 C<$env> is ignored.
 514
 515 C<$printers> is a reference-to-hash whose keys are the print queues
 516 defined in the printers table of the Koha database. The values are
 517 references-to-hash, whose keys are the fields in the printers table.
 518
 519 =cut
 520
 521 sub getprinters {
 522     my ($env) = @_;
 523     my %printers;
 524     my $dbh = C4::Context->dbh;
 525     my $sth=$dbh->prepare("select * from printers");
 526     $sth->execute;
 527     while (my $printer=$sth->fetchrow_hashref) {
 528     $printers{$printer->{'printqueue'}}=$printer;
 529     }
 530     return (\%printers);
 531 }
 532
 533 sub getbranch ($$) {
 534     my($query, $branches) = @_; # get branch for this query from branches
 535     my $branch = $query->param('branch');
 536     ($branch) || ($branch = $query->cookie('branch'));
 537     ($branches->{$branch}) || ($branch=(keys %$branches)[0]);
 538     return $branch;
 539 }
 540
 541 =item getbranchdetail
 542
 543   $branchname = &getbranchdetail($branchcode);
 544
 545 Given the branch code, the function returns the corresponding
 546 branch name for a comprehensive information display
 547
 548 =cut
 549
 550 sub getbranchdetail
 551 {
 552     my ($branchcode) = @_;
 553     my $dbh = C4::Context->dbh;
 554     my $sth = $dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
 555     $sth->execute($branchcode);
 556     my $branchname = $sth->fetchrow_hashref();
 557     $sth->finish();
 558     return $branchname;
 559 } # sub getbranchname
 560
 561
 562 sub getprinter ($$) {
 563     my($query, $printers) = @_; # get printer for this query from printers
 564     my $printer = $query->param('printer');
 565     ($printer) || ($printer = $query->cookie('printer')) || ($printer='');
 566     ($printers->{$printer}) || ($printer = (keys %$printers)[0]);
 567     return $printer;
 568 }
 569
 570 =item getalllanguages
 571
 572   (@languages) = &getalllanguages($type);
 573   (@languages) = &getalllanguages($type,$theme);
 574
 575 Returns an array of all available languages.
 576
 577 =cut
 578
 579 sub getalllanguages {
 580     my $type=shift;
 581     my $theme=shift;
 582     my $htdocs;
 583     my @languages;
 584     if ($type eq 'opac') {
 585         $htdocs=C4::Context->config('opachtdocs');
 586         if ($theme and -d "$htdocs/$theme") {
 587             opendir D, "$htdocs/$theme";
 588             foreach my $language (readdir D) {
 589                 next if $language=~/^\./;
 590                 next if $language eq 'all';
 591                 next if $language=~ /png$/;
 592                 next if $language=~ /css$/;
 593                 next if $language=~ /CVS$/;
 594                 next if $language=~ /itemtypeimg$/;
 595                 next if $language=~ /\.txt$/i; #Don't read the readme.txt !
 596                 push @languages, $language;
 597             }
 598             return sort @languages;
 599         } else {
 600             my $lang;
 601             foreach my $theme (getallthemes('opac')) {
 602                 opendir D, "$htdocs/$theme";
 603                 foreach my $language (readdir D) {
 604                     next if $language=~/^\./;
 605                     next if $language eq 'all';
 606                     next if $language=~ /png$/;
 607                     next if $language=~ /css$/;
 608                     next if $language=~ /CVS$/;
 609                     next if $language=~ /itemtypeimg$/;
 610                     next if $language=~ /\.txt$/i; #Don't read the readme.txt !
 611                     $lang->{$language}=1;
 612                 }
 613             }
 614             @languages=keys %$lang;
 615             return sort @languages;
 616         }
 617     } elsif ($type eq 'intranet') {
 618         $htdocs=C4::Context->config('intrahtdocs');
 619         if ($theme and -d "$htdocs/$theme") {
 620             opendir D, "$htdocs/$theme";
 621             foreach my $language (readdir D) {
 622                 next if $language=~/^\./;
 623                 next if $language eq 'all';
 624                 next if $language=~ /png$/;
 625                 next if $language=~ /css$/;
 626                 next if $language=~ /CVS$/;
 627                 next if $language=~ /itemtypeimg$/;
 628                 next if $language=~ /\.txt$/i; #Don't read the readme.txt !
 629                 push @languages, $language;
 630             }
 631             return sort @languages;
 632         } else {
 633             my $lang;
 634             foreach my $theme (getallthemes('opac')) {
 635                 opendir D, "$htdocs/$theme";
 636                 foreach my $language (readdir D) {
 637                     next if $language=~/^\./;
 638                     next if $language eq 'all';
 639                     next if $language=~ /png$/;
 640                     next if $language=~ /css$/;
 641                     next if $language=~ /CVS$/;
 642                     next if $language=~ /itemtypeimg$/;
 643                     next if $language=~ /\.txt$/i; #Don't read the readme.txt !
 644                     $lang->{$language}=1;
 645                 }
 646             }
 647             @languages=keys %$lang;
 648             return sort @languages;
 649         }
 650     } else {
 651         my $lang;
 652         my $htdocs=C4::Context->config('intrahtdocs');
 653         foreach my $theme (getallthemes('intranet')) {
 654             opendir D, "$htdocs/$theme";
 655             foreach my $language (readdir D) {
 656                 next if $language=~/^\./;
 657                 next if $language eq 'all';
 658                 next if $language=~ /png$/;
 659                 next if $language=~ /css$/;
 660                 next if $language=~ /CVS$/;
 661                 next if $language=~ /itemtypeimg$/;
 662                 next if $language=~ /\.txt$/i; #Don't read the readme.txt !
 663                 $lang->{$language}=1;
 664             }
 665         }
 666         $htdocs=C4::Context->config('opachtdocs');
 667         foreach my $theme (getallthemes('opac')) {
 668         opendir D, "$htdocs/$theme";
 669         foreach my $language (readdir D) {
 670             next if $language=~/^\./;
 671             next if $language eq 'all';
 672             next if $language=~ /png$/;
 673             next if $language=~ /css$/;
 674             next if $language=~ /CVS$/;
 675             next if $language=~ /itemtypeimg$/;
 676             next if $language=~ /\.txt$/i; #Don't read the readme.txt !
 677             $lang->{$language}=1;
 678             }
 679         }
 680         @languages=keys %$lang;
 681         return sort @languages;
 682     }
 683 }
 684
 685 =item getallthemes
 686
 687   (@themes) = &getallthemes('opac');
 688   (@themes) = &getallthemes('intranet');
 689
 690 Returns an array of all available themes.
 691
 692 =cut
 693
 694 sub getallthemes {
 695     my $type=shift;
 696     my $htdocs;
 697     my @themes;
 698     if ($type eq 'intranet') {
 699     $htdocs=C4::Context->config('intrahtdocs');
 700     } else {
 701     $htdocs=C4::Context->config('opachtdocs');
 702     }
 703     opendir D, "$htdocs";
 704     my @dirlist=readdir D;
 705     foreach my $directory (@dirlist) {
 706     -d "$htdocs/$directory/en" and push @themes, $directory;
 707     }
 708     return @themes;
 709 }
 710
 711 =item getnbpages
 712
 713 Returns the number of pages to display in a pagination bar, given the number
 714 of items and the number of items per page.
 715
 716 =cut
 717
 718 sub getnbpages {
 719     my ($nb_items, $nb_items_per_page) = @_;
 720
 721     return int(($nb_items - 1) / $nb_items_per_page) + 1;
 722 }
 723
 724
 725 =head2 getcities (OUEST-PROVENCE)
 726
 727   ($id_cityarrayref, $city_hashref) = &getcities();
 728
 729 Looks up the different city and zip in the database. Returns two
 730 elements: a reference-to-array, which lists the zip city
 731 codes, and a reference-to-hash, which maps the name of the city.
 732 WHERE =>OUEST PROVENCE OR EXTERIEUR
 733
 734 =cut
 735 sub getcities {
 736     #my ($type_city) = @_;
 737     my $dbh = C4::Context->dbh;
 738     my $sth=$dbh->prepare("Select cityid,city_name from cities order by cityid  ");
 739     #$sth->execute($type_city);
 740     $sth->execute();
 741     my %city;
 742     my @id;
 743 #    insert empty value to create a empty choice in cgi popup
 744
 745 while (my $data=$sth->fetchrow_hashref){
 746
 747     push @id,$data->{'cityid'};
 748       $city{$data->{'cityid'}}=$data->{'city_name'};
 749     }
 750
 751     #test to know if the table contain some records if no the function return nothing
 752     my $id=@id;
 753     $sth->finish;
 754     if ($id eq 0)
 755     {
 756     return();
 757     }
 758     else{
 759     unshift (@id ,"");
 760     return(\@id,\%city);
 761     }
 762 }
 763
 764
 765 =head2 getroadtypes (OUEST-PROVENCE)
 766
 767   ($idroadtypearrayref, $roadttype_hashref) = &getroadtypes();
 768
 769 Looks up the different road type . Returns two
 770 elements: a reference-to-array, which lists the id_roadtype
 771 codes, and a reference-to-hash, which maps the road type of the road .
 772
 773
 774 =cut
 775 sub getroadtypes {
 776     my $dbh = C4::Context->dbh;
 777     my $sth=$dbh->prepare("Select roadtypeid,road_type from roadtype order by road_type  ");
 778     $sth->execute();
 779     my %roadtype;
 780     my @id;
 781 #    insert empty value to create a empty choice in cgi popup
 782 while (my $data=$sth->fetchrow_hashref){
 783     push @id,$data->{'roadtypeid'};
 784       $roadtype{$data->{'roadtypeid'}}=$data->{'road_type'};
 785     }
 786     #test to know if the table contain some records if no the function return nothing
 787     my $id=@id;
 788     $sth->finish;
 789     if ($id eq 0)
 790     {
 791     return();
 792     }
 793     else{
 794         unshift (@id ,"");
 795         return(\@id,\%roadtype);
 796     }
 797 }
 798
 799 =head2 get_branchinfos_of
 800
 801   my $branchinfos_of = get_branchinfos_of(@branchcodes);
 802
 803 Associates a list of branchcodes to the information of the branch, taken in
 804 branches table.
 805
 806 Returns a href where keys are branchcodes and values are href where keys are
 807 branch information key.
 808
 809   print 'branchname is ', $branchinfos_of->{$code}->{branchname};
 810
 811 =cut
 812 sub get_branchinfos_of {
 813     my @branchcodes = @_;
 814
 815     my $query = '
 816 SELECT branchcode,
 817        branchname
 818   FROM branches
 819   WHERE branchcode IN ('.join(',', map({"'".$_."'"} @branchcodes)).')
 820 ';
 821     return get_infos_of($query, 'branchcode');
 822 }
 823
 824 =head2 get_notforloan_label_of
 825
 826   my $notforloan_label_of = get_notforloan_label_of();
 827
 828 Each authorised value of notforloan (information available in items and
 829 itemtypes) is link to a single label.
 830
 831 Returns a href where keys are authorised values and values are corresponding
 832 labels.
 833
 834   foreach my $authorised_value (keys %{$notforloan_label_of}) {
 835     printf(
 836         "authorised_value: %s => %s\n",
 837         $authorised_value,
 838         $notforloan_label_of->{$authorised_value}
 839     );
 840   }
 841
 842 =cut
 843 sub get_notforloan_label_of {
 844     my $dbh = C4::Context->dbh;
 845 my($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("notforloan","holdings");
 846     my $query = '
 847 SELECT authorised_value
 848   FROM holdings_subfield_structure
 849   WHERE tagfield =$tagfield and tagsubfield=$tagsubfield
 850   LIMIT 0, 1
 851 ';
 852     my $sth = $dbh->prepare($query);
 853     $sth->execute();
 854     my ($statuscode) = $sth->fetchrow_array();
 855
 856     $query = '
 857 SELECT lib,
 858        authorised_value
 859   FROM authorised_values
 860   WHERE category = ?
 861 ';
 862     $sth = $dbh->prepare($query);
 863     $sth->execute($statuscode);
 864     my %notforloan_label_of;
 865     while (my $row = $sth->fetchrow_hashref) {
 866         $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
 867     }
 868     $sth->finish;
 869
 870     return \%notforloan_label_of;
 871 }
 872
 873 =head2 get_infos_of
 874
 875 Return a href where a key is associated to a href. You give a query, the
 876 name of the key among the fields returned by the query. If you also give as
 877 third argument the name of the value, the function returns a href of scalar.
 878
 879   my $query = '
 880 SELECT itemnumber,
 881        notforloan,
 882        barcode
 883   FROM items
 884 ';
 885
 886   # generic href of any information on the item, href of href.
 887   my $iteminfos_of = get_infos_of($query, 'itemnumber');
 888   print $iteminfos_of->{$itemnumber}{barcode};
 889
 890   # specific information, href of scalar
 891   my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
 892   print $barcode_of_item->{$itemnumber};
 893
 894 =cut
 895 sub get_infos_of {
 896     my ($query, $key_name, $value_name) = @_;
 897
 898     my $dbh = C4::Context->dbh;
 899
 900     my $sth = $dbh->prepare($query);
 901     $sth->execute();
 902
 903     my %infos_of;
 904     while (my $row = $sth->fetchrow_hashref) {
 905         if (defined $value_name) {
 906             $infos_of{ $row->{$key_name} } = $row->{$value_name};
 907         }
 908         else {
 909             $infos_of{ $row->{$key_name} } = $row;
 910         }
 911     }
 912     $sth->finish;
 913
 914     return \%infos_of;
 915 }
 916 sub getFacets {
 917 ###Subfields is an array as well although MARC21 has them all in "a" in case UNIMARC has differing subfields
 918 my $dbh=C4::Context->dbh;
 919 my $query=new CGI;
 920 my $lang=$query->cookie('KohaOpacLanguage');
 921 $lang="en" unless $lang;
 922 my @facets;
 923 my $sth=$dbh->prepare("SELECT  facets_label_$lang,kohafield FROM facets  where (facets_label_$lang<>'' ) group by facets_label_$lang");
 924 my $sth2=$dbh->prepare("SELECT * FROM facets where facets_label_$lang=?");
 925 $sth->execute();
 926 while (my ($label,$kohafield)=$sth->fetchrow){
 927  $sth2->execute($label);
 928 my (@tags,@subfield);
 929         while (my $data=$sth2->fetchrow_hashref){
 930         push @tags,$data->{tagfield} ;
 931         push @subfield,$data->{subfield} ;
 932         }
 933          my $facet =  {
 934          link_value =>"kohafield=$kohafield",
 935                 label_value =>$label,
 936                 tags => \@tags,
 937                 subfield =>\@subfield,
 938                 } ;
 939          push @facets,$facet;
 940 }
 941   return \@facets;
 942 }
 943
 944
 945 1;
 946 __END__
 947
 948 =back
 949
 950 =head1 AUTHOR
 951
 952 Koha Team
 953
 954 =cut