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

# 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";
}