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(&slashifyDate
  54              &fixEthnicity
  55              &borrowercategories
  56              &ethnicitycategories
  57              &subfield_is_koha_internal_p
  58                 &getbranches &getprinters
  59                 &getbranch &getprinter
  60              $DEBUG);
  61
  62 use vars qw();
  63
  64 my $DEBUG = 0;
  65
  66 =item slashifyDate
  67
  68   $slash_date = &slashifyDate($dash_date);
  69
  70 Takes a string of the form "DD-MM-YYYY" (or anything separated by
  71 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
  72
  73 =cut
  74
  75 sub slashifyDate {
  76     # accepts a date of the form xx-xx-xx[xx] and returns it in the
  77     # form xx/xx/xx[xx]
  78     my @dateOut = split('-', shift);
  79     return("$dateOut[2]/$dateOut[1]/$dateOut[0]")
  80 }
  81
  82 =item fixEthnicity
  83
  84   $ethn_name = &fixEthnicity($ethn_code);
  85
  86 Takes an ethnicity code (e.g., "european" or "pi") and returns the
  87 corresponding descriptive name from the C<ethnicity> table in the
  88 Koha database ("European" or "Pacific Islander").
  89
  90 =cut
  91 #'
  92
  93 sub fixEthnicity($) {
  94
  95     my $ethnicity = shift;
  96     my $dbh = C4::Context->dbh;
  97     my $sth=$dbh->prepare("Select name from ethnicity where code = ?");
  98     $sth->execute($ethnicity);
  99     my $data=$sth->fetchrow_hashref;
 100     $sth->finish;
 101     return $data->{'name'};
 102 }
 103
 104 =item borrowercategories
 105
 106   ($codes_arrayref, $labels_hashref) = &borrowercategories();
 107
 108 Looks up the different types of borrowers in the database. Returns two
 109 elements: a reference-to-array, which lists the borrower category
 110 codes, and a reference-to-hash, which maps the borrower category codes
 111 to category descriptions.
 112
 113 =cut
 114 #'
 115
 116 sub borrowercategories {
 117     my $dbh = C4::Context->dbh;
 118     my $sth=$dbh->prepare("Select categorycode,description from categories order by description");
 119     $sth->execute;
 120     my %labels;
 121     my @codes;
 122     while (my $data=$sth->fetchrow_hashref){
 123       push @codes,$data->{'categorycode'};
 124       $labels{$data->{'categorycode'}}=$data->{'description'};
 125     }
 126     $sth->finish;
 127     return(\@codes,\%labels);
 128 }
 129
 130 =item ethnicitycategories
 131
 132   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
 133
 134 Looks up the different ethnic types in the database. Returns two
 135 elements: a reference-to-array, which lists the ethnicity codes, and a
 136 reference-to-hash, which maps the ethnicity codes to ethnicity
 137 descriptions.
 138
 139 =cut
 140 #'
 141
 142 sub ethnicitycategories {
 143     my $dbh = C4::Context->dbh;
 144     my $sth=$dbh->prepare("Select code,name from ethnicity order by name");
 145     $sth->execute;
 146     my %labels;
 147     my @codes;
 148     while (my $data=$sth->fetchrow_hashref){
 149       push @codes,$data->{'code'};
 150       $labels{$data->{'code'}}=$data->{'name'};
 151     }
 152     $sth->finish;
 153     return(\@codes,\%labels);
 154 }
 155
 156 # FIXME.. this should be moved to a MARC-specific module
 157 sub subfield_is_koha_internal_p ($) {
 158     my($subfield) = @_;
 159
 160     # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
 161     # But real MARC subfields are always single-character
 162     # so it really is safer just to check the length
 163
 164     return length $subfield != 1;
 165 }
 166
 167 =item getbranches
 168
 169   $branches = &getbranches();
 170   @branch_codes = keys %$branches;
 171   %main_branch_info = %{$branches->{"MAIN"}};
 172
 173 Returns information about existing library branches.
 174
 175 C<$branches> is a reference-to-hash. Its keys are the branch codes for
 176 all of the existing library branches, and its values are
 177 references-to-hash describing that particular branch.
 178
 179 In each branch description (C<%main_branch_info>, above), there is a
 180 key for each field in the branches table of the Koha database. In
 181 addition, there is a key for each branch category code to which the
 182 branch belongs (the category codes are taken from the branchrelations
 183 table).
 184
 185 =cut
 186
 187 sub getbranches {
 188 # returns a reference to a hash of references to branches...
 189         my %branches;
 190         my $dbh = C4::Context->dbh;
 191         my $sth=$dbh->prepare("select * from branches");
 192         $sth->execute;
 193         while (my $branch=$sth->fetchrow_hashref) {
 194                 my $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ?");
 195                 $nsth->execute($branch->{'branchcode'});
 196                 while (my ($cat) = $nsth->fetchrow_array) {
 197                         # FIXME - This seems wrong. It ought to be
 198                         # $branch->{categorycodes}{$cat} = 1;
 199                         # otherwise, there's a namespace collision if there's a
 200                         # category with the same name as a field in the 'branches'
 201                         # table (i.e., don't create a category called "issuing").
 202                         # In addition, the current structure doesn't really allow
 203                         # you to list the categories that a branch belongs to:
 204                         # you'd have to list keys %$branch, and remove those keys
 205                         # that aren't fields in the "branches" table.
 206                         $branch->{$cat} = 1;
 207                         }
 208                         $branches{$branch->{'branchcode'}}=$branch;
 209         }
 210         return (\%branches);
 211 }
 212
 213 =item getprinters
 214
 215   $printers = &getprinters($env);
 216   @queues = keys %$printers;
 217
 218 Returns information about existing printer queues.
 219
 220 C<$env> is ignored.
 221
 222 C<$printers> is a reference-to-hash whose keys are the print queues
 223 defined in the printers table of the Koha database. The values are
 224 references-to-hash, whose keys are the fields in the printers table.
 225
 226 =cut
 227
 228 sub getprinters {
 229     my ($env) = @_;
 230     my %printers;
 231     my $dbh = C4::Context->dbh;
 232     my $sth=$dbh->prepare("select * from printers");
 233     $sth->execute;
 234     while (my $printer=$sth->fetchrow_hashref) {
 235         $printers{$printer->{'printqueue'}}=$printer;
 236     }
 237     return (\%printers);
 238 }
 239 sub getbranch ($$) {
 240     my($query, $branches) = @_; # get branch for this query from branches
 241     my $branch = $query->param('branch');
 242     ($branch) || ($branch = $query->cookie('branch'));
 243     ($branches->{$branch}) || ($branch=(keys %$branches)[0]);
 244     return $branch;
 245 }
 246
 247 sub getprinter ($$) {
 248     my($query, $printers) = @_; # get printer for this query from printers
 249     my $printer = $query->param('printer');
 250     ($printer) || ($printer = $query->cookie('printer'));
 251     ($printers->{$printer}) || ($printer = (keys %$printers)[0]);
 252     return $printer;
 253 }
 254
 255
 256 1;
 257 __END__
 258
 259 =back
 260
 261 =head1 AUTHOR
 262
 263 Pat Eyler, pate@gnu.org
 264
 265 =cut