koha-dev.rot13.org Git - koha_ffzg/blob - 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 use strict;
  21 require Exporter;
  22 use C4::Context;
  23
  24 use vars qw($VERSION @ISA @EXPORT);
  25
  26 $VERSION = 0.01;
  27
  28 =head1 NAME
  29
  30 C4::Koha - Perl Module containing convenience functions for Koha scripts
  31
  32 =head1 SYNOPSIS
  33
  34   use C4::Koha;
  35
  36
  37   $date = slashifyDate("01-01-2002")
  38   $ethnicity = fixEthnicity('asian');
  39   ($categories, $labels) = borrowercategories();
  40   ($categories, $labels) = ethnicitycategories();
  41
  42 =head1 DESCRIPTION
  43
  44 Koha.pm provides many functions for Koha scripts.
  45
  46 =head1 FUNCTIONS
  47
  48 =over 2
  49
  50 =cut
  51
  52 @ISA = qw(Exporter);
  53 @EXPORT = qw(
  54                         &fixEthnicity
  55                         &borrowercategories &getborrowercategory
  56                         &ethnicitycategories
  57                         &subfield_is_koha_internal_p
  58                         &getbranches &getbranch &getbranchdetail
  59                         &getprinters &getprinter
  60                         &getitemtypes &getitemtypeinfo
  61                         &getframeworks &getframeworkinfo
  62                         &getauthtypes &getauthtype
  63                         &getallthemes &getalllanguages
  64                         &getallbranches &getletters
  65                         getnbpages
  66                         $DEBUG);
  67
  68 use vars qw();
  69
  70 my $DEBUG = 0;
  71
  72 # removed slashifyDate => useless
  73
  74 =head2 fixEthnicity
  75
  76   $ethn_name = &fixEthnicity($ethn_code);
  77
  78 Takes an ethnicity code (e.g., "european" or "pi") and returns the
  79 corresponding descriptive name from the C<ethnicity> table in the
  80 Koha database ("European" or "Pacific Islander").
  81
  82 =cut
  83 #'
  84
  85 sub fixEthnicity($) {
  86
  87     my $ethnicity = shift;
  88     my $dbh = C4::Context->dbh;
  89     my $sth=$dbh->prepare("Select name from ethnicity where code = ?");
  90     $sth->execute($ethnicity);
  91     my $data=$sth->fetchrow_hashref;
  92     $sth->finish;
  93     return $data->{'name'};
  94 }
  95
  96 =head2 borrowercategories
  97
  98   ($codes_arrayref, $labels_hashref) = &borrowercategories();
  99
 100 Looks up the different types of borrowers in the database. Returns two
 101 elements: a reference-to-array, which lists the borrower category
 102 codes, and a reference-to-hash, which maps the borrower category codes
 103 to category descriptions.
 104
 105 =cut
 106 #'
 107
 108 sub borrowercategories {
 109     my $dbh = C4::Context->dbh;
 110     my $sth=$dbh->prepare("Select categorycode,description from categories order by description");
 111     $sth->execute;
 112     my %labels;
 113     my @codes;
 114     while (my $data=$sth->fetchrow_hashref){
 115       push @codes,$data->{'categorycode'};
 116       $labels{$data->{'categorycode'}}=$data->{'description'};
 117     }
 118     $sth->finish;
 119     return(\@codes,\%labels);
 120 }
 121
 122 =item getborrowercategory
 123
 124   $description = &getborrowercategory($categorycode);
 125
 126 Given the borrower's category code, the function returns the corresponding
 127 description for a comprehensive information display.
 128
 129 =cut
 130
 131 sub getborrowercategory
 132 {
 133         my ($catcode) = @_;
 134         my $dbh = C4::Context->dbh;
 135         my $sth = $dbh->prepare("SELECT description FROM categories WHERE categorycode = ?");
 136         $sth->execute($catcode);
 137         my $description = $sth->fetchrow();
 138         $sth->finish();
 139         return $description;
 140 } # sub getborrowercategory
 141
 142
 143 =head2 ethnicitycategories
 144
 145   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
 146
 147 Looks up the different ethnic types in the database. Returns two
 148 elements: a reference-to-array, which lists the ethnicity codes, and a
 149 reference-to-hash, which maps the ethnicity codes to ethnicity
 150 descriptions.
 151
 152 =cut
 153 #'
 154
 155 sub ethnicitycategories {
 156     my $dbh = C4::Context->dbh;
 157     my $sth=$dbh->prepare("Select code,name from ethnicity order by name");
 158     $sth->execute;
 159     my %labels;
 160     my @codes;
 161     while (my $data=$sth->fetchrow_hashref){
 162       push @codes,$data->{'code'};
 163       $labels{$data->{'code'}}=$data->{'name'};
 164     }
 165     $sth->finish;
 166     return(\@codes,\%labels);
 167 }
 168
 169 # FIXME.. this should be moved to a MARC-specific module
 170 sub subfield_is_koha_internal_p ($) {
 171     my($subfield) = @_;
 172
 173     # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
 174     # But real MARC subfields are always single-character
 175     # so it really is safer just to check the length
 176
 177     return length $subfield != 1;
 178 }
 179
 180 =head2 getbranches
 181
 182   $branches = &getbranches();
 183   returns informations about branches.
 184   Create a branch selector with the following code
 185   Is branchIndependant sensitive
 186    When IndependantBranches is set AND user is not superlibrarian, displays only user's branch
 187
 188 =head3 in PERL SCRIPT
 189
 190 my $branches = getbranches;
 191 my @branchloop;
 192 foreach my $thisbranch (sort keys %$branches) {
 193         my $selected = 1 if $thisbranch eq $branch;
 194         my %row =(value => $thisbranch,
 195                                 selected => $selected,
 196                                 branchname => $branches->{$thisbranch}->{'branchname'},
 197                         );
 198         push @branchloop, \%row;
 199 }
 200
 201
 202 =head3 in TEMPLATE
 203                         <select name="branch">
 204                                 <option value="">Default</option>
 205                         <!-- TMPL_LOOP name="branchloop" -->
 206                                 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="branchname" --></option>
 207                         <!-- /TMPL_LOOP -->
 208                         </select>
 209
 210 =cut
 211
 212 sub getbranches {
 213 # returns a reference to a hash of references to branches...
 214         my %branches;
 215         my $dbh = C4::Context->dbh;
 216         my $sth;
 217         if (C4::Context->preference("IndependantBranches") && (C4::Context->userenv->{flags}!=1)){
 218                 my $strsth ="Select * from branches ";
 219                 $strsth.= " WHERE branchcode = ".$dbh->quote(C4::Context->userenv->{branch});
 220                 $strsth.= " order by branchname";
 221                 $sth=$dbh->prepare($strsth);
 222         } else {
 223         $sth = $dbh->prepare("Select * from branches order by branchname");
 224         }
 225         $sth->execute;
 226         while (my $branch=$sth->fetchrow_hashref) {
 227                 my $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ?");
 228                 $nsth->execute($branch->{'branchcode'});
 229                 while (my ($cat) = $nsth->fetchrow_array) {
 230                         # FIXME - This seems wrong. It ought to be
 231                         # $branch->{categorycodes}{$cat} = 1;
 232                         # otherwise, there's a namespace collision if there's a
 233                         # category with the same name as a field in the 'branches'
 234                         # table (i.e., don't create a category called "issuing").
 235                         # In addition, the current structure doesn't really allow
 236                         # you to list the categories that a branch belongs to:
 237                         # you'd have to list keys %$branch, and remove those keys
 238                         # that aren't fields in the "branches" table.
 239                         $branch->{$cat} = 1;
 240                         }
 241                         $branches{$branch->{'branchcode'}}=$branch;
 242         }
 243         return (\%branches);
 244 }
 245
 246 =head2 getallbranches
 247
 248   $branches = &getallbranches();
 249   returns informations about ALL branches.
 250   Create a branch selector with the following code
 251   IndependantBranches Insensitive...
 252
 253 =head3 in PERL SCRIPT
 254
 255 my $branches = getallbranches;
 256 my @branchloop;
 257 foreach my $thisbranch (keys %$branches) {
 258         my $selected = 1 if $thisbranch eq $branch;
 259         my %row =(value => $thisbranch,
 260                                 selected => $selected,
 261                                 branchname => $branches->{$thisbranch}->{'branchname'},
 262                         );
 263         push @branchloop, \%row;
 264 }
 265
 266
 267 =head3 in TEMPLATE
 268                         <select name="branch">
 269                                 <option value="">Default</option>
 270                         <!-- TMPL_LOOP name="branchloop" -->
 271                                 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="branchname" --></option>
 272                         <!-- /TMPL_LOOP -->
 273                         </select>
 274
 275 =cut
 276
 277 sub getallbranches {
 278 # returns a reference to a hash of references to ALL branches...
 279         my %branches;
 280         my $dbh = C4::Context->dbh;
 281         my $sth;
 282         $sth = $dbh->prepare("Select * from branches order by branchname");
 283         $sth->execute;
 284         while (my $branch=$sth->fetchrow_hashref) {
 285                 my $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ?");
 286                 $nsth->execute($branch->{'branchcode'});
 287                 while (my ($cat) = $nsth->fetchrow_array) {
 288                         # FIXME - This seems wrong. It ought to be
 289                         # $branch->{categorycodes}{$cat} = 1;
 290                         # otherwise, there's a namespace collision if there's a
 291                         # category with the same name as a field in the 'branches'
 292                         # table (i.e., don't create a category called "issuing").
 293                         # In addition, the current structure doesn't really allow
 294                         # you to list the categories that a branch belongs to:
 295                         # you'd have to list keys %$branch, and remove those keys
 296                         # that aren't fields in the "branches" table.
 297                         $branch->{$cat} = 1;
 298                         }
 299                         $branches{$branch->{'branchcode'}}=$branch;
 300         }
 301         return (\%branches);
 302 }
 303
 304 =head2 getletters
 305
 306   $letters = &getletters($category);
 307   returns informations about letters.
 308   if needed, $category filters for letters given category
 309   Create a letter selector with the following code
 310
 311 =head3 in PERL SCRIPT
 312
 313 my $letters = getletters($cat);
 314 my @letterloop;
 315 foreach my $thisletter (keys %$letters) {
 316         my $selected = 1 if $thisletter eq $letter;
 317         my %row =(value => $thisletter,
 318                                 selected => $selected,
 319                                 lettername => $letters->{$thisletter},
 320                         );
 321         push @letterloop, \%row;
 322 }
 323
 324
 325 =head3 in TEMPLATE
 326                         <select name="letter">
 327                                 <option value="">Default</option>
 328                         <!-- TMPL_LOOP name="letterloop" -->
 329                                 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="lettername" --></option>
 330                         <!-- /TMPL_LOOP -->
 331                         </select>
 332
 333 =cut
 334
 335 sub getletters {
 336 # returns a reference to a hash of references to ALL letters...
 337         my $cat =@_;
 338         my %letters;
 339         my $dbh = C4::Context->dbh;
 340         my $sth;
 341         if ($cat ne ""){
 342                 $sth = $dbh->prepare("Select * from letter where module = \'".$cat."\' order by name");
 343         } else {
 344                 $sth = $dbh->prepare("Select * from letter order by name");
 345         }
 346         $sth->execute;
 347         my $count;
 348         while (my $letter=$sth->fetchrow_hashref) {
 349                         $letters{$letter->{'code'}}=$letter->{'name'};
 350                         $count++;
 351         }
 352         return ($count,\%letters);
 353 }
 354
 355 =head2 getitemtypes
 356
 357   $itemtypes = &getitemtypes();
 358
 359 Returns information about existing itemtypes.
 360
 361 build a HTML select with the following code :
 362
 363 =head3 in PERL SCRIPT
 364
 365 my $itemtypes = getitemtypes;
 366 my @itemtypesloop;
 367 foreach my $thisitemtype (sort keys %$itemtypes) {
 368         my $selected = 1 if $thisitemtype eq $itemtype;
 369         my %row =(value => $thisitemtype,
 370                                 selected => $selected,
 371                                 description => $itemtypes->{$thisitemtype}->{'description'},
 372                         );
 373         push @itemtypesloop, \%row;
 374 }
 375 $template->param(itemtypeloop => \@itemtypesloop);
 376
 377 =head3 in TEMPLATE
 378
 379 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 380         <select name="itemtype">
 381                 <option value="">Default</option>
 382         <!-- TMPL_LOOP name="itemtypeloop" -->
 383                 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
 384         <!-- /TMPL_LOOP -->
 385         </select>
 386         <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 387         <input type="submit" value="OK" class="button">
 388 </form>
 389
 390
 391 =cut
 392
 393 sub getitemtypes {
 394 # returns a reference to a hash of references to branches...
 395         my %itemtypes;
 396         my $dbh = C4::Context->dbh;
 397         my $sth=$dbh->prepare("select * from itemtypes");
 398         $sth->execute;
 399         while (my $IT=$sth->fetchrow_hashref) {
 400                         $itemtypes{$IT->{'itemtype'}}=$IT;
 401         }
 402         return (\%itemtypes);
 403 }
 404
 405 =head2 getauthtypes
 406
 407   $authtypes = &getauthtypes();
 408
 409 Returns information about existing authtypes.
 410
 411 build a HTML select with the following code :
 412
 413 =head3 in PERL SCRIPT
 414
 415 my $authtypes = getauthtypes;
 416 my @authtypesloop;
 417 foreach my $thisauthtype (keys %$authtypes) {
 418         my $selected = 1 if $thisauthtype eq $authtype;
 419         my %row =(value => $thisauthtype,
 420                                 selected => $selected,
 421                                 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
 422                         );
 423         push @authtypesloop, \%row;
 424 }
 425 $template->param(itemtypeloop => \@itemtypesloop);
 426
 427 =head3 in TEMPLATE
 428
 429 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 430         <select name="authtype">
 431         <!-- TMPL_LOOP name="authtypeloop" -->
 432                 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
 433         <!-- /TMPL_LOOP -->
 434         </select>
 435         <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 436         <input type="submit" value="OK" class="button">
 437 </form>
 438
 439
 440 =cut
 441
 442 sub getauthtypes {
 443 # returns a reference to a hash of references to authtypes...
 444         my %authtypes;
 445         my $dbh = C4::Context->dbh;
 446         my $sth=$dbh->prepare("select * from auth_types order by authtypetext");
 447         $sth->execute;
 448         while (my $IT=$sth->fetchrow_hashref) {
 449                         $authtypes{$IT->{'authtypecode'}}=$IT;
 450         }
 451         return (\%authtypes);
 452 }
 453
 454 sub getauthtype {
 455         my ($authtypecode) = @_;
 456 # returns a reference to a hash of references to authtypes...
 457         my %authtypes;
 458         my $dbh = C4::Context->dbh;
 459         my $sth=$dbh->prepare("select * from auth_types where authtypecode=?");
 460         $sth->execute($authtypecode);
 461         my $res=$sth->fetchrow_hashref;
 462         return $res;
 463 }
 464
 465 =head2 getframework
 466
 467   $frameworks = &getframework();
 468
 469 Returns information about existing frameworks
 470
 471 build a HTML select with the following code :
 472
 473 =head3 in PERL SCRIPT
 474
 475 my $frameworks = frameworks();
 476 my @frameworkloop;
 477 foreach my $thisframework (keys %$frameworks) {
 478         my $selected = 1 if $thisframework eq $frameworkcode;
 479         my %row =(value => $thisframework,
 480                                 selected => $selected,
 481                                 description => $frameworks->{$thisframework}->{'frameworktext'},
 482                         );
 483         push @frameworksloop, \%row;
 484 }
 485 $template->param(frameworkloop => \@frameworksloop);
 486
 487 =head3 in TEMPLATE
 488
 489 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 490         <select name="frameworkcode">
 491                 <option value="">Default</option>
 492         <!-- TMPL_LOOP name="frameworkloop" -->
 493                 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
 494         <!-- /TMPL_LOOP -->
 495         </select>
 496         <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 497         <input type="submit" value="OK" class="button">
 498 </form>
 499
 500
 501 =cut
 502
 503 sub getframeworks {
 504 # returns a reference to a hash of references to branches...
 505         my %itemtypes;
 506         my $dbh = C4::Context->dbh;
 507         my $sth=$dbh->prepare("select * from biblio_framework");
 508         $sth->execute;
 509         while (my $IT=$sth->fetchrow_hashref) {
 510                         $itemtypes{$IT->{'frameworkcode'}}=$IT;
 511         }
 512         return (\%itemtypes);
 513 }
 514 =head2 getframeworkinfo
 515
 516   $frameworkinfo = &getframeworkinfo($frameworkcode);
 517
 518 Returns information about an frameworkcode.
 519
 520 =cut
 521
 522 sub getframeworkinfo {
 523         my ($frameworkcode) = @_;
 524         my $dbh = C4::Context->dbh;
 525         my $sth=$dbh->prepare("select * from biblio_framework where frameworkcode=?");
 526         $sth->execute($frameworkcode);
 527         my $res = $sth->fetchrow_hashref;
 528         return $res;
 529 }
 530
 531
 532 =head2 getitemtypeinfo
 533
 534   $itemtype = &getitemtype($itemtype);
 535
 536 Returns information about an itemtype.
 537
 538 =cut
 539
 540 sub getitemtypeinfo {
 541         my ($itemtype) = @_;
 542         my $dbh = C4::Context->dbh;
 543         my $sth=$dbh->prepare("select * from itemtypes where itemtype=?");
 544         $sth->execute($itemtype);
 545         my $res = $sth->fetchrow_hashref;
 546         return $res;
 547 }
 548
 549 =head2 getprinters
 550
 551   $printers = &getprinters($env);
 552   @queues = keys %$printers;
 553
 554 Returns information about existing printer queues.
 555
 556 C<$env> is ignored.
 557
 558 C<$printers> is a reference-to-hash whose keys are the print queues
 559 defined in the printers table of the Koha database. The values are
 560 references-to-hash, whose keys are the fields in the printers table.
 561
 562 =cut
 563
 564 sub getprinters {
 565     my ($env) = @_;
 566     my %printers;
 567     my $dbh = C4::Context->dbh;
 568     my $sth=$dbh->prepare("select * from printers");
 569     $sth->execute;
 570     while (my $printer=$sth->fetchrow_hashref) {
 571         $printers{$printer->{'printqueue'}}=$printer;
 572     }
 573     return (\%printers);
 574 }
 575
 576 sub getbranch ($$) {
 577     my($query, $branches) = @_; # get branch for this query from branches
 578     my $branch = $query->param('branch');
 579     ($branch) || ($branch = $query->cookie('branch'));
 580     ($branches->{$branch}) || ($branch=(keys %$branches)[0]);
 581     return $branch;
 582 }
 583
 584 =item getbranchdetail
 585
 586   $branchname = &getbranchdetail($branchcode);
 587
 588 Given the branch code, the function returns the corresponding
 589 branch name for a comprehensive information display
 590
 591 =cut
 592
 593 sub getbranchdetail
 594 {
 595         my ($branchcode) = @_;
 596         my $dbh = C4::Context->dbh;
 597         my $sth = $dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
 598         $sth->execute($branchcode);
 599         my $branchname = $sth->fetchrow_hashref();
 600         $sth->finish();
 601         return $branchname;
 602 } # sub getbranchname
 603
 604
 605 sub getprinter ($$) {
 606     my($query, $printers) = @_; # get printer for this query from printers
 607     my $printer = $query->param('printer');
 608     ($printer) || ($printer = $query->cookie('printer')) || ($printer='');
 609     ($printers->{$printer}) || ($printer = (keys %$printers)[0]);
 610     return $printer;
 611 }
 612
 613 =item getalllanguages
 614
 615   (@languages) = &getalllanguages($type);
 616   (@languages) = &getalllanguages($type,$theme);
 617
 618 Returns an array of all available languages.
 619
 620 =cut
 621
 622 sub getalllanguages {
 623     my $type=shift;
 624     my $theme=shift;
 625     my $htdocs;
 626     my @languages;
 627     if ($type eq 'opac') {
 628         $htdocs=C4::Context->config('opachtdocs');
 629         if ($theme and -d "$htdocs/$theme") {
 630             opendir D, "$htdocs/$theme";
 631             foreach my $language (readdir D) {
 632                 next if $language=~/^\./;
 633                 next if $language eq 'all';
 634                 next if $language=~ /png$/;
 635                 next if $language=~ /css$/;
 636                 push @languages, $language;
 637             }
 638             return sort @languages;
 639         } else {
 640             my $lang;
 641             foreach my $theme (getallthemes('opac')) {
 642                 opendir D, "$htdocs/$theme";
 643                 foreach my $language (readdir D) {
 644                     next if $language=~/^\./;
 645                     next if $language eq 'all';
 646                         next if $language=~ /png$/;
 647                         next if $language=~ /css$/;
 648                     $lang->{$language}=1;
 649                 }
 650             }
 651             @languages=keys %$lang;
 652             return sort @languages;
 653         }
 654     } elsif ($type eq 'intranet') {
 655         $htdocs=C4::Context->config('intrahtdocs');
 656         if ($theme and -d "$htdocs/$theme") {
 657             opendir D, "$htdocs/$theme";
 658             foreach my $language (readdir D) {
 659                 next if $language=~/^\./;
 660                 next if $language eq 'all';
 661                 next if $language=~ /png$/;
 662                 next if $language=~ /css$/;
 663                 push @languages, $language;
 664             }
 665             return sort @languages;
 666         } else {
 667             my $lang;
 668             foreach my $theme (getallthemes('opac')) {
 669                 opendir D, "$htdocs/$theme";
 670                 foreach my $language (readdir D) {
 671                     next if $language=~/^\./;
 672                     next if $language eq 'all';
 673                         next if $language=~ /png$/;
 674                         next if $language=~ /css$/;
 675                     $lang->{$language}=1;
 676                 }
 677             }
 678             @languages=keys %$lang;
 679             return sort @languages;
 680         }
 681     } else {
 682         my $lang;
 683         my $htdocs=C4::Context->config('intrahtdocs');
 684         foreach my $theme (getallthemes('intranet')) {
 685             opendir D, "$htdocs/$theme";
 686             foreach my $language (readdir D) {
 687                 next if $language=~/^\./;
 688                 next if $language eq 'all';
 689                 next if $language=~ /png$/;
 690                 next if $language=~ /css$/;
 691                 $lang->{$language}=1;
 692             }
 693         }
 694         $htdocs=C4::Context->config('opachtdocs');
 695         foreach my $theme (getallthemes('opac')) {
 696             opendir D, "$htdocs/$theme";
 697             foreach my $language (readdir D) {
 698                 next if $language=~/^\./;
 699                 next if $language eq 'all';
 700                 next if $language=~ /png$/;
 701                 next if $language=~ /css$/;
 702                 $lang->{$language}=1;
 703             }
 704         }
 705         @languages=keys %$lang;
 706         return sort @languages;
 707     }
 708 }
 709
 710 =item getallthemes
 711
 712   (@themes) = &getallthemes('opac');
 713   (@themes) = &getallthemes('intranet');
 714
 715 Returns an array of all available themes.
 716
 717 =cut
 718
 719 sub getallthemes {
 720     my $type=shift;
 721     my $htdocs;
 722     my @themes;
 723     if ($type eq 'intranet') {
 724         $htdocs=C4::Context->config('intrahtdocs');
 725     } else {
 726         $htdocs=C4::Context->config('opachtdocs');
 727     }
 728     opendir D, "$htdocs";
 729     my @dirlist=readdir D;
 730     foreach my $directory (@dirlist) {
 731         -d "$htdocs/$directory/en" and push @themes, $directory;
 732     }
 733     return @themes;
 734 }
 735
 736 =item 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 1;
 750 __END__
 751
 752 =back
 753
 754 =head1 AUTHOR
 755
 756 Koha Team
 757
 758 =cut