Index: openacs-4/packages/ecommerce/tcl/cybercash-emulator-procs.tcl.for.testing =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ecommerce/tcl/Attic/cybercash-emulator-procs.tcl.for.testing,v diff -u -N -r1.1 -r1.2 --- openacs-4/packages/ecommerce/tcl/cybercash-emulator-procs.tcl.for.testing 20 Apr 2001 20:51:13 -0000 1.1 +++ openacs-4/packages/ecommerce/tcl/cybercash-emulator-procs.tcl.for.testing 18 Jul 2001 18:19:01 -0000 1.2 @@ -1,170 +1,170 @@ -# This is a CyberCash emulator which gives weighted random results similar to -# results we've gotten in the past by talking to CyberCash. - -# To use, rename this file cybercash-emulator.tcl and put it into your private -# tcl directory. Then you can call the function cc_send_to_server_21 the same -# as you would if you had installed our cybercash.so module. - -# The README file for cybercash.so can be found at: -# http://www.arsdigita.com/free-tools/cybercash/README.txt -# The only useful command mentioned in the README file is cc_send_to_server_21, -# so that is the only function we've emulated. -# Documentation of CyberCash's API can be found in Appendix B of the CyberCash -# CashRegister Service Development Guide at: -# http://www.cybercash.com/cybercash/merchants/docs/dev.pdf -# The Dev Guide will help you determine which arguments to put into the input -# ns_set sent to cc_send_to_server_21. If this isn't enough, look at the source -# code for ArsDigita Shoppe: -# http://www.arsdigita.com/free-tools/shoppe.tar.gz - -# -# No statistical analysis of CyberCash results has been done, therefore the -# likelihood of getting any one of these results may differ significantly from -# the likelihood of getting the same result when actually talking to CyberCash. -# This is meant to be a tool to assist programmers who develop with CyberCash; -# it is not meant to be a reflection of CyberCash's reliability. -# - -proc cc_send_to_server_21 { txn_type args cc_output } { -## txn_type is mauthonly, postauth, retry, void, return, capture - - # level_of_success is used for just about all transaction types - set level_of_success [random] - - if { $txn_type == "mauthonly" || $txn_type == "retry"} { - # retry is treated the same as mauthonly because we happen to only use retry - # after a failed mauthonly (not after a failed anything else) in Shoppe - if { $level_of_success < 0.8 } { - # successful authorization - ns_set put $cc_output "MStatus" "success" - ns_set put $cc_output "aux-msg" "Financial Institute Response: authorization approved" - ns_set put $cc_output "auth-code" [expr round([random] * 100000)] - ns_set put $cc_output "action-code" "000" - ns_set put $cc_output "merch-txn" [expr round([random] * 10000000)] - - # generate an avs code - set avs_random_number [random] - if { $avs_random_number < 0.1 } { - set avs_code "A" - } elseif { $avs_random_number >= 0.1 && $avs_random_number < 0.3 } { - set avs_code "N" - } elseif { $avs_random_number >= 0.3 && $avs_random_number < 0.4 } { - set avs_code "U" - } elseif { $avs_random_number >= 0.4 && $avs_random_number < 0.5 } { - set avs_code "Y" - } else { - set avs_code "Z" - } - - ns_set put $cc_output "avs-code" $avs_code - } elseif { $level_of_success >= 0.8 && $level_of_success < 0.9 } { - # failure hard, fails LUHN-10 check - ns_set put $cc_output "MStatus" "failure-hard" - ns_set put $cc_output "MErrLoc" "smps" - ns_set put $cc_output "MErrMsg" "Credit card number '[ns_set get $args "card-number"]' fails LUHN-10 check" - - } elseif { $level_of_success >= 0.9 && $level_of_success < 0.92 } { - # failure-bad-money - ns_set put $cc_output "MStatus" "failure-bad-money" - ns_set put $cc_output "MErrLoc" "smps" - ns_set put $cc_output "MErrMsg" "Financial Institution Response: Declined, bad card. Call card issuer." - ns_set put $cc_output "merch-txn" [expr round([random] * 1000000)] - } elseif { $level_of_success >= 0.92 && $level_of_success < 0.94 } { - # failure-q-or-cancel - ns_set put $cc_output "MStatus" "failure-q-or-cancel" - ns_set put $cc_output "MErrLoc" "smps" - ns_set put $cc_output "MErrMsg" "Error while reading message from the Cybercash gateway: parse_http: Premature EOF read from socket. HTTP body is missing. A likely reason: server did not respond or dropped a connection" - } elseif { $level_of_success >= 0.94 && $level_of_success < 0.96 } { - # couldn't connect to MPS - ns_set put $cc_output "MStatus" "failure-hard" - ns_set put $cc_output "MErrLoc" "SYSTEM" - ns_set put $cc_output "MErrMsg" "Could not connect to Merchant Payment Server, possibly it is not running or your configuration is incorrect" - } elseif { $level_of_success >= 0.96 && $level_of_success < 0.98 } { - # timeout - ns_set put $cc_output "MStatus" "failure-hard" - ns_set put $cc_output "MErrLoc" "INTERNAL" - ns_set put $cc_output "MErrMsg" "Payment Server failed to respond in a timely manner." - } else { - # generic failure - ns_set put $cc_output "MStatus" "failure-hard" - ns_set put $cc_output "MErrLoc" "ccsp" - ns_set put $cc_output "MErrMsg" "Invalid credit card number." - ns_set put $cc_output "merch-txn" [expr round([random] * 1000000)] - } - # end of mauthonly section - } elseif { $txn_type == "postauth" } { - if { $level_of_success < 0.97 } { - ns_set put $cc_output "MStatus" "success" - ns_set put $cc_output "aux-msg" "Order [ns_set get $args "order-id"] is successfully marked for batching." - } else { - ns_set put $cc_output "MStatus" "failure-hard" - ns_set put $cc_output "MErrLoc" "SYSTEM" - ns_set put $cc_output "MErrMsg" "Could not connect to Merchant Payment Server, possibly it is not running or your configuration is incorrect" - } - # end of postauth section - } elseif { $txn_type == "return" } { - if { $level_of_success < 0.97 } { - ns_set put $cc_output "MStatus" "success" - ns_set put $cc_output "aux-msg" "Order [ns_set get $args "order-id"] is successfully marked for batching as a return." - } else { - ns_set put $cc_output "MStatus" "failure-hard" - ns_set put $cc_output "MErrLoc" "SYSTEM" - ns_set put $cc_output "MErrMsg" "Could not connect to Merchant Payment Server, possibly it is not running or your configuration is incorrect" - } - # end of return section - } elseif { $txn_type == "void" } { - # it doesn't matter if the txn-type is "marked" or "markret" -- the message from CyberCash - # is the same - if { $level_of_success < 0.97 } { - ns_set put $cc_output "MStatus" "success" - ns_set put $cc_output "aux-msg" "Order [ns_set get $args "order-id"] is successfully voided." - } else { - ns_set put $cc_output "MStatus" "failure-hard" - ns_set put $cc_output "MErrLoc" "SYSTEM" - ns_set put $cc_output "MErrMsg" "Could not connect to Merchant Payment Server, possibly it is not running or your configuration is incorrect" - } - # end of void section - } elseif { $txn_type == "query" } { - # this is going to be tedious to code... - - set db [ns_db gethandle subquery] - - set selection [ns_db 0or1row $db "select to_char(authorized_date,'YYYYMMDDHH24MISS') as authorized_date, cc_auth_status, cc_auth_txn_id, cc_auth_auth_code, cc_auth_action_code, cc_auth_avs_code, to_char(postauth_date, 'YYYYMMDDHH24MISS') as postauth_date, cc_post_status, cc_post_txn_id, cc_post_auth_code, to_char(cc_sett_date,'YYYYMMDDHH24MISS') as cc_sett_date, cc_sett_status, cc_sett_txn_id, cc_sett_auth_code, cc_sett_batch_id, to_char(return_date,'YYYYMMDDHH24MISS') as return_date, refunded_amount, cc_retn_status, cc_retn_txn_id, cc_retn_auth_code, to_char(cc_sret_date,'YYYYMMDDHH24MISS') as cc_sret_date, cc_sret_status, cc_sret_txn_id, cc_sret_auth_code, cc_sret_batch_id, to_char(void_marked_date,'YYYYMMDDHH24MISS') as void_marked_date, cc_vdmk_status, cc_vdmk_txn_id, cc_vdmk_auth_code, to_char(void_markret_date,'YYYYMMDDHH24MISS') as void_markret_date, cc_vdrn_status, cc_vdrn_txn_id, cc_vdrn_auth_code, currency, price_charged - from sh_orders - where order_id=[ns_set get $args "order-id"]"] - if { $selection != "" } { - set_variables_after_query - - ns_set put $cc_output "MStatus" "success" - - if { [string compare $authorized_date ""] != 0 } { - ns_set put $cc_output "a1" "order-id=[ns_set get $args "order-id"]&merch-txn=$cc_auth_txn_id&cust-txn=$cc_auth_txn_id&origin=m&txn-type=auth&txn-status=$cc_auth_status&cust-id=xxxxxx&card-type=xx&card-number=(first 2 and last 4 digits only)&card-exp=xx/xx&amount=$currency $price_charged&time=$authorized_date.000&auth_code=$cc_auth_auth_code&ref-code=&action-code=$cc_auth_action_code&batch-id=&avs-code=$cc_auth_avs_code" - } - if { [string compare $postauth_date "" ] != 0 } { - ns_set put $cc_output "a2" "order-id=[ns_set get $args "order-id"]&merch-txn=$cc_post_txn_id&cust-txn=$cc_auth_txn_id&origin=m&txn-type=marked&txn-status=$cc_post_status&cust-id=xxxxxx&card-type=xx&card-number=(first 2 and last 4 digits only)&card-exp=xx/xx&amount=$currency $price_charged&time=$postauth_date.000&auth_code=$cc_auth_auth_code&ref-code=&action-code=$cc_auth_action_code&batch-id=&avs-code=$cc_auth_avs_code" - } - if { [string compare $cc_sett_date "" ] != 0 } { - ns_set put $cc_output "a3" "order-id=[ns_set get $args "order-id"]&merch-txn=$cc_sett_txn_id&cust-txn=&origin=m&txn-type=settled&txn-status=$cc_sett_status&cust-id=xxxxxx&card-type=xx&card-number=(first 2 and last 4 digits only)&card-exp=xx/xx&amount=$currency $price_charged&time=$cc_sett_date.000&auth_code=$cc_auth_auth_code&ref-code=&action-code=$cc_auth_action_code&batch-id=$cc_sett_batch_id&avs-code=$cc_auth_avs_code" - } - if { [string compare $return_date "" ] != 0 } { - ns_set put $cc_output "a4" "order-id=[ns_set get $args "order-id"]&merch-txn=$cc_retn_txn_id&cust-txn=&origin=m&txn-type=markret&txn-status=$cc_retn_status&cust-id=xxxxxx&card-type=xx&card-number=(first 2 and last 4 digits only)&card-exp=xx/xx&amount=$currency $refunded_amount&time=$return_date.000&auth_code=$cc_auth_auth_code&ref-code=&action-code=&batch-id=&avs-code=$cc_auth_avs_code" - } - if { [string compare $cc_sret_date "" ] != 0 } { - ns_set put $cc_output "a5" "order-id=[ns_set get $args "order-id"]&merch-txn=$cc_sret_txn_id&cust-txn=&origin=m&txn-type=setlret&txn-status=$cc_sret_status&cust-id=xxxxxx&card-type=xx&card-number=(first 2 and last 4 digits only)&card-exp=xx/xx&amount=$currency $refunded_amount&time=$cc_sret_date.000&auth_code=$cc_auth_auth_code&ref-code=&action-code=&batch-id=$cc_sret_batch_id&avs-code=$cc_auth_avs_code" - } - if { [string compare $void_marked_date "" ] != 0 } { - ns_set put $cc_output "a6" "order-id=[ns_set get $args "order-id"]&merch-txn=$cc_vdmk_txn_id&cust-txn=$cc_auth_txn_id&origin=m&txn-type=voidmark&txn-status=$cc_vdmk_status&cust-id=xxxxxx&card-type=xx&card-number=(first 2 and last 4 digits only)&card-exp=xx/xx&amount=$currency $price_charged&time=$void_marked_date.000&auth_code=$cc_auth_auth_code&ref-code=&action-code=000&batch-id=&avs-code=$cc_auth_avs_code" - } - if { [string compare $void_markret_date "" ] != 0 } { - ns_set put $cc_output "a7" "order-id=[ns_set get $args "order-id"]&merch-txn=$cc_vdrn_txn_id&cust-txn=$cc_auth_txn_id&origin=m&txn-type=voidreturn&txn-status=$cc_vdrn_status&cust-id=xxxxxx&card-type=xx&card-number=(first 2 and last 4 digits only)&card-exp=xx/xx&amount=$currency $refunded_amount&time=$void_markret_date.000&auth_code=$cc_auth_auth_code&ref-code=&action-code=000&batch-id=&avs-code=$cc_auth_avs_code" - } - - - # end of selection not empty - } - - # end of query - } - -# end of proc -} +# This is a CyberCash emulator which gives weighted random results similar to +# results we've gotten in the past by talking to CyberCash. + +# To use, rename this file cybercash-emulator.tcl and put it into your private +# tcl directory. Then you can call the function cc_send_to_server_21 the same +# as you would if you had installed our cybercash.so module. + +# The README file for cybercash.so can be found at: +# http://www.arsdigita.com/free-tools/cybercash/README.txt +# The only useful command mentioned in the README file is cc_send_to_server_21, +# so that is the only function we've emulated. +# Documentation of CyberCash's API can be found in Appendix B of the CyberCash +# CashRegister Service Development Guide at: +# http://www.cybercash.com/cybercash/merchants/docs/dev.pdf +# The Dev Guide will help you determine which arguments to put into the input +# ns_set sent to cc_send_to_server_21. If this isn't enough, look at the source +# code for ArsDigita Shoppe: +# http://www.arsdigita.com/free-tools/shoppe.tar.gz + +# +# No statistical analysis of CyberCash results has been done, therefore the +# likelihood of getting any one of these results may differ significantly from +# the likelihood of getting the same result when actually talking to CyberCash. +# This is meant to be a tool to assist programmers who develop with CyberCash; +# it is not meant to be a reflection of CyberCash's reliability. +# + +ad_proc cc_send_to_server_21 { txn_type args cc_output } { cybercash emulator proc } { +## txn_type is mauthonly, postauth, retry, void, return, capture + + # level_of_success is used for just about all transaction types + set level_of_success [random] + + if { $txn_type == "mauthonly" || $txn_type == "retry"} { + # retry is treated the same as mauthonly because we happen to only use retry + # after a failed mauthonly (not after a failed anything else) in Shoppe + if { $level_of_success < 0.8 } { + # successful authorization + ns_set put $cc_output "MStatus" "success" + ns_set put $cc_output "aux-msg" "Financial Institute Response: authorization approved" + ns_set put $cc_output "auth-code" [expr round([random] * 100000)] + ns_set put $cc_output "action-code" "000" + ns_set put $cc_output "merch-txn" [expr round([random] * 10000000)] + + # generate an avs code + set avs_random_number [random] + if { $avs_random_number < 0.1 } { + set avs_code "A" + } elseif { $avs_random_number >= 0.1 && $avs_random_number < 0.3 } { + set avs_code "N" + } elseif { $avs_random_number >= 0.3 && $avs_random_number < 0.4 } { + set avs_code "U" + } elseif { $avs_random_number >= 0.4 && $avs_random_number < 0.5 } { + set avs_code "Y" + } else { + set avs_code "Z" + } + + ns_set put $cc_output "avs-code" $avs_code + } elseif { $level_of_success >= 0.8 && $level_of_success < 0.9 } { + # failure hard, fails LUHN-10 check + ns_set put $cc_output "MStatus" "failure-hard" + ns_set put $cc_output "MErrLoc" "smps" + ns_set put $cc_output "MErrMsg" "Credit card number '[ns_set get $args "card-number"]' fails LUHN-10 check" + + } elseif { $level_of_success >= 0.9 && $level_of_success < 0.92 } { + # failure-bad-money + ns_set put $cc_output "MStatus" "failure-bad-money" + ns_set put $cc_output "MErrLoc" "smps" + ns_set put $cc_output "MErrMsg" "Financial Institution Response: Declined, bad card. Call card issuer." + ns_set put $cc_output "merch-txn" [expr round([random] * 1000000)] + } elseif { $level_of_success >= 0.92 && $level_of_success < 0.94 } { + # failure-q-or-cancel + ns_set put $cc_output "MStatus" "failure-q-or-cancel" + ns_set put $cc_output "MErrLoc" "smps" + ns_set put $cc_output "MErrMsg" "Error while reading message from the Cybercash gateway: parse_http: Premature EOF read from socket. HTTP body is missing. A likely reason: server did not respond or dropped a connection" + } elseif { $level_of_success >= 0.94 && $level_of_success < 0.96 } { + # couldn't connect to MPS + ns_set put $cc_output "MStatus" "failure-hard" + ns_set put $cc_output "MErrLoc" "SYSTEM" + ns_set put $cc_output "MErrMsg" "Could not connect to Merchant Payment Server, possibly it is not running or your configuration is incorrect" + } elseif { $level_of_success >= 0.96 && $level_of_success < 0.98 } { + # timeout + ns_set put $cc_output "MStatus" "failure-hard" + ns_set put $cc_output "MErrLoc" "INTERNAL" + ns_set put $cc_output "MErrMsg" "Payment Server failed to respond in a timely manner." + } else { + # generic failure + ns_set put $cc_output "MStatus" "failure-hard" + ns_set put $cc_output "MErrLoc" "ccsp" + ns_set put $cc_output "MErrMsg" "Invalid credit card number." + ns_set put $cc_output "merch-txn" [expr round([random] * 1000000)] + } + # end of mauthonly section + } elseif { $txn_type == "postauth" } { + if { $level_of_success < 0.97 } { + ns_set put $cc_output "MStatus" "success" + ns_set put $cc_output "aux-msg" "Order [ns_set get $args "order-id"] is successfully marked for batching." + } else { + ns_set put $cc_output "MStatus" "failure-hard" + ns_set put $cc_output "MErrLoc" "SYSTEM" + ns_set put $cc_output "MErrMsg" "Could not connect to Merchant Payment Server, possibly it is not running or your configuration is incorrect" + } + # end of postauth section + } elseif { $txn_type == "return" } { + if { $level_of_success < 0.97 } { + ns_set put $cc_output "MStatus" "success" + ns_set put $cc_output "aux-msg" "Order [ns_set get $args "order-id"] is successfully marked for batching as a return." + } else { + ns_set put $cc_output "MStatus" "failure-hard" + ns_set put $cc_output "MErrLoc" "SYSTEM" + ns_set put $cc_output "MErrMsg" "Could not connect to Merchant Payment Server, possibly it is not running or your configuration is incorrect" + } + # end of return section + } elseif { $txn_type == "void" } { + # it doesn't matter if the txn-type is "marked" or "markret" -- the message from CyberCash + # is the same + if { $level_of_success < 0.97 } { + ns_set put $cc_output "MStatus" "success" + ns_set put $cc_output "aux-msg" "Order [ns_set get $args "order-id"] is successfully voided." + } else { + ns_set put $cc_output "MStatus" "failure-hard" + ns_set put $cc_output "MErrLoc" "SYSTEM" + ns_set put $cc_output "MErrMsg" "Could not connect to Merchant Payment Server, possibly it is not running or your configuration is incorrect" + } + # end of void section + } elseif { $txn_type == "query" } { + # this is going to be tedious to code... + + set db [ns_db gethandle subquery] + + set selection [ns_db 0or1row $db "select to_char(authorized_date,'YYYYMMDDHH24MISS') as authorized_date, cc_auth_status, cc_auth_txn_id, cc_auth_auth_code, cc_auth_action_code, cc_auth_avs_code, to_char(postauth_date, 'YYYYMMDDHH24MISS') as postauth_date, cc_post_status, cc_post_txn_id, cc_post_auth_code, to_char(cc_sett_date,'YYYYMMDDHH24MISS') as cc_sett_date, cc_sett_status, cc_sett_txn_id, cc_sett_auth_code, cc_sett_batch_id, to_char(return_date,'YYYYMMDDHH24MISS') as return_date, refunded_amount, cc_retn_status, cc_retn_txn_id, cc_retn_auth_code, to_char(cc_sret_date,'YYYYMMDDHH24MISS') as cc_sret_date, cc_sret_status, cc_sret_txn_id, cc_sret_auth_code, cc_sret_batch_id, to_char(void_marked_date,'YYYYMMDDHH24MISS') as void_marked_date, cc_vdmk_status, cc_vdmk_txn_id, cc_vdmk_auth_code, to_char(void_markret_date,'YYYYMMDDHH24MISS') as void_markret_date, cc_vdrn_status, cc_vdrn_txn_id, cc_vdrn_auth_code, currency, price_charged + from sh_orders + where order_id=[ns_set get $args "order-id"]"] + if { $selection != "" } { + set_variables_after_query + + ns_set put $cc_output "MStatus" "success" + + if { [string compare $authorized_date ""] != 0 } { + ns_set put $cc_output "a1" "order-id=[ns_set get $args "order-id"]&merch-txn=$cc_auth_txn_id&cust-txn=$cc_auth_txn_id&origin=m&txn-type=auth&txn-status=$cc_auth_status&cust-id=xxxxxx&card-type=xx&card-number=(first 2 and last 4 digits only)&card-exp=xx/xx&amount=$currency $price_charged&time=$authorized_date.000&auth_code=$cc_auth_auth_code&ref-code=&action-code=$cc_auth_action_code&batch-id=&avs-code=$cc_auth_avs_code" + } + if { [string compare $postauth_date "" ] != 0 } { + ns_set put $cc_output "a2" "order-id=[ns_set get $args "order-id"]&merch-txn=$cc_post_txn_id&cust-txn=$cc_auth_txn_id&origin=m&txn-type=marked&txn-status=$cc_post_status&cust-id=xxxxxx&card-type=xx&card-number=(first 2 and last 4 digits only)&card-exp=xx/xx&amount=$currency $price_charged&time=$postauth_date.000&auth_code=$cc_auth_auth_code&ref-code=&action-code=$cc_auth_action_code&batch-id=&avs-code=$cc_auth_avs_code" + } + if { [string compare $cc_sett_date "" ] != 0 } { + ns_set put $cc_output "a3" "order-id=[ns_set get $args "order-id"]&merch-txn=$cc_sett_txn_id&cust-txn=&origin=m&txn-type=settled&txn-status=$cc_sett_status&cust-id=xxxxxx&card-type=xx&card-number=(first 2 and last 4 digits only)&card-exp=xx/xx&amount=$currency $price_charged&time=$cc_sett_date.000&auth_code=$cc_auth_auth_code&ref-code=&action-code=$cc_auth_action_code&batch-id=$cc_sett_batch_id&avs-code=$cc_auth_avs_code" + } + if { [string compare $return_date "" ] != 0 } { + ns_set put $cc_output "a4" "order-id=[ns_set get $args "order-id"]&merch-txn=$cc_retn_txn_id&cust-txn=&origin=m&txn-type=markret&txn-status=$cc_retn_status&cust-id=xxxxxx&card-type=xx&card-number=(first 2 and last 4 digits only)&card-exp=xx/xx&amount=$currency $refunded_amount&time=$return_date.000&auth_code=$cc_auth_auth_code&ref-code=&action-code=&batch-id=&avs-code=$cc_auth_avs_code" + } + if { [string compare $cc_sret_date "" ] != 0 } { + ns_set put $cc_output "a5" "order-id=[ns_set get $args "order-id"]&merch-txn=$cc_sret_txn_id&cust-txn=&origin=m&txn-type=setlret&txn-status=$cc_sret_status&cust-id=xxxxxx&card-type=xx&card-number=(first 2 and last 4 digits only)&card-exp=xx/xx&amount=$currency $refunded_amount&time=$cc_sret_date.000&auth_code=$cc_auth_auth_code&ref-code=&action-code=&batch-id=$cc_sret_batch_id&avs-code=$cc_auth_avs_code" + } + if { [string compare $void_marked_date "" ] != 0 } { + ns_set put $cc_output "a6" "order-id=[ns_set get $args "order-id"]&merch-txn=$cc_vdmk_txn_id&cust-txn=$cc_auth_txn_id&origin=m&txn-type=voidmark&txn-status=$cc_vdmk_status&cust-id=xxxxxx&card-type=xx&card-number=(first 2 and last 4 digits only)&card-exp=xx/xx&amount=$currency $price_charged&time=$void_marked_date.000&auth_code=$cc_auth_auth_code&ref-code=&action-code=000&batch-id=&avs-code=$cc_auth_avs_code" + } + if { [string compare $void_markret_date "" ] != 0 } { + ns_set put $cc_output "a7" "order-id=[ns_set get $args "order-id"]&merch-txn=$cc_vdrn_txn_id&cust-txn=$cc_auth_txn_id&origin=m&txn-type=voidreturn&txn-status=$cc_vdrn_status&cust-id=xxxxxx&card-type=xx&card-number=(first 2 and last 4 digits only)&card-exp=xx/xx&amount=$currency $refunded_amount&time=$void_markret_date.000&auth_code=$cc_auth_auth_code&ref-code=&action-code=000&batch-id=&avs-code=$cc_auth_avs_code" + } + + + # end of selection not empty + } + + # end of query + } + +# end of proc +} Index: openacs-4/packages/ecommerce/tcl/ec-audit-trail-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ecommerce/tcl/ec-audit-trail-procs.tcl,v diff -u -N -r1.1 -r1.2 --- openacs-4/packages/ecommerce/tcl/ec-audit-trail-procs.tcl 20 Apr 2001 20:51:13 -0000 1.1 +++ openacs-4/packages/ecommerce/tcl/ec-audit-trail-procs.tcl 18 Jul 2001 18:19:01 -0000 1.2 @@ -215,12 +215,13 @@ return $return_string } -proc ec_audit_process_row {} { - # internal proc for ec_audit_trail - # Sets audit_entry to the HTML fragement representing one line - # from the audit table or main table. - # First it identifies whether the row was a delete, update, or insert - # Second, it builds a table of values that changed from the last row +ad_proc ec_audit_process_row { } { + internal proc for ec_audit_trail + Sets audit_entry to the HTML fragement representing one line + from the audit table or main table. + First it identifies whether the row was a delete, update, or insert + Second, it builds a table of values that changed from the last row +} { uplevel { Index: openacs-4/packages/ecommerce/tcl/ec-style-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ecommerce/tcl/Attic/ec-style-procs.tcl,v diff -u -N -r1.1 -r1.2 --- openacs-4/packages/ecommerce/tcl/ec-style-procs.tcl 20 Apr 2001 20:51:13 -0000 1.1 +++ openacs-4/packages/ecommerce/tcl/ec-style-procs.tcl 18 Jul 2001 18:19:01 -0000 1.2 @@ -7,7 +7,7 @@ @author ported by Jerry Asher (jerry@theashergroup.com) } -proc_doc ec_register_styletag { +ad_proc ec_register_styletag { tagname tag_documentation proc_body } { @@ -20,14 +20,14 @@ ns_share ec_styletag ns_share ec_styletag_source_file set generated_proc_name "ec_style_$tagname" - proc_doc $generated_proc_name {{string ""} {tagset ""}} "Proc generated by ec_register_styletag to support the $tagname ADP tag." $proc_body + ad_proc $generated_proc_name {{string ""} {tagset ""}} "Proc generated by ec_register_styletag to support the $tagname ADP tag." $proc_body # let's register the ADP tag now ns_register_adptag $tagname "/$tagname" $generated_proc_name set ec_styletag($tagname) $tag_documentation set ec_styletag_source_file($tagname) [info script] } -proc ec_style_template_root_internal {} { +ad_proc ec_style_template_root_internal {} { returns template root } { set templateroot [util_memoize {ad_parameter -package_id [ec_id] TemplateRoot "style"} [ec_cache_refresh]] if {[empty_string_p $templateroot]} { return [ec_url_concat [ec_pageroot] templates] @@ -41,13 +41,13 @@ } } -proc ec_style_template_root {} { +ad_proc ec_style_template_root {} { caches template root } { return [util_memoize {ec_style_template_root_internal} [ec_cache_refresh]] } # per /doc/style.html we standardize on "language_preference" # and "prefer_text_only_p" as the names of the cookies -proc ec_style_language_from_cookie {} { +ad_proc ec_style_language_from_cookie {} { returns language preference from cookie } { set headers [ns_conn headers] set cookie [ns_set get $headers Cookie] if { [regexp {language_preference=([^;]+)} $cookie {} language_preference] } { @@ -57,7 +57,7 @@ } } -proc ec_style_plain_fancy_from_cookie {} { +ad_proc ec_style_plain_fancy_from_cookie {} { returns fancy or text only preference from cookie } { set headers [ns_conn headers] set cookie [ns_set get $headers Cookie] if { [regexp {prefer_text_only_p=([^;]+)} $cookie {} prefer_text_only_p] } { @@ -72,7 +72,7 @@ } } -proc_doc ec_style_user_preferences_from_db {user_id} { +ad_proc ec_style_user_preferences_from_db {user_id} { Returns a list of prefer_text_only_p and language_preference from the user_preferences table; probably you should call this within a util_memoize so that you aren't kicking the stuffing out of Oracle. @@ -89,16 +89,17 @@ return $result_list } -# takes list of raw filenames and returns a list of lists -# (each sublist is score then filename) -# we give a template scores as follows: -# 2000 for having the user's preferred language -# 1000 for having the site's default language -# 200 for having the user's default plain/fanciness -# 100 for having the site's default plain/fanciness -# subtract the length of the filename so that shorter ones have precedence -# (note that language outweighs graphical fanciness) -proc ec_style_score_templates {template_filename_list} { +ad_proc ec_style_score_templates {template_filename_list} { +takes list of raw filenames and returns a list of lists + (each sublist is score then filename) + we give a template scores as follows: + 2000 for having the user's preferred language + 1000 for having the site's default language + 200 for having the user's default plain/fanciness + 100 for having the site's default plain/fanciness + subtract the length of the filename so that shorter ones have precedence + (note that language outweighs graphical fanciness) + } { # set defaults set user_preferred_language "" set user_preferred_plain_fancy "" @@ -149,7 +150,7 @@ return $result_list } -proc ec_style_sort_by_score {l1 l2} { +ad_proc ec_style_sort_by_score {l1 l2} { sorts by score } { if { [lindex $l1 0] < [lindex $l2 0] } { return -1 } elseif { [lindex $l1 0] == [lindex $l2 0] } { @@ -159,7 +160,7 @@ } } -proc_doc ec_return_template { +ad_proc ec_return_template { { file_name "" } { cache_p 1 } } { Index: openacs-4/packages/ecommerce/tcl/ecommerce-credit-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ecommerce/tcl/ecommerce-credit-procs.tcl,v diff -u -N -r1.1 -r1.2 --- openacs-4/packages/ecommerce/tcl/ecommerce-credit-procs.tcl 20 Apr 2001 20:51:13 -0000 1.1 +++ openacs-4/packages/ecommerce/tcl/ecommerce-credit-procs.tcl 18 Jul 2001 18:19:01 -0000 1.2 @@ -10,28 +10,30 @@ } -# If transaction_id is null, it tries to do an auth for the entire -# order; otherwise it tries to do an auth for the tranaction_amount. -# You can leave order_id blank if you're using a transaction_id -# (useful for gift certificates). -proc ec_creditcard_authorization { order_id {transaction_id ""} } { +ad_proc ec_creditcard_authorization { order_id {transaction_id ""} } { + does a credit card auth +} { + # Gets info it needs from database. + # Calls ec_talk_to_cybercash to authorize card (which in turn writes a line + # to the ec_cybercash_log table). + # Outputs one of the following strings, corresponding to the level of + # authorization: + # (a) failed_authorization + # (b) authorized_plus_avs + # (c) authorized_minus_avs + # (d) no_recommendation + # (e) invalid_input + # Case (d) occurs when CyberCash gives an error that is unrelated to + # the credit card used, such as timeout or failure-q-or-cancel. + # Case (e) occurs when there are no orders with the given order_id + # or with no billing_zip_code. This case shouldn't + # happen, since this proc is called from a tcl script with known + # order_id, and billing_zip_code shouldn't be null. - # Gets info it needs from database. - # Calls ec_talk_to_cybercash to authorize card (which in turn writes a line - # to the ec_cybercash_log table). - # Outputs one of the following strings, corresponding to the level of - # authorization: - # (a) failed_authorization - # (b) authorized_plus_avs - # (c) authorized_minus_avs - # (d) no_recommendation - # (e) invalid_input - # Case (d) occurs when CyberCash gives an error that is unrelated to - # the credit card used, such as timeout or failure-q-or-cancel. - # Case (e) occurs when there are no orders with the given order_id - # or with no billing_zip_code. This case shouldn't - # happen, since this proc is called from a tcl script with known - # order_id, and billing_zip_code shouldn't be null. + # If transaction_id is null, it tries to do an auth for the entire + # order; otherwise it tries to do an auth for the tranaction_amount. + # You can leave order_id blank if you're using a transaction_id + # (useful for gift certificates). if { [empty_string_p $transaction_id] } { @@ -183,36 +185,36 @@ return $level } -proc ec_creditcard_marking { transaction_id } { +ad_proc ec_creditcard_marking { transaction_id } { performs credit card marking +} { + # Gets info it needs from database. + # Calls ec_talk_to_cybercash to mark transaction for batching (which in turn + # writes a line to the ec_cybercash_log table). + # Outputs one of the following strings corresponding to whether or + # not the marking was successful: + # (a) success + # (b) failure + # (c) invalid_input + # (d) unknown + # In most instances, case (a) will occur because there are few + # chances for failure; CyberCash is not contacting the processor, + # and the card number has already been determined to be valid. + # Case (b) may occur, for instance, if there is a communications + # failure with CyberCash. Also, CyberCash will fail a postauth + # if the transaction has already been marked or if the postauth amount + # is higher than the original authorized amount. Of course, the + # .tcl script that calls this proc shouldn't be trying to mark an + # transaction that's already been marked and, because the transaction + # amount is stored in the database , there should be no + # discrepancy in the auth amount and the postauth amount. + # Case (c) occurs if there is no transaction with the given transaction_id. + # If case (c) occurs, then there is probably an error in + # the .tcl script that called this proc. + # Case (d) is not expected to occur. This proc outputs "unknown" + # if cases (a), (b) and (c) do not apply. ns_log Notice "begin ec_creditcard_marking on transaction $transaction_id" - # Gets info it needs from database. - # Calls ec_talk_to_cybercash to mark transaction for batching (which in turn - # writes a line to the ec_cybercash_log table). - # Outputs one of the following strings corresponding to whether or - # not the marking was successful: - # (a) success - # (b) failure - # (c) invalid_input - # (d) unknown - # In most instances, case (a) will occur because there are few - # chances for failure; CyberCash is not contacting the processor, - # and the card number has already been determined to be valid. - # Case (b) may occur, for instance, if there is a communications - # failure with CyberCash. Also, CyberCash will fail a postauth - # if the transaction has already been marked or if the postauth amount - # is higher than the original authorized amount. Of course, the - # .tcl script that calls this proc shouldn't be trying to mark an - # transaction that's already been marked and, because the transaction - # amount is stored in the database , there should be no - # discrepancy in the auth amount and the postauth amount. - # Case (c) occurs if there is no transaction with the given transaction_id. - # If case (c) occurs, then there is probably an error in - # the .tcl script that called this proc. - # Case (d) is not expected to occur. This proc outputs "unknown" - # if cases (a), (b) and (c) do not apply. - set transaction_amount [db_string transaction_amount_select { select transaction_amount from ec_financial_transactions where transaction_id = :transaction_id } -default ""] @@ -255,31 +257,31 @@ return $mark_status } -proc ec_creditcard_return { transaction_id } { - # Calls ec_talk_to_cybercash to mark order for return (which in turn - # writes a line to the ec_cybercash_log table). - # Outputs one of the following strings corresponding to whether or - # not the marking was successful: - # (a) success - # (b) failure - # (c) invalid_input - # (d) unknown - # In most instances, case (a) will occur because there are few - # chances for failure; CyberCash is not contacting the processor, - # and the card number has already been determined to be valid. - # Case (b) may occur, for instance, if there is a communications - # failure with CyberCash. Also, CyberCash will fail a return - # if the order has already been marked for return, if the return - # has been settled, or if the return - # amount is higher than the settled amount. Of course, the - # .tcl script that calls this proc shouldn't be trying to mark an - # transaction for return that's has already had a return marked or settled. - # Case (c) occurs if there is no transaction with the given transaction_id, or - # if the transaction_amount column is empty for that transaction - # If case (c) occurs, then there is probably an error in - # the .tcl script that called this proc. - # Case (d) is not expected to occur. This proc outputs "unknown" - # if cases (a), (b) and (c) do not apply. +ad_proc ec_creditcard_return { transaction_id } { marks order for return } { + # Calls ec_talk_to_cybercash to mark order for return (which in turn + # writes a line to the ec_cybercash_log table). + # Outputs one of the following strings corresponding to whether or + # not the marking was successful: + # (a) success + # (b) failure + # (c) invalid_input + # (d) unknown + # In most instances, case (a) will occur because there are few + # chances for failure; CyberCash is not contacting the processor, + # and the card number has already been determined to be valid. + # Case (b) may occur, for instance, if there is a communications + # failure with CyberCash. Also, CyberCash will fail a return + # if the order has already been marked for return, if the return + # has been settled, or if the return + # amount is higher than the settled amount. Of course, the + # .tcl script that calls this proc shouldn't be trying to mark an + # transaction for return that's has already had a return marked or settled. + # Case (c) occurs if there is no transaction with the given transaction_id, or + # if the transaction_amount column is empty for that transaction + # If case (c) occurs, then there is probably an error in + # the .tcl script that called this proc. + # Case (d) is not expected to occur. This proc outputs "unknown" + # if cases (a), (b) and (c) do not apply. if { ![db_0or1row transaction_info_select { @@ -332,15 +334,15 @@ } } -proc_doc ec_get_from_quasi_form {quasi_form key} "CyberCash sometimes gives us a value back that is itself key/value pairs but in standard HTTP request form (e.g., \"foo=5&bar=7\"). We couldn't find an AOLserver API call that pulls this apart (though obviously the code is there somewhere, presumably in C)." { +ad_proc ec_get_from_quasi_form {quasi_form key} "CyberCash sometimes gives us a value back that is itself key/value pairs but in standard HTTP request form (e.g., \"foo=5&bar=7\"). We couldn't find an AOLserver API call that pulls this apart (though obviously the code is there somewhere, presumably in C)." { if [regexp "$key=(\[^&\]*)" $quasi_form match the_value] { return $the_value } else { return "" } } -proc_doc ec_talk_to_cybercash { txn_attempted_type cc_args } "This procedure talks to CyberCash to do whatever transaction is specified, adds a row to the ec_cybercash_log table, and returns all of CyberCash's output in an ns_set" { +ad_proc ec_talk_to_cybercash { txn_attempted_type cc_args } "This procedure talks to CyberCash to do whatever transaction is specified, adds a row to the ec_cybercash_log table, and returns all of CyberCash's output in an ns_set" { # Possible values of txn_attempted_type are listed below and # in the data model (in the ec_cybercash_log table). @@ -581,7 +583,7 @@ return $ttcc_output } -proc_doc ec_avs_acceptable_p {avs_code_from_cybercash} "Returns 1 if the AVS code is acceptable (implying that the consumer address sufficiently matches the creditor's records), or 0 otherwise" { +ad_proc ec_avs_acceptable_p {avs_code_from_cybercash} "Returns 1 if the AVS code is acceptable (implying that the consumer address sufficiently matches the creditor's records), or 0 otherwise" { set acceptable_codes [list A W X Y Z] if { [lsearch $acceptable_codes $avs_code_from_cybercash] != -1 } { # code was valid @@ -591,7 +593,7 @@ } } -proc_doc ec_date_to_cybercash_date_for_query { the_date n_hours_to_add } "turns date in the format YYYY-MM-DD HH24:MI:SS into CyberCash's format yyyymmddhhmmss with n_hours_to_add hours added because CyberCash uses GMT" { +ad_proc ec_date_to_cybercash_date_for_query { the_date n_hours_to_add } "turns date in the format YYYY-MM-DD HH24:MI:SS into CyberCash's format yyyymmddhhmmss with n_hours_to_add hours added because CyberCash uses GMT" { return [db_string cybercash_date_create { select to_char(:n_hours_to_add / 24 + to_date(:the_date, 'YYYY-MM-DD HH24:MI:SS'), 'YYYYMMDDHH24MISS') from dual }] @@ -610,7 +612,7 @@ # m=mastercard, v=visa, a=american express # ec_check_creditcard_type_number_match -proc ec_creditcard_precheck { creditcard_number creditcard_type } { +ad_proc ec_creditcard_precheck { creditcard_number creditcard_type } { prechecks credit card numbers } { set exception_count 0 set exception_text "" @@ -716,7 +718,7 @@ # # Original name: valCC -proc ec_creditcard_validation {numIn} { +ad_proc ec_creditcard_validation {numIn} { validates credit card number } { regsub -all { } $numIn {} entered_number set num [split $entered_number {}] ; # a list form of the number set numLen [llength $num] ; # the number of digits in the entered number Index: openacs-4/packages/ecommerce/tcl/ecommerce-customer-service-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ecommerce/tcl/ecommerce-customer-service-procs.tcl,v diff -u -N -r1.1 -r1.2 --- openacs-4/packages/ecommerce/tcl/ecommerce-customer-service-procs.tcl 20 Apr 2001 20:51:13 -0000 1.1 +++ openacs-4/packages/ecommerce/tcl/ecommerce-customer-service-procs.tcl 18 Jul 2001 18:19:01 -0000 1.2 @@ -10,7 +10,7 @@ } -proc ec_customer_service_email_address { {user_identification_id ""} {issue_id ""}} { +ad_proc ec_customer_service_email_address { {user_identification_id ""} {issue_id ""}} { returns the customer server email address } { return [util_memoize {ad_parameter -package_id [ec_id] CustomerServiceEmailAddress ecommerce} [ec_cache_refresh]] } @@ -28,17 +28,17 @@ } } -# Creates an issue, interaction, and action and closes the issue. -# Either user_id or user_identification_id should be non-null. -# Often ec_customer_service_simple_issue is called from another -# procedure within a transaction, so you will not want to begin/end -# a transaction within ec_customer_service_simple_issue. In these -# cases, leave begin_new_transaction_p as "f". +ad_proc ec_customer_service_simple_issue { customer_service_rep interaction_originator interaction_type interaction_headers order_id issue_type_list action_details {user_id ""} {user_identification_id ""} {begin_new_transaction_p "f"} {gift_certificate_id ""} } { + Creates an issue, interaction, and action and closes the issue. + Either user_id or user_identification_id should be non-null. + Often ec_customer_service_simple_issue is called from another + procedure within a transaction, so you will not want to begin/end + a transaction within ec_customer_service_simple_issue. In these + cases, leave begin_new_transaction_p as "f". -# (Seb 20000817) Since Oracle driver now supports nested transactions -# we will, for the time being, simply ignore begin_new_transaction_p. - -proc ec_customer_service_simple_issue { customer_service_rep interaction_originator interaction_type interaction_headers order_id issue_type_list action_details {user_id ""} {user_identification_id ""} {begin_new_transaction_p "f"} {gift_certificate_id ""} } { + (Seb 20000817) Since Oracle driver now supports nested transactions + we will, for the time being, simply ignore begin_new_transaction_p. +} { set issue_id [db_string get_ec_issue_seq "select ec_issue_id_sequence.NEXTVAL from dual"] if { ![empty_string_p $user_id] } { @@ -108,8 +108,7 @@ return [list $user_identification_id $issue_id] } -# either user_id or user_identification_id should be non-empty -proc ec_all_cs_issues_by_one_user { {user_id ""} {user_identification_id ""} } { +ad_proc ec_all_cs_issues_by_one_user { {user_id ""} {user_identification_id ""} } { lists all issues by user_id or user_identification } { set to_return "
    " if { ![empty_string_p $user_id] } { Index: openacs-4/packages/ecommerce/tcl/ecommerce-money-computations-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ecommerce/tcl/ecommerce-money-computations-procs.tcl,v diff -u -N -r1.1 -r1.2 --- openacs-4/packages/ecommerce/tcl/ecommerce-money-computations-procs.tcl 20 Apr 2001 20:51:13 -0000 1.1 +++ openacs-4/packages/ecommerce/tcl/ecommerce-money-computations-procs.tcl 18 Jul 2001 18:19:01 -0000 1.2 @@ -18,7 +18,7 @@ @author ported by Jerry Asher (jerry@theashergroup.com) } -proc ec_lowest_price_and_price_name_for_an_item { product_id user_id {offer_code ""} } { +ad_proc ec_lowest_price_and_price_name_for_an_item { product_id user_id {offer_code ""} } { returns the lowest price and price name for an item } { set lowest_price 0 set lowest_price_name "" set reg_price [db_string get_price "select price from ec_products where product_id=:product_id"] @@ -73,7 +73,7 @@ # I've included the product_id, order_id, and shipping_method in the arguments because they're # always already known in any environment where I intend to call this procedure, so I might as # well save two database hits. -proc ec_shipping_price_for_one_item {item_id product_id order_id shipping_method} { +ad_proc ec_shipping_price_for_one_item {item_id product_id order_id shipping_method} { returns the shipping price for one item } { # get shipping, shipping_additional, default_shipping_per_item, weight, weight_shipping_cost # to determine regular shipping price @@ -122,7 +122,7 @@ # because they are constant, so I don't want to have to pull them from the database each # time (this procedure is called from within a loop) # For preconfirmed orders. -proc ec_price_price_name_shipping_price_tax_shipping_tax_for_one_item { product_id offer_code item_id order_id shipping_method user_class_id_list default_shipping_per_item weight_shipping_cost add_exp_amount_per_item add_exp_amount_by_weight tax_rate shipping_p } { +ad_proc ec_price_price_name_shipping_price_tax_shipping_tax_for_one_item { product_id offer_code item_id order_id shipping_method user_class_id_list default_shipping_per_item weight_shipping_cost add_exp_amount_per_item add_exp_amount_by_weight tax_rate shipping_p } { Returns price, price_name, shipping, price_tax, and shipping_tax (all in a list) for one item. } { ## ## Part 1: Get Price & Price Name @@ -247,7 +247,7 @@ # for not yet confirmed orders # Note: the price it shows is really price charged minus price refunded, similarly # for shipping and tax. -proc ec_price_shipping_gift_certificate_and_tax_in_an_order { order_id } { +ad_proc ec_price_shipping_gift_certificate_and_tax_in_an_order { order_id } { returns a list containing the total price, total shipping, gift_certificate amount and total tax for an order } { db_1row get_confirmed_info { select confirmed_date, user_id, Index: openacs-4/packages/ecommerce/tcl/ecommerce-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ecommerce/tcl/ecommerce-procs.tcl,v diff -u -N -r1.2 -r1.3 --- openacs-4/packages/ecommerce/tcl/ecommerce-procs.tcl 15 Jul 2001 05:47:18 -0000 1.2 +++ openacs-4/packages/ecommerce/tcl/ecommerce-procs.tcl 18 Jul 2001 18:19:01 -0000 1.3 @@ -212,7 +212,7 @@ # current_location can be "Shopping Cart", "Your Account", "Home", or # any category_id -proc ec_footer { {current_location ""} {category_id ""} {search_text ""} } { +ad_proc ec_footer { {current_location ""} {category_id ""} {search_text ""} } { returns the ecommerce footer } { set to_return "
    [ec_search_widget $category_id $search_text] " @@ -250,7 +250,7 @@ } # For administrators -proc ec_shipping_cost_summary { base_shipping_cost default_shipping_per_item weight_shipping_cost add_exp_base_shipping_cost add_exp_amount_per_item add_exp_amount_by_weight } { +ad_proc ec_shipping_cost_summary { base_shipping_cost default_shipping_per_item weight_shipping_cost add_exp_base_shipping_cost add_exp_amount_per_item add_exp_amount_by_weight } { returns cost summary } { set currency [util_memoize {ad_parameter -package_id [ec_id] Currency ecommerce} [ec_cache_refresh]] @@ -301,7 +301,7 @@ } # for one product, displays the sub/sub/category info in a table. -proc_doc ec_category_subcategory_and_subsubcategory_display { category_list subcategory_list subsubcategory_list } "Returns an HTML table of category, subcategory, and subsubcategory information" { +ad_proc ec_category_subcategory_and_subsubcategory_display { category_list subcategory_list subsubcategory_list } "Returns an HTML table of category, subcategory, and subsubcategory information" { if { [empty_string_p $category_list] } { return "None Defined" @@ -364,13 +364,13 @@ return $to_return } -proc ec_product_name_internal {product_id} { +ad_proc ec_product_name_internal {product_id} { returns product name } { return [db_string product_name_select { select product_name from ec_products where product_id = :product_id } -default ""] } -proc_doc ec_product_name {product_id {value_if_not_found ""}} "Returns product name from product_id, memoized for efficiency" { +ad_proc ec_product_name {product_id {value_if_not_found ""}} "Returns product name from product_id, memoized for efficiency" { # throw an error if this isn't an integer (don't want security risk of user-entered # data being eval'd) validate_integer "product_id" $product_id @@ -382,12 +382,13 @@ } } -# given a category_id, subcategory_id, and subsubcategory_id -# (can be null), displays the full categorization, e.g. -# category_name: subcategory_name: subsubcategory_name. -# If you have a subcategory_id but not a category_id, this -# will look up the category_id to find the category_name. -proc ec_full_categorization_display { {category_id ""} {subcategory_id ""} {subsubcategory_id ""} } { +ad_proc ec_full_categorization_display { {category_id ""} {subcategory_id ""} {subsubcategory_id ""} } { +given a category_id, subcategory_id, and subsubcategory_id +(can be null), displays the full categorization, e.g. +category_name: subcategory_name: subsubcategory_name. +If you have a subcategory_id but not a category_id, this +will look up the category_id to find the category_name. +} { if { [empty_string_p $category_id] && [empty_string_p $subcategory_id] && [empty_string_p $subsubcategory_id] } { return "" } elseif { ![empty_string_p $subsubcategory_id] } { @@ -427,7 +428,10 @@ # subcategory/subsubcategory a product is in. # If the product is multiply categorized, this will just use the first categorization that # Oracle finds for this product. -proc ec_mailing_list_link_for_a_product { product_id } { +ad_proc ec_mailing_list_link_for_a_product { product_id } { +returns a link for the user to add him/herself to the mailing list for whatever category/subcategory/subsubcategory a product is in. +If the product is multiply categorized, this will just use the first categorization that Oracle finds for this product. +} { set category_id "" set subcategory_id "" set subsubcategory_id "" @@ -463,18 +467,19 @@ } } -proc ec_space_to_nbsp { the_string } { +ad_proc ec_space_to_nbsp { the_string } { converts space to html nbsp } { regsub -all " " $the_string "\\ " new_string return $new_string } -# Given a product's rating, if the star gifs exist, it will -# print out the appropriate # (to the nearest half); otherwise -# it will just say what the rating is (to the nearest half). -# The stars should be in the subdirectory /graphics of the ecommerce -# user pages and they should be named star-full.gif, star-empty.gif, -# star-half.gif -proc ec_display_rating { rating } { +ad_proc ec_display_rating { rating } { +Given a product's rating, if the star gifs exist, it will +print out the appropriate # (to the nearest half); otherwise +it will just say what the rating is (to the nearest half). +The stars should be in the subdirectory /graphics of the ecommerce +user pages and they should be named star-full.gif, star-empty.gif, +star-half.gif +} { set double_ave_rating [expr $rating * 2] set double_rounded_rating [expr round($double_ave_rating)] set rating_to_nearest_half [expr double($double_rounded_rating)/2] @@ -527,7 +532,7 @@ return $rating_to_print } -proc ec_product_links_if_they_exist { product_id } { +ad_proc ec_product_links_if_they_exist { product_id } { return product links } { set to_return "

    We think you may also be interested in:

      @@ -549,7 +554,7 @@ } } -proc ec_professional_reviews_if_they_exist { product_id } { +ad_proc ec_professional_reviews_if_they_exist { product_id } { returns professional reviews } { set product_reviews "" @@ -572,7 +577,7 @@ } # this won't show anything if ProductCommentsAllowP=0 -proc ec_customer_comments { product_id {comments_sort_by ""} {prev_page_url ""} {prev_args_list ""} } { +ad_proc ec_customer_comments { product_id {comments_sort_by ""} {prev_page_url ""} {prev_args_list ""} } { returns customer comments } { if { [util_memoize {ad_parameter -package_id [ec_id] ProductCommentsAllowP ecommerce} [ec_cache_refresh]] == 0 } { return "" @@ -645,13 +650,13 @@ return $to_return } -proc ec_add_to_cart_link { +ad_proc ec_add_to_cart_link { product_id {add_to_cart_button_text "Add to Cart"} {preorder_button_text "Pre-order This Now!"} {form_action "shopping-cart-add"} {order_id ""} -} { +} { returns cart link } { db_1row get_product_info_1 { select decode(sign(sysdate-available_date),1,1,null,1,0) as available_p, @@ -734,7 +739,7 @@ # current_location can be "Shopping Cart", "Your Account", "Home", or # any category_id -proc ec_navbar {{current_location ""}} { +ad_proc ec_navbar {{current_location ""}} { returns ec nav bar } { if { [string equal [lindex $current_location 0] checkout] } { set top_links "" @@ -813,7 +818,7 @@ # for_customer, as opposed to one for the admins # if show_item_detail_p is "t", then the user will see the tracking number, etc. -proc ec_order_summary_for_customer { order_id user_id {show_item_detail_p "f"} } { +ad_proc ec_order_summary_for_customer { order_id user_id {show_item_detail_p "f"} } { shows item details } { # display : # email address # shipping address (w/phone #) @@ -929,7 +934,7 @@ # (a) it's only used once, and # (b) it's extremely simple -proc ec_item_summary_in_confirmed_order { order_id {ul_p "f"}} { +ad_proc ec_item_summary_in_confirmed_order { order_id {ul_p "f"}} { item summary in confirmed order } { set item_list [list] @@ -971,7 +976,7 @@ } } -proc ec_item_summary_for_admins { order_id } { +ad_proc ec_item_summary_for_admins { order_id } { item summary for admins } { set item_list [list] @@ -1013,8 +1018,7 @@ } } -# produced a HTML form fragment for administrators to check off items that are fulfilled or received back -proc ec_items_for_fulfillment_or_return { order_id {for_fulfillment_p "t"} } { +ad_proc ec_items_for_fulfillment_or_return { order_id {for_fulfillment_p "t"} } { produced a HTML form fragment for administrators to check off items that are fulfilled or received back } { if { $for_fulfillment_p == "t" } { set item_view "ec_items_shippable" @@ -1070,7 +1074,7 @@ } } -proc ec_price_line { product_id user_id {offer_code "" } {order_confirmed_p "f"} } { +ad_proc ec_price_line { product_id user_id {offer_code "" } {order_confirmed_p "f"} } { returns the price line } { set lowest_price_and_price_name [ec_lowest_price_and_price_name_for_an_item $product_id $user_id $offer_code] set lowest_price_description [lindex $lowest_price_and_price_name 1] @@ -1081,7 +1085,7 @@ return "$lowest_price_description [ec_pretty_price [lindex $lowest_price_and_price_name 0] $currency]" } -proc_doc ec_product_review_summary {author_name publication review_date} "Returns a one-line user-readable summary of a product review" { +ad_proc ec_product_review_summary {author_name publication review_date} "Returns a one-line user-readable summary of a product review" { set result_list [list] if ![empty_string_p $author_name] { lappend result_list $author_name @@ -1095,7 +1099,7 @@ return [join $result_list ", "] } -proc ec_order_summary_for_admin { order_id first_names last_name confirmed_date order_state user_id} { +ad_proc ec_order_summary_for_admin { order_id first_names last_name confirmed_date order_state user_id} { returns order summary for admins } { set to_return "$order_id : $first_names $last_name\n" if { [exists_and_not_null confirmed_date] } { append to_return " on [ec_IllustraDatetoPrettyDate $confirmed_date] " @@ -1109,7 +1113,7 @@ } } -proc ec_all_orders_by_one_user { user_id } { +ad_proc ec_all_orders_by_one_user { user_id } { returns all order for this user } { set to_return "
        \n" @@ -1137,7 +1141,7 @@ return $to_return } -proc ec_display_product_purchase_combinations { product_id } { +ad_proc ec_display_product_purchase_combinations { product_id } { display product purchase combinations } { # we don't want to return anything if either no purchase combinations # have been calculated or if no other products have been bought by # people who bought this product @@ -1173,7 +1177,7 @@ return $to_return } -proc ec_formatted_price_shipping_gift_certificate_and_tax_in_an_order {order_id} { +ad_proc ec_formatted_price_shipping_gift_certificate_and_tax_in_an_order {order_id} { returns formatted price } { set price_shipping_gift_certificate_and_tax [ec_price_shipping_gift_certificate_and_tax_in_an_order $order_id] @@ -1219,7 +1223,10 @@ # says how the items with a given product_id, color, size, style, price_charged, # and price_name in a given order shipped; the reason we put in all these parameters # is that item summaries group items in this manner -proc ec_shipment_summary_sub { product_id color_choice size_choice style_choice price_charged price_name order_id } { +ad_proc ec_shipment_summary_sub { product_id color_choice size_choice style_choice price_charged price_name order_id } { +says how the items with a given product_id, color, size, style, price_charged, +and price_name in a given order shipped; the reason we put in all these parameters is that item summaries group items in this manner +} { set shipment_list [list] @@ -1259,7 +1266,7 @@ #### #### obsoleted and subsited by www/product-file/index.vuh #### -### proc_doc ec_return_product_file { } "Returns a file for the product in the calling url." { +### ad_proc ec_return_product_file { } "Returns a file for the product in the calling url." { ### ### # Get file_path from url ### set is_url [ad_conn url] @@ -1284,7 +1291,7 @@ # Takes a database handle, the name associated with a form, # and the name of the textarea to insert into. -proc ec_canned_response_selector { form_name textarea_name } { +ad_proc ec_canned_response_selector { form_name textarea_name } { returns a canned response selector } { set selector_text " " } -# default is a list of all the items you want selected -proc ec_only_category_widget { {multiple_p "f"} {default ""} } { +ad_proc ec_only_category_widget { {multiple_p "f"} {default ""} } { category widget } { if { $multiple_p == "f" } { set select_tag "\n" } else { @@ -78,7 +75,7 @@ # gives a drop-down list and, if category_id_list is specified, it will display # the templates associated with those categories (if any) first -proc ec_template_widget { {category_id_list ""} {default ""} } { +ad_proc ec_template_widget { {category_id_list ""} {default ""} } { gives a drop-down list and, if category_id_list is specified, it will display the templates associated with those categories (if any) first } { set to_return "\n" set sql "select * from states order by state_name" @@ -179,7 +176,7 @@ return $widget_value } -proc ec_reach_widget { {default ""} } { +ad_proc ec_reach_widget { {default ""} } { reach widget } { set to_return "\n