* moving generic functions to Koha.pm
[wip/koha-chris_n.git] / 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 $query = "select categorycode from branchrelations where branchcode = ?";
195                 my $nsth = $dbh->prepare($query);
196                 $nsth->execute($branch->{'branchcode'});
197                 while (my ($cat) = $nsth->fetchrow_array) {
198                         # FIXME - This seems wrong. It ought to be
199                         # $branch->{categorycodes}{$cat} = 1;
200                         # otherwise, there's a namespace collision if there's a
201                         # category with the same name as a field in the 'branches'
202                         # table (i.e., don't create a category called "issuing").
203                         # In addition, the current structure doesn't really allow
204                         # you to list the categories that a branch belongs to:
205                         # you'd have to list keys %$branch, and remove those keys
206                         # that aren't fields in the "branches" table.
207                         $branch->{$cat} = 1;
208                         }
209                         $branches{$branch->{'branchcode'}}=$branch;
210         }
211         return (\%branches);
212 }
213
214 =item getprinters
215
216   $printers = &getprinters($env);
217   @queues = keys %$printers;
218
219 Returns information about existing printer queues.
220
221 C<$env> is ignored.
222
223 C<$printers> is a reference-to-hash whose keys are the print queues
224 defined in the printers table of the Koha database. The values are
225 references-to-hash, whose keys are the fields in the printers table.
226
227 =cut
228
229 sub getprinters {
230     my ($env) = @_;
231     my %printers;
232     my $dbh = C4::Context->dbh;
233     my $sth=$dbh->prepare("select * from printers");
234     $sth->execute;
235     while (my $printer=$sth->fetchrow_hashref) {
236         $printers{$printer->{'printqueue'}}=$printer;
237     }
238     return (\%printers);
239 }
240 sub getbranch ($$) {
241     my($query, $branches) = @_; # get branch for this query from branches
242     my $branch = $query->param('branch');
243     ($branch) || ($branch = $query->cookie('branch'));
244     ($branches->{$branch}) || ($branch=(keys %$branches)[0]);
245     return $branch;
246 }
247
248 sub getprinter ($$) {
249     my($query, $printers) = @_; # get printer for this query from printers
250     my $printer = $query->param('printer');
251     ($printer) || ($printer = $query->cookie('printer'));
252     ($printers->{$printer}) || ($printer = (keys %$printers)[0]);
253     return $printer;
254 }
255
256
257 1;
258 __END__
259
260 =back
261
262 =head1 AUTHOR
263
264 Pat Eyler, pate@gnu.org
265
266 =cut