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.