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

# ipdb/cgi-bin/CustIDCK.pm
# External Customer ID checker stub
###
# SVN revision info
# $Date: 2004-12-01 20:42:57 +0000 (Wed, 01 Dec 2004) $
# SVN revision $Rev: 94 $
# 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;

$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 $custid = shift;

  return 1 if $custid =~ /^STAFF$/;
  return 1 if $custid =~ /^6750400$/;  # just in case some later change might block this
  return 1 if $custid =~ /^\d{7}$/;
  return 1 if $custid =~ /^\d{10}$/;

# some example code for a database check
  my $dbh = DBI->connect ("DBI:Pg:host=billing;dbname=custids", "cidcheck", "c1dch4ck");
  my $sth = $dbh->prepare("SELECT custid FROM custid WHERE custid = '$custid';");
  $sth->execute;
  if ($dbh->err) {
    $CustIDCK::Error = 1;
    $CustIDCK::ErrMsg = $dbh->errstr();
    $sth->finish;
    $dbh->disconnect;
    return 0;
  }
  my $hr = $sth->fetchrow_hashref();
  my $status = 0;
  $status = 1 if ( $hr->{custid} );
  $sth->finish;
  $dbh->disconnect;
  return $status;

  return 0;
  # Stubs for error messages
  $CustIDCK::Error = 1 if 1 == 0;
  $CustIDCK::ErrMsg = "bad foo-frob: 1 == 0";
}