1#
2#
3# Librairie de fonctions TCL pour faciliter l'acc�s � une base PostgreSQL
4#
5# Historique
6#   1999/04/16 : pda      : conception
7#   1999/04/17 : pda      : separation en une librairie
8#   2002/05/03 : pda/jean : ajout de getcols
9#   2003/05/30 : pda/jean : ajout de lock/unlock
10#   2003/06/13 : pda/jean : autorisation de requ�tes vides dans pg_exec
11#
12
13package provide pgsql 1.2
14package require Pgtcl
15
16namespace eval pgsql {
17    namespace export quote execsql getcols lock unlock
18}
19
20##############################################################################
21# Acc�s � une base PostgreSQL
22##############################################################################
23
24#
25# Neutralise les caract�res sp�ciaux figurant dans une cha�ne,
26# de fa�on � pouvoir la passer au moteur SQL.
27# - double toutes les apostrophes
28#
29# Entr�e :
30#   - param�tres
31#	- chaine : cha�ne � traiter
32#	- maxindex (optionnel) : taille maximum de la cha�ne
33# Sortie :
34#   - valeur de retour : la cha�ne trait�e
35#
36# Historique
37#   1999/07/14 : pda : conception et codage
38#   1999/10/24 : pda : mise en package
39#
40
41proc ::pgsql::quote {chaine {maxindex 99999}} {
42    set chaine [string range $chaine 0 $maxindex]
43    regsub -all {'} $chaine {&&} chaine
44    regsub -all {\\} $chaine {&&} chaine
45    return $chaine
46}
47
48#
49# Ex�cute une commande sql, et affiche une erreur et sort
50# en cas de probl�me. Retourne le r�sultat de la commande
51# (r�sultat pour pg_result).
52#
53# Entr�e :
54#   - param�tres
55#	- dbfd : la base
56#	- cmd : la commande � passer
57#	- result : contient en retour le nom de la variable contenant l'erreur
58# Sortie :
59#   - valeur de retour : 1 si tout est ok, 0 sinon
60#   - variable result :
61#	- si erreur, la variable contient le message d'erreur
62#
63# Historique
64#   1999/07/14 : pda      : conception et codage
65#   1999/10/24 : pda      : mise en package
66#   2003/06/13 : pda/jean : autorisation des requ�tes vides
67#
68
69proc ::pgsql::execsql {dbfd cmd result} {
70    upvar $result rmsg
71
72    set res [pg_exec $dbfd $cmd]
73    switch -- [pg_result $res -status] {
74	PGRES_COMMAND_OK -
75	PGRES_TUPLES_OK -
76	PGRES_EMPTY_QUERY {
77	    set ok 1
78	    set rmsg {}
79	}
80	default {
81	    set ok 0
82	    set rmsg "$cmd : [pg_result $res -error]"
83	}
84    }
85    pg_result $res -clear
86    return $ok
87}
88
89#
90# R�cup�re une liste de colonnes d'une table
91#
92# Entr�e :
93#   - param�tres
94#	- dbfd : la base
95#	- table : la commande � passer
96#	- where : clause where �ventuelle (sans le WHERE)
97#	- order : clause order �ventuelle (sans le ORDER BY)
98#	- lcol : liste des colonnes � r�cup�rer
99# Sortie :
100#   - valeur de retour : liste
101#
102# Historique
103#   2002/05/03 : pda/jean : conception et codage
104#
105
106proc ::pgsql::getcols {dbfd table where order lcol} {
107    if {! [string equal $where ""]} then {
108	set where "WHERE $where"
109    }
110    if {! [string equal $order ""]} then {
111	set order "ORDER BY $order"
112    }
113    set selcol [join $lcol ", "]
114    set lres {}
115    pg_select $dbfd "SELECT $selcol FROM $table $where $order" tab {
116	set l {}
117	foreach c $lcol {
118	    lappend l $tab($c)
119	}
120	lappend lres $l
121    }
122    return $lres
123}
124
125#
126# Entame une transaction et verrouille une ou plusieurs tables
127#
128# Entr�e :
129#   - param�tres
130#	- dbfd : la base
131#	- ltab : liste des tables � verrouiller
132#	- result : variable contenant en retour le message d'erreur
133# Sortie :
134#   - valeur de retour : 1 si tout est ok, 0 sinon
135#   - variable result :
136#	- si erreur, la variable contient le message d'erreur
137#
138# Historique
139#   2002/05/03 : pda/jean : conception et codage
140#
141
142proc ::pgsql::lock {dbfd ltab result} {
143    upvar $result msg
144
145    set sql "BEGIN WORK ;"
146    foreach t $ltab {
147	append sql " LOCK $t ;"
148    }
149
150    if {[::pgsql::execsql $dbfd $sql msg]} then {
151	set r 1
152	set msg ""
153    } else {
154	set r 0
155	set msg "Transaction impossible : $msg"
156    }
157
158    return $r
159}
160
161#
162# Termine une transaction, et d�verrouille les tables.
163# Eventuellement, interrompt la transaction sans faire le "commit"
164#
165# Entr�e :
166#   - param�tres
167#	- dbfd : la base
168#	- commit : "commit" ou "abort"
169#	- result : variable contenant en retour le message d'erreur
170# Sortie :
171#   - valeur de retour : 1 si tout est ok, 0 sinon
172#   - variable result :
173#	- si erreur, la variable contient le message d'erreur
174#
175# Historique
176#   2002/05/03 : pda/jean : conception et codage
177#
178
179proc ::pgsql::unlock {dbfd commit result} {
180    upvar $result msg
181
182    switch -- $commit {
183	"commit" {
184	    set sql "COMMIT WORK"
185	}
186	"abort" {
187	    set sql "ABORT WORK"
188	}
189	default {
190	    set msg "Param�tre 'commit' incorrect ('$commit')"
191	    return 0
192	}
193    }
194
195    if {[::pgsql::execsql $dbfd $sql msg]} then {
196	set r 1
197	set msg ""
198    } else {
199	::pgsql::execsql $dbfd "ABORT WORK" m
200	set r 0
201	set msg "Echec de la transaction : $msg"
202    }
203
204    return $r
205}
206