#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