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         &buildCGIsort
  56 );
  57
  58 =item checkdigit
  59
  60   $valid = &checkdigit($cardnumber $nounique);
  61
  62 Takes a card number, computes its check digit, and compares it to the
  63 checkdigit at the end of C<$cardnumber>. Returns a true value iff
  64 C<$cardnumber> has a valid check digit.
  65
  66 =cut
  67
  68 #'
  69 sub checkdigit ($;$) {
  70
  71         my ($infl, $nounique) =  @_;
  72         $infl = uc $infl;
  73
  74         # Check to make sure the cardnumber is unique
  75
  76         #FIXME: We should make the error for a nonunique cardnumber
  77         #different from the one where the checkdigit on the number is
  78         #not correct
  79
  80         unless ( $nounique )
  81         {
  82                 my $query=qq{SELECT * FROM borrowers WHERE cardnumber=?};
  83                 my $sth=C4::Context->prepare($query);
  84                 $sth->execute($infl);
  85                 my %results = $sth->fetchrow_hashref();
  86                 if ( $sth->rows != 0 )
  87                 {
  88                         return 0;
  89                 }
  90         }
  91         if (C4::Context->preference("checkdigit") eq "none") {
  92                 return 1;
  93         }
  94
  95         my @weightings = (8,4,6,3,5,2,1);
  96         my $sum;
  97         foreach my $i (1..7) {
  98                 my $temp1 = $weightings[$i-1];
  99                 my $temp2 = substr($infl,$i,1);
 100                 $sum += $temp1 * $temp2;
 101         }
 102         my $rem = ($sum%11);
 103         if ($rem == 10) {
 104                 $rem = "X";
 105         }
 106         if ($rem eq substr($infl,8,1)) {
 107                 return 1;
 108         }
 109         return 0;
 110 } # sub checkdigit
 111
 112 =item buildCGISort
 113
 114   $CGIScrollingList = &buildCGISort($name string, $input_name string);
 115
 116 Returns the scrolling list with name $input_name, built on authorised Values named $name.
 117 Returns NULL if no authorised values found
 118
 119 =cut
 120
 121 sub buildCGIsort {
 122     my ( $name, $input_name, $data ) = @_;
 123     my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
 124
 125     my $dbh=C4::Context->dbh;
 126     my $query = qq{
 127         SELECT *
 128         FROM authorised_values
 129     };
 130     $query .= qq{
 131           LEFT JOIN authorised_values_branches ON ( id = av_id )
 132     } if $branch_limit;
 133     $query .= qq{
 134         WHERE category = ?
 135     };
 136     $query .= qq{ AND ( branchcode = ? OR branchcode IS NULL )} if $branch_limit;
 137     $query .= qq{ GROUP BY lib ORDER BY lib};
 138
 139     my $sth=$dbh->prepare($query);
 140     $sth->execute( $name, $branch_limit ? $branch_limit : () );
 141     my $CGISort;
 142     if ($sth->rows>0){
 143         my @values;
 144         my %labels;
 145
 146         for (my $i =0;$i<$sth->rows;$i++){
 147             my $results = $sth->fetchrow_hashref;
 148             push @values, $results->{authorised_value};
 149             $labels{$results->{authorised_value}}=$results->{lib};
 150         }
 151         $CGISort= CGI::scrolling_list(
 152                     -name => $input_name,
 153                     -id =>   $input_name,
 154                     -values => \@values,
 155                     -labels => \%labels,
 156                     -default=> $data,
 157                     -size => 1,
 158                     -multiple => 0);
 159     }
 160     $sth->finish;
 161     return $CGISort;
 162 }
 163
 164 END { }       # module clean-up code here (global destructor)
 165
 166 1;
 167 __END__
 168
 169 =back
 170
 171 =head1 AUTHOR
 172
 173 Koha Development Team <http://koha-community.org/>
 174
 175 =cut