# ipdb/cgi-bin/CustIDCK.pm # External Customer ID checker stub ### # SVN revision info # $Date$ # SVN revision $Rev$ # Last update by $Author$ ### 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"; }