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