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