source: branches/stable/cgi-bin/CustIDCK.pm@ 178

Last change on this file since 178 was 156, checked in by Kris Deugau, 20 years ago

/branches/stable

Updated CustIDCK.pm and checkcusts.pl with new billing server
due to old machine being rather unstable.

  • Property svn:keywords set to Date Rev Author
File size: 2.2 KB
Line 
1# ipdb/cgi-bin/CustIDCK.pm
2# External Customer ID checker stub
3###
4# SVN revision info
5# $Date: 2005-02-07 17:00:47 +0000 (Mon, 07 Feb 2005) $
6# SVN revision $Rev: 156 $
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$VERSION = 1.00;
19@ISA = qw(Exporter);
20@EXPORT = ();
21@EXPORT_OK = qw ( &custid_exist );
22
23# this is really an example stub, and should be replaced by
24# the local admin on installation
25sub custid_exist {
26 my $custid = shift;
27
28 return 1 if $custid =~ /^STAFF$/;
29 return 1 if $custid =~ /^6750400$/; # just in case some later change might block this
30 return 1 if $custid =~ /^\d{7}$/;
31 return 1 if $custid =~ /^\d{10}$/;
32
33# some example code for a database check
34 # Try to catch failures to connect. If the remote server is up but
35 # not responding (this has HAPPENED) we need to break out rather than hanging.
36 my $dbh;
37 eval {
38 local $SIG{ALRM} = sub { die "failed connection to newbilling!!" };
39 alarm 3; # 3-second timeout. This may be too aggressive.
40
41 eval {
42 $dbh = DBI->connect ("DBI:Pg:host=newbilling;dbname=custids", "cidcheck", "c1dch4ck");
43 die "failed connection to newbilling!!" if !$dbh;
44# Not certain if this is needed here. It doesn't seem to be.
45# $dbh->ping; # Gotta do this to "force" a "failure". NRGH.
46 };
47 alarm 0; # cancel the alarm
48 $dbh->ping; # Gotta do this to "force" a "failure". NRGH.
49 };
50 alarm 0; # avoid race conditions. May not be needed here. (Hah!)
51 if ($@ && $@ !~ /failed connection to newbilling!!/) {
52 $CustIDCK::Error = 1;
53 $CustIDCK::ErrMsg = "Failed connection to newbilling DB host! Unable to verify CustIDs.";
54 return 0;
55 }
56
57 # We should have a valid DB connection by now.
58 my $sth = $dbh->prepare("SELECT custid FROM custid WHERE custid = '$custid'");
59 $sth->execute;
60 if ($dbh->err) {
61 $CustIDCK::Error = 1;
62 $CustIDCK::ErrMsg = $dbh->errstr();
63 $sth->finish;
64 $dbh->disconnect;
65 return 0;
66 }
67 my $hr = $sth->fetchrow_hashref();
68 my $status = 0;
69 $status = 1 if ( $hr->{custid} );
70 $sth->finish;
71 $dbh->disconnect;
72 return $status;
73
74 return 0;
75 # Stubs for error messages
76 $CustIDCK::Error = 1 if 1 == 0;
77 $CustIDCK::ErrMsg = "bad foo-frob: 1 == 0";
78}
Note: See TracBrowser for help on using the repository browser.