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 under the
   9 # terms of the GNU General Public License as published by the Free Software
  10 # Foundation; either version 2 of the License, or (at your option) any later
  11 # version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License along
  18 # with Koha; if not, write to the Free Software Foundation, Inc.,
  19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  20
  21 use strict;
  22 use warnings;
  23
  24 require Exporter;
  25 use C4::Context;
  26 use CGI;
  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