source: tol/tolbase/lib/byswidget/bodbc/bodbc.tcl @ 0e1eabc

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

blt::busy should not be used because it may crash.

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@4043 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 29.8 KB
RevLine 
[6d7779d]1#/////////////////////////////////////////////////////////////////////////////
2# FILE    : bodbc.tcl
3# PURPOSE : This file contains a namespace called BODBC with its
4#           functions. It's for creating a ODBC connect options dialog and
5#           managing its events.
6#/////////////////////////////////////////////////////////////////////////////
7
8# INCLUDES
9package require byscommon
10package require bcombobox
11package require bfunctions
12
13
14#/////////////////////////////////////////////////////////////////////////////
15snit::type bodbcmodule {
16#
17# PURPOSE: BODBCModule widget class definition
18#
19#/////////////////////////////////////////////////////////////////////////////
20#/////////////////////////////////////////////////////////////////////////////
21#
22# options:
23#   module        -> Name of modules to connect
24#   stdtolcon     -> Connection TOL : true
25#   stdtclcon     -> Connection TCL : true
26#   procconnect   -> Function connect : {}
27#   prodisconnect -> Function disconnect : {}
28#   iniconfig     -> Header in .ini file : $modele
29#   savealias     -> Save "alias" in .ini : true
30#   saveuser      -> Save "user" in .ini : true
31#   savepwd       -> Save "pwd" in .ini : false
32#   alias         -> Alias by defect
33#   user          -> User by defect
34#   pwd           -> Password by defect
35#   connection    -> name of connection TCL
36#   autoconnect   -> connects automatically with Data Base
37#   
38#/////////////////////////////////////////////////////////////////////////////
39  delegate option * to hull
40
41  option -stdtolcon     true
42  option -stdtclcon     true
43  option -procconnect   {}
44  option -prodisconnect {}
45  option -iniconfig     {}
46  option -savealias     true
47  option -saveuser      true
48  option -savepwd       false
49  option -alias         {}
50  option -user          {}
51  option -pwd           {}
52  option -gestor        {}
53  option -name          {}
54  option -connection    {}
55  option -autoconnect   false
56
57  #///////////////////////////////////////////////////////////////////////////
58  constructor { args } {
59  #
60  # PURPOSE: beditselector constructor
61  #
62  # PARAMETERS:
63  #   args -> options
64  #
65  #///////////////////////////////////////////////////////////////////////////
66    # Apply all options passed at creation time.
67    $self configurelist $args
68    # load parameters .ini
69    $self _LoadParamIni
70  }
71
72  #///////////////////////////////////////////////////////////////////////////
73  method _LoadParamIni {} {
74  #
75  # PURPOSE: To recover values of the configuration file
76  #
77  #///////////////////////////////////////////////////////////////////////////
78    # load parameters from ini
79    if {[string length [$self cget -iniconfig]]} {
80Tolcon_Trace "_LoadParamIni ..."
81      set key [$self cget -iniconfig]
82      if {[$self cget -savealias]} {
83        $self configure -alias  \
84          [::iniFile::Read $key DataSource [$self cget -alias] ]
85      }
86      if {[$self cget -saveuser]} {
87        $self configure -user \
88          [::iniFile::Read $key Userid     [$self cget -user]]
89      }
90      if {[$self cget -savepwd]} {
91        $self configure -pwd \
92          [::iniFile::Read $key Password   [$self cget -pwd]]
93      }     
94    }
95  }
96
97
98  #///////////////////////////////////////////////////////////////////////////
99  method get { var} {
100  #
101  # PURPOSE: Obtain the value of a variable
102  #
103  # PARAMETERS: var -> name of variable
104  #
105  # RETURN: value of variable
106  #
107  #///////////////////////////////////////////////////////////////////////////
108    return [subst $[subst "$var"]]
109  }
110   
111  #///////////////////////////////////////////////////////////////////////////
112  method set { var value } {
113  #
114  # PURPOSE: Establish the value of a variable
115  #
116  # PARAMETERS: var -> name of variable
117  #             value -> values of variable
118  #
119  #///////////////////////////////////////////////////////////////////////////
120    set [subst $var] $value
121  }
122}
123
124
125#/////////////////////////////////////////////////////////////////////////////
126snit::type bodbc {
127#
128# PURPOSE: BODBC type class definition
129#
130#/////////////////////////////////////////////////////////////////////////////
131#/////////////////////////////////////////////////////////////////////////////
132# variables:
133#   lstConnection -> list of list. Name module  and  variable connection
134#   widget        -> array of name of widget
135#   counter       -> variable accountant
136#
137#/////////////////////////////////////////////////////////////////////////////
138  delegate option * to hull
139
140  variable lstConnection     {}
141  variable widget
142  variable counter 0
143 
144  #///////////////////////////////////////////////////////////////////////////
145  method showdialog { { namMod {} } } {
146  #
147  # PURPUSE: Show the dialog
148  #
149  # PARAMETERS:
150  #   namMod -> if it is specified I name of module, it asks for its information.
151  #             ESLE
152  #             it shows box of selection of module
153  #
154  #///////////////////////////////////////////////////////////////////////////
155    set module {}
156    # one connection ?
157    if {[string length $namMod]} {
158      set module [$self _GetModuleToName $namMod]
159    } else {
160      switch -exact [llength $lstConnection] {
161        0 { return 0 }
162        1 { set module [lindex [lindex $lstConnection 0] 1] }
163      }
164    }
165    # create dialog
166    if {[string length $module]} {
167      $self _CreateDialog $module
168    } else  {
169      $self _CreateDialog
170    }
171  }
172
173  #///////////////////////////////////////////////////////////////////////////
174  method validateconnection { namMod } {
175  #
176  # PURPUSE: it verifies if we are connected to the data base, else, show
177  #          selection dialog   
178  #
179  # PARAMETERS:
180  #   namMod -> if it is specified I name of module, it asks for its information.
181  #
182  # RETURN: 1 -> connection OK
183  #         0 -> error
184  #       
185  #///////////////////////////////////////////////////////////////////////////
186    # get module
187    set module [$self _GetModuleToName $namMod]
188    if {![string length module]} {
189#Tolcon_Trace "ValidateConnection. El modulo $namMod no existe"
190      return 0
191    } 
192   
193    # connection TCL && TCL
194    set status [$self checkconnection $module]
195    # activate connection TOL
196    if {($status) && ([$module cget -stdtolcon])} {
197      set op [GetUniqueName Real _ActTOLTK]
198      set alias  [$module cget -alias]
199      set cmd "Real $op = DBActivate(\"$alias\");"
200      ::tol::console eval $cmd
201      ::tol::console stack release $op
202    }
203    # Auto connect
204    if {[expr !$status && [$module cget -autoconnect]]} {
205      set alias  [$module cget -alias]
206      set user   [$module cget -user]
207      set pwd    [$module cget -pwd]
208      set status [$self _Connect $module $alias $user $pwd]
209    }
210       
211    # Dialogo
212    if {!$status} {
213      set status [$self _CreateDialog $module]
214    }
215    # return
216#Tolcon_Trace "validateconnection $status"
217    return $status
218  }
219
220
221  #///////////////////////////////////////////////////////////////////////////
222  method checkconnection {module} {
223  #
224  # PURPUSE: Verifies if its are connected to the data base in TCL and TOL
225  #
226  # PARAMETERS:
227  #   module: name of connection (bodbcmodule)
228  #
229  # RETURN: 1 -> connection
230  #         0 -> no
231  #       
232  #///////////////////////////////////////////////////////////////////////////
233    # connection TCL
234    set statusTcl [$self checkconnectiontcl $module]
235    # connection TOL
236    set statusTol [$self checkconnectiontol $module]
237#Tolcon_Trace "CheckConnection [expr $statusTcl && $statusTol]"
238    return [expr $statusTcl && $statusTol]
239  }
240
241  #///////////////////////////////////////////////////////////////////////////
242  method checkconnectiontcl {module} {
243  #
244  # PURPUSE: Verifies if is are connected to the data base in TCL
245  #
246  # PARAMETERS:
247  #   module: name of connection (bodbcmodule)
248  #
249  # RETURN: 1 -> connection
250  #         0 -> no
251  #       
252  #///////////////////////////////////////////////////////////////////////////
253#Tolcon_Trace "checkconnectiontcl $module"
254    set result 1
255
256    # connection TCL ?
257    if {[$module cget -stdtclcon]} {
258      if {[string length [$module cget -connection]]} {
259        if {[catch "[$module cget -connection] statement get tables" msg]} {
260          # no connection
261          #Tolcon_Trace "No conectado a TCL"
262          set result 0
263        }
264      } else {
265        #Tolcon_Trace "No conectado a TCL"
266        set result 0
267      }
268    }
269#Tolcon_Trace "checkconnectiontcl $result"
270    return $result
271  }
272
273  #///////////////////////////////////////////////////////////////////////////
274  method checkconnectiontol {module} {
275  #
276  # PURPUSE: Verifies if is are connected to the data base in TOL
277  #
278  # PARAMETERS:
279  #   module: name of connection (bodbcmodule)
280  #
281  # RETURN: 1 -> connection
282  #         0 -> no
283  #       
284  #///////////////////////////////////////////////////////////////////////////
285#Tolcon_Trace "checkconnectiontol ... module: $module"
286    set status 1
287    # connection TOL
288    if {[$module cget -stdtolcon]} {
289      # parameters
290      set alias [$module cget -alias]
291      # connect tol ?
292      set status [GetAliasOpen $alias]
293    }
294#Tolcon_Trace "CheckConnectionTol.end = $status"
295    return $status
296  }
297
298  #///////////////////////////////////////////////////////////////////////////
299  method _ConnectDlg {} {
300  #
301  # PURPUSE: Makes connection a TOL and TCL with dialog
302  #
303  #///////////////////////////////////////////////////////////////////////////
304#Tolcon_Trace "ConnectDlg  ..."
305#    variable widget
306    # wait
[0e1eabc]307    if { 0 } {
308      blt::busy hold $widget(dlg)
309      update
310    }
[6d7779d]311    # _Connect
312    set mamMod [BfoGetText $widget(module)]
313    # get module
314    set module {}
315    set lst [ltraspose $lstConnection]
316    set inx [lsearch [lindex $lst 0] $mamMod]
317    if {[expr $inx != -1]} {
318      set module [lindex [lindex $lst 1] $inx]
319    }
320#Tolcon_Trace "Nombre del module: mamMod ; Modulo a cargar: $module"
321    set alias [BfoGetText $widget(alias)]
322    set user  [BfoGetText $widget(user)]
323    set pwd   [BfoGetText $widget(pwd)]
324    set status [$self _Connect $module $alias $user $pwd]
325    # OK -> close dialog ?
326    if {$status} {
327      $widget(dlg) enddialog ok
328    }
329    # end wait
[0e1eabc]330    if { 0 } {
331      blt::busy release $widget(dlg)
332    }
[6d7779d]333  }
334
335  #///////////////////////////////////////////////////////////////////////////
336  method _Connect {module alias user pwd} {
337  #
338  # PURPUSE: Makes connection a TOL and TCL
339  #
340  # PARAMETERS:
341  #   module: name of connection (bodbcmodule)
342  #   alias: name od bridge
343  #   user: name of user
344  #   pwd: password
345  #
346  #///////////////////////////////////////////////////////////////////////////
347    # parameters
348
349Tolcon_Trace "_Connect: module: $module  alias: $alias  user: $user  pwd: $pwd"
350    # connection TCL
351    set statusTcl [$self _ConnectTcl $module $alias $user $pwd]
352    # connection TOL
353    set statusTol [$self _ConnectTol $module $alias $user $pwd]
354#Tolcon_Trace "Connect: [expr $statusTcl && $statusTol]"
355    # .ini ?
356    if {[string length [$module cget -iniconfig]]} {
357#Tolcon_Trace ".ini"
358      if {[$module cget -savealias]} {
359        ::iniFile::Write [$module cget -iniconfig] DataSource $alias
360      }
361      if {[$module cget -saveuser]} {
362        ::iniFile::Write [$module cget -iniconfig] Userid     $user
363      }
364      if {[$module cget -savepwd]} {
365        ::iniFile::Write [$module cget -iniconfig] Password   $pwd
366      }
367    }
368    # update parameters
369    $module configure -alias $alias
370    $module configure -user  $user
371    $module configure -pwd   $pwd
372 
373    set gestor [SqlGetGestor [SqlGetDriver $alias]]
374    $module configure -gestor $gestor
375 
376    # execute proc ?
377    if {[string length [$module cget -procconnect]]} {
378#Tolcon_Trace "execute proc"
379      eval [$module cget -procconnect]
380    }
381
382    # OK ?
383    return [expr $statusTcl && $statusTol]
384  }
385
386  #///////////////////////////////////////////////////////////////////////////
387  method _ConnectTcl {module alias user pwd} {
388  #
389  # PURPUSE: Makes connection a TCL
390  #
391  # PARAMETERS:
392  #   module: name of connection (bodbcmodule)
393  #   alias: name od bridge
394  #   user: name of user
395  #   pwd: password
396  #
397  # RETURN:
398  # RETURN: 1 -> connection
399  #         0 -> no   
400  #
401  #///////////////////////////////////////////////////////////////////////////
402#Tolcon_Trace "_ConnectTcl: module: $module  alias: $alias  user: $user  pwd: $pwd Connect: [$module cget -stdtclcon]"
403    set status 1
404    # connection TCL
405    if {[$module cget -stdtclcon]} {
406      if {[$self checkconnectiontcl $module]} {
407        set status [$self _DisconnectTcl $module]
408      }
409      if {$status} {
410        if {[string length [$module cget -connection]]} {
411          set con [$module cget -connection]
412        } else  {
413          set con [$self _UniqueName [$module cget -name]]
414        }
415        if [catch "database $con $alias $user $pwd" msg] {
416          set status 0
417          $module configure -connection {}
418          MessageDlg ._msgerr -type ok -icon error -message $msg
419        } else  {
420          $module configure -connection $con
421        }
422      }
423#Tolcon_Trace "ConnectTcl = $status"
424    }
425    # return
426    return $status
427  }
428
429  #///////////////////////////////////////////////////////////////////////////
430  method _ConnectTol {module alias user pass} {
431  #
432  # PURPUSE: Makes connection a TOL
433  #
434  # PARAMETERS:
435  #   module: name of connection (bodbcmodule)
436  #   alias: name od bridge
437  #   user: name of user
438  #   pwd: password
439  #
440  # RETURN:
441  # RETURN: 1 -> connection
442  #         0 -> no 
443  #
444  #///////////////////////////////////////////////////////////////////////////
445#Tolcon_Trace "_ConnectTol: module: $module  alias: $alias  user: $user  pwd: $pwd Connect: [$module cget -stdtolcon]"
446    if {[$module cget -stdtolcon]} {
447      if {[$self checkconnectiontol $module]} {
448        # intento activarla
449        #
450        if {[$self _ActivateAlias $alias]} {
451          # el alias ha sido activado correctamente
452          #
453          return 1
454        } else {
455          # Algo ha ido mal, me dijeron que el alias estaba abierto
456          # pero no pude activarlo.
457          #
458          $self _CloseAlias $alias
459        }
460      }
461      return [$self _OpenAlias $alias $user $pass]
462    }
463    return 1
464  }
465
466  method _OpenAlias { alias user pass } {
467    tol::console eval [string map "%A $alias %U $user %P $pass" {
468      Real __dbopen_status__ = DBOpen("%A","%U","%P");
469    }]
[fd65ddb]470    set status [lindex [tol::info variable [list Real __dbopen_status__]] 0]
[6d7779d]471    tol::console stack release __dbopen_status__
472    expr {$status>0.0}
473  }
474
475  method _ActivateAlias { alias } {
476    tol::console eval [string map "%A $alias" {
477      Real __dbact_status__ = DBActivate("%A");
478    }]
[fd65ddb]479    set status [lindex [tol::info variable [list Real __dbact_status__]] 0]
[6d7779d]480    tol::console stack release __dbact_status__
481    expr {$status>0.0}
482  }
483
484  method _CloseAlias { alias } {
485    tol::console eval [string map "%A $alias" {
486      Real __dbclose_status__ = DBClose("%A");
487    }]
[fd65ddb]488    set status [lindex [tol::info variable [list Real __dbclose_status__]] 0]
[6d7779d]489    tol::console stack release __dbclose_status__
490    expr {$status>0.0}
491  }
492
493  #///////////////////////////////////////////////////////////////////////////
494  method _Disconnect { } {
495  #
496  # PURPUSE: Makes disconnect of TOL and TCL
497  #
498  # RETURN: 1 -> disconnect
499  #         0 -> error   
500  #
501  #///////////////////////////////////////////////////////////////////////////
502#Tolcon_Trace "Disconnect ..."
503    # get module
504    set lst [ltraspose $lstConnection]
505    set inx [lsearch [lindex $lst 0] [BfoGetText $widget(module)]]
506    if {[expr $inx != -1]} {
507        set module [lindex [lindex $lst 1] $inx]
508    }
509    # parameters
510    set alias [BfoGetText $widget(alias)]
511    # disconnect TOL
512    set statusTol [$self _DisconnectTol $module $alias]
513
514    # disconnect TCL
515    set statusTcl [$self _DisconnectTcl $module]
516
517    # control status
518    SetControlsStatus $self $widget(dlg) [expr !($statusTol && $statusTcl)]
519
520    # execute proc ?
521    if {[string length [$module cget -prodisconnect]]} {
522#Tolcon_Trace "Disconnect ... proc"
523      eval [$module cget -prodisconnect]
524    }
525    # return
526#Tolcon_Trace "Disconnect = [expr $statusTol && $statusTcl]"
527    return [expr $statusTol && $statusTcl]
528  }
529
530  #///////////////////////////////////////////////////////////////////////////
531  method _DisconnectTol {module alias} {
532  #
533  # PURPUSE: Makes disconnect of TOL
534  #
535  # PARAMETERS:
536  #   module: name of connection (bodbcmodule)
537  #   alias: name od bridge
538  #
539  # RETURN:
540  # RETURN: 1 -> disconnect
541  #         0 -> no 
542  #
543  #///////////////////////////////////////////////////////////////////////////
544#Tolcon_Trace "_DisconnectTol. module:  $module alias: $alias Disconnect: [$module cget -stdtolcon]"
545    set status 1
546    # disconnect TOL
547    if {[$module cget -stdtolcon]} {
548      # connecition TOL ?
549      set connect [GetAliasOpen $alias]
550      if {$connect} {
551        set op [GetUniqueName Real]
552        set cmd "Real $op =  DBClose(\"$alias\");"
553        ::tol::console eval $cmd
554        array set aryInfo [TclInfoVar Real $op]
555        #> 1 -> OK, 0 -> ERROR
556        set status [lindex $aryInfo(CONTENT) 0]
557        unset aryInfo
558        ::tol::console stack release $op
559      }
560#Tolcon_Trace "Disconnect: $status"
561    }
562    # return
563    return $status
564  }
565
566  #///////////////////////////////////////////////////////////////////////////
567  method _DisconnectTcl {module} {
568  #
569  # PURPUSE: Makes disconnect of TCL
570  #
571  # PARAMETERS:
572  #   module: name of connection (bodbcmodule)
573  #   alias: name od bridge
574  #
575  # RETURN:
576  # RETURN: 1 -> disconnect
577  #         0 -> no 
578  #
579  #///////////////////////////////////////////////////////////////////////////
580#Tolcon_Trace "DisconnectTcl .... module: $module  Disconnect: [$module cget -stdtclcon]"
581    set status 1
582    # disconnect TCL
583    if {[$module cget -stdtclcon]} {
584      set con [$module cget -connection]
585      if {[string length $con]} {
586        $con disconnect
587      }
588#Tolcon_Trace "DisconnectTcl = $status"
589    }
590    # return
591    return $status
592  }
593
594  #///////////////////////////////////////////////////////////////////////////
595  method _CreateDialog { {module {}} } {
596  #
597  # PURPOSE: Shows the connect options dialog
598  #
599  # PARAMETERS:
600  #   module: name of connection (bodbcmodule)
601  #
602  #///////////////////////////////////////////////////////////////////////////
603Tolcon_Trace "CreateDialog: module: $module"   
604    set status 0
605    # exists module ?
606    set alias    {}
607    set user     {}
608    set password {}
609    if {[string length $module]} {
610      # parameters
611      set alias    [$module cget -alias]
612      set user     [$module cget -user]
613      set password [$module cget -pwd]
614      # connection
615      set status [$self checkconnection $module]
616    }
617
618    set widget(dlg) [set dlg \
619      [Dialog ._cnnopt -title [mc "Connect options"] \
620               -parent . -default 0 -cancel 1 -modal local]]
621    if {$status} {
622      $dlg add -text [mc "Disconnect"] -image [::Bitmap::get stop] \
623               -compound right -helptext [mc "Disconnect"] \
624               -relief link -command [list $self _Disconnect]
625    } else  {
626      $dlg add -text [mc "Connect"] -image [::Bitmap::get play]\
627               -compound right -helptext [mc "Connect"] \
628               -relief link -command [list $self _ConnectDlg]
629    }
630   
631    $dlg add -text [mc "Cancel"] -image [::Bitmap::get cancel]\
632             -compound right -helptext [mc "Cancel"]\
633             -relief link -command "$dlg enddialog cancel"
634   
635    set w [$dlg getframe]
636    wm resizable $dlg 0 0
637    bind $widget(dlg) <F1> "ShowHelp Tb4Cbd"
638
639    # one module ?
640    Label $w.lbmodule -text "[mc Connection]:"
641    if {[string length $module]} {
642      set widget(module) [Entry $w.ecbmodule -editable false \
643                                             -text [$module cget -name]]
644    } else {
645      set widget(module) \
646        [ComboBox $w.ecbmodule -editable false \
647           -values [lindex [ltraspose $lstConnection] 0] \
648           -modifycmd [list $self _ModifyLstConnection]]
649# BComboBox (desactivado hasta que se realize un nuevo BComboBox)
650#        [bcombobox $w.ecbmodule -editable false \
651                   -values [lindex [ltraspose $lstConnection] 0] \
652                   -bkeypress true \
653                   -modifycmd [list $self _ModifyLstConnection]]
654    }
655    Label $w.lbalias -text "[mc Alias]:"
656    #ComboBox $w.cbalias
657    #  -editable false -textvariable $alias
658    set widget(alias) \
659      [ComboBox $w.cbalias -editable false \
660         -text $alias]
661# BComboBox (desactivado hasta que se realize un nuevo BComboBox)
662#      [bcombobox $w.cbalias -editable false \
663                 -text $alias \
664                 -bkeypress true]
665    Label $w.lbuser -text "[mc User]:"
666    set widget(user) [Entry $w.euser -text $user]
667    Label $w.lbpass -text "[mc Password]:"
668    set widget(pwd) [Entry $w.epass  -show "*" -text $password]
669    set datasources [lsort -index 0 [database datasources]]
670    #  puts "DataSources : $datasources"
671    set all_alias ""
672    foreach al $datasources {
673      lappend all_alias [lindex $al 0]
674    }
675    #  puts "ALL_alias: $all_alias"
676    SetControlsStatus $self $dlg $status
677    $w.cbalias configure -values $all_alias
678
679    grid $w.lbmodule     -row 0 -column 0 -sticky e -padx 4
680    grid $w.ecbmodule    -row 0 -column 1 -sticky w -padx 2
681    grid $w.lbalias      -row 1 -column 0 -sticky e -padx 4
682    grid $w.cbalias      -row 1 -column 1 -sticky w -padx 2
683    grid $w.lbuser       -row 2 -column 0 -sticky e -padx 4
684    grid $w.euser        -row 2 -column 1 -sticky w -padx 2
685    grid $w.lbpass       -row 3 -column 0 -sticky e -padx 4
686    grid $w.epass        -row 3 -column 1 -sticky w -padx 2
687    grid rowconfigure $w 1 -pad 6
688   
689    set result [$dlg draw]
690    # puts "draw == $result"
691   
692
693    destroy $dlg
694Tolcon_Trace "_CreateDialog = $result"
695    return $result
696  }
697
698 
699  #///////////////////////////////////////////////////////////////////////////
700  method _ModifyLstConnection {} {
701  #
702  # PURPOSE: Updates the values after a selection
703  #
704  #///////////////////////////////////////////////////////////////////////////
705    # module
706    set namMod [BfoGetText $widget(module)]
707    # load values
708    set module [$self _GetModuleToName $namMod]
709    if {[string length $module]} {
710      $widget(alias) configure -text [$module cget -alias]
711      $widget(user)  configure -text [$module cget -user]
712      $widget(pwd)   configure -text [$module cget -pwd]
713      # control state
714      SetControlsStatus $self $widget(dlg) [$self checkconnection $module]
715    } else {
716      $widget(alias) configure -text {}
717      $widget(user)  configure -text {}
718      $widget(pwd)   configure -text {}
719    }
720   
721    # set the focus in the first field not filled
722    if {!([$module cget -alias] eq "")} {
723      if {!([$module cget -user] eq "")} {
724        if {!([$module cget -pwd] eq "")} {
725          focus $widget(module)
726        } else {
727          focus $widget(pwd)
728        }         
729      } else {
730        focus $widget(user)
731      }       
732    } else {
733      focus $widget(alias)
734    }
735  }
736
737  #/////////////////////////////////////////////////////////////////////////////
738  proc SetControlsStatus {self dlg status} {
739  #
740  # PURPOSE: Sets controls state to normal/disabled according to connection
741  #          status.
742  #
743  # PARAMETERS:
744  #   self   -> instancia of bodbc
745  #   dlg    -> Instance of ODBCDialog
746  #   status -> connection status (1 connected, 0 disconnected)
747  #
748  #/////////////////////////////////////////////////////////////////////////////
749    set w [$dlg getframe]
750    if {$status} {
751      set newStat disabled
752      # button disconnect
753      $dlg itemconfigure 0 -text [mc "Disconnect"] -image [::Bitmap::get stop]\
754             -compound right -helptext [mc "Disconnect"] \
755             -relief link -command [list $self _Disconnect]
756    } else  {
757      set newStat normal
758      #button disconnect
759      $dlg itemconfigure 0 -text [mc "Connect"] -image [::Bitmap::get play]\
760             -compound right -helptext [mc "Connect"] \
761             -relief link -command [list $self _ConnectDlg]
762     
763    }
764    $w.cbalias configure -state $newStat
765    $w.euser   configure -state $newStat
766    $w.epass   configure -state $newStat
767   
768    if {[$w.epass cget -text] eq ""} {
769      focus $w.epass
770    }
771    # set the focus in the first field not filled
772    if {!([$w.cbalias cget -text] eq "")} {
773      if {!([$w.euser cget -text] eq "")} {
774        if {!([$w.epass cget -text] eq "")} {
775          focus $dlg
776        } else {
777          focus $w.epass
778        }         
779      } else {
780        focus $w.euser
781      }       
782    } else {
783      focus $w.cbalias
784    }
785   
786  }
787
788
789  #///////////////////////////////////////////////////////////////////////////
790  method connection {args} {
791  #
792  # PURPOSE: Create a new module
793  #
794  # PARAMETERS:
795  #   args: parameters of bodbcmodule
796  #
797  #///////////////////////////////////////////////////////////////////////////
798    # parameters default
799    array set opts [list \
800                      -name   {} \
801                   ]
802    array set opts $args   
803    # exists $mod ?
804    if {[string length $opts(-name)]} {
805      if {[info exists lstConnection]} {
806        set lst [lindex [ltraspose $lstConnection] 0]
807        if {[expr [lsearch $lst $opts(-name)] != -1]} {
808          puts "Error. Modulo ya asignado."
809          return {}
810        }
811      }
812    } else  {
813      puts "Error. No se ha especificado un nombre al modulo"
814      return {}
815    }
816    # create a new module
817    set namCon [$self _UniqueName $opts(-name)]
818    set namMod [eval ::bodbcmodule $namCon $args]
819    lappend lstConnection "$opts(-name) $namMod"
820    return $namMod
821  }
822
823  #///////////////////////////////////////////////////////////////////////////
824  method unregister {module} {
825  #
826  # PURPOSE: Eliminated one module register
827  #
828  # PARAMETERS:
829  #   module: name of connection (bodbcmodule)
830  #
831  #///////////////////////////////////////////////////////////////////////////
832    # eliminate register
833    set lst [ltraspose $lstConnection]
834    set inx [lsearch [lindex $lst 1] $module]
835    if {[expr $inx != -1]} {
836      set lstConnection [lreplace $lstConnection $inx $inx]
837      # disconnect
838      if {[$self checkconnectiontcl $module]} {
839        $self _DisconnectTcl $module
840      }
841      if {[$self checkconnectiontol $module]} {
842        $self _DisconnectTol $module [$module cget -alias]
843      }
844      # destroy
845      $module destroy
846    }
847  }
848 
849
850  #///////////////////////////////////////////////////////////////////////////
851  method get { var } {
852  #
853  # PURPOSE: Obtain the value of a variable
854  #
855  # PARAMETERS: var -> name of variable
856  #
857  # RETURN: value of variable
858  #
859  #///////////////////////////////////////////////////////////////////////////
860    return [subst $[subst "$var"]]
861  }
862
863  #///////////////////////////////////////////////////////////////////////////
864  method _UniqueName { namMod } {
865  #
866  # PURPOSE: Obtain a unique name
867  #
868  # RETURN: name of bodbcmodule
869  #
870  #///////////////////////////////////////////////////////////////////////////
871    set lst [lindex [ltraspose $lstConnection] 1]
872    while 1 {
873      incr counter
874      if {$counter > 2147483647} {
875        set counter 0
876      }
877      set candidate db${namMod}${counter}
878      if {[expr [lsearch $lst $candidate] == -1]} {
879        return $candidate
880      }
881    }
882  }
883
884  #///////////////////////////////////////////////////////////////////////////
885  method _GetModuleToName { namMod } {
886  #
887  # PURPOSE: From the name of I modulate, we obtain the name of connection TCL
888  #
889  # PARAMETERS:
890  #   namMod -> name of module
891  #
892  # RETURN: name of connection TCL
893  #
894  #///////////////////////////////////////////////////////////////////////////
895    set module {}
896    if {[string length $namMod]} {
897      set lst [ltraspose $lstConnection]
898      set inx [lsearch [lindex $lst 0] $namMod]
899      if {[expr $inx != -1]} {
900        set module [lindex [lindex $lst 1] $inx]
901      } else {
902        set module {}
903      }
904    }
905    return $module
906  }
907
908  #///////////////////////////////////////////////////////////////////////////
909  proc GetAliasOpen {alias} {
910  #
911  # PURPOSE: It verifies that connection TOL this open one
912  #
913  # PARAMETERS: alias -> name of bridget
914  #
915  # RETURN: 1 -> open
916  #         0 -> no
917  #
918  #///////////////////////////////////////////////////////////////////////////
919
920    set result 0
921    # command
922    set op [GetUniqueName Set]
923    set cmd "Set $op = DBGetOpened(\"\");"
924    # evaluation
925    ::tol::console eval $cmd
926    #Capturar el valor devuelto por TOL
927    array set aryInfo [TclInfoVar Set $op]
928    set lenAry [lindex $aryInfo(CONTENT) 0]
929    set inx 1
930    while {!($result) && ([expr $inx <= $lenAry])} {
[47cbb8f]931      array set infoReg [TclInfoRef [list Set $op $inx 1]]
[6d7779d]932      set aliasConn [lindex $infoReg(CONTENT) 0]
933      if {[string equal $alias $aliasConn]} {
934        set result 1
935      }
936      incr inx
937    }
938    ::tol::console stack release $op
939    # return
940#Tolcon_Trace "GetAliasOpen $result"
941    return $result
942  }
943}
944
945
946#/////////////////////////////////////////////////////////////////////////////
947proc test_bodbc {} {
948#
949# PURPOSE: Test function of a bodbc
950#
951#/////////////////////////////////////////////////////////////////////////////
952#  package require msgcat
953#  namespace import msgcat::*
954#  ::msgcat::mclocale es
955 
956  package require tclodbc
957  package require BWidget
958  package require BLT
959  Bitmap::use
960  #lappend Bitmap::path ../images
961
962  if {[winfo exists ._cnnopt]} {
963    destroy ._cnnopt
964  }
965
966  set b [bodbc b]
967
968  set telesp [$b connection -name telesp -alias ddw_ld -user dbo -pwd dbo]
969  set sadd   [$b connection -name sadd   -alias prueba -user bayes -pwd bayes]
970
971  set latam   [$b connection -name latam  -alias TfnLatam -user bayes -pwd bayes \
972     -stdtolcon 0 -stdtclcon 1 -procconnect [list puts "Conexion realizada"] \
973     -prodisconnect [list puts "Deconexión realizada"] \
974     -iniconfig     TflLatamODBC \
975     -savealias     1 \
976     -saveuser      1 \
977     -savepwd       0]
978
979  set prbini  [$b connection -name prbini  \
980     -procconnect [list puts "Conexion realizada"] \
981     -prodisconnect [list puts "Deconexión realizada"] \
982     -iniconfig     PruebaIniODBC \
983     -savealias     1 \
984     -saveuser      1 \
985     -savepwd       1]
986
987
988  $b connection -name sadd
989
990  puts "Modulos cargados: [$b get lstConnection]"
991
992  #$b showdialog
993  $b showdialog
994}
995
996
997package provide bodbc 1.0
Note: See TracBrowser for help on using the repository browser.