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 with
  18 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  19 # Suite 330, Boston, MA  02111-1307 USA
  20
  21 use strict;
  22 require Exporter;
  23 use C4::Context;
  24
  25 use vars qw($VERSION @ISA @EXPORT);
  26
  27 # set the version for version checking
  28 $VERSION = 0.01;
  29
  30 =head1 NAME
  31
  32 C4::Input - Miscellaneous sanity checks
  33
  34 =head1 SYNOPSIS
  35
  36   use C4::Input;
  37
  38 =head1 DESCRIPTION
  39
  40 This module provides functions to see whether a given library card
  41 number or ISBN is valid.
  42
  43 =head1 FUNCTIONS
  44
  45 =over 2
  46
  47 =cut
  48
  49 @ISA = qw(Exporter);
  50 @EXPORT = qw(
  51         &checkdigit &checkvalidisbn
  52 );
  53
  54 # FIXME - This is never used.
  55 #sub checkflds {
  56 #  my ($env,$reqflds,$data) = @_;
  57 #  my $numrflds = @$reqflds;
  58 #  my @probarr;
  59 #  my $i = 0;
  60 #  while ($i < $numrflds) {
  61 #    if ($data->{@$reqflds[$i]} eq "") {
  62 #      push(@probarr, @$reqflds[$i]);
  63 #    }
  64 #    $i++
  65 #  }
  66 #  return (\@probarr);
  67 #}
  68
  69 =item checkdigit
  70
  71   $valid = &checkdigit($env, $cardnumber);
  72
  73 Takes a card number, computes its check digit, and compares it to the
  74 checkdigit at the end of C<$cardnumber>. Returns a true value iff
  75 C<$cardnumber> has a valid check digit.
  76
  77 C<$env> is ignored.
  78
  79 =cut
  80 #'
  81 sub checkdigit {
  82         if (C4::Context->preference("checkdigit") eq "none") {
  83                 warn "XXcheckdigit : ".C4::Context->preference("checkdigit");
  84                 return 1;
  85         } else {
  86                 my ($env,$infl) =  @_;
  87                 $infl = uc $infl;
  88                 my @weightings = (8,4,6,3,5,2,1);
  89                 my $sum;
  90                 my $i = 1;
  91                 my $valid = 0;
  92
  93                 foreach $i (1..7) {
  94                         my $temp1 = $weightings[$i-1];
  95                         my $temp2 = substr($infl,$i,1);
  96                         $sum += $temp1 * $temp2;
  97                 }
  98                 my $rem = ($sum%11);
  99                 if ($rem == 10) {
 100                 $rem = "X";
 101                 }
 102                 if ($rem eq substr($infl,8,1)) {
 103                         $valid = 1;
 104                 }
 105                 return $valid;
 106         }
 107 } # sub checkdigit
 108
 109 =item checkvalidisbn
 110
 111   $valid = &checkvalidisbn($isbn);
 112
 113 Returns a true value iff C<$isbn> is a valid ISBN: it must be ten
 114 digits long (counting "X" as a digit), and must have a valid check
 115 digit at the end.
 116
 117 =cut
 118 #'
 119 #--------------------------------------
 120 # Determine if a number is a valid ISBN number, according to length
 121 #   of 10 digits and valid checksum
 122 sub checkvalidisbn {
 123         use strict;
 124         my ($q)=@_ ;    # Input: ISBN number
 125
 126         my $isbngood = 0; # Return: true or false
 127
 128         $q=~s/x$/X/g;           # upshift lower case X
 129         $q=~s/[^X\d]//g;
 130         $q=~s/X.//g;
 131
 132         #return 0 if $q is not ten digits long
 133         if (length($q)!=10) {
 134                 return 0;
 135         }
 136
 137         #If we get to here, length($q) must be 10
 138         my $checksum=substr($q,9,1);
 139         my $isbn=substr($q,0,9);
 140         my $i;
 141         my $c=0;
 142         for ($i=0; $i<9; $i++) {
 143             my $digit=substr($q,$i,1);
 144             $c+=$digit*(10-$i);
 145         }
 146         $c %= 11;
 147         ($c==10) && ($c='X');
 148         $isbngood = $c eq $checksum;
 149
 150         return $isbngood;
 151
 152 } # sub checkvalidisbn
 153
 154 END { }       # module clean-up code here (global destructor)
 155
 156 1;
 157 __END__
 158
 159 =back
 160
 161 =head1 AUTHOR
 162
 163 Koha Developement team <info@koha.org>
 164
 165 =cut