source: trunk/cgi-bin/CustIDCK.pm@ 560

Last change on this file since 560 was 546, checked in by Kris Deugau, 12 years ago

/trunk

Tweak custid check in both main.cgi and admin.cgi; move the
general hardcoded checks into CustIDCK.pm.

  • Property svn:keywords set to Date Rev Author
File size: 2.6 KB
Line 
1# ipdb/cgi-bin/CustIDCK.pm
2# External Customer ID checker stub
3###
4# SVN revision info
5# $Date: 2012-11-07 22:45:28 +0000 (Wed, 07 Nov 2012) $
6# SVN revision $Rev: 546 $
7# Last update by $Author: kdeugau $
8###
9
10package CustIDCK;
11
12use strict;
13use warnings;
14use Exporter;
15use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
16use DBI;
17
18# Supposed to provide cross-Perl-version signal handling.
19# Not part of stock Debian Perl, use dh-make-perl or just
20# install straight from CPAN.
21# Not part of stock RHEL/CentOS, use cpan2perl, cpanflute,
22# or just install straight from CPAN.
23use Sys::SigAction;
24
25$VERSION = 1.00;
26@ISA = qw(Exporter);
27@EXPORT = ();
28@EXPORT_OK = qw ( &custid_exist );
29
30# this is really an example stub, and should be replaced by
31# the local admin on installation
32sub custid_exist {
33 my $self = shift;
34 my $custid = shift;
35
36 # hardcoded "OK" custids.
37 return 1 if $custid =~ /^STAFF(?:-\d\d?)?$/;
38 return 1 if $custid =~ /^5554242(?:-\d\d?)?$/; # just in case some later change might block this
39 return 1 if $custid =~ /^\d{7}(?:-\d\d?)?$/;
40 return 1 if $custid =~ /^\d{10}(?:-\d\d?)?$/;
41
42 # Force uppercase for now...
43 $custid =~ tr/a-z/A-Z/;
44
45# some example code for a database check
46 # Try to catch failures to connect. If the remote server is up but
47 # not responding (this has HAPPENED) we need to break out rather than hanging.
48 my $dbh;
49 eval {
50 my $h = Sys::SigAction::set_sig_handler( 'ALRM',
51 sub { die "failed connection to apex!!"; } );
52
53 alarm 3; # 3-second timeout. This may be too aggressive.
54
55 eval {
56 $dbh = DBI->connect ("DBI:Pg:host=billing;dbname=custids", "cidcheck", "c1dch4ck");
57 die "failed connection to billing!!" if !$dbh;
58# Not certain if this is needed here. It doesn't seem to be.
59# $dbh->ping; # Gotta do this to "force" a "failure". NRGH.
60 };
61 alarm 0; # cancel the alarm
62 $dbh->ping; # Gotta do this to "force" a "failure". NRGH.
63 };
64 alarm 0; # avoid race conditions. May not be needed here. (Hah!)
65 if ($@ && $@ !~ /failed connection to billing!!/) {
66 $CustIDCK::Error = 1;
67 $CustIDCK::ErrMsg = "Failed connection to billing DB host! Unable to verify CustIDs.";
68 return 0;
69 }
70
71 # We should have a valid DB connection by now.
72
73 my $hr = $dbh->selectrow_hashref("SELECT custid FROM custid WHERE custid = ?", undef, ($custid) );
74 my $status = 0;
75 if ($dbh->err) {
76 $CustIDCK::Error = 1;
77 $CustIDCK::ErrMsg = $dbh->errstr();
78 } else {
79 $status = 1 if ( $hr->{custid} );
80 }
81 $dbh->disconnect;
82 return $status;
83
84 return 0;
85 # Stubs for error messages
86 $CustIDCK::Error = 1 if 1 == 0;
87 $CustIDCK::ErrMsg = "bad foo-frob: 1 == 0";
88}
Note: See TracBrowser for help on using the repository browser.