Index by: file name | procedure name | procedure call | annotation
gscope_sql.tcl (annotations | original source)

#rR gscope_sql.tcl

proc FedSql {{Db ""}} {
    if {$Db==""} { set Db "fedlord" }
    set LesNCP [SqlExecForDatabase $Db "select name, passwd, passwd64 from people order by name" "GetList"]
    foreach {N C P} $LesNCP {
	Espionne $N =$C= =$P=
    }
    exit
}

proc FedNull {{Db ""}} {
    if {$Db==""} { set Db "fedlord" }
    set Update "update people set passwd64 = NULL"
    if {[OuiOuNon "for Db : $Update" 0]} { 
	set Res [SqlExecForDatabase $Db $Update]
	return $Res
    }
    return "Tant pis"
}

proc MemeLigne {} {
    puts "Coucou"
    puts "recoucou"
    foreach I [NombresEntre 1 100] {
	puts -nonewline "\rI = $I"
	flush stdout
	after 100
    }
}

proc ValeurPk Texte {
    set Pk ""
    scan $Texte "%s" Pk
    return $Pk
}

proc LogSqlReceptacleDir {} {
    return "/usr/local/apache/logs/LogSqlReceptacle"
}

proc LogInsUpDelPourExec {Query {Fichier ""}} {
    global FichierInsUpDelPourExec
    global LogInsUpDelPourExec

    set LogInsUpDelPourExec 0

    if { ! [info exists LogInsUpDelPourExec] || ! $LogInsUpDelPourExec} { return "" } 

    if {$Query=="CloseFile"} {
	if {[info exists $FichierInsUpDelPourExec]} {
	    set F $FichierInsUpDelPourExec
	    unset  FichierInsUpDelPourExec
	    return $F
	}
	return ""
    }

    if {$Query=="InFile"} {
	if {$Fichier==""} { 
	    set FichierInsUpDelPourExec "[LogSqlReceptacleDir]/InsUpDelPourExec_[pid]_[Date].sql"
	} else {
	    set FichierInsUpDelPourExec $Fichier
	}
	return $FichierInsUpDelPourExec
    }

    if { ! [info exists FichierInsUpDelPourExec]} {
	set FichierInsUpDelPourExec "[LogSqlReceptacleDir]/InsUpDelPourExec_[pid]_[Date].sql"
    }

    if {$Query=="DeleteFile"} {
	if { ! [info exists FichierInsUpDelPourExec]} { return "" }
	if {[file exists $FichierInsUpDelPourExec]} {
	     file delete $FichierInsUpDelPourExec
	}
	set F $FichierInsUpDelPourExec
	unset  FichierInsUpDelPourExec
	return $F 
    }

    if {0 && [regexp -nocase "^ *select" $Query]} { return "" }

    return [AppendAuFichier $FichierInsUpDelPourExec "$Query ;"]
}

proc AvecPkTable Table {
    if {[regexp -nocase "RetinoBase" $Table]} { return 1 }
    if {[WithinGenoret] || [WithinFed]} { return 0 }
    if {[regexp -nocase "^LN_" $Table]} { return 0 }
    return 0
    return 1
}

proc QuoteEtBackslashPourSql {Texte {Trim ""}} {
    set Trim [string equal -nocase $Trim "Trim"]
    if {[regexp {^[0-9]+$} $Texte]} { return $Texte }

    if {$Texte==""} { return "DEFAULT" }

    regsub -all {\\} $Texte {\\}  Texte
    regsub -all {\,} $Texte {\\,} Texte
    regsub -all {\'} $Texte "''"  Texte

    if {$Trim} { set Texte [string trim $Texte] }

    return "'$Texte'"
}

#rR attention il y a ausso ProchainPk
proc NextPk SchemaTable {
    set Table $SchemaTable
    if {[regexp "\." $SchemaTable]} {
	ScanLaListe [split $SchemaTable "."] Schema Table
    }
    set nomPk "pk_$Table"
    if {$Table=="analysissoftware" && [regexp -nocase "retinobase" $Schema]} { set nomPk  "pk_software" }
    set Sql "select max($nomPk) from $SchemaTable"
    set Last [SqlExec $Sql "GetFirstValue"]
    if {[regexp {^[0-9]+$} $Last]} { return [incr Last] }
    return 1
}

#rR attention il y a ausso NextPk
proc ProchainPk Table {
    if {[TestonsSql]} { return 999 }
    regsub {[^\.]+\.} $Table "" LocalTable
    set ProchainPk [SqlExec "select last_value from ${Table}_pk_${LocalTable}_seq;" "GetFirstValue"]
    incr ProchainPk
    return $ProchainPk
}

proc TestonsSql {{Action ""}} {
    global TestonsSql

    if {[regexp -nocase "^(Y|O|1)" $Action]} { set TestonsSql 1 }
    if {[regexp -nocase "^(N|0)"   $Action]} { set TestonsSql 0 }
    if { ! [info exists TestonsSql]} {
	set TestonsSql [catch {package require Pgtcl} Message]
    }
    if {$TestonsSql} { Espionne "Attention TestonsSql est a 1. I got the message \n$Message" } 
    return $TestonsSql
}

proc TestTaxonomy {} {
    CanalSql [ConnInfo "" taxonomy]
    Espionne [SqlExec "select name from taxon where id=9606"]
}

proc SqlResult {Handle {Quoi ""} {Clear ""}} {
    if {$Clear==""} { set Clear "Clear" }
    if {$Quoi==""} { set Quoi "GetFirstValue" }
    if {$Quoi=="Clear"} { pg_result $Handle -clear ; return "" }

#    Espionne [pg_result $Handle -attributes]
#    exit
#    pg_result $Handle -assign toto
#    EspionneL [array get toto]
#    exit
    set Resultat ""

    if {[regexp -- {^\-} $Quoi]} {
	#rR on peut demander ce qu'on veut
	set Resultat [encoding convertfrom ascii [pg_result $Handle $Quoi]]
    } elseif {$Quoi=="GetFirstValue" || $Quoi=="GetLastValue" || $Quoi=="GetList"} {
	set LeResultat [encoding convertfrom ascii [pg_result $Handle -list]]
	if {$LeResultat=={}} {
	    set Resultat ""
	} else {
	    if {$Quoi=="GetList"      } { set Resultat $LeResultat }
	    if {$Quoi=="GetFirstValue"} { set Resultat [lindex $LeResultat 0] }
	    if {$Quoi=="GetLastValue" } { set Resultat [lindex $LeResultat end] }
	}
    } else {
	FaireLire "Wrong second arg in SqlResult"
	return ""
    }
    if {$Clear=="Clear"} { pg_result $Handle -clear }
    return $Resultat
}

proc tsq {} {
    CanalSqlGeneOntology 
    Espionne [SqlExec "mysqlinfo [CanalSql] tables"]
    set R [SqlExec "select * from term limit 10;"]
    foreach {Id Na Ty Ac toto titi tutu} $R {
	Espionne "$Id $Ac"
    }
    exit
}

proc SqdbTest {Database Query {Quoi ""} {Clear ""}} {
    set D64 [Base64Encode $Database]
    set Q64 [Base64Encode $Query]
#   set Url "[LbgiUrl]/~ripp/cgi-bin/GscopeServer?EVImm&Sqdb&$D64&$Q64&$Quoi&$Clear"
#   set R [ContenuDuFichier $Url]
    set R [QuestionDeScience EVImm "ret Sqdb $D64 $Q64 $Quoi $Clear"]
    return $R
}

proc Sqdb {D64 Q64 {Quoi ""} {Clear ""}} {
    return [SqlExecForDatabase [Base64Decode $D64] [Base64Decode $Q64] $Quoi $Clear]
}

proc SqlExecForDatabase {Database Query {Quoi ""} {Clear ""}} {
    CanalSql [ConnInfoForDatabase $Database]
    return [SqlExec $Query $Quoi $Clear]
}

proc SqlColumnName {Table {Schema ""} {Database ""}} {
    if {$Schema==""} {
	if {[regexp {^([^\.]+)\.([^\.]+)} $Table S T]} {
	    set Schema $S
	    set Table $T
	} else {
	    set Schema "public"
	}
    }
    set Sql "SELECT column_name FROM INFORMATION_SCHEMA.COLUMNS where table_schema='$Schema' and table_name='$Table'";

    if {$Database!=""} { return [SqlExecForDatabase $Database $Sql "GetList"] }
    return [SqlExec $Sql "GetList"]
}

proc SqlExec {Query {Quoi ""} {Clear ""}} {
    if {[regexp "EqUaL" $Query]} { regsub -all "EqUaL" $Query "=" Query }
    if { ! [regexp {[ \n]} $Query]} { regsub -all @ $Query " " Query }

    LogInsUpDelPourExec $Query
    global SqlExecCounter
    if {[TestonsSql]} {
	if { ! [info exists SqlExecCounter]} { set SqlExecCounter 0 }
	return [incr SqlExecCounter]
    }

    if {[regexp -nocase "mysql" [CanalSql]]} {
	if {$Quoi==""} { set Quoi "-flatlist" }
	if {[regexp -nocase "^ *(select)" $Query]} {
	    set Result [mysqlsel [CanalSql] $Query $Quoi]
	} elseif {[regexp -nocase "^ *(insert|update|delete)" $Query]} {
	    set Result [mysqlexec [CanalSql] $Query]
	} else {
	    if { ! [regexp -nocase { *mysql[^ \n]+[ \n]+mysql[^ \n]+[ \n]} $Query]} {
		regsub -nocase {mysql[^ \n]+[ \n]} $Query "&[CanalSql] " Query
	    } 
	    set Result [eval $Query]
	}
	return $Result
    }

    if {[regexp -nocase "sqlite" [CanalSql]]} {
	if {$Quoi==""} { set Quoi "GetArray" }
	set Handle [CanalSql]
	if {$Quoi=="GetList"}       { return [$Handle eval $Query] }
	if {$Quoi=="GetFirstValue"} { return [$Handle onecolumn $Query] }
	set i 0
	set LeA {}
	set LeR {}
	$Handle eval $Query X {
	    if {$Quoi=="GetNames"} { return $X(*) }
	    set LeRecord {}
#	    foreach {K V} [array get X]  #rR il y avait ça avant 2016/10/07 ... du coup on n'avait pas l'ordre
	    foreach K $X(*) {
		set V $X($K)
		if {$K=="*"} { continue }
		lappend LeR [list $K $V]
		lappend LeA [list "$i,$K" $V]
		lappend LeRecord $V
	    }
	    incr i
	    lappend LesRecords $LeRecord
	}
	if {$Quoi=="GetListOfList"} { return $LesRecords }
	if {$Quoi=="GetArray"} { return $LeA }
	return $LeR
	return [array get X]
    }
    set Handle [pg_exec [CanalSql] $Query]
    if {$Quoi=="GetHandle"} { return $Handle }
    return [SqlResult $Handle $Quoi $Clear]
}
 
proc SqlDisconnect Canal {
    if {[TestonsSql]} {
	return "$Canal is closed"
    }
    if {[regexp "mysql" $Canal]} {
	mysqlclose $Canal
	return "$Canal is closed"
    }
    if {[regexp -nocase "Sqlite" $Canal]} {
	$Canal close
	return "$Canal is closed"
    }
    pg_disconnect $Canal
    return "$Canal is closed"
}

proc SqlConnect args {
    global SqlExecCounter
    if { ! [info exists SqlExecCounter]} { set SqlExecCounter 0 }
    if {[TestonsSql]} {
	set Query [join $args " "] 
	return [incr SqlExecCounter]
    }
    set Retour [eval pg_connect $args]
    return $Retour
}

proc TestCanalSqlCurrent {} {
    CanalSql
    Espionne [CanalSqlCurrent]
    CanalSqlDisconnect
    Espionne [CanalSqlCurrent]
    CanalSql
    Espionne [CanalSqlCurrent]
}

proc CanalSqlCurrent {} {
    global CanalSql OldConnInfo
    if { ! [info exists CanalSql]} { return "" }
    return $OldConnInfo
}

proc CanalSqlDisconnect {} {
    global CanalSql
    if { ! [info exists CanalSql]} {return ""}
    set OldCanalSql $CanalSql
    unset CanalSql
    return [SqlDisconnect $OldCanalSql]
}

proc CanalSql {{ConnInfo ""}} {
    global CanalSql OldConnInfo

    if {[string equal -nocase $ConnInfo "GetDbname"]} {
	if { ! [info exists OldConnInfo]} { return "" }
	return [StringApres "dbname=" dans $OldConnInfo]
    }

    if {$ConnInfo==""} {
	if {[info exists OldConnInfo]} {
	    set ConnInfo $OldConnInfo
	} else {
	    # set ConnInfo "host=[LbgiHost] dbname=macsim user=ripp password=postgresRIPP"
	    # set ConnInfo "host=[LbgiHost] dbname=genoret user=ripp password=postgresRIPP"
	    set ConnInfo [ConnInfo]
	}
    }
    if {[info exists OldConnInfo] && $OldConnInfo==$ConnInfo && [info exists CanalSql]} {
	set Sgbd [StringApres "sgbd=" dans $ConnInfo]
	if { ! [string equal -nocase "mysql" $Sgbd]} { return $CanalSql }
	set  State [mysqlstate $CanalSql -numeric]
	if {$State==2 || $State==4} { return $CanalSql } 
	catch {mysqlclose $CanalSql} 
	unset CanalSql
	unset OldConnInfo
	return [CanalSql $ConnInfo]
    }
 
    if {[info exists CanalSql]} { CanalSqlDisconnect }

    set OldConnInfo $ConnInfo
    set Sgbd [StringApres "sgbd=" dans $ConnInfo]
    if {[string equal -nocase "mysql" $Sgbd]} {
	set Host     [StringApres "host="     dans $ConnInfo]
	set DbName   [StringApres "dbname="   dans $ConnInfo]
	set User     [StringApres "user="     dans $ConnInfo]
	set Password [StringApres "password=" dans $ConnInfo]
	set Sgbd     [StringApres "sgbd="     dans $ConnInfo]
	package require mysqltcl
	set Handle [mysqlconnect -host $Host -user $User -password $Password]

	mysqluse $Handle $DbName
	set CanalSql $Handle
	return $CanalSql
    }

    if {[string equal -nocase "sqlite" $Sgbd]} {
	global SqliteHandle
	set Host     [StringApres "host="     dans $ConnInfo]
	set DbName   [StringApres "dbname="   dans $ConnInfo]
	set User     [StringApres "user="     dans $ConnInfo]
	set Password [StringApres "password=" dans $ConnInfo]
	set Sgbd     [StringApres "sgbd="     dans $ConnInfo]

	if {[info exists SqliteHandle($Host)]} { return $SqliteHandle($Host) }

	package require sqlite3
	set Handle [NomDe "SqliteHandle"]
	sqlite3 $Handle $Host
	set SqliteHandle($Host) $Handle

	set CanalSql $Handle
	return $CanalSql
    }
    regsub { sgbd=[^ ]+} $ConnInfo "" ConnInfo
    set CanalSql [SqlConnect -conninfo $ConnInfo]
    return $CanalSql
}

proc IsSqlNull Valeur {
    if {$Valeur==""} { return 1 }
    return 0
}

proc TestSqlInsert {} {
    CanalSqlMacsims
    set R [SqlInsertOnceRecordIntoTable macsims name salut ]
    Espionne $R
}

proc SqlInsertOnceRecordIntoTable {Table args} {

    if {[set TellMeIfAlreadyExists [regexp {^\+} $Table]]} { regsub {^\+} $Table "" Table }

    set LeWhere {}
    foreach {C V} $args {
	if {$C==""} { continue }
	if {$V==""} { continue }
	lappend LeWhere "$C=[QuoteEtBackslashPourSql $V]"
    }
    if {$LeWhere!={}} {
	set Where [join $LeWhere " and "]
	if {[AvecPkTable $Table]} {
	    set Query "select pk_$Table from $Table where $Where" 
	} else {
	    set Query "select * from $Table where $Where" 
	}
	set Pk [SqlExec $Query "GetFirstValue"]
	if { ! [IsSqlNull $Pk]} {
	    if {$TellMeIfAlreadyExists} { append Pk " already exists" }
	    return $Pk
	}
    }
    return [eval SqlInsertRecordIntoTable $Table $args] 
}

proc SqlInsertRecordIntoTable {Table args} {

    set LesC {}
    set LesV {}

    set AvecPkTable [AvecPkTable $Table]

    set PkTable -1
    if {$AvecPkTable} {
	set PkTable [ProchainPk $Table]
	set LesC [list "pk_$Table"]
	set LesV [list $PkTable]
    }

    foreach {C V} $args {
	if {$C==""} { continue }
	lappend LesC $C
	lappend LesV [QuoteEtBackslashPourSql $V]
    }
    set Cs "([join $LesC ","])"
    set Vs "([join $LesV ",\n"]\n)"

    set SqlInsert "insert into $Table $Cs values $Vs"
    SqlExec $SqlInsert "Clear" "Clear"

    if {$PkTable==-1} {
	catch {
	    regsub {[^\.]+\.} $Table "" LocalTable
	    set SqlLastValue "select last_value from ${Table}_pk_${LocalTable}_seq ;"
	    set PkTable [SqlExec $SqlLastValue]
	}
    }
    LogInsUpDelPourExec "pk_$Table inserted $PkTable" 
    return $PkTable
}

proc TestPostgreSQL {} {
    puts [package require Pgtcl]
    
}

#rR fin








Index by: file name | procedure name | procedure call | annotation
File generated 2022-04-05 at 12:55.