source: tol/tolbase/lib/byswidget/bfunctions/bfsql.tcl @ 6d7779d

1941-docker-image-to-testdevel
Last change on this file since 6d7779d 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: 14.6 KB
Line 
1#/////////////////////////////////////////////////////////////////////////////
2# FILE    : bfsql.tcl -> Sql
3# PURPOSE : Bayes Function SQL
4#/////////////////////////////////////////////////////////////////////////////
5
6#///////////////////////////////////////////////////////////////////////////
7proc Sql2Tol { typ } {
8#
9# PURPOSE: For a SQL type returns its equivalent in TOL
10#
11#///////////////////////////////////////////////////////////////////////////
12  set typ [string tolower $typ]
13 
14  switch $typ {
15    "char" -
16    "varchar" -
17    "varchar2" -
18    "long" {
19      return "Text"
20    }
21    "int" -
22    "number" -
23    "decimal" -
24    "numeric" -
25    "float" -
26    "real" -
27    "bit" -
28    "integer" -
29    "money" -
30    "smallmoney" -
31    "tinyint" -
32    "double" {
33      return "Real"
34    }
35    "date" -
36    "datetime" -
37    "smalldatetime" {
38      return "Date"
39    }
40    default {
41      return "Unknown"
42    }
43  }
44}   
45
46#///////////////////////////////////////////////////////////////////////////
47proc NumSql2Tol { typ } {
48#
49# PURPOSE: For a numerical SQL type returns its equivalent in TOL
50#
51#///////////////////////////////////////////////////////////////////////////
52  switch {$typ} {
53    1 - 12 {
54      return "Text"
55    }
56    2 - 3 - 4 - 5 - 6 - 7 - 8 {
57      return "Real"
58    }
59    9 - 10 - 11 {
60      return "Date"
61    }
62    default {
63      return "Text"
64    }
65  }
66}   
67
68#///////////////////////////////////////////////////////////////////////////
69proc SqlListBfilter { db table } {
70#
71# PURPOSE: Creates the list to fill bfilter with all the columns of the
72#          given table.
73#
74#///////////////////////////////////////////////////////////////////////////
75  set cols [$db columns $table]
76  set res {}
77  foreach col $cols {
78    set name [lindex $col 3]
79    set typ [Sql2Tol [lindex $col 5]]
80    set func [list "TolGetFieldValues $table $name $db"]
81    set mcname [mc $name]
82    lappend res "$name $typ {} $func $mcname"
83  }
84  return $res
85}
86
87
88#///////////////////////////////////////////////////////////////////////////
89proc SqlGetDriver {alias} {
90#
91# PURPOSE: Devuelve el driver utilizado por una conexión tclODBC dado el
92#          alias (datasource name).
93#
94#///////////////////////////////////////////////////////////////////////////
95  set driver ""
96  set lst [database datasources]
97  foreach ite $lst {
98    set name [lindex $ite 0]
99    if {$name eq $alias} {
100      set driver [lindex $ite 1]
101      break
102    }
103  }
104  return $driver
105}
106
107#///////////////////////////////////////////////////////////////////////////
108proc SqlGetGestor {driver} {
109#
110# PURPOSE: Devuelve el gestor de una conexión tclODBC dado el driver
111#          TODO: Verificar y ampliar con más drivers
112#
113# RETURNS: Devuelve un identificador de Gestor de Base de Datos o vacio
114#    Mic -> Sql Server
115#    Ora -> Oracle
116#
117#///////////////////////////////////////////////////////////////////////////
118  set gestor ""
119
120  switch -regexp $driver  {
121    SQL.Server   { set gestor Mic }
122    Oracle*      { set gestor Ora }
123    MySql -       
124    MySQL        { set gestor Mys }
125    TDS          { set gestor Mic }
126  }
127  return $gestor
128}
129
130#///////////////////////////////////////////////////////////////////////////
131proc SqlGetTolGestor {gestor} {
132#
133# PURPOSE: Devuelve el gestor asociado a TOL equivalente a gestor TCL
134#          devuelto por la función SqlGetGestor
135#
136#///////////////////////////////////////////////////////////////////////////
137  set tolGestor -1
138  switch $gestor {
139    Mic {set tolGestor 0}
140    Ora {set tolGestor 1}
141    Mys {set tolGestor 2}
142    Acc {set tolGestor 3}
143  }
144  return $tolGestor
145}
146
147#///////////////////////////////////////////////////////////////////////////
148proc SqlValidateData {P typFie} {
149#
150# PURPOSE: Verifies that a given value observes the rules of a data type
151#
152# PARAMETERS:
153#   P      : value to verify
154#   typFie : data type
155#
156# RETURN: 1 -> OK, 0 -> NO
157#
158#///////////////////////////////////////////////////////////////////////////
159  #Tolcon_Trace "SqlValidateData: Valor: $P   Tipo: $typFie"
160  set ok 1
161  # si no hay ningun caracter no comprobamos
162  if {![string length $P]} {
163    return $ok
164  }
165  # ralizamos las comprobacines
166  set sepDec {.}
167  set typeField [string tolower [lindex $typFie 0]]
168  set lonField  [string tolower [lindex $typFie 1]]
169  #Tolcon_Trace "SqlValidateData: typeField: $typeField   lonField: $lonField" 
170  switch $typeField {
171    # Integers
172    "bigint" {
173      # Datos enteros (números enteros) comprendidos entre -2^63
174      # (-9223372036854775808) y 2^63 -1 (9223372036854775807).
175      set ok [expr {([string match {[-+]} $P] || [string is int $P]) && \
176                    $P>=[expr pow(-2,63)] && $P<=[expr pow(2,63)]}]
177    }
178    "int" {
179      #Datos enteros (números enteros) comprendidos entre -2^31
180      # (-2.147.483.648) y 2^31 - 1 (2.147.483.647).
181      set ok [expr {([string match {[-+]} $P] || [string is int $P]) && \
182                     $P>=[expr pow(-2,31)] && $P<=[expr pow(2,31)]}]
183    }
184    "smallint" {
185      #Datos enteros comprendidos entre 215 (-32.768) y 215 - 1 (32.767).
186      set ok [expr {([string match {[-+]} $P] || [string is int $P]) && \
187                     $P>=-32768 && $P<=32767}]
188    }
189    "tinyint" {
190      #Datos enteros comprendidos 0 y 255.
191      set ok [expr {([string is int $P]) && $P>=0 && $P<=255}]
192    }
193    "bit" {
194      #Datos enteros con valor 1 ó 0
195      set ok [expr {$P==0 || $P==1}]
196    }
197    # Decimal y numeric
198    "number"   -
199    "decimal"  -
200    "numeric" {
201      #Datos de precisión y escala numérica fijas comprendidos
202      # entre -10^38 +1 y 10^38 - 1. Hay que tener encuante la escala y la
203      # precision
204      if {[string length $lonField]} {
205        set lst [split $lonField ,]
206        set sca [expr [lindex $lst 1] + 0]
207        set pre [expr [lindex $lst 0] - $sca]
208        set lst [split $P $sepDec]
209        set np  [string length [lindex $lst 0]]
210        set ns  [expr [llength $lst] == 1 ? 0 : [string length [lindex $lst 1]]]
211        set ok [expr {[string is double $P] && $pre>=$np && $sca>=$ns}]
212      } else  {
213        set ok [expr {[string is double $P] && \
214                      $P>=[expr pow(-10,37) + 1] && \
215                      $P<=[expr pow(10,37)  - 1]}]
216      }
217    }
218    # money y smallmoney
219    "money" {
220      #Valores de moneda comprendidos entre -263 (-922.337.203.685.477,5808)
221      # y 263 - 1 (+922.337.203.685.477,5807), con una precisión de una
222      # diezmilésima de la unidad monetaria. El tamaño es de 8 bytes.
223      set lst [split $P $sepDec]
224      set np  [string length [lindex $lst 0]]
225      set ns  [expr [llength $lst] == 1 ? 0 : [string length [lindex $lst 1]]]
226      set ok [expr ([string is double $P] && 19>=$np && 4>=$ns)]
227    }
228    "smallmoney" {
229      #Valores de moneda comprendidos entre - 214.748,3648 y +214.748,3647,
230      # con una precisión de una diezmilésima de la unidad monetaria.
231      # El tamaño de almacenamiento es 4 bytes.
232      set lst [split $P $sepDec]
233      set np  [string length [lindex $lst 0]]
234      set ns  [expr [llength $lst] == 1 ? 0 : [string length [lindex $lst 1]]]
235      set ok [expr ([string is double $P] && 10>=$np && 4>=$ns)]
236    }
237    # Numéricos con aproximación
238    "float" {
239      #Un número de punto flotante es un valor comprendido entre
240      # -1.79E + 308 y 1.79E + 308. n es el número de bits que se
241      # utilizan para almacenar la mantisa del número float en notación
242      # científica y por tanto dicta su precisión y el tamaño de almacenamiento.
243      # n tiene que ser un valor entre 1 y 53.
244      set ok [expr {([string match {[-+]} $P] || [string is double $P]) && \
245                     $P>=[expr -1.79 * pow(10,308)] && \
246                     $P<=[expr  1.79 * pow(10,308)]}]
247    }
248    "real" {
249      #Datos numéricos de punto flotante entre –3.40E + 38 y 3.40E + 38.
250      # El tamaño de almacenamiento es 4 bytes. En SQL Server, el sinónimo
251      # de real es float(24).
252      set ok [expr {([string match {[-+]} $P] || [string is double $P]) && \
253                     $P>=[expr -3.40 * pow(10,38)] && \
254                     $P<=[expr  3.40 * pow(10,38)]}]
255    }
256    # datetime y smalldatetime
257    "date" -
258    "datetime"  -
259    "smalldatetime" {
260      #TODO: Tienen su propio componente
261    }
262    # Cadenas de caracteres
263    "char"     -
264    "varchar"  -
265    "varchar2" -   
266    "text" {
267      if {[string length $lonField]} {
268        set ok [expr ([string len $P]<=$lonField)]
269      }
270    }
271    "nchar"     -
272    "nvarchar"  -
273    "ntext" {
274    # Cadenas de caracteres Unicode
275      if {[string length $lonField]} {
276        set ok [expr ([string len $P]<=$lonField)]
277      }
278    }
279    "binary"     -
280    "varbinary"  -
281    "image" {
282    # Cadenas binarias
283      # TODO: de momento no es posible editar estos campos
284    }
285    default {puts "SqlValidateData:\n\
286                   WARNING: Tipo no reconocido $typeField"}
287  }
288  return $ok
289}
290
291
292#///////////////////////////////////////////////////////////////////////////
293  proc SqlFormatField {value type gestor {format ""}} {
294# PURPUSE: Formatea un campo field, en función del tipo de dato que sea
295#          para su uso en un gestor de BBDD dado por gestor
296#
297# PARAMETERS:
298#   value  -> Valor a formatear
299#   type   -> Tipo de datos (BBDD) del campo cuyo valor se va a formatear
300#   gestor -> Gestor de BBDD para el que se formatea.
301#                Ora -> Oracle, Mic -> SqlServer
302#   format -> Especificador de formato especial. Por ejemplo para los
303#             campos de tipo fecha, pueden utilizarse formatos especiales.
304#             No implementado por el momento
305#
306# RETURNS: Valor del campo formateado   
307#
308#///////////////////////////////////////////////////////////////////////////
309  set valFor ""
310  if {[string tolower $value] eq "null"} {
311    set valFor $value
312  } else {
313    set typeField [string tolower [lindex $type 0]]
314    switch $typeField {
315      "bigint"     -
316      "int"        -
317      "smallint"   -
318      "tinyint"    -
319      "bit"        -
320      "number"     -
321      "decimal"    -
322      "numeric"    -
323      "money"      -
324      "smallmoney" -
325      "float"      -
326      "double"     -
327      "real"       { set valFor $value }
328      "date"       -
329      "datetime"   -
330      "smalldatetime" {
331        switch $gestor {
332          "Mic" { set valFor "convert(datetime,'${value}',121)"            }
333          "Ora" { set valFor "to_date('${value}','YYYY-MM-DD HH24:MI:SS')" }
334          "Mys" { set valFor "str_to_date('${value}','%Y%m%d %H:%i:%s')" }
335          default { error "Gestor no implementado $gestor"  }
336        }
337      }
338      "char"       -
339      "varchar"    -
340      "varchar2"   -
341      "text"       -
342      "nchar"      -
343      "nvarchar"   -
344      "ntext"      { set valFor '${value}' }
345      "binary"     -
346      "varbinary"  -
347      "image"      { set valFor $value  }
348      default      { error "SqlFormatField:\n\ERROR: Tipo no reconocido $type"}
349    }
350  }
351  return $valFor
352}
353
354#///////////////////////////////////////////////////////////////////////////
355  proc SqlGetDelimeterField {type} {
356# PURPUSE: Comprobamos el tipo de un campo e indicamos si sus valores deben
357#          ir precedidos por algun caracter especial. Por ejemplo los textos
358#          van entre comillas, los numeros no cesesitan comillas
359#          TODO: Igual hay que usar las las funciones de TOL
360#
361# RETURN: El texto a concatenar a al valor del campo
362#
363#///////////////////////////////////////////////////////////////////////////
364#puts "SqlGetDelimeterField: $type"
365  set delimeter {}
366  set typeField [string tolower [lindex $type 0]]
367  switch $typeField {
368    # Integers
369    "bigint"   -
370    "int"      -
371    "smallint" -
372    "tinyint" {
373      # no necesita ningun delimitador
374    }
375    # bit
376    "bit" {
377      # no necesita ningun delimitador
378    }
379    # Decimal y numeric
380    "number"   -
381    "decimal"  -
382    "numeric" {
383      # no necesita ningun delimitador
384    }
385    # money y smallmoney
386    "money"  -
387    "smallmoney" {
388      # no necesita ningun delimitador
389    }
390    # Numéricos con aproximación
391    "float"  -
392    "real" {
393      # no necesita ningun delimitador
394    }
395    # datetime y smalldatetime
396    "date" -
397    "datetime"  -
398    "smalldatetime" {
399      set delimeter {' '}
400      set gestor [string trim [TclGetVar Text DBA] {"}];#"
401      switch $gestor {
402        "SqlServer" {
403          set delimeter {{convert(datetime,'} {',121)}}       
404        }
405        "Oracle" {
406          set delimeter {{to_date('} {','YYYY-MM-DD HH24:MI:SS')}}       
407        }
408        default { error "Variable DBA (Gestor) not defined"  }
409      }
410     }
411    # Cadenas de caracteres
412    "char"     -
413    "varchar"  -
414    "varchar2"  -
415    "text" {
416      set delimeter {' '}
417    }
418    # Cadenas de caracteres Unicode
419    "nchar"     -
420    "nvarchar"  -
421    "ntext" {
422      set delimeter {' '}
423    }
424    # Cadenas binarias
425    "binary"     -
426    "varbinary"  -
427    "image" {
428      # TODO: de momento no es posible editar estos campos
429    }
430    default { error "SqlGetDelimeterField:\n\
431                   WARNING: Tipo no reconocido $typeField"}
432  }
433  #puts "SqlGetDelimeterField: $delimeter"
434  return $delimeter
435}
436
437
438#///////////////////////////////////////////////////////////////////////////
439  proc DBQuery {bodbc args} {
440# PURPUSE: Execute query witch bodbc module
441# PARAMETERS:
442#   bodbc -> name of bodbc module
443#   args  -> arguments of database query
444
445#
446#///////////////////////////////////////////////////////////////////////////
447  # name connection TCL
448  set connection [$bodbc cget -connection]
449  # connection ?
450  $::project::data(bodbc) validateconnection [$bodbc cget -name] 
451  # run
452  eval DBQueryConnection $connection $args
453} 
454
455
456#///////////////////////////////////////////////////////////////////////////
457  proc DBQueryConnection {connection args} {
458# PURPUSE: Execute query witch database connection
459# PARAMETERS:
460#   connection -> name of database connection
461#   args       -> arguments of database query
462#
463#///////////////////////////////////////////////////////////////////////////
464  #NOTE:  move traces to "DBQuery"
465  . configure -cursor watch
466  ::blt::busy hold .
467  set lst {}
468  Tolcon_Trace "IniQuery: \
469    [clock format [clock seconds] -format "%Y%m%d %T"]:\n[lindex $args 0]"
470  if {([info exists ::project::data(SqlTra)]) && \
471      ($::project::data(SqlTra))} {
472    ::TolConsole::HciWriter \
473      "\nIniQuery. [clock format [clock seconds] -format "%Y%m%d %T"]:\n\
474      [lindex $args 0]"
475  }
476  # eval
477  if { [catch { set lst [eval $connection $args] } result ] } {
478    ShowMessage E $result .
479  } 
480  # trace
481  if {([info exists ::project::data(SqlTra)]) && \
482      ($::project::data(SqlTra))} {
483    ::TolConsole::HciWriter \
484      "\nEndQuery. [clock format [clock seconds] -format "%Y%m%d %T"]"
485  }
486  Tolcon_Trace "EndQuery: [clock format [clock seconds] -format "%Y%m%d %T"]"
487  . configure -cursor ""
488  ::blt::busy release .
489  update
490  return $lst
491}
492
493
Note: See TracBrowser for help on using the repository browser.