source: tol/tolbase/lib/toltk/odbc.tcl @ b83b8ed3

1941-docker-image-to-testdevel
Last change on this file since b83b8ed3 was 6d7779d, checked in by Jorge Pérez <josp.jorge@…>, 18 years ago

initial import

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@1 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 11.2 KB
RevLine 
[6d7779d]1#/////////////////////////////////////////////////////////////////////////////
2# FILE    : odbc.tcl
3# PURPOSE : This file contains a namespace called ODBCDialog with its
4#           functions. It's for creating a ODBC connect options dialog and
5#           managing its events.
6#/////////////////////////////////////////////////////////////////////////////
7
8
9#/////////////////////////////////////////////////////////////////////////////
10# TESTING
11#/////////////////////////////////////////////////////////////////////////////
12# Put if {1} for testing this file.
13if {0} {
14  package require Tk
15  package require BWidget
16  package require BLT
17  # force BWidget autoload
18  Bitmap::use
19  set toltk_script_path [file dirname [info script]]
20  set toltk_images_path [file join ${toltk_script_path} images]
21  if { [lsearch $Bitmap::path $toltk_images_path] == -1 } {
22      lappend Bitmap::path [file join $toltk_script_path images]
23  }
24  package require msgcat
25  namespace import msgcat::*
26  ::msgcat::mclocale es
27  ::msgcat::mcload [file join $toltk_script_path msgs]
28  if { ![info exists toltk_library] } {
29    set toltk_library [file join $toltk_script_path ..]
30  }
31  if { [string equal $tcl_platform(platform) "windows"] } {
32    load [file join $::toltk_library tclodbc tclodbc.dll]
33  } else {
34    load [file join $::toltk_library tclodbc libtclodbc.so]
35  }
36
37}
38
39package require bcombobox
40
41#/////////////////////////////////////////////////////////////////////////////
42  namespace eval ODBCDialog {
43#
44# PURPOSE: The purpose of this namespace is organize code and functions.
45#
46#/////////////////////////////////////////////////////////////////////////////
47  variable tmpdata
48}
49
50
51#/////////////////////////////////////////////////////////////////////////////
52  proc ::ODBCDialog::Create {parent {alias ""} {user ""} {pass ""}
53                             {connectProc ""} {disconnectProc ""}} {
54#
55# PURPOSE: Creates a instance of ODBCDialog. If it already exists calls to
56#          ConnectOptions.
57#
58# PARAMETERS:
59#   parent         -> widget's parent path
60#   alias          -> ODBC alias (DSN)
61#   user           -> ODBC user
62#   pass           -> ODBC password
63#   connectProc    -> user procedure to call when connect
64#   disconnectProc -> user procedure to call when disconnect
65#
66#/////////////////////////////////////////////////////////////////////////////
67  set Instance ::ODBCDialog::${parent}ODBC
68  if { [lsearch [namespace children ::ODBCDialog] $Instance] != -1 } {
69    #error "$Instance already exists as a children of ::ODBCDialog"
70  } else {
71    #  A namespace is created for each ODBCDialog widget.
72    namespace eval $Instance {
73      # data -> array with information about the instance:
74      #   parent   -> widget's parent path
75      #   alias    -> ODBC alias (DSN)
76      #   user     -> ODBC user
77      #   password -> ODBC password
78      #   status   -> Connection status
79      #   OnConnnec    -> user procedure to call when connect
80      #   OnDisconnect -> user procedure to call when disconnect
81      variable data
82    }
83    upvar #0 ${Instance}::data data
84    set data(alias)        $alias
85    set data(user)         $user
86    set data(pass)         $pass
87    set data(parent)       $parent
88    set data(status)       0
89    set data(OnConnect)    $connectProc
90    set data(OnDisconnect) $disconnectProc
91    bind $data(parent) <Destroy> [list ::ODBCDialog::Destroy $Instance]
92  }
93  set result [ConnectOptions $Instance]
94  return $result
95   
96}
97
98
99#/////////////////////////////////////////////////////////////////////////////
100  proc ::ODBCDialog::Destroy {this} {
101#
102# PURPOSE: Destroyes the instance given by this.
103#
104#
105# PARAMETERS:
106#   this -> Instance of ODBCDialog
107#
108#/////////////////////////////////////////////////////////////////////////////
109  namespace delete $this
110}
111
112
113#/////////////////////////////////////////////////////////////////////////////
114  proc ::ODBCDialog::ConnectOptions {this} {
115#
116# PURPOSE: Shows the connect options dialog
117#
118# PARAMETERS:
119#   this -> Instance of ODBCDialog
120#
121#/////////////////////////////////////////////////////////////////////////////
122  variable tmpdata
123  upvar #0 ${this}::data data
124     
125  set tmpdata(alias)    $data(alias)
126  set tmpdata(user)     $data(user)
127  set tmpdata(password) $data(pass)
128
129  set dlg [Dialog $data(parent)._cnnopt -title [mc "Connect options"] \
130          -parent $data(parent) -default 0 -cancel 1 -modal local]
131  if $data(status) {
132    $dlg add -text [mc "Disconnect"] -image [::Bitmap::get stop] \
133             -compound right -helptext [mc "Disconnect"] \
134             -relief link -command [list ::ODBCDialog::Disconnect $this]
135  } else  {
136    $dlg add -text [mc "Connect"] -image [::Bitmap::get play]\
137             -compound right -helptext [mc "Connect"] \
138             -relief link -command [list ::ODBCDialog::Connect $this]
139  }
140
141  $dlg add -text [mc "Cancel"] -image [::Bitmap::get cancel]\
142           -compound right -helptext [mc "Cancel"]\
143           -relief link -command "$dlg enddialog cancel"
144   
145  set w [$dlg getframe]
146  wm resizable $dlg 0 0
147
148  set tmpdata(dlg)      $dlg
149  Label $w.lbalias -text "[mc Alias]:"
150  ComboBox $w.cbalias -editable false -textvariable ::ODBCDialog::tmpdata(alias)
151#  bcombobox $w.cbalias -editable false \
152#            -textvariable ::ODBCDialog::tmpdata(alias) \
153#            -bkeypress true
154  set tmpdata(cbalias) $w.cbalias
155  Label $w.lbuser -text "[mc User]:"
156  Entry $w.euser  -textvariable ::ODBCDialog::tmpdata(user)
157  Label $w.lbpass -text "[mc Password]:"
158  Entry $w.epass  -show "*" -textvariable ::ODBCDialog::tmpdata(password)
159  set tmpdata(datasources) [lsort -index 0 [database datasources]]
160#  puts "DataSources : $tmpdata(datasources)"
161  set all_alias ""
162  foreach al $tmpdata(datasources) {
163    lappend all_alias [lindex $al 0]
164  }
165#  puts "ALL_alias: $all_alias"
166  SetControlsStatus $this $data(status)
167  $w.cbalias configure -values $all_alias
168  grid $w.lbalias      -row 0 -column 0 -sticky e -padx 4
169  grid $w.cbalias      -row 0 -column 1 -sticky w -padx 2
170  grid $w.lbuser       -row 1 -column 0 -sticky e -padx 4
171  grid $w.euser        -row 1 -column 1 -sticky w -padx 2
172  grid $w.lbpass       -row 2 -column 0 -sticky e -padx 4
173  grid $w.epass        -row 2 -column 1 -sticky w -padx 2
174  grid rowconfigure $w 1 -pad 6
175
176  set result [$dlg draw]
177  puts "draw == $result"
178  if { [string equal $result "ok"] } {
179    #::BayesTable::SetOption $this alias    $tmpdata(alias)
180    #::BayesTable::SetOption $this user     $tmpdata(user)
181    #::BayesTable::SetOption $this password $tmpdata(password)
182    array unset tmpdata
183  }
184  array unset tmpdata
185  destroy $dlg
186  return $result
187}
188
189
190#/////////////////////////////////////////////////////////////////////////////
191  proc ::ODBCDialog::SetControlsStatus {this status} {
192#
193# PURPOSE: Sets controls state to normal/disabled according to connection
194#          status.
195#
196# PARAMETERS:
197#   this   -> Instance of ODBCDialog
198#   status -> connection status (1 connected, 0 disconnected)
199#
200#/////////////////////////////////////////////////////////////////////////////
201  variable tmpdata
202  set w [$tmpdata(dlg) getframe]
203  if $status {
204   set newStat disabled
205  } else  {
206   set newStat normal
207  }
208  $w.cbalias configure -state $newStat
209  $w.euser   configure -state $newStat
210  $w.epass   configure -state $newStat
211}
212
213
214#/////////////////////////////////////////////////////////////////////////////
215  proc ::ODBCDialog::Connect {this} {
216#
217# PURPOSE: Procedure that is called when Connect button is pushed. Checks if
218#          connection can be established and calls user connection procedure.
219#
220# PARAMETERS:
221#   this -> Instance of ODBCDialog
222#
223#/////////////////////////////////////////////////////////////////////////////
224  upvar #0 ${this}::data data
225  variable tmpdata
226
227  blt::busy hold $tmpdata(dlg)
228  update
229  if [catch "database dbtest $tmpdata(alias) $tmpdata(user) $tmpdata(password)" msg] {
230    set data(status) 0
231    MessageDlg ._msgerr -type ok -icon error -message $msg
232  } else {
233    dbtest disconnect
234    set data(status) 1
235    set data(alias) $tmpdata(alias)
236    set data(user)  $tmpdata(user)
237    set data(pass)  $tmpdata(password)
238    set idx [$tmpdata(cbalias) getvalue]
239    set datasource [lindex $tmpdata(datasources) $idx]
240    # write .ini
241    ::ODBCDialog::WriteIni $this $tmpdata(alias) $tmpdata(user)
242    #User procedure
243    set args [list $tmpdata(alias) $tmpdata(user) $tmpdata(password) $datasource]
244    if { [string length $data(OnConnect)] } {
245      eval $data(OnConnect) $args
246    }
247    #database connect db $tmpdata(alias) $tmpdata(user) $tmpdata(password)
248    #::BayesTable::SetOption $this "db" db
249    $tmpdata(dlg) enddialog ok
250  }
251  blt::busy release $tmpdata(dlg)
252}
253
254
255#/////////////////////////////////////////////////////////////////////////////
256  proc ::ODBCDialog::Disconnect {this} {
257#
258# PURPOSE: Procedure that is called when Disconnect button is pushed.
259#          Configures ODBC dialog and calls user disconnect procedure.
260#
261# PARAMETERS:
262#   this -> Instance of ODBCDialog
263#
264#/////////////////////////////////////////////////////////////////////////////
265  variable tmpdata
266  upvar #0 ${this}::data data 
267  set data(status) 0
268  SetControlsStatus $this $data(status)
269  set idx [$tmpdata(cbalias) getvalue]
270  set datasource [lindex $tmpdata(datasources) $idx]
271  # write .ini
272  ::ODBCDialog::WriteIni $this
273  #User procedure
274  set args [list $tmpdata(alias) $tmpdata(user) $tmpdata(password) datasource]
275  if { [string length $data(OnDisconnect)] } {
276    eval $data(OnDisconnect) $args
277  }
278  $tmpdata(dlg) itemconfigure 0 -text [mc "Connect"] -image [::Bitmap::get play]\
279             -compound right -helptext [mc "Connect"] \
280             -relief link -command [list ::ODBCDialog::Connect $this]
281}
282
283#/////////////////////////////////////////////////////////////////////////////
284  proc ::ODBCDialog::ReadIni {} {
285#
286# PURPOSE: Read configuration file
287#
288# RETURN: Values configuration connection ODBC. Alias User
289#
290#/////////////////////////////////////////////////////////////////////////////
291  # cargamos variables de conexion a la BD
292  set alias  [::iniFile::Read TolBaseODBC DataSource  ""]
293  set user   [::iniFile::Read TolBaseODBC UserId      ""]
294  return [list $alias $user]
295}
296
297#/////////////////////////////////////////////////////////////////////////////
298  proc ::ODBCDialog::WriteIni {this {alias ""} {user ""}} {
299#
300# PURPOSE: Write configuration file
301#
302# PARAMETERS:
303#   this -> Instance of ODBCDialog
304#   alias -> data sourece
305#   user  -> user connection
306#
307#/////////////////////////////////////////////////////////////////////////////
308  variable tmpdata
309  ::iniFile::Write TolBaseODBC DataSource $alias
310  ::iniFile::Write TolBaseODBC UserId     $user
311}
312
313#/////////////////////////////////////////////////////////////////////////////
314# TESTING
315#/////////////////////////////////////////////////////////////////////////////
316#
317#proc UserConnect {alias user pass datasource} {
318#  global galias guser gpass
319#  database connect db $alias $user $pass
320#  puts "galias=$galias, guser=$guser, gpass=$gpass"
321#  puts "alias=$alias, user=$user, pass=$pass, datasource=$datasource"
322#  puts "db= db"
323#}
324#
325#     set galias ICIPP
326#     set guser icipp
327#     set gpass icipp
328#     toplevel .t
329#     set this [::ODBCDialog::Create .t  $galias $guser $gpass ::UserConnect]
330#     ::ODBCDialog::ConnectOptions $this
331#/////////////////////////////////////////////////////////////////////////////
Note: See TracBrowser for help on using the repository browser.