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

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

/trunk

Merge addition of CustIDCK.pm from r56 - proprietary info this contained
was stripped during repo history conversion and it makes a good base for
providing data validation hooks.
Also merge all updates and related additions since.
See #13.

  • 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-05-11 21:06:26 +0000 (Tue, 11 May 2010) $
6# SVN revision $Rev: 400 $
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 =~ /^6750400$/;  # 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.