#!/usr/local/qddb/bin/qtclsh
#
# buymonth.qtcl - buy a month 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 months!"
   puts "$FOOTER"
   exit 1
}


set changed 0
set TITLE "Online Month Purchase"
puts [format $HEADER $TITLE $TITLE]
puts "<H2>Account making purchase: $env(REMOTE_USER)</H2>"

proc print_form {} {
  global arr MONTHCOST CURRENCY MONTHCOST_EXPLAIN
  puts "<P><FONT SIZE=+1>"
  puts "Purchase of an online month for"
  puts "<STRONG>$MONTHCOST</STRONG> $CURRENCY (taxes included)<P>"
  puts "This option purchases an online month, which does not include"
  puts "any modem-usage hours for that month."
  puts "That is, it simply pushes the basic POP account's expiry"
  puts "date one more month into the future.<P>"
  puts "</FONT>"
  puts "<TABLE CELLPADDING=4>"
  puts "<TR><TD>Credit Limit<TD ALIGN=RIGHT> $arr(CreditLimit)"
  puts "<TR><TD>Current Balance<TD ALIGN=RIGHT> $arr(CurrentBalance)"
  puts "<TR><TD>Pending Amounts<TD ALIGN=RIGHT> $arr(Pending)"
  set neg [expr $arr(CurrentBalance) + $arr(Pending) + $MONTHCOST]
  if { $arr(CreditLimit) < $neg } {
    puts "<TR><TD COLSPAN=2>"
    puts "<BLINK><STRONG>Sorry, you have insufficient credit</STRONG></BLINK>"
    puts "</TABLE>"
  } else {
     puts "</TABLE>"
     puts "<P><FONT SIZE=+1>"
     puts "<STRONG>One</STRONG> month will cost"
     puts "<STRONG>$MONTHCOST</STRONG> $CURRENCY (taxes included).<P>"
     puts "</FONT>"
     puts "If that is acceptable, input your Personal Identity Number"
     puts "to validate this request, purchasing one month of basic"
     puts "account existence for $MONTHCOST"
     puts "$CURRENCY $MONTHCOST_EXPLAIN.<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) Months
        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 bad_PIN {} {
  global MONTHCOST CURRENCY ACCOUNTS_EMAIL MAILSERVER uname
  puts "<P><FONT SIZE=+1><BLINK><STRONG>"
  puts "Incorrect Personal Identity Number (P.I.N.)"
  puts "</STRONG></BLINK></FONT><P>"
  set title "$uname P.I.N. failure"
  set blurb "$uname failed to purchase one month\n"
  append blurb "for $MONTHCOST $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
}

proc staff_Acct {} {
  puts "<P><FONT SIZE=+1><BLINK><STRONG>"
  puts "This is a Staff, Admin or Daemon account"
  puts "</STRONG></BLINK>"
  puts "it automatically receives months so need not purchase any.</FONT><P>"
}

proc process_form {} {
  global arr value t MONTHCOST CURRENCY MODEMHOST ACCOUNTS_EMAIL changed uname
  while {[qddb_tuple lock $t] == 0} {
    exec sleep 1
    puts "Record locked, retrying..."
  }
  set value(PIN) [string trim $value(PIN)]
  if {$value(PIN) == ""} {
    bad_PIN
  } else {
    if {$value(PIN)=="NONE"} {
      set value(PIN) ""
    }
    if {$arr(Company.Contact.Months) == -99} {
      staff_Account
    } else {
      if {$value(PIN)==[string trim $arr(Company.Contact.PIN)]} {
        set arr(Company.Contact.Months) [expr $arr(Company.Contact.Months)+1]
        postfee $MONTHCOST
        set changed 1
        set title "$arr(Company.Contact.Username) P.I.N. usage"
        set blurb "$arr(Company.Contact.Username) purchased one month\n"
        append blurb "for $MONTHCOST $CURRENCY\n"
	append blurb "\nAccount Balance Now: $arr(CurrentBalance)\n"
        exec /bin/mail -s "$title" -c $ACCOUNTS_EMAIL $uname << $blurb
      } else {
        bad_PIN
      }
    }
  }
}


proc no_PIN {} {
  global ACCOUNTS_EMAIL
  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"
  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 MONTHCOST ISPLOG
  catch {exec date} astr
  append astr " buymonth: $uname bought $uname \$$MONTHCOST 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]
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 MONTHCOST "$PRI_0_MONTHCOST"
    set MONTHCOST_EXPLAIN "$PRI_0_MONTHCOST_EXPLAIN"
    puts "<BLINK>This is a Zero-Priority account.</BLINK><P>"
  }
  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"

