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              $DEBUG);
  59
  60 use vars qw();
  61
  62 my $DEBUG = 0;
  63
  64 =item slashifyDate
  65
  66   $slash_date = &slashifyDate($dash_date);
  67
  68 Takes a string of the form "DD-MM-YYYY" (or anything separated by
  69 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
  70
  71 =cut
  72
  73 sub slashifyDate {
  74     # accepts a date of the form xx-xx-xx[xx] and returns it in the
  75     # form xx/xx/xx[xx]
  76     my @dateOut = split('-', shift);
  77     return("$dateOut[2]/$dateOut[1]/$dateOut[0]")
  78 }
  79
  80 =item fixEthnicity
  81
  82   $ethn_name = &fixEthnicity($ethn_code);
  83
  84 Takes an ethnicity code (e.g., "european" or "pi") and returns the
  85 corresponding descriptive name from the C<ethnicity> table in the
  86 Koha database ("European" or "Pacific Islander").
  87
  88 =cut
  89 #'
  90
  91 sub fixEthnicity($) {
  92
  93     my $ethnicity = shift;
  94     my $dbh = C4::Context->dbh;
  95     my $sth=$dbh->prepare("Select name from ethnicity where code = ?");
  96     $sth->execute($ethnicity);
  97     my $data=$sth->fetchrow_hashref;
  98     $sth->finish;
  99     return $data->{'name'};
 100 }
 101
 102 =item borrowercategories
 103
 104   ($codes_arrayref, $labels_hashref) = &borrowercategories();
 105
 106 Looks up the different types of borrowers in the database. Returns two
 107 elements: a reference-to-array, which lists the borrower category
 108 codes, and a reference-to-hash, which maps the borrower category codes
 109 to category descriptions.
 110
 111 =cut
 112 #'
 113
 114 sub borrowercategories {
 115     my $dbh = C4::Context->dbh;
 116     my $sth=$dbh->prepare("Select categorycode,description from categories order by description");
 117     $sth->execute;
 118     my %labels;
 119     my @codes;
 120     while (my $data=$sth->fetchrow_hashref){
 121       push @codes,$data->{'categorycode'};
 122       $labels{$data->{'categorycode'}}=$data->{'description'};
 123     }
 124     $sth->finish;
 125     return(\@codes,\%labels);
 126 }
 127
 128 =item ethnicitycategories
 129
 130   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
 131
 132 Looks up the different ethnic types in the database. Returns two
 133 elements: a reference-to-array, which lists the ethnicity codes, and a
 134 reference-to-hash, which maps the ethnicity codes to ethnicity
 135 descriptions.
 136
 137 =cut
 138 #'
 139
 140 sub ethnicitycategories {
 141     my $dbh = C4::Context->dbh;
 142     my $sth=$dbh->prepare("Select code,name from ethnicity order by name");
 143     $sth->execute;
 144     my %labels;
 145     my @codes;
 146     while (my $data=$sth->fetchrow_hashref){
 147       push @codes,$data->{'code'};
 148       $labels{$data->{'code'}}=$data->{'name'};
 149     }
 150     $sth->finish;
 151     return(\@codes,\%labels);
 152 }
 153
 154 # FIXME.. this should be moved to a MARC-specific module
 155 sub subfield_is_koha_internal_p ($) {
 156     my($subfield) = @_;
 157
 158     # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
 159     # But real MARC subfields are always single-character
 160     # so it really is safer just to check the length
 161
 162     return length $subfield != 1;
 163 }
 164
 165 1;
 166 __END__
 167
 168 =back
 169
 170 =head1 AUTHOR
 171
 172 Pat Eyler, pate@gnu.org
 173
 174 =cut