[Date Prev][Date Next][Thread Prev][Thread Next][Minivend by date
][Minivend by thread
]
Re: [mv] Adding items to cart basket via Perl+LWP?
****** message to minivend-users from cfm@maine.com ******
On Mon, Oct 30, 2000 at 10:42:53AM +0000, William Martin wrote:
> ****** message to minivend-users from "William Martin" <w.martin@angelfire.com> ******
>
> Adding items to cart basket via Perl+LWP?
>
> Interchange: 4.6.0, Perl: 5.005.03, Redhat: 6.1
>
> Hi,
> I am looking for a way to add items to a cart via a Perl script (as we use Macromedia's Flash as a front end). As a test I cut the link for "Add to cart" from the source of a Interchange page on a session I was using and pasted it directly into the browser window. This worked fine and added the item to the cart.
>
...
> I would greatly appreciate it if someone could provide an example or advice toward a working script that adds an item/s to a carts basket (assume we know the session_id).
>
> Background:
> The shop is part of a site that is completely front-ended by Flash. Users earn points as they use the site that they can then spend in the shop. As part of the security system all input from the front-end goes to a perl script which then passes the user requests to the appropriate part of the system (mail, chat, shop etc). In the Shop script we can pick up the mv_session_id when the shop index page is first accessed. The difficulty arises in adding things to the cart as outlined above.
>
I've attached a script that does places orders via LWP. We use it to
automatically accept <XML>ish email orders from resellers. Note that
this is only good for general idea. One issue was handling the reply
from minivend. If I recall we could not place the order in one shot
but needed request -> reply -> final. Probably something to do with
passing session_id or order number; I've not got time to unearth. :-)
Best,
cfm
--
Christopher F. Miller, Publisher cfm@maine.com
MaineStreet Communications, Inc 208 Portland Road, Gray, ME 04039
1.207.657.5078 http://www.maine.com/
Database publishing, e-commerce, office/internet integration, Debian linux.
#!/usr/bin/perl
# parse_email_orders.pl
# rev 1999-10-25, cfm
use MS::System;
use MS::DB;
use MS::DBPublish qw(merchants_config);
use HTTP::Request::Common;
use LWP::UserAgent;
my $MAILTO = 'cfm@maine.com';
{
my(@A,%CODES,$DB,%M,%atts,@fields,$match,%opt,$order_number,$query,$ref,$time,%v,@vals);
$opt{config}='foo';
$opt{db_user}='foo';
$opt{verbose}=1;
# open(STDIN, '/var/admin/groupmail/testemail');
$time = time();
{
local $/ = undef;
$_ = <STDIN>;
}
$opt{DB}=$DB=new MS::DB();
$DB->connect('foo','foo','');
%M=%{&merchants_config(\%opt)};
if($M{attributes}) {
foreach $a (split /\s+/, $M{attributes}) {
$DB->query(\%opt,qq`SELECT DISTINCT $a FROM aux`);
@A=@{$DB->fetchall_arrayref()};
push @{$atts{LIST}}, $a;
foreach (@A) {
foreach (split /\s*,\s*/, $_->[0]) {
$atts{lc($_)} = $a;
}
}
}
}
$v{full_email} = $_;
$ref = load_routines(\%v,\%atts,$DB);
/\n([^\n]+?)<.*\n(\1)<.*\n(\1)</s;
$match = $1;
s/^$match//gm;
s/^\s*>\s*//gm;
s/#.*?\n/\n/gm;
s/\n\n+/\n/gm;
s/<(.*?)>(.*?)<\/\1>/exists($ref->{lc($1)}) ? &{$ref->{lc($1)}{CODE}}($1,$2) : &{$ref->{DEFAULT}{CODE}}($1,$2) /gse;
$v{mv_payment} = 'Distributor';
$v{cc_card} = 'Distributor'; #for foo only
{
my(@tmp,%vv);
$DB->query(\%opt,qq`SELECT box,email,fx_phone,name_first,name_last,org_name,state,street,town,wk_phone,url,zip FROM distributors WHERE status > 0 AND account = '$v{reseller}'`);
@A=$DB->fetchrow_array();
unless(@A) {
}
($vv{box},$vv{email},$vv{fx_phone},$vv{name_first},$vv{name_last},
$vv{org_name},$vv{state},$vv{street},$vv{town},$vv{wk_phone},$vv{url},$vv{zip}) = @A;
$v{address} .= $vv{box};
$v{address} .= "\n" if $vv{box} && $vv{street};
$v{address} .= $vv{street};
$v{city} = $vv{city};
$v{city} .= $vv{town};
$v{state} = $vv{state};
$v{fax_phone} = $vv{fx_phone};
$v{day_phone} = $vv{wk_phone};
$v{org_name} = $vv{org_name};
$v{name} = "$vv{name_first} $vv{name_last}";
$v{b_url} = $vv{url};
$v{zip} = $vv{zip};
$v{email} = $vv{email};
}
# exit(0) if{$v{email} eq 'cfm@maine.com';
push @vals, 'CFM_referer' => 'DISTIBUTORS_EMAIL';
push @vals, 'mv_doit' => 'refresh';
#the by_email page returns the
push @vals,'mv_orderpage' => 'by_email'; # why was this test?
foreach $a (keys %v) {
if($a eq 'items') {
foreach $b (@{$v{$a}}) {
foreach (keys %{$b}) {
push @vals, "mv_order_$_", $b->{$_};
print "mv_order_$_\n", $b->{$_} if ($opt{verbose});
}
}
} else {
push @vals, $a, $v{$a};
}
}
# print join "\n", @vals;
my $ua = LWP::UserAgent->new;
print "\n";
s/\s*(.*?)\s*/\1/s;
$_ = $ua->request(POST 'http://WWW.Foo.Com/Catalog/foo.cgi/process', \@vals)->{_content};
print "$_\n";
print $ua->request(POST $_, ['mv_doit' => 'refresh',
'mv_order_report' => 'r/report',
'mv_order_profile' => 'final_by_email',
'mv_orderpage' => 'mv/receipt',
'mv_todo' => 'submit',
])->{_content};
exit(0); # ant had this uncommented 1999-10-26.
#info below shows how to add to db... but without pricing.
}
sub load_routines {
my($atts,$db,%subs,$v);
($v,$atts,$db) = @_;
$subs{foo_reseller}{CODE} = sub {
$_ = $_[1];
s/\s//gs;
print "FOO_RESELLER IS $_\n\n\n\n\n";
sleep 5;
$v->{reseller} = $_;
};
$subs{delivery_date}{CODE} = sub {
$_ = $_[1];
/(\d{4})\D*(\d{2})\D*(\d{2})/;
$v->{delivery_yyyy} = $1;
$v->{delivery_mon} = ('ERROR','Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$2];
$v->{delivery_dd} = $3;
};
$subs{ship_to_address}{CODE} = sub {
$_ = $_[1];
print "$_\n";
s/<(.*?)>(.*?)<\/\1>/exists($subs{'ship_to_address_items'}) ? &{$subs{'ship_to_address_items'}{CODE}}($1,$2) : exists($subs{lc($1)}) ? &{$subs{lc($1)}{CODE}}($1,$2) : &{$subs{DEFAULT}{CODE}}($1,$2)/gse;
/^\s*(.*?)\s*$/s;
$_ = $1;
# return if $v->{s_address};
return unless $_;
s/^(.+?)\n//m;
$v->{s_name} = $1;
if(s/\n(.+?)\s*,\s*(.+?)[ ,]+(\d{5,})\s*$//m) {
$v->{s_city} = $1;
$v->{s_state} = $2;
$v->{s_zip} = $3;
} else {
s/^(.+?)[ ,]+(.+?)[ ,]+(\d{5,})\s*$//m;
$v->{s_city} = $1;
$v->{s_state} = $2;
$v->{s_zip} = $3;
}
/^\s*(.*?)\s*$/;
$v->{s_address} = $1;
print "NAME: $v->{s_name}\n";
print "ADDRESS: $v->{s_address}\n";
print "CITYSTZIP: $v->{s_city} $v->{s_state} $v->{s_zip} \n";
};
$subs{ship_to_address_items}{CODE} = sub {
$_ = $_[1];
my $field = lc($_[0]);
print "s_$field = $_[1]\n";
/^\s*(.*?)\s*$/s;
$v->{"s_$field"} = $1;
# print join "-\n", grep /s_/, keys %{$v};
return '';
};
$subs{billing_address}{CODE} = sub {
};
$subs{ship_to_phone}{CODE} = $subs{shipping_phone}{CODE} = sub {
$_ = $_[1];
s/\s//g;
$v->{s_phone} = $_;
};
$subs{order_items}{CODE} = sub {
$_ = $_[1];
foreach (split /\s*\n\s*/, $_) {
my($quantity,%vv);
/()/;
s/\((\d+)\)//;
$quantity = ($1 || 1);
next unless /^\s*(\d+).*?(?:\bw\/(.*))?\s*$/;
$vv{item} = $1;
$db->query("SELECT A.base_item FROM aux AS A,products AS P WHERE A.code = '$vv{item}' AND A.code = P.code AND P.status > 0");
fail("Invalid code $vv{item} in order!", $v->{full_email}) unless $db->{row_count};
{
my %vvv = %{$db->fetchrow_hashref()};
$vv{base_item} = $vvv{base_item};
}
$vv{quantity} = $quantity;
foreach (split /\s*,\s*/, $2) {
$_ = lc($_);
# if($vv{$atts->{$_}} =~ /(\A|,)\s*$_\s*(\Z|,)/s) {
# print "vv{$atts->{$_}} = $_;\n";
$vv{$atts->{$_}} = $_ if $atts->{$_};
# }
}
foreach (@{$atts->{LIST}}) {
$vv{$_} =~ s/\s*,.*//;
}
push @{$v->{items}}, \%vv;
}
};
$subs{gift_message}{CODE} = sub {
$_ = $_[1];
# print ">> $_\n";
# s/<(.*?)>(.*?)<\/\1>/&{$subs{'gift_message_'.lc($1)}{CODE}}($1,$2)/gse;
s/<(.*?)>(.*?)<\/\1>/exists($subs{'gift_message_items'}) ? &{$subs{'gift_message_items'}{CODE}}($1,$2) : exists($subs{lc($1)}) ? &{$subs{lc($1)}{CODE}}($1,$2) : &{$subs{DEFAULT}{CODE}}($1,$2)/gse;
/^\s*(.*?)\s*$/s;
$v->{message} = $1;
$v->{gift_message} = $1;
};
$subs{gift_message_items}{CODE} = sub {
$_ = $_[1];
my $field = lc($_[0]);
/^\s*(.*?)\s*$/s;
$v->{"gift_$field"} = $1;
print qq`\nv->{"gift_$field"} = $1;\n`;
return '';
};
$subs{gift_certificate}{CODE} = sub {
$_ = $_[1];
s/\s//g;
if($_) {
$v->{shipping} = $_;
$v->{gift_certificate} = 1;
}
};
$subs{payment}{CODE} = sub {
$_ = $_[1];
/^\s*(.*?)\s*$/;
return; #only distributor in foo
if(/(fax|phone|mail|check)/i) {
$v->{mv_payment} = 'call';
} else {
#[if value mv_payment =~ /cc/][then]
#[value cc_card]
#[value mv_credit_card_info][/then][else]Fax or Mail[/else][/if]
#[embed]
$v->{mv_payment} = 'cc';
$v->{cc_card} = 'cc';
$v->{mv_credit_card_info} = $1;
}
};
$subs{DEFAULT}{CODE} = sub {
$_ = $_[1];
# print "DEFAULT called with name $_[0] and value: $_[1]\n\n";
};
return \%subs;
}
sub fail {
open(MAIL ,"| $MS::System::QMAIL_COMMAND $MAILTO") or print $!;
print MAIL "Subject: bad email order!\n\n";
print MAIL qq`
This may be sent back to the ordering party as well.
There was a problem in an email order, the error was:";
`;
print MAIL "$_[0]\n\nEmail Was:\n";
print MAIL "$_[1]\n";
exit(0);
}
-
To unsubscribe from the list, DO NOT REPLY to this message. Instead, send
email with 'UNSUBSCRIBE minivend-users' in the body to Majordomo@minivend.com.
Archive of past messages: http://www.minivend.com/minivend/minivend-list
