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