# postgresql.tcl

# Init Pgtcl or pgintcl
# Experience has shown that pgintcl has to be sourced at the global
# namespace.

proc initPgtcl {} {
	# From version 2.0.5 on pfm also tries to load pgintcl as a tcl
	# package, if it is not found in the installation directory
	global env
	set env(PGCLIENTENCODING) "UNICODE"
	if {[catch {source [file join $::config::installDir pgin.tcl]} errMsg1]} then {
		if {[catch {package require pgintcl} pgintclVersion]} then {
			if {[catch {package require Pgtcl} PgtclVersion]} then {
				pfm_message [mc no_api $errMsg1 $PgtclVersion] {.}
				set API {}
			} else {
				set API [list Pgtcl $PgtclVersion]
			}
		} else {
			set API [list pgintcl $pgintclVersion]
		}
	} else {
		if {[catch {set pgintclVersion $pgtcl::version} errMsg]} then {
			set pgintclVersion "???"
		}
		set API [list pgintcl $pgintclVersion]
	}
	return $API
}

proc getPostgresqlDefault {option} {
	global tcl_platform
	switch $option {
		"dblist" {
			set value [list $tcl_platform(user)]
		}
		"dbname" {
			set value $tcl_platform(user)
		}
		"host" {
			set value {}
		}
		"port" {
			set value {5432}
		}
		"user" {
			set value $tcl_platform(user)
		}
		"psql" {
			switch -- $tcl_platform(platform) {
				"unix" {
					set value {psql}
				}
				"windows" {
					set value {psql.exe}
				}
				default {
					set value {}
				}
			}
		}
		"usePGPASSWORD" {
			set value 1
		}
		default {
			set value {}
		}
	}
	return $value
}

class PostgresqlApi {
	public variable state closed
	public variable dbname {}
	protected common psqlCommands {
		listDatabases {\l}
		listTables {\d}
		helpSQL {\h}
		helpTool {\?}
		quit {\q}
		importFile {\i}
	}
	protected variable host {}
	protected variable port {}
	protected variable user {}
	protected variable password {}
	protected variable db {}

	constructor {} {

		return
	}

	destructor {

		return
	}

	protected method readPgPass {passMatrixName} {
		upvar $passMatrixName passMatrix
		global tcl_platform
		global env

		# This procedure reads the ~/.pgpass file if it exists and if it
		# has the right permissions (00600, i.e. rw for owner only).
		# It parses this file and stores the result in passMatrix.
		# This procedure supports the backslash escape for : and backslash.
		# backslash backslash is read as backslash
		# backslash ':' is read as ':' and not interpreted as entry separator
		# backslash 'anything else' is read as 'anything else'
		#                                      (i.e. backslash is dropped)
		# ':' is interpreted as entry separator

		# On Windows platforms, the pgpass file is
		# %APPDATA%\postgresql\pgpass.conf

		set seqnr 0
		if {$tcl_platform(platform) eq {windows}} then {
			set filename [file join $env(APPDATA) postgresql pgpass.conf]
		} else {
			set filename [file normalize "~/.pgpass"]
		}
		if {[file exists $filename]} then {
			if {$tcl_platform(platform) eq {unix}} then {
				set filePermission [file attributes $filename -permissions]
				set first [expr [string length $filePermission] - 3]
				set filePermission [string range $filePermission $first end]
			} else {
				set filePermission "600"
			}
			if { $filePermission ne "600" } then {
				set map {0 --- 1 --x 2 -w- 3 -wx 4 r-- 5 r-x 6 rw- 7 rwx}
				set filePermission [string map $map $filePermission]
				pfm_message [mc wrongPermissions $filePermission] .
			} else {
				if { [catch {open $filename r} pgPass ] } then {
					pfm_message $pgPass .
				} else {
					set argList {host port dbname user password}
					while {![eof $pgPass]} {
						if {[gets $pgPass current_line] > 0} then {
							incr seqnr
							foreach name $argList {
								set passMatrix($seqnr,$name) {}
							}
							set arg {}
							set argNr 0
							set last [expr [string length $current_line] - 1]
							for {set i 0} {$i <= $last} {incr i} {
								set curChar [string index $current_line $i]
								switch -- $curChar {
									"\\" {
										# This is the way to write 1 backslash:
										# NOT with curly braces.
										# Skip the backslash and copy the next character
										incr i
										append arg [string index $current_line $i]
									}
									":" {
										# end of an arg
										set name [lindex $argList $argNr]
										if {$name ne {}} then {
											set passMatrix($seqnr,$name) $arg
										}
										# puts "$seqnr, $name : $arg"
										set arg {}
										incr argNr
									}
									default {
										# just copy the character
										append arg $curChar
									}
								}
							}
							# We are at end of line. Just copy the last arg.
							set name [lindex $argList $argNr]
							if {$name ne {}} then {
								set passMatrix($seqnr,$name) $arg
							}
							# puts "$seqnr, $name : $arg"
							set arg {}
							incr argNr
						}
					}
					close $pgPass
				}
			}
		}
		return $seqnr
	}

	protected method getPasswordFromFile {} {

		# This procedure tries to get the password from ~/.pgpass
		# It returns the found password. If it does not find
		# a password, it returns the empty string.

		set nr_of_lines [readPgPass passMatrix]
		set found 0
		set password {}
		for {set seqnr 1} {($seqnr <= $nr_of_lines) && (!$found)} {incr seqnr} {
			if {(($host eq $passMatrix($seqnr,host)) || \
				 ({*} eq $passMatrix($seqnr,host))) && \
				 (($port eq $passMatrix($seqnr,port)) || \
				  ({*} eq $passMatrix($seqnr,port))) && \
				 (($dbname eq $passMatrix($seqnr,dbname)) || \
				  ({*} eq $passMatrix($seqnr,dbname))) && \
				 (($user eq $passMatrix($seqnr,user)) || \
				  ({*} eq $passMatrix($seqnr,user)))} then {
			set found 1
			set password $passMatrix($seqnr,password)
			}
		}
		return
	}

	public method connect {} {
		set conninfo {}
		if {[string length $host]} then {
			lappend conninfo "host='$host'"
		}
		if {[string length $port]} then {
			lappend conninfo "port=$port"
		}
		if {[string length $dbname]} then {
			lappend conninfo "dbname='$dbname'"
		}
		if {[string length $user]} then {
			lappend conninfo "user='$user'"
		}
		if {[string length $password]} then {
			lappend conninfo "password='$password'"
		}
		if {[catch {pg_connect -conninfo [join $conninfo]} db]} then {
			pfm_message [mc pg_connect_failed $dbname $db] {.}
			set state closed
			set status 0
			set db {}
		} else {
			set state open
			set status 1
		}
		return $status
	}

	protected method registerDatabase {newdb} {
		set save 0
		set dblist [$::pfmOptions getOption postgresql dblist]
		if {$newdb ni $dblist} then {
			lappend dblist $newdb
			set dblist [lsort $dblist]
			$::pfmOptions setOption postgresql dblist $dblist
			set save 1
		}
		set lastUsed [$::pfmOptions getOption postgresql dbname]
		if {$lastUsed ne $newdb} then {
			$::pfmOptions setOption postgresql dbname $newdb
			set save 1
		}
		if {$save} then {
			$::pfmOptions saveOptions
		}
		return
	}

	public method setConParms {a_host a_port a_dbname a_user a_password} {
		set host $a_host
		set port $a_port
		set dbname $a_dbname
		set user $a_user
		set password $a_password
		return
	}

	public method opendb {} {
		set dataList {}
		foreach openParm {host port user} {
			set dataSpec {}
			dict append dataSpec name $openParm
			dict append dataSpec type string
			dict append dataSpec value [$::pfmOptions getOption postgresql $openParm]
			dict append dataSpec valuelist {}
			lappend dataList $dataSpec
		}
		if {[$::pfmOptions getOption postgresql usePGPASSWORD]} then {
			set dataSpec {}
			dict append dataSpec name password
			dict append dataSpec type password
			dict append dataSpec value {}
			dict append dataSpec valuelist {}
			lappend dataList $dataSpec
		}
		set dataSpec {}
		dict append dataSpec name dbname
		dict append dataSpec type string
		dict append dataSpec value [$::pfmOptions getOption postgresql dbname]
		dict append dataSpec valuelist [$::pfmOptions getOption postgresql dblist]
		lappend dataList $dataSpec
		set dlg [GenForm "#auto" . [mc OpenDialog] $dataList]
		if {[$dlg wait result]} then {
			foreach parm {host port dbname user} {
				set $parm $result($parm)
			}
			if {[$::pfmOptions getOption postgresql usePGPASSWORD]} then {
				set password $result(password)
			} else {
				getPasswordFromFile
			}
			if {[connect]} then {
				registerDatabase $dbname
				set status 1
			} else {
				set status 0
			}
		} else {
			set status 0
		}
		return $status
	}

	public method closedb {} {
		pg_disconnect $db
		set db {}
		set state closed
		set dbname {}
		set host {}
		set port {}
		set user {}
		set password {}
		return
	}

	public method select_query {query numTuplesName resultArrayName errorMsgName} {
		upvar $numTuplesName numTuples
		upvar $resultArrayName resultArray
		upvar $errorMsgName errorMsg
		set resHandle [pg_exec $db $query]
		if {[pg_result $resHandle -status] eq {PGRES_TUPLES_OK}} then {
			set status 1
			set numTuples [pg_result $resHandle -numTuples]
			pg_result $resHandle -assign resultArray
		} else {
			set status 0
			set errorMsg [pg_result $resHandle -error]
		}
		pg_result $resHandle -clear
		return $status
	}

	public method select_query_list {query numTuplesName namesName \
			resultListName errorMsgName} {
		upvar $numTuplesName numTuples
		upvar $namesName names
		upvar $resultListName resultList
		upvar $errorMsgName errorMsg
		set resHandle [pg_exec $db $query]
		if {[pg_result $resHandle -status] eq {PGRES_TUPLES_OK}} then {
			set status 1
			set numTuples [pg_result $resHandle -numTuples]
			set names [pg_result $resHandle -attributes]
			set resultList [pg_result $resHandle -llist]
		} else {
			set status 0
			set errorMsg [pg_result $resHandle -error]
		}
		pg_result $resHandle -clear
		return $status
	}

	public method send_command {query errMsgName} {
		upvar $errMsgName errMsg
		set resHandle [pg_exec $db $query]
		if {[pg_result $resHandle -status] eq {PGRES_COMMAND_OK}} then {
			set status 1
		} else {
			set status 0
			set errMsg [pg_result $resHandle -error]
		}
		pg_result $resHandle -clear
		return $status
	}

	public method connect_sql {errChan outChan sqlChanName} {
		upvar $sqlChanName sqlChan
		global env
		set cmd [list | [$::pfmOptions getOption postgresql psql]]
		lappend cmd {--echo-queries}
		foreach parm {host port dbname user} {
			if {$parm eq {user}} then {
				set option {--username}
			} else {
				set option "--$parm"
			}
			set value [subst $[subst $parm]]
			if {$value ne {}} then {
				lappend cmd $option
				lappend cmd $value
			}
		}
		lappend cmd ">@$outChan"
		lappend cmd "2>@$errChan"
		# puts $errChan $cmd
		if {[$::pfmOptions getOption postgresql usePGPASSWORD]} then {
			set env(PGPASSWORD) $password
		}
		if {[catch {open $cmd WRONLY} sqlChan]} then {
			unset -nocomplain env(PGPASSWORD)
			pfm_message [mc psqlFailed $sqlChan] {.}
			set status 0
		} else {
			unset -nocomplain env(PGPASSWORD)
			chan configure $sqlChan -encoding utf-8
			set status 1
		}
		return $status
	}

	public method getSpecialCommand {purpose} {
		if {[dict exists $psqlCommands $purpose]} then {
			return [dict get $psqlCommands $purpose]
		} else {
			return {}
		}
	}
}

# Main

# Init Pgtcl or pgintcl

set config::API [initPgtcl]