[56] | 1 | # ipdb/cgi-bin/CustIDCK.pm
|
---|
| 2 | # External Customer ID checker stub
|
---|
| 3 | ###
|
---|
| 4 | # SVN revision info
|
---|
| 5 | # $Date: 2014-10-17 20:26:49 +0000 (Fri, 17 Oct 2014) $
|
---|
| 6 | # SVN revision $Rev: 639 $
|
---|
| 7 | # Last update by $Author: kdeugau $
|
---|
| 8 | ###
|
---|
| 9 |
|
---|
| 10 | package CustIDCK;
|
---|
| 11 |
|
---|
| 12 | use strict;
|
---|
| 13 | use warnings;
|
---|
| 14 | use Exporter;
|
---|
| 15 | use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
|
---|
| 16 | use DBI;
|
---|
| 17 |
|
---|
[310] | 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.
|
---|
| 23 | use Sys::SigAction;
|
---|
| 24 |
|
---|
[56] | 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
|
---|
| 32 | sub custid_exist {
|
---|
[517] | 33 | my $self = shift;
|
---|
[56] | 34 | my $custid = shift;
|
---|
| 35 |
|
---|
[639] | 36 | # Arguably this is wrong, but spaces don't really show up well on printed material...
|
---|
| 37 | $custid =~ s/^\s+//;
|
---|
| 38 | $custid =~ s/\s+$//;
|
---|
| 39 |
|
---|
[546] | 40 | # hardcoded "OK" custids.
|
---|
| 41 | return 1 if $custid =~ /^STAFF(?:-\d\d?)?$/;
|
---|
| 42 | return 1 if $custid =~ /^5554242(?:-\d\d?)?$/; # just in case some later change might block this
|
---|
[639] | 43 | return 1 if $custid =~ /^\d{6}(?:-\d\d?)?$/;
|
---|
[546] | 44 | return 1 if $custid =~ /^\d{7}(?:-\d\d?)?$/;
|
---|
| 45 | return 1 if $custid =~ /^\d{10}(?:-\d\d?)?$/;
|
---|
[56] | 46 |
|
---|
[546] | 47 | # Force uppercase for now...
|
---|
| 48 | $custid =~ tr/a-z/A-Z/;
|
---|
| 49 |
|
---|
[56] | 50 | # some example code for a database check
|
---|
[113] | 51 | # Try to catch failures to connect. If the remote server is up but
|
---|
| 52 | # not responding (this has HAPPENED) we need to break out rather than hanging.
|
---|
[114] | 53 | my $dbh;
|
---|
[113] | 54 | eval {
|
---|
[310] | 55 | my $h = Sys::SigAction::set_sig_handler( 'ALRM',
|
---|
| 56 | sub { die "failed connection to apex!!"; } );
|
---|
| 57 |
|
---|
[113] | 58 | alarm 3; # 3-second timeout. This may be too aggressive.
|
---|
[151] | 59 |
|
---|
| 60 | eval {
|
---|
[318] | 61 | $dbh = DBI->connect ("DBI:Pg:host=billing;dbname=custids", "cidcheck", "c1dch4ck");
|
---|
| 62 | die "failed connection to billing!!" if !$dbh;
|
---|
[151] | 63 | # Not certain if this is needed here. It doesn't seem to be.
|
---|
| 64 | # $dbh->ping; # Gotta do this to "force" a "failure". NRGH.
|
---|
| 65 | };
|
---|
[113] | 66 | alarm 0; # cancel the alarm
|
---|
[151] | 67 | $dbh->ping; # Gotta do this to "force" a "failure". NRGH.
|
---|
[113] | 68 | };
|
---|
| 69 | alarm 0; # avoid race conditions. May not be needed here. (Hah!)
|
---|
[318] | 70 | if ($@ && $@ !~ /failed connection to billing!!/) {
|
---|
[113] | 71 | $CustIDCK::Error = 1;
|
---|
[318] | 72 | $CustIDCK::ErrMsg = "Failed connection to billing DB host! Unable to verify CustIDs.";
|
---|
[113] | 73 | return 0;
|
---|
| 74 | }
|
---|
| 75 |
|
---|
[151] | 76 | # We should have a valid DB connection by now.
|
---|
[546] | 77 |
|
---|
| 78 | my $hr = $dbh->selectrow_hashref("SELECT custid FROM custid WHERE custid = ?", undef, ($custid) );
|
---|
| 79 | my $status = 0;
|
---|
[56] | 80 | if ($dbh->err) {
|
---|
| 81 | $CustIDCK::Error = 1;
|
---|
| 82 | $CustIDCK::ErrMsg = $dbh->errstr();
|
---|
[546] | 83 | } else {
|
---|
| 84 | $status = 1 if ( $hr->{custid} );
|
---|
[56] | 85 | }
|
---|
| 86 | $dbh->disconnect;
|
---|
| 87 | return $status;
|
---|
| 88 |
|
---|
| 89 | return 0;
|
---|
| 90 | # Stubs for error messages
|
---|
| 91 | $CustIDCK::Error = 1 if 1 == 0;
|
---|
| 92 | $CustIDCK::ErrMsg = "bad foo-frob: 1 == 0";
|
---|
| 93 | }
|
---|