1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
# database.tcl
proc getFormsReports {db tabType} {
switch $tabType {
forms {
set query "SELECT name FROM pfm_form WHERE showform ORDER BY name"
}
design {
set query "SELECT name FROM pfm_form WHERE NOT showform ORDER BY name"
}
reports {
set query "SELECT name, description FROM pfm_report ORDER BY name"
}
}
if {![$db select_query_list $query numTuples headerList formsList errorMsg]} then {
set formsList {}
# pfm_message [mc getFormList $errorMsg] {.}
}
return $formsList
}
proc getFormDef {db formName parent formDefName} {
upvar $formDefName formDef
set query {SELECT name, tablename, sqlselect, sqlfrom, groupby, showform, }
append query {"view", pkey, sqlorderby, sqllimit }
append query {FROM pfm_form }
append query "WHERE name = '$formName'"
if {[$db select_query_list $query numTuples attribList resultList errorMsg]} then {
if {$numTuples == 1} then {
set status 1
set idx 0
foreach attrib $attribList {
set formDef($attrib) [lindex $resultList 0 $idx]
incr idx
}
} else {
pfm_message [mc getFormFailed $formName "numTuples = $numTuples"] $parent
set status 0
}
} else {
pfm_message [mc getFormFailed $formName $errorMsg] $parent
set status 0
}
return $status
}
proc getAttribDef {db formName parent attribDefName attribListName modAttribListName} {
upvar $attribDefName attribDef
upvar $attribListName attribList
upvar $modAttribListName modAttribList
set attribList {}
set modAttribList {}
set query {SELECT attribute, typeofattrib, typeofget, sqlselect, nr, valuelist, "default" }
append query "FROM pfm_attribute WHERE form = '${formName}' "
append query {ORDER BY nr}
if {[$db select_query $query numTuples resultArray errorMsg]} then {
set status 1
for {set tuple 0} {$tuple < $numTuples} {incr tuple} {
set attrib [string trim $resultArray($tuple,attribute)]
lappend attribList $attrib
foreach property {typeofattrib typeofget sqlselect nr valuelist default} {
set attribDef($attrib,$property) \
[string trim $resultArray($tuple,$property)]
}
if {($attribDef($attrib,typeofget) ne {tgReadOnly}) || \
($attribDef($attrib,default) ne {})} then {
lappend modAttribList $attrib
}
}
} else {
pfm_message [mc getAttribFailed $formName $errorMsg] $parent
set status 0
}
return $status
}
proc getLinkDef {db formName parent linkDefName lastLinkName} {
upvar $linkDefName linkDef
upvar $lastLinkName lastLink
set query {SELECT linkname, sqlwhere, orderby, displayattrib, toform}
append query " FROM pfm_link WHERE fromform = '$formName'"
append query { ORDER BY linkname}
if {[$db select_query $query numTuples linkDef errorMsg]} then {
set lastLink [expr $numTuples - 1]
set status 1
} else {
set status 0
pfm_message [mc getLinkDefFailed $formName $errorMsg] $parent
}
return $status
}
proc check_pfm_tables {tablesInstalledName dbVersionName} {
upvar $tablesInstalledName tablesInstalled
upvar $dbVersionName dbVersion
set query {SELECT COUNT(*) AS nr_of_tables FROM pg_tables }
append query {WHERE tablename IN ('pfm_form', 'pfm_attribute', }
append query {'pfm_value', 'pfm_value_list', 'pfm_link', }
append query {'pfm_report', 'pfm_section')}
if {[$::dbObject select_query_list $query numTuples names \
resultList errMsg]} then {
set tablesInstalled [lindex $resultList 0 0]
if {$tablesInstalled > 0} then {
set query {SELECT version FROM pfm_version ORDER BY seqnr DESC}
if {[$::dbObject select_query_list $query numTuples names \
resultList errMsg]} then {
set dbVersion [lindex $resultList 0 0]
} else {
# versions 1.0.4 and earlier did not have pfm_version table
set dbVersion {1.0.4}
pfm_message "${query}\n${errMsg}" {.}
}
} else {
set dbVersion {}
}
} else {
set dbVersion {}
set tablesInstalled 0
pfm_message "${query}\n${errMsg}" {.}
}
return
}
|
