source: branches/htmlform/cgi-bin/CustIDCK.pm@ 480

Last change on this file since 480 was 417, checked in by Kris Deugau, 14 years ago

/trunk

Rearrangements and tweaks toward releaseability:

  • Add Makefile to install halfway-sanely
  • Add .spec file
  • Shuffle "use IPDB;" and "use MyIPDB;" lines so that we can automagically insert a suitable "use lib..." line during 'make install'
  • Check copyright statements
  • Clear up some defaults, and place a number of "constants" in IPDB/MyIPDB rather than having them hardcoded all over the place (Still need to think of a sane way to do this for ipdb.psql's alloctype preseeding)
  • Tweak $VERSION identifier in IPDB.pm so it can be defined in the Makefile
  • Clean up some dangling bits from repository history conversion, remove unneeded "use ..." statements
  • Tweak rWHOIS export script to use more globals and "constants" from (My)IPDB.pm, and more Perl internals than system()-equivalents. Add a few fixme comments for longer-term flexibility improvements.
  • Property svn:keywords set to Date Rev Author
File size: 2.5 KB
Line 
1# ipdb/cgi-bin/CustIDCK.pm
2# External Customer ID checker stub
3###
4# SVN revision info
5# $Date: 2010-06-30 21:48:03 +0000 (Wed, 30 Jun 2010) $
6# SVN revision $Rev: 417 $
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 $custid = shift;
34
35 return 1 if $custid =~ /^STAFF$/;
36 return 1 if $custid =~ /^5554242$/; # just in case some later change might block this
37 return 1 if $custid =~ /^\d{7}$/;
38 return 1 if $custid =~ /^\d{10}$/;
39
40# some example code for a database check
41 # Try to catch failures to connect. If the remote server is up but
42 # not responding (this has HAPPENED) we need to break out rather than hanging.
43 my $dbh;
44 eval {
45 my $h = Sys::SigAction::set_sig_handler( 'ALRM',
46 sub { die "failed connection to apex!!"; } );
47
48 alarm 3; # 3-second timeout. This may be too aggressive.
49
50 eval {
51 $dbh = DBI->connect ("DBI:Pg:host=billing;dbname=custids", "cidcheck", "c1dch4ck");
52 die "failed connection to billing!!" if !$dbh;
53# Not certain if this is needed here. It doesn't seem to be.
54# $dbh->ping; # Gotta do this to "force" a "failure". NRGH.
55 };
56 alarm 0; # cancel the alarm
57 $dbh->ping; # Gotta do this to "force" a "failure". NRGH.
58 };
59 alarm 0; # avoid race conditions. May not be needed here. (Hah!)
60 if ($@ && $@ !~ /failed connection to billing!!/) {
61 $CustIDCK::Error = 1;
62 $CustIDCK::ErrMsg = "Failed connection to billing DB host! Unable to verify CustIDs.";
63 return 0;
64 }
65
66 # We should have a valid DB connection by now.
67 my $sth = $dbh->prepare("SELECT custid FROM custid WHERE custid = '$custid'");
68 $sth->execute;
69 if ($dbh->err) {
70 $CustIDCK::Error = 1;
71 $CustIDCK::ErrMsg = $dbh->errstr();
72 $sth->finish;
73 $dbh->disconnect;
74 return 0;
75 }
76 my $hr = $sth->fetchrow_hashref();
77 my $status = 0;
78 $status = 1 if ( $hr->{custid} );
79 $sth->finish;
80 $dbh->disconnect;
81 return $status;
82
83 return 0;
84 # Stubs for error messages
85 $CustIDCK::Error = 1 if 1 == 0;
86 $CustIDCK::ErrMsg = "bad foo-frob: 1 == 0";
87}
Note: See TracBrowser for help on using the repository browser.