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

set ISPUTIL /var/lib/ISPutil
source $ISPUTIL/bin/init.tcl

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 Time Purchase"
puts [format $HEADER $TITLE $TITLE]
puts "<H2>Account making purchase: $env(REMOTE_USER)</H2>"

proc print_form {} {
  global arr TIMEBLOCK BLOCKCOST BLOCKCOST_EXPLAIN CURRENCY
  puts "<P><FONT SIZE=+1>"
  puts "Purchase 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) + $BLOCKCOST]
  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 "<P><FONT SIZE=+1>"
    puts "<STRONG>$TIMEBLOCK</STRONG> hours will cost"
    puts "<STRONG>$BLOCKCOST</STRONG> $CURRENCY.<P>"
    puts "$BLOCKCOST_EXPLAIN"
    puts "<P></FONT>"
    puts "If that is acceptable, input your Personal Identity Number"
    puts "to validate this request,"
    puts "purchasing $TIMEBLOCK hours of online time for $BLOCKCOST"
    puts "$CURRENCY including taxes.<P>"
    puts "(If you have no PIN enter NONE as your PIN)<P>"
    puts "<FORM METHOD=POST>"
    puts "<INPUT NAME=PIN TYPE=PASSWORD>"
    puts "<INPUT TYPE=SUBMIT>"
    puts "</FORM>"
  }
}

proc postfee {cost} {
    global arr changed v
    if {$cost != 0} {
	set changed 1
	set cost [currency_format $cost ROUND]
	qddb_instance switch $v Transaction \
		[qddb_instance new $v Transaction]
	set arr(Transaction.Date) \
		[qddb_util formatdate "%m/%d/%y" today]
	set arr(Transaction.Clock) [qddb_util formatdate "%X" now]
	set arr(Transaction.TType) Hours
	set arr(Transaction.InvoiceNumber) "0"
	set arr(Transaction.Amount) $cost
	set arr(Transaction.RunningBalance) \
		[expr $arr(CurrentBalance) + $cost]
	set arr(Transaction.RunningBalance) \
		[currency_format $arr(Transaction.RunningBalance) ROUND]
	set arr(CurrentBalance) $arr(Transaction.RunningBalance)
	set arr(CurrentBalance) \
		[currency_format $arr(CurrentBalance) ROUND]
	set arr(Recent) [expr $arr(Recent) + $cost]
	set arr(Recent) \
		[currency_format $arr(Recent) ROUND]
    }
}

proc Record_Locked {} {
  puts "<P><FONT SIZE=+1>"
  puts "I'm sorry, but the record is locked."
  puts "Please try again later.</FONT><P>"
}

proc process_form {} {
  global arr value t TIMEBLOCK BLOCKCOST MODEMHOST USER_TIME \
	SUPER CURRENCY ACCOUNTS_EMAIL MAILSERVER changed uname
  if {[qddb_tuple lock $t] == 0} {
    puts "Record locked, retrying..."
    exec sleep 1
  }
  if {[qddb_tuple lock $t] == 0} {
    puts "Record locked, retrying..."
    exec sleep 2
  }
  if {[qddb_tuple lock $t] == 0} {
    Record_Locked
  }
  set value(PIN) [string trim $value(PIN)]
  if {$value(PIN) == ""} {
    set value(PIN) NoPINEnteredSorryNoGood
  }
  if {$value(PIN) == "NONE"} {
    set value(PIN) ""
  }
  if {$value(PIN)==[string trim $arr(Company.Contact.PIN)]} {
    postfee $BLOCKCOST
    catch {exec hostname} host
    if { $MODEMHOST == $host } {
      exec $USER_TIME $uname tLeft += [expr 60 * $TIMEBLOCK]
      exec $USER_TIME $uname tLimit += [expr 60 * $TIMEBLOCK]
      exec $USER_TIME $uname sLeft += [expr 60 * $TIMEBLOCK]
      exec $USER_TIME $uname sLimit += [expr 60 * $TIMEBLOCK]
      if {$arr(Company.Contact.Priority) == 0} {
        exec $USER_TIME $uname priority = 0
      }
    } else {
      exec rsh $MODEMHOST $USER_TIME $uname tLeft += [expr 60 * $TIMEBLOCK]
      exec sleep 2
      exec rsh $MODEMHOST $USER_TIME $uname tLimit += [expr 60 * $TIMEBLOCK]
      exec sleep 2
      exec rsh $MODEMHOST $USER_TIME $uname sLeft += [expr 60 * $TIMEBLOCK]
      exec sleep 2
      exec rsh $MODEMHOST $USER_TIME $uname sLimit += [expr 60 * $TIMEBLOCK]
      if {$arr(Company.Contact.Priority) == 0} {
        exec sleep 2
        exec rsh $MODEMHOST $USER_TIME $uname priority = 0
      }
    }
    set title "$arr(Company.Contact.Username) P.I.N. usage"
    set blurb "$arr(Company.Contact.Username) purchased a timeblock\n"
    append blurb "of $TIMEBLOCK hours for $BLOCKCOST $CURRENCY\n"
    append blurb "\nAccount Balance Now: $arr(CurrentBalance)\n"
    exec /bin/mail -s "$title" -c $ACCOUNTS_EMAIL $uname << $blurb
  } else {
    set title "$arr(Company.Contact.Username) P.I.N. failure"
    set blurb "$arr(Company.Contact.Username) failed to purchase a timeblock\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@$MAILSERVER << $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>"
}


proc no_Month {} {
  puts "<P><FONT SIZE=+1>"
  puts "I'm sorry, but you must first purchase this month"
  puts "before you can purchase modem hours for this month.</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 " buytime: $uname bought $uname \$$BLOCKCOST $TIMEBLOCK hours"
  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]
foreach i [qddb_keylist get $k] {
    set t [qddb_tuple read $s $i]
    if {[llength $t] > 0} {
        break
    }
}
qddb_keylist delete $k
if {[string length $t] != 0} {
  set v [new_view $s $t arr]
  if {$arr(Company.Contact.Priority) == 0} {
    set BLOCKCOST "$PRI_0_BLOCKCOST"
    set TIMEBLOCK "$PRI_0_TIMEBLOCK"
    set BLOCKCOST_EXPLAIN "$PRI_0_BLOCKCOST_EXPLAIN"
    puts "<BLINK>This is a Zero-Priority account.</BLINK><P>"
  }
  if {$arr(Company.Contact.Months) < 1} {
    no_Month
  } else {
    if {[info exists value(PIN)]} {
      process_form
    } else {
      print_form
    }
  }
  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 "$uname: not found (tuple is empty)."
}
qddb_schema close $s
puts $FOOTER

