#!/usr/bin/perl use lib '../lib/perl5'; use strict 'vars'; use Carp; use CGI::Carp qw(fatalsToBrowser); #$SIG{__DIE__} = sub { confess @_ }; use Swan::Application; use Swan::Database; use Swan::Template; use Swan::Shop; use Edint; use Data::Dumper; use CGI ':cgi'; use Date::Calc qw(Delta_Days); import_names('Q'); ################## my $debug = 0; #my $debug = 1; ################## my $swan = Swan::Application->handle(); my $shop = Swan::Shop->handle(); my $pagevars = { swan => $swan, shop => $shop, site => { googleid => $Edint::Config::googleid, }, }; $$pagevars{debug} = $debug if $debug; my $pagerequest = url(-rewrite => 1, -absolute => 1); my $action = lc($Q::action); ########### feed functions if ($action eq 'feed') { my $rss= $swan->template('productfeed.rss.tmpl',$pagevars); $swan->download_file($rss,'productfeed.xml'); exit; } ########### user functions # Get the user if there is one my $user; if ($action eq 'logout') { $swan->logout(); $swan->localredirect('/'); } if ($Q::login) { $user = $swan->login($Q::username,$Q::password); if ($user) { push @{$$pagevars{messages}{debug}}, "Logged in as $$user{details}{realname}"; } else { push @{$$pagevars{messages}{error}}, "Log in details incorrect"; } # TODO consider redirect } if ($Q::reminder) { my $posuser = new Swan::User({ username => $Q::username}); if ($posuser) { push @{$$pagevars{messages}{info}}, "Password reminder sent to $$posuser{details}{email}"; my $sc = $shop->config(); $swan->email('passwordreminder', { to => "$$posuser{details}{realname} <$$posuser{details}{email}>", from => "$$sc{adminemailname} <$$sc{adminemailaddress}>", subject => 'Password Reminder', }, { shop => $shop, user => $posuser, } ); } else { push @{$$pagevars{messages}{error}}, "No user exists with username $Q::username"; } # TODO consider redirect } my $isnewuser; if ($action eq 'register' || $pagerequest =~ /register/) { my $aok = 1; my $auser = $swan->user(); my $istheshop = $auser && $$auser{role}{shopkeeper}; if ($action eq 'register') { $swan->logout() unless $istheshop; unless ($Q::forename =~ /\w/) { push @{$$pagevars{messages}{error}}, "The 'Forename(s)' (below) doesn't seem to make sense or is missing"; $$pagevars{formerror}{forename} = "invalid"; $aok = 0; } unless ($Q::surname =~ /\w/) { push @{$$pagevars{messages}{error}}, "The 'Surname' (below) doesn't seem to make sense or is missing"; $$pagevars{formerror}{surname} = "invalid"; $aok = 0; } if (my $posuser = new Swan::User({ email => $Q::email})) { push @{$$pagevars{messages}{error}}, "This 'Email Address' (below) is already in use. Please Choose another email address or Log In."; $$pagevars{formerror}{email} = "already in use"; $aok = 0; } unless ($Q::email =~ /\@/) { push @{$$pagevars{messages}{error}}, "The 'Email Address' (below) doesn't seem to make sense or is missing"; $$pagevars{formerror}{email} = "invalid"; $aok = 0; } unless ($Q::phone =~ /^[-+\s\d()]+$/) { push @{$$pagevars{messages}{error}}, "The 'Phone Number' (below) doesn't seem to make sense or is missing"; $$pagevars{formerror}{phone} = "invalid"; $aok = 0; } unless ($Q::street1 =~ /\w/) { push @{$$pagevars{messages}{error}}, "The 'Street Address' (below) doesn't seem to make sense or is missing"; $$pagevars{formerror}{street1} = "invalid"; $aok = 0; } unless ($Q::towncity =~ /\w/) { push @{$$pagevars{messages}{error}}, "The 'Town/City' (below) doesn't seem to make sense or is missing"; $$pagevars{formerror}{towncity} = "invalid"; $aok = 0; } # unless ($Q::countystate =~ /\w/) { # push @{$$pagevars{messages}{error}}, # "The 'County/State' (below) doesn't seem to make sense or is missing"; # $$pagevars{formerror}{countystate} = "invalid"; # $aok = 0; # } unless ($Q::postcode =~ /\w/) { push @{$$pagevars{messages}{error}}, "The 'Post/Zip Code' (below) doesn't seem to make sense or is missing"; $$pagevars{formerror}{postcode} = "invalid"; $aok = 0; } unless ($Q::newpass =~ /\w{6,}/) { push @{$$pagevars{messages}{error}}, "The 'Password' (below) must be six or more characters"; $$pagevars{formerror}{newpass} = "invalid"; $aok = 0; } unless ($Q::newpass eq $Q::reppass) { push @{$$pagevars{messages}{error}}, "The 'Passwords' (below) do not match"; $$pagevars{formerror}{reppass} = "invalid"; $aok = 0; } } else { # just a blank form $aok = 0; } if ($aok) { if ($Q::mlist) { use WWW::Mailchimp; my $apikey = "d2424bce9ee1ba6b77c9e1e38a29b8c2-us5"; my $mailchimp = WWW::Mailchimp->new( apikey => $apikey, datacenter => 'us5' ); my $listid = "f19084701f"; my $ok = $mailchimp->listSubscribe( id => $listid, email_address => $Q::email, merge_vars => [ FNAME => $Q::forename, LNAME => $Q::surname, ORG => $Q::organisation, ] ); } my $address = { street1 => $Q::street1, towncity => $Q::towncity, postcode => $Q::postcode, ctyid => $Q::ctyid, }; $$address{organisation} = $Q::organisation if $Q::organisation; $$address{street2} = $Q::street2 if $Q::street2; $$address{locality} = $Q::locality if $Q::locality; $$address{countystate} = $Q::countystate if $Q::countystate; my $newuser = new Swan::User({ create => 1, forename => $Q::forename, surname => $Q::surname, realname => "$Q::forename $Q::surname", email => $Q::email, phone => $Q::phone, password => $Q::newpass, }); $newuser->addaddress($address); if ($istheshop) { $$pagevars{newuser} = $newuser; } else { $user = $swan->login($Q::email); $isnewuser = 1; my $sc = $shop->config(); $swan->email('newuser', { to => "$$user{details}{realname} <$$user{details}{email}>", from => "$$sc{adminemailname} <$$sc{adminemailaddress}>", subject => $$sc{registeremailsubject}, }, { shop => $shop, user => $user, } ); # TODO consider redirect or variable } $action = 'basket'; } else { $$pagevars{register} = { forename => $Q::forename, surname => $Q::surname, email => $Q::email, phone => $Q::phone, organisation => $Q::organisation, street1 => $Q::street1, street2 => $Q::street2, locality => $Q::locality, towncity => $Q::towncity, countystate => $Q::countystate, postcode => $Q::postcode, ctystatus => $Q::ctystatus, ctyid => $Q::ctyid, newpass => $Q::newpass, reppass => $Q::reppass, mlist => $Q::mlist, }; $action = 'basket'; } } $user = $swan->user(); $$pagevars{user} = $user if $user; ########### ajax functions sub ccode { $$pagevars{ctystatus} = $Q::ctystatus if $Q::ctystatus; return $swan->template('countryselector.tt',$pagevars); } $swan->register_func('countries', \&ccode); if ($Q::fname) { $swan->handle_request(); exit; } ########### shop functions if ($Q::crypt) { # sagepay # TODO check it's the right person and order from their cookie my $result = $shop->process_sp_payment_result($Q::crypt); if ($shop->get_sp_payment_result($$result{VendorTxCode})) { my $qbasket = $shop->get_user_basket($$user{details}{userid}); $$pagevars{basket} = $shop->make_basket($qbasket); $swan->page('cardrepeat',$pagevars); exit; } $shop->store_sp_payment_result($result); if ($$result{Status} ne 'OK') { my $qbasket = $shop->get_user_basket($$user{details}{userid}); $$pagevars{basket} = $shop->make_basket($qbasket); $$pagevars{result} = $result; $swan->page('cardfailed',$pagevars); exit; } my $txcode = $$result{VendorTxCode}; my $order = $shop->get_order_summary($txcode); if ($$order{odpaid}) { my $qbasket = $shop->get_user_basket($$user{details}{userid}); $$pagevars{basket} = $shop->make_basket($qbasket); $swan->page('cardrepeat',$pagevars); exit; } $shop->completepay_order($txcode); $shop->delete_user_basket($$user{details}{userid}); my $order = $$pagevars{order} = $shop->get_order($txcode); $$pagevars{googlecommerce} = 1; $swan->page('ordercompletepage',$pagevars); my $sc = $shop->config(); $swan->email('orderbuyer', { from => "$$sc{adminemailname} <$$sc{adminemailaddress}>", to => "$$user{details}{realname} <$$user{details}{email}>", subject => $$sc{orderemailsubject}, }, { shop => $shop, user => $user, order => $order, } ); $swan->email('ordershop', { from => "$$user{details}{realname} <$$user{details}{email}>", to => "$$sc{adminemailname} <$$sc{adminemailaddress}>", subject => $$sc{orderemailsubject}, }, { shop => $shop, user => $user, order => $order, } ); exit; } if ($Q::tx) { # paypal my $result = $shop->process_pp_payment_result($Q::tx); if ($shop->get_pp_payment_result($$result{invoice})) { my $qbasket; if ($user) { my $ubasket = $shop->get_user_basket($$user{details}{userid}); while (my ($itid,$quantity) = each %{$$ubasket{item}}) { $$qbasket{item}{$itid} = $quantity; } } else { $qbasket = $swan->get_cookie('basket'); } $$pagevars{basket} = $shop->make_basket($qbasket); $swan->page('pprepeat',$pagevars); exit; } $shop->store_pp_payment_result($result); # TODO modularis variables if ($$result{tx_status} ne 'SUCCESS') { my $qbasket; if ($user) { my $ubasket = $shop->get_user_basket($$user{details}{userid}); while (my ($itid,$quantity) = each %{$$ubasket{item}}) { $$qbasket{item}{$itid} = $quantity; } } else { $qbasket = $swan->get_cookie('basket'); } $$pagevars{basket} = $shop->make_basket($qbasket); $$pagevars{result} = $result; $swan->page('ppfailed',$pagevars); exit; } my $txcode = $$result{invoice}; my $order = $shop->get_order_summary($txcode); unless ($$order{odcomplete}) { if ($$order{userid} == -13) { my $posuser = new Swan::User({ email => $$result{payer_email}}); if ($posuser) { $shop->pp_fix_order_olduser($order,$result); } else { $shop->pp_fix_order_newuser($order,$result); } } # with no stock change # $shop->complete_order($txcode,2,1); # with stock change $shop->complete_order($txcode,2); } if ($user) { $shop->set_user_basket($$user{details}{userid},{}); } else { $shop->empty_cbasket(); } my $order = $$pagevars{order} = $shop->get_order($txcode); $$pagevars{googlecommerce} = 1; my $sc = $shop->config(); $swan->email('orderbuyer', { from => "$$sc{adminemailname} <$$sc{adminemailaddress}>", to => "$$user{details}{realname} <$$user{details}{email}>", subject => $$sc{orderemailsubject}, }, { shop => $shop, user => $user, order => $order, } ); $swan->email('ordershop', { from => "$$user{details}{realname} <$$user{details}{email}>", to => "$$sc{adminemailname} <$$sc{adminemailaddress}>", subject => $$sc{orderemailsubject}, }, { shop => $shop, user => $user, order => $order, } ); $swan->page('ordercompletepage',$pagevars); exit; } if ($action eq 'invoice') { my $db = Swan::Database->handle(); $db->update( 'ordersummary', { odsrcid => $Q::odsrcid, }, { odid => $Q::odid }); } if ($action eq 'rqinv' || $action eq 'invoice') { # TODO check it's the right person and order from their cookie my $order = $shop->get_order_summary($Q::odid); my $txcode = $$order{txcode}; my $noemail = $Q::noemail; $noemail = 1 if $action eq 'invoice'; if ($$order{odcomplete}) { $noemail = 1; } else { $shop->complete_order($$order{odid},3); $$pagevars{googlecommerce} = 1; # only on first time $shop->delete_user_basket($$user{details}{userid}); if ($Q::odreference) { my $db = Swan::Database->handle(); $db->update( 'ordersummary', { odreference => $Q::odreference, }, { odid => $Q::odid }); } } $order = $$pagevars{order} = $shop->get_order($$order{odid}); $$pagevars{noprompt} = 1 if $Q::noprompt; $$pagevars{remit} = 1 if $Q::remit; $$pagevars{incvat} = 1 unless $Q::noincvat; $$pagevars{exvat} = 1; $$pagevars{nosale} = 1 if $Q::nosale; my @cd = $$order{odcomplete} =~ /(\d{4})-(\d{2})-(\d{2})/; my @td = (2012,3,14); $$pagevars{ivs} = Delta_Days(@td,@cd) < 0 ? 'ei' : 'mz'; $swan->page('orderinvoicepage',$pagevars); unless ($noemail) { my $sc = $shop->config(); $swan->email('orderbuyer', { from => "$$sc{adminemailname} <$$sc{adminemailaddress}>", to => "$$user{details}{realname} <$$user{details}{email}>", subject => $$sc{orderemailsubject}, }, { shop => $shop, user => $user, order => $order, } ); $swan->email('ordershop', { from => "$$user{details}{realname} <$$user{details}{email}>", to => "$$sc{adminemailname} <$$sc{adminemailaddress}>", subject => "$$sc{orderemailsubject} (Invoice)", }, { shop => $shop, user => $user, order => $order, } ); } exit; } my $redirectto; if (param('add')) { # NOTE those brackets at the end force the list $shop->basket_add_item($_) for (param('add')); $redirectto = referer(); $action = 'basket'; } if (param('scan')) { if (my $item = $shop->basket_scan_item(param('scan'))) { $action = 'basket'; push @{$$pagevars{messages}{info}}, "Item $$item{itname} added"; } else { push @{$$pagevars{messages}{error}}, "Unable to find scanned item"; } } if ($user && $action eq 'gopaypal') { $action= 'checkout'; } if (!$user && $action eq 'checkout') { $action= 'basket'; } my $theshop = $user && $$user{role}{shopkeeper}; if ($action eq 'adjust' && !$theshop) { $action= 'basket'; } if ($action eq 'complete' && !$theshop) { $action= 'basket'; } my $qbasket; if ($user) { if ($action eq 'apply') { my $db = Swan::Database->handle(); $db->update('basket',{ dccstring => $Q::dcc }, { userid => $$user{details}{userid} }); $action = 'basket'; } $qbasket = $shop->get_user_basket($$user{details}{userid}); my $cbasket = $swan->get_cookie('basket'); if ($$cbasket{item}) { while (my ($itid,$quantity) = each %{$$cbasket{item}}) { $$qbasket{item}{$itid} += $quantity; } $shop->set_user_basket($$user{details}{userid},$qbasket); delete $$cbasket{item}; $swan->set_cookie('basket',$cbasket); unless ($isnewuser) { push @{$$pagevars{messages}{warn}}, "Don't forget to check the contents of your basket. You may have left some things in it during a previous visit."; } } } else { $qbasket = $swan->get_cookie('basket'); } if ($action eq 'recalculate') { delete $$qbasket{item}; for my $q (grep { /^qty:/ } param()) { my $qty = param($q); next unless $qty > 0; $q =~ s/^qty://; $$qbasket{item}{$q} = $qty; } if ($user) { $shop->set_user_basket($$user{details}{userid},$qbasket); } else { $swan->set_cookie('basket',$qbasket); } $action = 'basket'; } $$pagevars{qbasket} = $qbasket; # DEBUG $$pagevars{basket} = $shop->make_basket($qbasket); if ($action eq 'search' || $Q::query) { $$pagevars{search}{query} = $Q::query; $$pagevars{search}{agerange} = $Q::agerange; my $results = $$pagevars{search}{results} = $shop->search($Q::query,$Q::agerange); $swan->page('searchresults',$pagevars); exit; } if ($action eq 'show') { $$pagevars{order} = $shop->get_order($Q::txcode); $swan->page('orderpage',$pagevars); exit; } if ($action eq 'checkout' && !$qbasket) { $action = 'basket'; } if ($action eq 'gopaypal' && !$qbasket) { $action = 'basket'; } my $anonzone = { UK => -14, EU => -15, WW => -16, }; my $szone; if ($action eq 'gopaypal') { $szone = $$anonzone{$Q::szone}; if (!$szone) { $action = 'basket'; } } if ($action eq 'adjust') { my $db = Swan::Database->handle(); for my $p (grep { /^itprice:/ } param()) { my $itprice = param($p); $p =~ s/^itprice://; $db->update( 'orderitem', { oditprice => $itprice, }, { odid => $Q::odid, itid => $p, } ); } my $items = $db->quickselect( 'orderitem o join item i on i.itid = o.itid','*', { cond => { odid => $Q::odid } } ); my $order = $shop->get_order_summary($Q::odid); my $discount = $db->quickselect('discountcode','*', { cond => { dccstring => $$order{dccstring} }, ctx => 'record', } ); my $ittotal; my $totalvat; $$order{totals}{dc} = 0; $$order{totals}{dcvat} = 0; for my $item (@$items) { my $vatrate = $$item{oditvatrate} || 0; my $vat = 0; my $dc = 0; my $dcvat = 0; if ($vatrate) { $vat = int(100 * $$item{oditprice} * $vatrate/(100 + $vatrate)) / 100; # rounded down if ($discount) { if (my $dcm = $$discount{dccmatch}) { my $dcr = qr/^($dcm)/; if ($$item{itcode} =~ $dcr) { $dc = $$item{oditprice} * $$discount{dccpercent} / 100; $dcvat = $vat * $$discount{dccpercent} / 100; } } else { $dc = $$item{oditprice} * $$discount{dccpercent} / 100; $dcvat = $vat * $$discount{dccpercent} / 100; } } else { $dcvat = 0; } } else { $vat = 0; $dcvat = 0; } $$order{totals}{dc} += int($$item{oditquantity} * $dc * 100) / 100; $$order{totals}{dcvat} += int($$item{oditquantity} * $dcvat * 100) / 100; $db->update( 'orderitem', { oditvat => $vat, }, { odid => $Q::odid, itid => $$item{itid}, } ); $totalvat += $vat * $$item{oditquantity}; $ittotal += $$item{oditprice} * $$item{oditquantity}; } if ($discount) { my $vat = $totalvat; $totalvat = $vat - $$order{totals}{dcvat}; my $totalit = $ittotal - $$order{totals}{dc}; $db->update('ordersummary', { odittotal => $totalit, odittotalvat => $totalvat, odittotaldc => $$order{totals}{dc}, odittotaldcvat => $$order{totals}{dcvat} }, { odid => $Q::odid }); } else { $db->update('ordersummary', { odittotal => $ittotal, odittotalvat => $totalvat, odittotaldc => 0, odittotaldcvat => 0 }, { odid => $Q::odid }); } my $order = $$pagevars{order} = $shop->get_shop_order($Q::odid); unless ($$order{pickup} || $$order{odpickup}) { my $shipaddress = $$order{address}{shipping} = $shop->get_address($$order{shipaddrid}); $$order{totals}{order} = $$order{totals}{items}; # so far my $shipping = $shop->calc_shipping($order,$shipaddress); $$order{shipping} = $shipping; $$order{totals}{shipping} = $$shipping{shcost} || 0; $$order{totals}{order} += $$order{totals}{shipping}; $db->update( 'ordersummary', { odshtotal => $$order{totals}{shipping}, odshvatprop => $$shipping{vatprop}, odshvatrate => $$shipping{vatrate}, odshvat => $$shipping{vat}, }, { odid => $Q::odid }); } $swan->page('shopcheckoutpage',$pagevars); exit; } if ($action eq 'checkout') { my $db = Swan::Database->handle(); if ($theshop) { my $customer; my $aok = 1; if ($Q::userid) { $customer = new Swan::User( { userid => $Q::userid } ); unless ($customer) { push @{$$pagevars{messages}{error}}, "No such customer"; $aok = 0; } } else { $customer = $user; } if ($aok) { if ($Q::userid) { my $addrid = $db->quickselect('user_address','addrid',{ cond => { userid => $$customer{details}{userid}, adtyid => 1, adactive => 1 }, ctx => 'value' } ); my $shipaddrid = $addrid; my $billaddrid = $addrid; # my $shoid = $Q::shoid; my $pickup = $Q::pickup; my $txcodesub = \&TestApp::make_txcode; my $order = $shop->create_order($customer,$qbasket,$billaddrid,$shipaddrid,$pickup,$txcodesub); $$pagevars{order} = $shop->get_shop_order($$order{odid}); } else { my $order = $shop->create_shop_order($customer,$qbasket); my $pickup = $Q::pickup; $pickup = 1; if ($pickup) { $db->update( 'ordersummary', { odpickup => 1, odshtotal => 0, odshvatprop => undef, odshvatrate => undef, odshvat => undef, }, { odid => $$order{odid} }); } $$pagevars{order} = $shop->get_shop_order($$order{odid}); } $swan->page('shopcheckoutpage',$pagevars); exit; } else { $action = 'basket'; } } else { my $addrid = $db->quickselect('user_address','addrid',{ cond => { userid => $$user{details}{userid}, adtyid => 1 }, ctx => 'value' } ); my $shipaddrid = $addrid; my $billaddrid = $addrid; # my $shoid = $Q::shoid; my $pickup = $Q::pickup; my $txcodesub = \&TestApp::make_txcode; $$pagevars{order} = $shop->create_order($user,$qbasket,$billaddrid,$shipaddrid,$pickup,$txcodesub); if ($Q::pp) { $swan->page('goppcheckpage',$pagevars); } else { $swan->page('checkoutpage',$pagevars); } exit; } } if ($action eq 'gopaypal') { my $db = Swan::Database->handle(); my $ppuser = new Swan::User( { userid => -13 } ); my $shipaddrid = $szone; my $billaddrid = $shipaddrid; my $pickup = $Q::pickup; my $txcodesub = \&TestApp::make_txcode; $$pagevars{order} = $shop->create_order($ppuser,$qbasket,$billaddrid,$shipaddrid,$pickup,$txcodesub); $swan->page('goppcheckpage',$pagevars); exit; } if ($action eq 'pay') { my $order = $shop->get_order_summary($Q::odid); if ($$order{odpaid}) { #TODO do this exit; } my $db = Swan::Database->handle(); $db->update( 'ordersummary', { odsrcid => $Q::odsrcid, }, { odid => $Q::odid }); $shop->shoppay_order($Q::odid,$Q::pytyid,$Q::dispatch); $shop->delete_user_basket($$user{details}{userid}); if ($Q::odreference) { $db->update( 'ordersummary', { odreference => $Q::odreference, }, { odid => $Q::odid }); } my $order = $$pagevars{order} = $shop->get_shop_order($Q::odid); $$pagevars{googlecommerce} = 1; $swan->page('ordercompletepage',$pagevars); exit; } if ($redirectto) { $swan->remoteredirect($redirectto); } if ($action eq 'basket') { if ($theshop) { $swan->page('shopbasketpage',$pagevars); exit; } if (!defined($$pagevars{register})) { $$pagevars{register}{mlist} = 1; } $swan->page('basketpage',$pagevars); exit; } if ($Q::psid) { $$pagevars{psid} = $Q::psid; $swan->page('psetpage',$pagevars); exit; } if ($Q::pgid) { $$pagevars{pgid} = $Q::pgid; $swan->page('pgrouppage',$pagevars); exit; } if ($Q::prid) { $$pagevars{prid} = $Q::prid; $swan->page('productpage',$pagevars); exit; } if ($theshop) { $swan->page('theshoppagetop',$pagevars); } else { $$pagevars{psid} = 1; $swan->page('psetpagetop',$pagevars); } __END__ http://www.themathszone.co.uk/shop/paypalok?tx=3AY42046TH9127628&st=Completed&amt=1.00&cc=GBP&cm=&item_number=