forked from TPC-Council/HammerDB
-
Notifications
You must be signed in to change notification settings - Fork 0
/
hammerdb
executable file
·257 lines (235 loc) · 8.7 KB
/
hammerdb
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
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
#!/bin/sh
########################################################################
# \
export LD_LIBRARY_PATH="./lib:$LD_LIBRARY_PATH"
# \
export PATH="./bin:$PATH"
# \
exec wish8.6 -file $0 ${1+"$@"}
# \
exit
########################################################################
# HammerDB
# Copyright (C) 2003-2024 Steve Shaw
# Author contact information at: http://www.hammerdb.com
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public
# License as published by the Free Software Foundation; either
# version 3 of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public
# License along with this program; If not, see <https://www.gnu.org/licenses/>
########################################################################
global hdb_version
set hdb_version "v4.11"
set mainGeometry +10+10
set UserDefaultDir [ file dirname [ info script ] ]
::tcl::tm::path add "$UserDefaultDir/modules"
namespace eval autostart {
set autostartap "false"
if {$argc == 0} { ; } else {
if {$argc != 2 || [lindex $argv 0] != "auto" } {
puts {Usage: hammerdb [ auto [ script_to_autoload.tcl ] ]}
exit
} else {
set autostartap "true"
set autoloadscript [lindex $argv 1]
if { [ file exists $autoloadscript ] && [ file isfile $autoloadscript ] && [ file extension $autoloadscript ] eq ".tcl" } {
;# autostart selected and tcl file exists
} else {
puts {Usage: hammerdb [ auto [ script_to_autoload.tcl ] ]}
exit
}
}
}
}
namespace eval LoadingProgressMeter {
set max 14
wm title . "Loading HammerDB"
wm protocol . WM_DELETE_WINDOW {#Do nothing}
wm overrideredirect . 1
wm geometry . +100+120
wm transient .
tk appname "HammerDB Splash Screen"
set logo_file logo.tcl
if [catch {source [ file join $UserDefaultDir images $logo_file ]}] {
puts stderr "While loading image file\
\"$logo_file\"...\n$errorInfo"
}
#Display LOGO in SVG format to scale HD displays, fallback is PNG
if {[catch {package require tksvg}]} {
# SVG not supported use original PNG logo
set logoset [ create_logo_images ]
set logo [ dict get $logoset logo ]
set logim [ image create photo -height 120 -width 694 -data $logo ]
} else {
# SVG supported use SVG logo to scale
set logoset [ create_logo_images ]
set logosetsvg [ create_logo_images_svg ]
set logosvg [ dict get $logosetsvg logosvg ]
if { [ format "%.2f" [ tk scaling ] ] <= 1.33 } {
set logim [ image create photo -data $logosvg -format "svg -scaletoheight 240" ]
} else {
set scaleheight [ expr {round((240/1.333333)*[tk scaling])} ]
set logim [ image create photo -data $logosvg -format "svg -scaletoheight $scaleheight" ]
}
}
# Window Icon is not supported in SVG always use PNG
set iconwht [ dict get $logoset iconwht ]
set iconw [ image create photo -height 120 -width 97 -data $iconwht ]
foreach imagedata {logo iconwht logoset logosetsvg} {unset -nocomplain $imagedata}
#Splash Screen Fonts
set gbg white;
set mid {TkDefaultFont 20 {bold}}
set load {TkDefaultFont 14}
if {$tcl_platform(platform) == "windows"} {
if {{Segoe UI} in [ font families ] } {
set mid {{Segoe UI} 20 {bold}}
set load {{Segoe UI} 14}
} else {
set mid {TkDefaultFont 20 {bold}}
set load {TkDefaultFont 14}
}
} else {
if {{Liberation Sans} in [ font families ] } {
set mid {{Liberation Sans} 20 {bold}}
set load {{Liberation Sans} 14}
} else {
set mid {TkDefaultFont 20 {bold}}
set load {TkDefaultFont 14}
}
}
. conf -bg $gbg -cursor watch
wm iconphoto . -default $iconw
frame .progress -bg $gbg
label .title -text " $hdb_version " -font $mid \
-bg $gbg -fg #f99317 -padx 0
label .progress.loadmsg -textvariable loadtext \
-anchor s -bg $gbg -font $load
if { [ format "%.2f" [ tk scaling ] ] <= 1.33 } {
set disp_canv [ canvas .progress.canv -highlightthickness 0 -bg $gbg -height 150 -width 694 ]
$disp_canv create image 350 70 -image $logim
} else {
set disp_canv [ canvas .progress.canv -highlightthickness 0 -bg $gbg -height [expr {round((150/1.333333)*[tk scaling])}] -width [expr {round((694/1.333333)*[tk scaling])}] ]
$disp_canv create image [expr {round((350/1.333333)*[tk scaling])} ] [expr {round((70/1.333333)*[tk scaling])} ] -image $logim
}
foreach imagedata {logim iconw} {unset -nocomplain $imagedata}
pack $disp_canv
pack .progress.loadmsg
scale .progress.bar -from 0 -to 1 -label {} -bd 0 \
-orient horizontal -length 20 -showvalue 0 \
-background #003068 -troughcolor $gbg -state normal \
-tickinterval 0 -width [expr {round((10/1.333333)*[tk scaling])}] -takefocus 0 -cursor {} \
-relief flat -sliderrelief flat -sliderlength 4
.progress.bar set 0
bindtags .progress.bar {. all}
pack .progress.bar -fill x -expand 1
grid .title - -padx 1.5m -pady 1m -sticky ew
if [winfo exist .evalmsg] {grid .evalmsg -columnspan 3}
grid .progress -sticky nsew
variable count -1
variable len 0
proc updateprogress {args} {
global loadtext
variable count
variable max
incr count
set width [winfo width .progress.bar]
.progress.bar conf -sliderlength \
[expr {int(($width-4)*$count/$max)+4}]
if {$count%5 == 0} {
update;
} else {
update idletasks
}
}
trace variable ::loadtext w [namespace code updateprogress]
set ::loadtext ""
namespace export check_progress_length
proc check_progress_length {} {
variable count
variable max
variable len
if {$count!=$max} {
puts stderr "[namespace current]::max not correctly\
adjusted - FIX to be [expr {$count-$len}]"
}
catch {unset loadtext}
}
}
namespace import LoadingProgressMeter::*
if [info exist env(Load_List)] {
foreach {sofile description} $env(Load_List) {
set loadtext "Loading Object Code: $description"
if [catch {load $sofile} s] {
puts stderr "Failed to load $sofile\nPerhaps\
it should be built?\n$s"
exit 1
}
}
}
append modulelist { Thread msgcat tablelist_tile tooltip tkcon xml xscale ctext comm emu_graph socktest tkblt http huddle jobs tkpath }
set loadtext "Loading hammerdb modules"
after 100
for { set modcount 0 } { $modcount < [llength $modulelist] } { incr modcount } {
set m [lindex $modulelist $modcount]
set loadtext $m
if [catch { package require $m }] {
puts stderr "While loading module\
\"$m\"...\n$errorInfo"
exit 1
}
}
append iconlist { icons.tcl }
set loadtext "Loading hammerdb icons"
after 100
for { set iconcount 0 } { $iconcount < [llength $iconlist] } { incr iconcount } {
set f [lindex $iconlist $iconcount]
set loadtext $f
if [catch {source [ file join $UserDefaultDir images $f ]}] {
puts stderr "While loading component file\
\"$f\"...\n$errorInfo"
exit 1
}
}
append loadlist { gentheme.tcl genvu.tcl gentpcc.tcl gentpch.tcl gengen.tcl genmodes.tcl gentab.tcl gencnv.tcl gentccmn.tcl gentc.tcl genmetrics.tcl gened.tcl genxml.tcl geninit.tcl }
set loadtext "Loading generic source"
after 100
for { set loadcount 0 } { $loadcount < [llength $loadlist] } { incr loadcount } {
set f [lindex $loadlist $loadcount]
set loadtext $f
if [catch {source [ file join $UserDefaultDir src generic $f ]}] {
puts stderr "While loading component file\
\"$f\"...\n$errorInfo"
exit 1
}
}
set loadtext "Loading database source"
after 100
for { set dbsrccount 0 } { $dbsrccount < [llength $dbsrclist] } { incr dbsrccount } {
set f [lindex $dbsrclist $dbsrccount]
set loadtext $f
if [catch {source [ file join $UserDefaultDir src $f ]}] {
puts stderr "Error loading database source files/$f"
}
}
after 100
set loadtext "Starting HammerDB"
update
#pause to display splash screen
after 2000
wm withdraw .
wm deiconify .ed_mainFrame
ed_edit
if { $autostart::autostartap == "true" } {
ed_file_load
start_autopilot
}
tkwait window .ed_mainFrame
exit