C4/Input.pm

   1 package C4::Input; #assumes C4/Input
   2
   3
   4 # Copyright 2000-2002 Katipo Communications
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it
   9 # under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 3 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  20
  21 use strict;
  22 use warnings;
  23
  24 require Exporter;
  25 use C4::Context;
  26 use CGI qw ( -utf8 );
  27
  28 use vars qw($VERSION @ISA @EXPORT);
  29
  30 # set the version for version checking
  31 $VERSION = 3.07.00.049;
  32
  33 =head1 NAME
  34
  35 C4::Input - Miscellaneous sanity checks
  36
  37 =head1 SYNOPSIS
  38
  39   use C4::Input;
  40
  41 =head1 DESCRIPTION
  42
  43 This module provides functions to see whether a given library card
  44 number or ISBN is valid.
  45
  46 =head1 FUNCTIONS
  47
  48 =over 2
  49
  50 =cut
  51
  52 @ISA = qw(Exporter);
  53 @EXPORT = qw(
  54         &checkdigit
  55 );
  56
  57 =item checkdigit
  58
  59   $valid = &checkdigit($cardnumber $nounique);
  60
  61 Takes a card number, computes its check digit, and compares it to the
  62 checkdigit at the end of C<$cardnumber>. Returns a true value iff
  63 C<$cardnumber> has a valid check digit.
  64
  65 =cut
  66
  67 #'
  68 sub checkdigit ($;$) {
  69
  70         my ($infl, $nounique) =  @_;
  71         $infl = uc $infl;
  72
  73         # Check to make sure the cardnumber is unique
  74
  75         #FIXME: We should make the error for a nonunique cardnumber
  76         #different from the one where the checkdigit on the number is
  77         #not correct
  78
  79         unless ( $nounique )
  80         {
  81                 my $query=qq{SELECT * FROM borrowers WHERE cardnumber=?};
  82                 my $sth=C4::Context->prepare($query);
  83                 $sth->execute($infl);
  84                 my %results = $sth->fetchrow_hashref();
  85                 if ( $sth->rows != 0 )
  86                 {
  87                         return 0;
  88                 }
  89         }
  90         if (C4::Context->preference("checkdigit") eq "none") {
  91                 return 1;
  92         }
  93
  94         my @weightings = (8,4,6,3,5,2,1);
  95         my $sum;
  96         foreach my $i (1..7) {
  97                 my $temp1 = $weightings[$i-1];
  98                 my $temp2 = substr($infl,$i,1);
  99                 $sum += $temp1 * $temp2;
 100         }
 101         my $rem = ($sum%11);
 102         if ($rem == 10) {
 103                 $rem = "X";
 104         }
 105         if ($rem eq substr($infl,8,1)) {
 106                 return 1;
 107         }
 108         return 0;
 109 } # sub checkdigit
 110
 111 END { }       # module clean-up code here (global destructor)
 112
 113 1;
 114 __END__
 115
 116 =back
 117
 118 =head1 AUTHOR
 119
 120 Koha Development Team <http://koha-community.org/>
 121
 122 =cut