# ipdb/cgi-bin/CustIDCK.pm # External Customer ID checker stub ### # SVN revision info # $Date: 2014-10-17 20:26:49 +0000 (Fri, 17 Oct 2014) $ # SVN revision $Rev: 639 $ # Last update by $Author: kdeugau $ ### package CustIDCK; use strict; use warnings; use Exporter; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); use DBI; # Supposed to provide cross-Perl-version signal handling. # Not part of stock Debian Perl, use dh-make-perl or just # install straight from CPAN. # Not part of stock RHEL/CentOS, use cpan2perl, cpanflute, # or just install straight from CPAN. use Sys::SigAction; $VERSION = 1.00; @ISA = qw(Exporter); @EXPORT = (); @EXPORT_OK = qw ( &custid_exist ); # this is really an example stub, and should be replaced by # the local admin on installation sub custid_exist { my $self = shift; my $custid = shift; # Arguably this is wrong, but spaces don't really show up well on printed material... $custid =~ s/^\s+//; $custid =~ s/\s+$//; # hardcoded "OK" custids. return 1 if $custid =~ /^STAFF(?:-\d\d?)?$/; return 1 if $custid =~ /^5554242(?:-\d\d?)?$/; # just in case some later change might block this return 1 if $custid =~ /^\d{6}(?:-\d\d?)?$/; return 1 if $custid =~ /^\d{7}(?:-\d\d?)?$/; return 1 if $custid =~ /^\d{10}(?:-\d\d?)?$/; # Force uppercase for now... $custid =~ tr/a-z/A-Z/; # some example code for a database check # Try to catch failures to connect. If the remote server is up but # not responding (this has HAPPENED) we need to break out rather than hanging. my $dbh; eval { my $h = Sys::SigAction::set_sig_handler( 'ALRM', sub { die "failed connection to apex!!"; } ); alarm 3; # 3-second timeout. This may be too aggressive. eval { $dbh = DBI->connect ("DBI:Pg:host=billing;dbname=custids", "cidcheck", "c1dch4ck"); die "failed connection to billing!!" if !$dbh; # Not certain if this is needed here. It doesn't seem to be. # $dbh->ping; # Gotta do this to "force" a "failure". NRGH. }; alarm 0; # cancel the alarm $dbh->ping; # Gotta do this to "force" a "failure". NRGH. }; alarm 0; # avoid race conditions. May not be needed here. (Hah!) if ($@ && $@ !~ /failed connection to billing!!/) { $CustIDCK::Error = 1; $CustIDCK::ErrMsg = "Failed connection to billing DB host! Unable to verify CustIDs."; return 0; } # We should have a valid DB connection by now. my $hr = $dbh->selectrow_hashref("SELECT custid FROM custid WHERE custid = ?", undef, ($custid) ); my $status = 0; if ($dbh->err) { $CustIDCK::Error = 1; $CustIDCK::ErrMsg = $dbh->errstr(); } else { $status = 1 if ( $hr->{custid} ); } $dbh->disconnect; return $status; return 0; # Stubs for error messages $CustIDCK::Error = 1 if 1 == 0; $CustIDCK::ErrMsg = "bad foo-frob: 1 == 0"; }