#!/usr/local/qddb/bin/qtclsh
#
# buymonth.qtcl - buy timeblock for current REMOTE_USER (cgibin form)
#

set MODEMHOST dialup1
set ACCOUNTS_EMAIL_ANCHOR \
  "<A HREF=mailto:accounts@kayhay.com>email the accounting department</A>"
set ACCOUNTS_EMAIL "accounts@kayhay.com"

set WWWDB /var/lib/WWWutil/qdDBs/WWWutil
set WWWPROJECT MembersRoom
set CLIENTDB /var/lib/ISPutil/qdDBs/Clients
set TIMEBLOCK 20
set BLOCKCOST 10
set CURRENCY dollars
set ISPLOG /var/adm/isputil.log
set USER_TIMEADD /var/lib/BBSutil/user_timeadd
set SUPER "/usr/bin/super"

puts "Content-type: text/html"
puts ""

proc new_view {schema_desc tuple_desc array_name} {
  set l [qddb_schema leaves $schema_desc]
  foreach i $l {
    lappend attrs [list $i ${array_name}($i)]
  }
  return [qddb_view define $tuple_desc $attrs]
}


 set HEADER ""
 set FOOTER ""
set s [qddb_schema open $WWWDB]
set k [qddb_search $s -prunebyattr Name $WWWPROJECT]
set k [qddb_keylist process nullop -deldup_sameentry on $k]
set k [qddb_keylist process nullop -deldup_sameattr on $k]
set k [qddb_keylist get $k]
set k [lindex $k 0]
if {[llength $k] > 0} {
  set t [qddb_tuple read $s $k]
  if {[string length $t] != 0} {
    set v [qddb_view define $t {
      { Header arr(Header) }
      { Footer arr(Footer) }
    }]
    set HEADER $arr(Header)
    set FOOTER $arr(Footer)
  }
  qddb_tuple delete $t ;# free the memory
}
qddb_keylist delete $k
qddb_schema close $s

if {[info exists env(REMOTE_USER)]} {
  set uname $env(REMOTE_USER)
} else {
   set TITLE "Function requires logged-in user"
   puts [format $HEADER $TITLE $TITLE]
   puts "You have to be logged-in to the server for this to work,"
   puts "otherwise I have no idea who it is that wants more time!"
   puts $FOOTER
   exit 1
}


set changed 0
set TITLE "Online Month Purchase"
puts [format $HEADER $TITLE $TITLE]


proc print_form {} {
  global arr TIMEBLOCK BLOCKCOST CURRENCY
  puts "<P><FONT SIZE=+1>"
  puts "Purchase of one month of <STRONG>$TIMEBLOCK</STRONG> hours for"
  puts "<STRONG>$BLOCKCOST</STRONG> $CURRENCY plus taxes.<P>"
  puts "</FONT>"
  puts "<TABLE CELLPADDING=4>"
#  puts "<TR><TD><P>Credit Limit<TD ALIGN=RIGHT> $arr(CreditLimit)"
#  puts "<TR><TD><P>Current Balance<TD ALIGN=RIGHT> $arr(CurrentBalance)"
#  puts "<TR><TD><P>Pending Amounts<TD ALIGN=RIGHT> $arr(Pending)"
#  set neg [expr $arr(CurrentBalance) + $arr(Pending) + 5]
  set neg 0.00
  if { $arr(CreditLimit) < $neg } {
    puts "<TR><TD COLSPAN=2><P>"
    puts "<BLINK><STRONG>Sorry, you have insufficient credit</STRONG></BLINK>"
    puts "</TABLE>"
  } else {
    puts "</TABLE>"
    puts "<FORM METHOD=POST>"
    puts "<INPUT NAME=PIN TYPE=PASSWORD>"
    puts "</FORM>"
    puts "<P><FONT SIZE=+1>"
    puts "One month of <STRONG>$TIMEBLOCK</STRONG> hours will cost"
    puts "<STRONG>$BLOCKCOST</STRONG> $CURRENCY.<P>"
    set pst [expr 0.11 * $BLOCKCOST]
    set gst [expr 0.07 * [expr $BLOCKCOST + $pst]]
    set total [expr $BLOCKCOST + $pst + $gst]
    puts [format "In addition, there is %0.2f P.S.T." $pst]
    puts [format "plus %0.2f G.S.T. giving a grand" $gst]
    puts [format "total of %0.2f $CURRENCY altogether.<P>" $total]
    puts "</FONT>"
    puts "If that is acceptable, input your Personal Identity Number"
    puts "in your browser's search input to validate this request,"
    puts "purchasing $TIMEBLOCK hours of online time for $total"
    puts "$CURRENCY plus taxes.<P>"
  }
}

proc process_form {} {
  global arr value t TIMEBLOCK BLOCKCOST MODEMHOST USER_TIMEADD \
	SUPER CURRENCY ACCOUNTS_EMAIL changed uname
#  while {[qddb_tuple lock $t] == 0} {
#    exec sleep 1
#    puts "Record locked, retrying..."
#  }
  if {[string trim $value(PIN)]==[string trim $arr(Company.Contact.PIN)]} {
#    set arr(Company.Contact.Pending) \
#	[expr $arr(Company.Contact.Pending) + $BLOCKCOST]
#    set arr(Pending) [expr $arr(Pending) + $BLOCKCOST]
#    set changed 1
    exec $SUPER addpending $uname $BLOCKCOST
    exec $SUPER addmonths $uname 1
#    catch {exec hostname} host
#    if { $MODEMHOST == $host } {
#      exec $USER_TIMEADD $uname [expr 60.0 * $TIMEBLOCK]
#    } else {
#      exec rsh $MODEMHOST $USER_TIMEADD $uname [expr 60.0 * $TIMEBLOCK]
#    }
    set title "$arr(Company.Contact.Username) P.I.N. usage"
    set blurb "$arr(Company.Contact.Username) purchased a month\n"
    append blurb "of $TIMEBLOCK hours for $BLOCKCOST $CURRENCY\n"
    exec /bin/mail -s "$title" -c $ACCOUNTS_EMAIL $uname << $blurb
    log_it
    puts "<FONT SIZE=+1>Purchase completed, thank you!</FONT><P>"
  } else {
    set title "$arr(Company.Contact.Username) P.I.N. failure"
    set blurb "$arr(Company.Contact.Username) failed to purchase a month\n"
    append blurb "of $TIMEBLOCK hours for $BLOCKCOST $CURRENCY\n"
    append blurb "due to failure to provide correct P.I.N.\n"
    exec /bin/mail -s "$title" -c $ACCOUNTS_EMAIL $uname << $blurb
    puts "<P><FONT SIZE=+1><BLINK><STRONG>"
    puts "Incorrect Personal Identity Number (P.I.N.)"
    puts "</STRONG></BLINK></FONT><P>"
  }
}


proc no_PIN {} {
  global ACCOUNTS_EMAIL_ANCHOR
  puts "<P><FONT SIZE=+1>"
  puts "I'm sorry, but your account does not have a P.I.N."
  puts "(Personal Identification Number) activated."
  puts "If this is an oversight, $ACCOUNTS_EMAIL_ANCHOR"
  puts "to request P.I.N. activation.</FONT><P>"
}


if {[info exists env(CONTENT_LENGTH)]} {
  set message [split [read stdin $env(CONTENT_LENGTH)] &]
  foreach pair $message {
    set name [lindex [split $pair =] 0]
    set val [lindex [split $pair =] 1]
    regsub -all {\+} $val { } val
    # kludge to unescape chars
    regsub -all {\%0A} $val \n\t val
    regsub -all {\%2C} $val {,} val
    regsub -all {\%27} $val {'} val
    set value($name) $val
  }
}


proc log_it {} {
  global uname BLOCKCOST TIMEBLOCK ISPLOG
  catch {exec date} astr
  append astr " buymonth: $uname bought $uname \$$BLOCKCOST 1 month"
  set fd [open $ISPLOG a]
  puts $fd $astr
  flush $fd
  close $fd
}


set s [qddb_schema open $CLIENTDB]
set k [qddb_search $s -prunebyattr Company.Contact.Username $uname]
set k [qddb_keylist process nullop -deldup_sameentry on $k]
set k [qddb_keylist process nullop -deldup_sameattr on $k]
set k [qddb_keylist get $k]
set k [lindex $k 0]
if {[llength $k] > 0} {
  set t [qddb_tuple read $s $k]
  qddb_keylist delete $k
  if {[string length $t] != 0} {
    set v [new_view $s $t arr]
    if { [string trim $arr(Company.Contact.PIN)] == "" } {
      no_PIN
    } else {
      if {[info exists value(PIN)]} {
        process_form
      } else {
        print_form
      }
    }
  } else {
    puts "$uname: tuple is empty."
  }
  if { $changed } {
    qddb_tuple write $t  ;# write to disk
    log_it
    puts "<FONT SIZE=+1>Purchase completed, thank you!</FONT><P>"
  }
  qddb_tuple delete $t ;# free the memory
} else {
  puts "User \"$uname\" not found in database."
}
qddb_schema close $s
puts $FOOTER
