[ic] How do deal with multiple shops credit cards
Murray Gibbins
Murray@scotweb.ltd.uk
Mon, 18 Dec 2000 17:02:03 +0000
How do deal with shops credit cards.
We have several shops in a mall, but each shop has it's own set of credit cards
it likes. How do you deal with this in minivend when at the end of the day you
want to do do the purchase once fro mmultiple shops. Well this is now we do it.
First each shop has a file called "creditcards.asc" which looks a bit like
this...
[minivend@handle products]$ less creditcards.asc
code name image width height
Mastercard Mastercard /sys-images/payment/mastercard.jpg 36
28
Visa Visa /sys-images/payment/visa.jpg 45 28
[minivend@handle products]$
#####################################
then when I install a shop into the "mall" part of my install script does
this...
# ok before we chack the cc database
# put the info in first
my $dbi = DBI->connect("dbi:Pg:dbname=minivend","minivend","");
#print "soo far\n";
#print STDERR "\$main_config = $main_config\n";
$dbi = insert_cc_db($main_config,$obj,$dbi);
# check that the credit card database
# does not produc a null set.
# if it does stop and produce an error
# message.
my $cc_check = check_cc($main_config,$dbi);
# above turned one if check failed
# need to remove stuff from db before
# ending the script
if ($cc_check){
remove_from_cc_db($main_config,$dbi);
$dbi->disconnect;
exit(1);
}
$dbi->disconnect;
################################################
sub check_cc{
my $main_config = shift ;
# first we need to access the database
my $dbi = shift ;
# if we have been asked not to check for the credit carn null min
# set problem then return;
(exists($main_config->{no_check_cc}) && $main_config->{no_check_cc} == 1 )
?
return 1:
1;
# this checks out the dbi making sure
# we have a db connection object
$dbi = cc_dbi($main_config,$dbi);
# make a new cc object
my $cc = new Min_set_cc ;
# pass the db object to the cc object
$cc->accept_new_DBI($dbi);
# now lets get the minimal set;
my $set_ref = $cc->auto_min_set();
# now we have a min set.
my $num = scalar(@$set_ref);
# ok now get the min munber of null set of cc
my $min_cc ;
if(exists($main_config->{min_cc}) && defined($main_config->{min_cc})){
$min_cc = $main_config->{min_cc} ;
}
else{
$min_cc = 1 ;
}
if ($num < $min_cc){
print STDERR "The number of credit cards",
" that would form a mininum set with this",
" shop is smaller or equal to $min_cc",
" which is the minimun set up for this",
" install.Exitting install\n";
return 1;
}
return 0;
}
sub insert_cc_db{
my $main_config = shift ;
my $shop_config = shift ;
my $dbi = shift ;
# this is the locatio of the files afeter they hav been
# installed n the right place.
my $base_dir = $shop_config->{basedir};
# we wnat to find the file creditcards.asc
# should be in products.
# first check we have the right ending for the path
if($base_dir !~ /\/$/){
$base_dir .= "/";
}
$base_dir .= "products/creditcards.asc" ;
#lets check that $base_dir exists
if ( ! -e $base_dir ){
print STDERR "h'm tried to find $base_dir",
" so I could read its contents. Ths is a terminal error",
" please correct it and run this program again";
exit(1);
}
# ok slurp in its contents.
open(SLURP,"$base_dir") || die "$!";
my @slurp = <SLURP> ;
close SLURP || die "$!";
chomp @slurp ;
# ok remove some lines with
# #'s on it.
# these are comments and we don't want them
@slurp = grep { ! /^\s*\#/ } @slurp ;
# remove any blank lines
@slurp = grep { ! /^\s*$/ } @slurp ;
# sometimes the first line will be the
# headers containing the names of the feilds.
# so lets check for that and if its there remove it
# this might have to be changed in the furture
if ( $slurp[0] =~ /^\s*code\s+name/ ){
shift @slurp ;
}
# now we have raw data, yippee.
# lets try our database.
# lets test our dbi and mke sure we have a
# database connection object.
$dbi = cc_dbi($main_config,$dbi);
# now we have a db connection lets use it.
# turn off Autocommit
my $old_AutoCommit = $dbi->{AutoCommit};
$dbi->{AutoCommit} = 0;
my @codes ;
foreach my $line (@slurp){
# the first word of each line
my $code;
my @CODE = split("\t",$line);
$code = shift @CODE;
undef @CODE;
push @codes,$code ;
my $str = "INSERT INTO shops_creditcards (shop,code) VALUES";
$str .= "(".$dbi->quote($shop).",".$dbi->quote($code).")";
my $sth = $dbi->prepare($str);
$sth->execute || die $sth->err;
select(undef,undef,undef,0.001);
}
# now lets see if we have any new things to
# add to the creditcards_data db.
# we'll get all the codes from the db
# and compare them to the list above.
# any that do not exist will be added.
my $str = "SELECT code FROM creditcards_data";
#my $sth = $dbi->prepare($str);
my $ref = $dbi->selectall_arrayref($str);
#my $thing = ref $ref;
#die "wibble $ref->[0]->[0])\n";
my @CARDS;
foreach my $card_ref (@$ref){
push @CARDS,$card_ref->[0];
}
$ref = \@CARDS;
my %code_hash = map { $_ => $_ } @$ref ;
undef $ref ; # return memory;
foreach my $line (@slurp){
chomp $line;
my @bits = split("\t",$line);
if( ! exists($code_hash{$bits[0]})){
my $str = "INSERT INTO creditcards_data (code,name,image,width,heigh
t)";
$str .= " VALUES (";
$str .= $dbi->quote($bits[0]);
$str .= ",";
$str .= $dbi->quote($bits[1]);
$str .= ",";
$str .= $dbi->quote($bits[2]);
$str .= ",";
$str .= $dbi->quote($bits[3]);
$str .= ",";
$str .= $dbi->quote($bits[4]);
#$str .= ",";
#$str .= $dbi->quote($bits[5]);
$str .= ")";
my $sth = $dbi->prepare($str);
$sth->execute || die $sth->err;
select(undef,undef,undef,0.001);
}
}
$dbi->commit || die $dbi->err;
$dbi->{AutoCommit} = $old_AutoCommit ;
return $dbi;
}
sub cc_dbi {
my $main_config = shift ;
my $dbi = shift ;
# if the dbi hase not been passed to this function
# then try to look for it in the config hash.
if( (! defined($dbi)) || ( !$dbi) ){
if(exists($main_config->{dbi_cc}) && defined($main_config->{dbi_cc}) ){
$dbi = $main_config->{dbi_cc};
}
elsif(exists($main_config->{dbi}) && defined($main_config->{dbi}) ){
$dbi = $main_config->{dbi};
}
else{
print STDERR "Undefined DBI object passed to check_cc in mall_cat\n"
;
die "$!";
}
}
# ok this subroutine make some assuptions.
# 1) that we have postresql installed
# 2) all the credit card db's for all
# 3) the shops are installed
# 4) all the credit card db's are called
# *._creditcards
# we need to make sure that $dbi is an object not
# just the string used for DBI;
# we don't have an object try to make it ourselves
# this means that the string must be of the format
# dbi:blah:blah etc.
# best check for this...
{
my $usefull_dbi_stuff = new Usefull_dbi_stuff ;
my ($exit,$error) ;
($exit,$error) = $usefull_dbi_stuff->try_dbi_taint($dbi);
# ok if $exit is true then the object could not
# be maid. However even it we send it a string
# or object it it could connect to the db
# then it will return a DBI object for that
# db.
if( defined($exit) && $exit){
print STDERR "$error" ;
defined($dbi) and ref($dbi) ? $dbi->disconnect :1;
exit($exit);
}
else{
$dbi = $error ;
}
}
return $dbi ;
}
sub remove_from_cc_db {
my $main_config = shift ;
my $dbi = shift ;
# remove entries from the shops_creditcards db
# form each entry with shop = $shop
my $str = "DELETE FROM shops_creditcards WHERE shop=$shop";
$dbi->do($str) || die"$dbi->err";
return ;
}
####################################################################
The real magic is in Min_set_cc a module listed below....
package Min_set_cc;
$VERSION = 0.1;
use strict ;
sub new{
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
$self->{verbose} = 0 ;
bless ($self, $class);
return $self;
}
1;
################################################################
sub accept_new_DBI{
my $self = shift ;
$self->{dbi} = shift ;
return ;
}
################################################################
sub accept_new_shops{
my $self = shift ;
my $shop_array_ref = shift ;
$self->{shop_array_ref} = $shop_array_ref ;
return;
}
################################################################
sub get_list_of_cc_tables{
my $self = shift ;
my $dbi = $self->{dbi} ;
my @tables = $dbi->tables ;
@tables = grep { /.*\_creditcards/ } @tables ;
return \@tables;
}
################################################################
sub get_list_of_cc_shops{
my $self = shift ;
my $dbi = $self->{dbi} ;
my $str = "SELECT DISTINCT shop FROM shops_creditcards";
my $SHOPS = $dbi->selectcol_arrayref($str) || die $dbi->err;
return $SHOPS;
}
################################################################
sub auto_min_set{
my $self = shift ;
# lets find the shops with cc db's
$self->accept_new_shops($self->get_list_of_cc_shops());
# now lets get the minimal set;
return $self->min_set();
}
################################################################
sub min_set{
my $self = shift ;
my $dbi = $self->{dbi} ;
my @ok_cards;
foreach my $shop (@{$self->{shop_array_ref}}){
my $str = "SELECT code from shops_creditcards where shop=";
$str .= $dbi->quote($shop);
$str .= "";
my $ary_ref = $dbi->selectcol_arrayref($str);
if( ! @ok_cards){
@ok_cards = @$ary_ref;
}
else{
my %hash = map { $_ => $_ } @ok_cards ;
@ok_cards = ();
foreach my $card (@$ary_ref){
if(exists $hash{$card}){
push @ok_cards,$card;
}
}
}
}
return \@ok_cards ;
}
################################################################
As you can see any shop that one tries to put into a mall that will result in
combination of purchases that ends up with a set of credit cards smaller than
you want throws up an error message and then removes it self from the database.
Neat !
All thats left is to put this into minivend.cfg like this....
GlobalSub <<EOS
sub return_cc{
use strict ;
my $cart_ref = shift ; #this is an array of the shops in the current
my $Sql = shift ;
#my %Sql = %$Sql;
# baskets.
# ie a ref to the basket data structure.
my $dbh_str = '$dbh = $Sql->{shops_creditcards}';
#my $dbh = $Sql{"shops_creditcards"};
my @sql_keys = keys %$Sql;
#die"@sql_keys\n";
my $dbh;
eval($dbh_str);
if($@){
die"$@\n";
}
if(! defined($dbh)){
die"\$dbh not defined\n";
}
# This is a ref to the shops_creditcards db
# Note this is a dbi ref, database access handle.
# we need to remove form this any shop that
# have null baskets
my @tainted_shops = keys %$cart_ref ;
#die"@tainted_shops\n";
# now lets remove stuff we don't want.
# remove null and not usefull entries
@tainted_shops = grep { ! /^\s*$/ } @tainted_shops ;
@tainted_shops = grep { ! /^main$/ } @tainted_shops ;
@tainted_shops = grep { ! /^mv_shipping$/ } @tainted_shops ;
@tainted_shops = grep { ! /^UNKNOWN$/ } @tainted_shops ;
# now each 'shop' is really a ref to an anomymous array
# which has for it's elements a ref to an anonymous hash
# which contains the detals of each purchase.
# the first step is to remove any carts that have no
# or emtpy arrays/ Then we check for arrays that are not emtpy
# but have the atribute of there anonymous hash called
# quantity set to <=0 .
my @slighty_less_tainted_shops ;
foreach my $tainted_shop (@tainted_shops){
# $tainted_shop is the key of a ref to an array
my @shop_array = @{$cart_ref->{$tainted_shop}};
if(@shop_array){
push @slighty_less_tainted_shops,$tainted_shop;
}
}
# now get rid of @tainted_shops as we don't need it
# anymore.
undef @tainted_shops;
# now the zero quantity stuff.
my @almost_not_tainted_shops ;
foreach my $slighty_tainted_shop (@slighty_less_tainted_shops){
my @shop_array = @{$cart_ref->{$slighty_tainted_shop}};
# we now that they must have at least
# one entry on their arrays.
foreach my $item_hash_ref (@shop_array){
if(! defined $item_hash_ref){next;}
if(ref($item_hash_ref) ne "HASH"){
#die"Strange it should be a hash\n";
}
else{
if(! exists($item_hash_ref->{quantity})){
die"What no quantity\n";
}
else{
if(! defined($item_hash_ref->{quantity})){
die"What no quantity defined\n";
}
else{
if($item_hash_ref->{quantity} !~ /^\d.*$/){
die"What quantity is not a number\n";
}
else{
# we have a number
if($item_hash_ref->{quantity} <= 0){
die"What quantity is <=0\n";
}
else{
if(! scalar(grep{/^$slighty_tainted_shop$/} @almost_not_tainted_
shops)){
# not already in the array then
push @almost_not_tainted_shops,$slighty_tainted_shop;
}
}
}
}
}
}
}
}
# ok now we know for sure that we have only shops in the cart
# that have the properties we want.
# lets remove from memory @slighty_less_tainted_shops.
undef @slighty_less_tainted_shops ;
# great we have the shops in @almost_not_tainted_shops
# lets find the credit cards we can use.
my @ok_cards ;
foreach my $shop (@almost_not_tainted_shops){
my $str = "SELECT DISTINCT code from shops_creditcards where shop=";
$str .= $dbh->quote($shop);
my $ary_ref = $dbh->selectcol_arrayref($str);
if( ! @ok_cards){
@ok_cards = @$ary_ref;
}
else{
my %hash = map { $_ => $_ } @ok_cards ;
@ok_cards = ();
foreach my $card (@$ary_ref){
if(exists $hash{$card}){
push @ok_cards,$card;
}
}
}
}
# lets return the array of cards in a way that we can use
# in minivend loop directive.
# flatten the array once more to be sure.
my %hash = map { $_ => $_ } @ok_cards ;
@ok_cards = keys %hash;
#return join(" ",@ok_cards);
# or not as the case may be
return @ok_cards;
}
EOS
############################################################
which returns for any given set of shops being purchase from a set of credit
cars that comprises the union of the ones that they can all accept.
I use it like this...
td><b>Card type:</b><BR clear="all">
<select name="mv_credit_card_type">
__card_accept2__
</select>
</td>
############################################################
where __card_accept2__ is set in catalog.cfg using....
### Generate pull down menu of credit cards to accept, version 2!
Variable card_accept2 <<_EOF_;
[perl global=1 subs=1 tables="shops_creditcards creditcards_data"]
my $string = "";
# now loop over all the card returned
my $ref = $Sql{creditcards_data};
my $sth = $ref->prepare('select name from creditcards_data where code=?');
#my $num = scalar(return_cc($Carts,\%Sql));
#die"Wibble:$num\n";
foreach my $card (return_cc($Carts,\%Sql)){
$string .= "<option value=\"$card\" [selected mv_credit_card_type $card]
>";
$sth->execute($card);
my ($name) = $sth->fetchrow();
$string .= $name;
$string .= "</option>\n";
select(undef,undef,undef,0.001);
}
# now we have created our string set it to an scratch variable.
$Scratch->{sw_cc_cards}= $string;
return;
[/perl]
[scratch name="sw_cc_cards" interpolate=1]
_EOF_
I'll write this up on a web page soon, but untill then enjoy :-)
Murray
--
____
\__/ Murray Gibbins murray@scotweb.ltd.uk
/ \ Programmer
_ \__/ _ ================================================
\\ || // Scotweb Limited, info@scotweb.ltd.uk
\\||// 13a Albert Terrace, http://www.scotweb.ltd.uk
\||/ Edinburgh EH10 5EA Tel: +44 (0) 131 270 82 33
|| Scotland. Europe. Fax: +44 (0) 7020 93 49 04