diff --git a/COPYRIGHT b/COPYRIGHT deleted file mode 100644 index 13e0704f..00000000 --- a/COPYRIGHT +++ /dev/null @@ -1,7 +0,0 @@ -HammerDB Copyright (C) 2003-2017 Steve Shaw -Contact : smshaw@users.sourceforge.net -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 2 of the License, or (at your option) any later version. -This copyright notice must be included in all distributions. -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." diff --git a/config.xml b/config.xml deleted file mode 100644 index 138fec1e..00000000 --- a/config.xml +++ /dev/null @@ -1,368 +0,0 @@ - - - - - classic - - - true - - - - Oracle - TPC-C - - - - system - manager - oracle - - - - 1 - 1 - tpcc - tpcc - tpcctab - tpcctab - temp - 0 - - - false - false - false - - - 1000000 - false - false - false - standard - 2 - 5 - false - false - - - - - 1 - tpch - tpch - tpchtab - temp - 1 - false - - - 1 - false - false - 2 - false - 1 - 1000 - false - false - - - - system/manager@oracle - 10 - 0 - 0 - - - - - (local) - localhost - 1433 - windows - sql - SQL Server Native Client 11.0 - ODBC Driver 13 for SQL Server - sa - admin - - - - 1 - 1 - tpcc - false - 1 - SCHEMA_AND_DATA - - - 1000000 - false - false - false - standard - 2 - 5 - false - false - - - - - 1 - 2 - tpch - 1 - false - - - 1 - false - false - false - 1 - 1000 - false - - - - - - 127.0.0.1 - 3306 - - - - 1 - 1 - root - mysql - tpcc - innodb - false - - - 1000000 - false - false - standard - 2 - 5 - false - false - - - - - 1 - root - mysql - tpch - 1 - myisam - - - 1 - false - false - false - 1 - 1000 - false - false - - - - - - localhost - 5432 - - - - 1 - 1 - postgres - postgres - postgres - tpcc - tpcc - tpcc - false - false - false - - - 1000000 - false - false - standard - 2 - 5 - false - false - - - - - 1 - postgres - postgres - postgres - tpch - tpch - tpch - false - false - 1 - - - 1 - false - false - false - 1 - 1000 - false - false - false - - - - - - 127.0.0.1 - 6379 - 1 - - - - 1 - 1 - - - 1000000 - false - false - standard - 2 - 5 - false - false - - - - - - Default_DataSource - Trafodion - sandbox - 37800 - trafodion - traf123 - tpcc - - - - 1 - 1 - upsert - true - true - false - sandbox - - - 1000000 - false - false - standard - 2 - 5 - false - false - - - - - - - 1 - 1 - db2inst1 - ibmdb2 - tpcc - USERSPACE1 - C "" D "" H "" I "" W "" S "" NO "" OR "" OL "" - false - - - 1000000 - false - false - standard - 2 - 5 - 0 - false - false - - - - - 1 - db2inst1 - ibmdb2 - tpch - USERSPACE1 - 1 - NONE - - - 1 - false - false - 1 - false - 1 - 1000 - false - - - - - 1 - 1 - 1 - - - - - 1 - 500 - 500 - 1 - 0 - 0 - 0 - 0 - - - - disabled - 10 - 2 3 5 9 13 17 21 25 - - - localhost - 0 - - - - - localhost - 0 - - - diff --git a/hammerdb.license b/hammerdb.license deleted file mode 100644 index 5b6e7c66..00000000 --- a/hammerdb.license +++ /dev/null @@ -1,340 +0,0 @@ - GNU GENERAL PUBLIC LICENSE - Version 2, June 1991 - - Copyright (C) 1989, 1991 Free Software Foundation, Inc. - 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The licenses for most software are designed to take away your -freedom to share and change it. By contrast, the GNU General Public -License is intended to guarantee your freedom to share and change free -software--to make sure the software is free for all its users. This -General Public License applies to most of the Free Software -Foundation's software and to any other program whose authors commit to -using it. (Some other Free Software Foundation software is covered by -the GNU Library General Public License instead.) You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -this service if you wish), that you receive source code or can get it -if you want it, that you can change the software or use pieces of it -in new free programs; and that you know you can do these things. - - To protect your rights, we need to make restrictions that forbid -anyone to deny you these rights or to ask you to surrender the rights. -These restrictions translate to certain responsibilities for you if you -distribute copies of the software, or if you modify it. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must give the recipients all the rights that -you have. You must make sure that they, too, receive or can get the -source code. And you must show them these terms so they know their -rights. - - We protect your rights with two steps: (1) copyright the software, and -(2) offer you this license which gives you legal permission to copy, -distribute and/or modify the software. - - Also, for each author's protection and ours, we want to make certain -that everyone understands that there is no warranty for this free -software. If the software is modified by someone else and passed on, we -want its recipients to know that what they have is not the original, so -that any problems introduced by others will not reflect on the original -authors' reputations. - - Finally, any free program is threatened constantly by software -patents. We wish to avoid the danger that redistributors of a free -program will individually obtain patent licenses, in effect making the -program proprietary. To prevent this, we have made it clear that any -patent must be licensed for everyone's free use or not licensed at all. - - The precise terms and conditions for copying, distribution and -modification follow. - - GNU GENERAL PUBLIC LICENSE - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION - - 0. This License applies to any program or other work which contains -a notice placed by the copyright holder saying it may be distributed -under the terms of this General Public License. The "Program", below, -refers to any such program or work, and a "work based on the Program" -means either the Program or any derivative work under copyright law: -that is to say, a work containing the Program or a portion of it, -either verbatim or with modifications and/or translated into another -language. (Hereinafter, translation is included without limitation in -the term "modification".) Each licensee is addressed as "you". - -Activities other than copying, distribution and modification are not -covered by this License; they are outside its scope. The act of -running the Program is not restricted, and the output from the Program -is covered only if its contents constitute a work based on the -Program (independent of having been made by running the Program). -Whether that is true depends on what the Program does. - - 1. You may copy and distribute verbatim copies of the Program's -source code as you receive it, in any medium, provided that you -conspicuously and appropriately publish on each copy an appropriate -copyright notice and disclaimer of warranty; keep intact all the -notices that refer to this License and to the absence of any warranty; -and give any other recipients of the Program a copy of this License -along with the Program. - -You may charge a fee for the physical act of transferring a copy, and -you may at your option offer warranty protection in exchange for a fee. - - 2. You may modify your copy or copies of the Program or any portion -of it, thus forming a work based on the Program, and copy and -distribute such modifications or work under the terms of Section 1 -above, provided that you also meet all of these conditions: - - a) You must cause the modified files to carry prominent notices - stating that you changed the files and the date of any change. - - b) You must cause any work that you distribute or publish, that in - whole or in part contains or is derived from the Program or any - part thereof, to be licensed as a whole at no charge to all third - parties under the terms of this License. - - c) If the modified program normally reads commands interactively - when run, you must cause it, when started running for such - interactive use in the most ordinary way, to print or display an - announcement including an appropriate copyright notice and a - notice that there is no warranty (or else, saying that you provide - a warranty) and that users may redistribute the program under - these conditions, and telling the user how to view a copy of this - License. (Exception: if the Program itself is interactive but - does not normally print such an announcement, your work based on - the Program is not required to print an announcement.) - -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the Program, -and can be reasonably considered independent and separate works in -themselves, then this License, and its terms, do not apply to those -sections when you distribute them as separate works. But when you -distribute the same sections as part of a whole which is a work based -on the Program, the distribution of the whole must be on the terms of -this License, whose permissions for other licensees extend to the -entire whole, and thus to each and every part regardless of who wrote it. - -Thus, it is not the intent of this section to claim rights or contest -your rights to work written entirely by you; rather, the intent is to -exercise the right to control the distribution of derivative or -collective works based on the Program. - -In addition, mere aggregation of another work not based on the Program -with the Program (or with a work based on the Program) on a volume of -a storage or distribution medium does not bring the other work under -the scope of this License. - - 3. You may copy and distribute the Program (or a work based on it, -under Section 2) in object code or executable form under the terms of -Sections 1 and 2 above provided that you also do one of the following: - - a) Accompany it with the complete corresponding machine-readable - source code, which must be distributed under the terms of Sections - 1 and 2 above on a medium customarily used for software interchange; or, - - b) Accompany it with a written offer, valid for at least three - years, to give any third party, for a charge no more than your - cost of physically performing source distribution, a complete - machine-readable copy of the corresponding source code, to be - distributed under the terms of Sections 1 and 2 above on a medium - customarily used for software interchange; or, - - c) Accompany it with the information you received as to the offer - to distribute corresponding source code. (This alternative is - allowed only for noncommercial distribution and only if you - received the program in object code or executable form with such - an offer, in accord with Subsection b above.) - -The source code for a work means the preferred form of the work for -making modifications to it. For an executable work, complete source -code means all the source code for all modules it contains, plus any -associated interface definition files, plus the scripts used to -control compilation and installation of the executable. However, as a -special exception, the source code distributed need not include -anything that is normally distributed (in either source or binary -form) with the major components (compiler, kernel, and so on) of the -operating system on which the executable runs, unless that component -itself accompanies the executable. - -If distribution of executable or object code is made by offering -access to copy from a designated place, then offering equivalent -access to copy the source code from the same place counts as -distribution of the source code, even though third parties are not -compelled to copy the source along with the object code. - - 4. You may not copy, modify, sublicense, or distribute the Program -except as expressly provided under this License. Any attempt -otherwise to copy, modify, sublicense or distribute the Program is -void, and will automatically terminate your rights under this License. -However, parties who have received copies, or rights, from you under -this License will not have their licenses terminated so long as such -parties remain in full compliance. - - 5. You are not required to accept this License, since you have not -signed it. However, nothing else grants you permission to modify or -distribute the Program or its derivative works. These actions are -prohibited by law if you do not accept this License. Therefore, by -modifying or distributing the Program (or any work based on the -Program), you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or modifying -the Program or works based on it. - - 6. Each time you redistribute the Program (or any work based on the -Program), the recipient automatically receives a license from the -original licensor to copy, distribute or modify the Program subject to -these terms and conditions. You may not impose any further -restrictions on the recipients' exercise of the rights granted herein. -You are not responsible for enforcing compliance by third parties to -this License. - - 7. If, as a consequence of a court judgment or allegation of patent -infringement or for any other reason (not limited to patent issues), -conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot -distribute so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you -may not distribute the Program at all. For example, if a patent -license would not permit royalty-free redistribution of the Program by -all those who receive copies directly or indirectly through you, then -the only way you could satisfy both it and this License would be to -refrain entirely from distribution of the Program. - -If any portion of this section is held invalid or unenforceable under -any particular circumstance, the balance of the section is intended to -apply and the section as a whole is intended to apply in other -circumstances. - -It is not the purpose of this section to induce you to infringe any -patents or other property right claims or to contest validity of any -such claims; this section has the sole purpose of protecting the -integrity of the free software distribution system, which is -implemented by public license practices. Many people have made -generous contributions to the wide range of software distributed -through that system in reliance on consistent application of that -system; it is up to the author/donor to decide if he or she is willing -to distribute software through any other system and a licensee cannot -impose that choice. - -This section is intended to make thoroughly clear what is believed to -be a consequence of the rest of this License. - - 8. If the distribution and/or use of the Program is restricted in -certain countries either by patents or by copyrighted interfaces, the -original copyright holder who places the Program under this License -may add an explicit geographical distribution limitation excluding -those countries, so that distribution is permitted only in or among -countries not thus excluded. In such case, this License incorporates -the limitation as if written in the body of this License. - - 9. The Free Software Foundation may publish revised and/or new versions -of the General Public License from time to time. Such new versions will -be similar in spirit to the present version, but may differ in detail to -address new problems or concerns. - -Each version is given a distinguishing version number. If the Program -specifies a version number of this License which applies to it and "any -later version", you have the option of following the terms and conditions -either of that version or of any later version published by the Free -Software Foundation. If the Program does not specify a version number of -this License, you may choose any version ever published by the Free Software -Foundation. - - 10. If you wish to incorporate parts of the Program into other free -programs whose distribution conditions are different, write to the author -to ask for permission. For software which is copyrighted by the Free -Software Foundation, write to the Free Software Foundation; we sometimes -make exceptions for this. Our decision will be guided by the two goals -of preserving the free status of all derivatives of our free software and -of promoting the sharing and reuse of software generally. - - NO WARRANTY - - 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY -FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN -OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES -PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED -OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS -TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE -PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, -REPAIR OR CORRECTION. - - 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR -REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, -INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING -OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED -TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY -YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER -PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE -POSSIBILITY OF SUCH DAMAGES. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -convey the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - 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 2 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, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - -Also add information on how to contact you by electronic and paper mail. - -If the program is interactive, make it output a short notice like this -when it starts in an interactive mode: - - Gnomovision version 69, Copyright (C) year name of author - Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. - This is free software, and you are welcome to redistribute it - under certain conditions; type `show c' for details. - -The hypothetical commands `show w' and `show c' should show the appropriate -parts of the General Public License. Of course, the commands you use may -be called something other than `show w' and `show c'; they could even be -mouse-clicks or menu items--whatever suits your program. - -You should also get your employer (if you work as a programmer) or your -school, if any, to sign a "copyright disclaimer" for the program, if -necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright interest in the program - `Gnomovision' (which makes passes at compilers) written by James Hacker. - - , 1 April 1989 - Ty Coon, President of Vice - -This General Public License does not permit incorporating your program into -proprietary programs. If your program is a subroutine library, you may -consider it more useful to permit linking proprietary applications with the -library. If this is what you want to do, use the GNU Library General -Public License instead of this License. diff --git a/hammerdb.tcl b/hammerdb.tcl deleted file mode 100755 index 962c6e45..00000000 --- a/hammerdb.tcl +++ /dev/null @@ -1,212 +0,0 @@ -#!/bin/sh -######################################################################## -# \ -export LD_LIBRARY_PATH=./lib:./lib64:$LD_LIBRARY_PATH -# \ -export PATH=./bin:$PATH -# \ -exec wish8.6 -file $0 ${1+"$@"} -# \ -exit -######################################################################## -# HammerDB -# -# Copyright (C) 2003-2017 Steve Shaw -# -# 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 2 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, write to the -# Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. -# -# Author contact information: smshaw@users.sourceforge.net -###################################################################### -#This loader program loads the following components in order: -#hdb_logo.tcl - HammerDB Logo image -#hdb_theme.tcl - GUI Themes -#hdb_vu.tcl - Virtual user TCL threads -#hdb_tpcc.tcl - TPC-C schema creation and driver -#hdb_tpch.tcl - TPC-H schema creation and driver -#hdb_gen.tcl - Flat File Data Generation -#hdb_modes.tcl - Remote Modes and Autopilot -#hdb_tab.tcl - Virtual user display tablelist -#hdb_cnv.tcl - Tracefile to oratcl conversion -#hdb_tc.tcl - Transaction counter -#hdb_im.tcl - Image data -#hdb_ed.tcl - Editor -#hdb_xml.tcl - XML Configuration -#hdb_metrics.tcl - Metrics -#hdb_go.tcl - Run HammerDB -###################################################################### -global hdb_version -set hdb_version "v2.23" -set mainGeometry +10+10 -set UserDefaultDir [ file dirname [ info script ] ] -::tcl::tm::path add "$UserDefaultDir/hdb-modules" - -namespace eval autostart { - set autostartap "false" - if {$argc == 0} { ; } else { - if {$argc != 2 || [lindex $argv 0] != "auto" } { -puts {Usage: hammerdb.tcl [ 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.tcl [ 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 hdb_logo.tcl -if [catch {source [ file join $UserDefaultDir hdb-components $logo_file ]}] { - puts stderr "While loading image file\ - \"$logo_file\"...\n$errorInfo" - } - - set logim [ image create photo -height 120 -width 694 -data $logo ] - - set gbg white; - set big {Helvetica -24 {bold italic}} - set mid {Helvetica -18 {bold}} - set small {Helvetica -10} - set load {Helvetica -12} - - . conf -bg $gbg -cursor watch - set icont [ image create photo -height 120 -width 97 -data $icontrans ] - wm iconphoto . -default $icont - 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 - set disp_canv [ canvas .progress.canv -highlightthickness 0 -bg $gbg -height 120 -width 694 ] - $disp_canv create image 350 70 -image $logim - - 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 10 -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 tkcon xml ctext comm emu_graph socktest ttk_theme_black } - -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 loadlist { hdb_theme.tcl hdb_vu.tcl hdb_tpcc.tcl hdb_tpch.tcl hdb_gen.tcl hdb_modes.tcl hdb_tab.tcl hdb_cnv.tcl hdb_tc.tcl hdb_metrics.tcl hdb_im.tcl hdb_ed.tcl hdb_xml.tcl hdb_go.tcl } - -set loadtext "Loading hammerdb components" -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 hdb-components $f ]}] { - puts stderr "While loading component file\ - \"$f\"...\n$errorInfo" - exit 1 - } - } -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 diff --git a/hdb-components/hdb_cnv.tcl b/hdb-components/hdb_cnv.tcl deleted file mode 100644 index fcddcef3..00000000 --- a/hdb-components/hdb_cnv.tcl +++ /dev/null @@ -1,295 +0,0 @@ -proc convert_to_oratcl { } { -global _ED -set flbuff $_ED(package) -set match "" -set new_curs 0 -set dep 0 -set depzerobind 0 -set currcur 0 -set fetch 0 -set in_bind -1 -set bind_pos -1 -set nbinds 0 -set lastfetchedcursor 0 -set donehead 0 -set filelist [split $flbuff "\n"] - -proc check_date_formats { bindmatch } { -set datecnt 0 -while { -[ regexp -indices -nocase {(?:to_)(?:date|char)\((?:.*)(\'[^\']+?:[^\']+?\')[^\']*?\)(?:\W*?|,)} $bindmatch match value ] eq 1 } { -set bindmatch [string replace $bindmatch [ lindex $value 0 ] [ lindex $value 1 ] ] -if { [ incr datecnt ] eq 50 } { -puts "ERROR : Matched more than 50 date formats in a SQL Statement during conversion"; break - } - } -return $bindmatch -} - -foreach line $filelist { - if {[string match {*Instance name*} $line]} { - regexp {(:)\ (.*)} $line a b c - if { $donehead == 0 } { - append ora "#!/usr/local/bin/tclsh8.6\n" - append ora "package require Oratcl\n" - append ora "####UPDATE THE CONNECT STRING BELOW###\n" - append ora "#set connect user/password@$c\n" - append ora "set lda \[oralogon \$connect\]\n" - set donehead 1 - } - } - - if {[string match {END\ OF\ STMT*} $line]} { - set new_curs 0 - set fetch 0 - } - - if {[string match {PARSING\ IN\ CURSOR*dep=0*} $line]} { - regexp {PARSING\ IN\ CURSOR\ #([0-9]+)\ len=([0-9]+)\ dep=([0-9]+) uid=([0-9]+)\ oct=([0-9]+)\ lid=([0-9]+)\ tim=([0-9]+)\ hv=([0-9]+) ad=\'([0-9,a-z]+)\'} $line all cursor len dep uid oct lid tim hv ad - if {[array exists cur2hash]} { - if {[array get cur2hash $cursor] != ""} { - append ora "oraclose \$curn$cursor\n" - unset -nocomplain cur2hash($cursor) plsql($cursor) - } - } - set lastfetchedcursor $cursor - set new_curs 1 - set hashvalue [concat $hv\_$ad] - set cur2hash($cursor) $hashvalue - append ora "set curn$cursor " - append ora "\[oraopen \$lda \]\n" - } - - if {$new_curs != 0} { - if {[string match {PARSING\ IN\ CURSOR*dep=0*} $line]} { - unset -nocomplain text($cur2hash($cursor)) - } { - append text($cur2hash($cursor)) $line " " - if {[regexp {\-\-} $line match value]} { - append text($cur2hash($cursor)) "\n" - } - } - } - if {[string match {PARSE*dep=0*} $line] && ![string match {*ERROR*} $line]} { - regexp {PARSE\ \#([0-9]+)\:} $line all cursor - if { [ set ix [ lsearch $depzerobind $cursor ]] == -1 } { - lappend depzerobind $cursor - } - unset -nocomplain exectype($cursor) bindvarlist($cursor) bindvarlist2 bindvarlength bindmatch plsql($cursor) preapp($cursor) errinexec($cursor) - set text($cur2hash($cursor)) [remspace $text($cur2hash($cursor))] - set bindmatch [ check_date_formats $text($cur2hash($cursor)) ] -if {[regexp {:\"?([[:alnum:]_]+)(?!\=)\"?|(?!\=)\"?:\"?([[:alnum:]_]+)} $bindmatch) match]} { -## BB: 7/25/13 - based on order of projection filtering in SQL , ie :1=ColumnName versus ColumnName=:1, handle bind variable setting... - if {[regexp {:\"?([[:alnum:]_]+)(?!\=)\"?} $bindmatch) match]} { - set bindvarlist($cursor) [split [regexp -inline -all --\ - {:\"?([[:alnum:]_]+)(?!\=)\"?} $bindmatch ]] - } else { - set bindvarlist($cursor) [split [regexp -inline -all --\ - {(?!\=)\"?:\"?([[:alnum:]_]+)} $bindmatch ]] - } - set bindvarlength [llength $bindvarlist($cursor)] - set count 0 - while {$count < $bindvarlength} { - if {[expr fmod($count,2)] == 1.0} { - lappend bindvarlist2 [lindex $bindvarlist($cursor) $count] - } - incr count - } - set bindvarlist($cursor) $bindvarlist2 - set bindvarlength [llength $bindvarlist($cursor)] - regsub -all {\"} $text($cur2hash($cursor)) {\\"} text($cur2hash($cursor)) - regsub -all {\$} $text($cur2hash($cursor)) {\\$} text($cur2hash($cursor)) - append ora "set sql$cursor \"$text($cur2hash($cursor))\"\n" - set preapp($cursor) 1 - if { $oct == 47 } { - set plsql($cursor) 1 - append ora "oraparse \$curn$cursor \$sql$cursor\n" - set preapp($cursor) 1 - } else { - append ora "orasql \$curn$cursor \$sql$cursor -parseonly\n" - set preapp($cursor) 1 - } - } else { - regsub -all {\"} $text($cur2hash($cursor)) {\\"} text($cur2hash($cursor)) - regsub -all {\$} $text($cur2hash($cursor)) {\\$} text($cur2hash($cursor)) - append ora "set sql$cursor \"$text($cur2hash($cursor))\"\n" - set preapp($cursor) 1 - if { $oct == 47 } { - set plsql($cursor) 1 - append ora "oraparse \$curn$cursor \$sql$cursor\n" - append exectype($cursor) "oraplexec \$curn$cursor \$sql$cursor\n" - set preapp($cursor) 1 - } else { - append exectype($cursor) "orasql \$curn$cursor \$sql$cursor\n" - set preapp($cursor) 1 - } - } - } else { -if {[string match {PARSE*dep=*} $line] && ![string match {*ERROR*} $line]} { -regexp {PARSE\ \#([0-9]+)\:} $line all cursor -if { [ set ix [ lsearch $depzerobind $cursor ]] != -1 } { - set depzerobind [ lreplace $depzerobind $ix $ix ] - } - } - } - - if {[string match {FETCH*dep=0*} $line]} { - regexp {FETCH\ \#([0-9]+)\:} $line all cursor -if { [ info exists errinexec($cursor) ] && $errinexec($cursor) == 1 } { -if { [ info exists fetched($cursor) ] && $fetched($cursor) == 0 } { - append ora "###CANNOT FETCH $cursor:Failed to convert corresponding execute\n" - set fetched($cursor) 1 - set lastfetchedcursor $cursor - unset errinexec($cursor) - } - } else { -if { [ info exists fetched($cursor) ] && $fetched($cursor) == 0 } { - append ora "set row \[orafetch \$curn$cursor -datavariable output \]\n" - append ora "while \{ \[ oramsg \$curn$cursor \] == 0 \} \{\n" - append ora "puts \$output\n" - append ora "set row \[orafetch \$curn$cursor -datavariable output \]\n" - append ora "\}\n" - set fetched($cursor) 1 - set lastfetchedcursor $cursor - } - } - } - if {([string match {BINDS*} $line])} { - regexp {BINDS\ \#([0-9]+)\:} $line all cursor - set currcur $cursor -if { [ lsearch $depzerobind $cursor ] != -1 } { - if {[array exists cur2hash]} { - if {[array get cur2hash $cursor] != ""} { - set in_bind $cursor - unset -nocomplain bindexec - } - } - } else { ; } -} - if {$in_bind >= 0} { -if {[string match {kkscoacd} $line]} { -#We are dealing with the new 10.2 trace file format -continue - } -if {[string match {Dump\ of\ memory*} $line]} { -set errorlist($in_bind) "###CANNOT EXECUTE $in_bind:Memory Dump in tracefile instead of value\n" - } - if {[string match {\ bind\ [0-9]*:*} $line]} { - regexp {\ bind\ ([0-9]+)\:} $line all bind_pos - if {$nbinds == 0} { - incr nbinds - } - } -if {[string match {\ Bind\#[0-9]*} $line]} { - regexp {\ Bind\#([0-9]+)} $line all bind_pos - if {$nbinds == 0} { - incr nbinds - } - } - if {!([string match {BINDS*} $line])} { - if {![regexp {^[[:space:]]} $line match]} { - unset -nocomplain execlist($in_bind) - if {$nbinds > 0} { - if {[array exists bindexec]} { - if {[info exists plsql($in_bind)]} { - if { $plsql($in_bind) == 1 } { - append execlist($in_bind) "oraplexec \$curn$in_bind \$sql$in_bind " - } else { - puts "Error $plsql($in_bind) incorrect value" - } - } else { - append execlist($in_bind) "orabindexec \$curn$in_bind " - } - foreach i [array names bindexec] { - append execlist($in_bind) ":$i \{$bindexec($i)\} " - unset bindexec($i) - } - append execlist($in_bind) "\n" - } - } - set nbinds 0 - set bind_pos -1 - set in_bind -1 - } - } - } - if {$in_bind >= 0 && $in_bind == $currcur} { - if {$bind_pos >= 0} { - if {[string match {*value=*} $line]} { - if {[regexp {value=\"?(.*[^\"])\"?} $line match value]} { - if {[info exists bindvarlist($in_bind)]} { - set bindvar [lindex $bindvarlist($in_bind) $bind_pos] - - if {[string match {*[\\\}\{\;\#]*} $value] } { -regsub -all {([\\\}\{\;\#])} $value {\\\1} value - set value - } - set bindexec($bindvar) $value - } - } - } else { - if {[string match {*avl=00*} $line]} { - set value "" - if {[info exists bindvarlist($in_bind)]} { - set bindvar [lindex $bindvarlist($in_bind) $bind_pos] - set bindexec($bindvar) $value - } - } - } - } - } - - if {[string match {EXEC*dep=0*} $line]} { - regexp {EXEC\ \#([0-9]+)\:} $line all cursor - set fetched($cursor) 0 - if { [info exists errorlist($cursor)] } { - append ora $errorlist($cursor) - } else { - if { [info exists exectype($cursor)] } { - append ora $exectype($cursor) - } else { - if { [info exists execlist($cursor)] } { - append ora $execlist($cursor) - } else { -#EXECUTE HAS been called for a cursor without a PARSE line -if { [ info exists preapp($cursor) ] && $preapp($cursor) == 1 } { -if { [ info exists plsql($cursor) ] && $plsql($cursor) == 1 } { -append ora "###CANNOT EXECUTE $cursor:Failed to find expected bind variables in PL/SQL statement before execute\n" -set errinexec($cursor) 1 -} else { -append ora "###CANNOT EXECUTE $cursor:Failed to find expected bind variables in statement before execute\n" -set errinexec($cursor) 1 - } - } else { -set bindmatch [ check_date_formats $text($cur2hash($cursor)) ] -if {[regexp {:\"?([[:alnum:]_]+)\"?} $bindmatch) match]} { -append ora "###CANNOT EXECUTE $cursor:Found bind variables in the following statement that has not been parsed before execute\n" -append ora "###\"$text($cur2hash($cursor))\"\n" -set errinexec($cursor) 1 - } else { -#Valid format for execute without previous PARSE - append ora "set sql$cursor \"$text($cur2hash($cursor))\"\n" - append ora "orasql \$curn$cursor \$sql$cursor\n" - } - } - } - } - } - } -} -if { [ info exists lastfetchedcursor ] } { -if {$lastfetchedcursor != 0} { - append ora "oraclose \$curn$lastfetchedcursor\n" - unset -nocomplain plsql($lastfetchedcursor) preapp($lastfetchedcursor) fetched($lastfetchedcursor) - } -} - append ora "oralogoff \$lda\n" -set _ED(package) $ora - update - set _ED(temppackage) $_ED(package) - ed_status_message -perm - set _ED(blockflag) 0 -if { [ info exists c ] } { set _ED(packagekeyname) $c } - ed_edit - applyctexthighlight .ed_mainFrame.mainwin.textFrame.left.text -} diff --git a/hdb-components/hdb_ed.tcl b/hdb-components/hdb_ed.tcl deleted file mode 100644 index 480f5180..00000000 --- a/hdb-components/hdb_ed.tcl +++ /dev/null @@ -1,6981 +0,0 @@ -proc ttk::toplevel {w args} { - eval [linsert $args 0 ::toplevel $w] - place [ttk::frame $w.tilebg] -x 0 -y 0 -relwidth 1 -relheight 1 - set w - } - -set tkcmdlist { tkCancelRepeat tkListboxBeginSelect tkCancelRepeat tkwait tkEntryInsert tkListboxMotion tkListboxUpDown tkEntryBackspace } -foreach tkcmd $tkcmdlist { - if {![llength [ info commands $tkcmd]]} { - tk::unsupported::ExposePrivateCommand $tkcmd - } -} - -proc ed_start_gui {} { -global _ED ed_mainf tcl_platform new open save copy cut paste search test ctext lvuser runworld succ fail vus run tick cross oneuser running clock clo masterthread table opmode masterlist pencil distribute boxes datagen autopilot apmode dashboard windock winundock datagen defaultBackground defaultForeground rdbms tabix tabiy - - set opmode "Local" - #Scaling factor for physical units to pixels with design default of 1.3333333 - set scale_fact 1.333333 - tk scaling $scale_fact - #Scale fonts - foreach font [ font names ] { - font configure $font -size [font configure $font -size ] - } - set tabix [ expr {round(481.2 * $scale_fact)} ] - set tabiy [ expr {round(240.6 * $scale_fact)} ] - set mainx [ expr {round(606 * $scale_fact)} ] - set mainy [ expr {round(482.7 * $scale_fact)} ] - set mainminx [ expr {round(248.1 * $scale_fact)} ] - set mainminy [ expr {round(240.6 * $scale_fact)} ] - set mainmaxx [ expr {round(744.3 * $scale_fact)} ] - set mainmaxy [ expr {round(556.4 * $scale_fact)} ] - ttk::toplevel .ed_mainFrame - wm withdraw .ed_mainFrame - wm title .ed_mainFrame "HammerDB" - wm geometry .ed_mainFrame +100+100 - set Parent .ed_mainFrame - set masterlist "" - - set Name $Parent.statusbar - pack [ ttk::frame $Name ] -side bottom -anchor se - pack [ ttk::sizegrip $Name.grip ] -side right -anchor se - - set Name $Parent.menuframe - ttk::frame $Name - pack $Name -anchor nw -expand 0 -fill x -ipadx 0 -ipady 0 \ - -padx 0 -pady 2 -side top - - set Name $Parent.menuframe.file - - set Menu_string($Name) { - {{command} {New} {-command ed_edit_clear -underline 0}} - {{command} {Open} {-command ed_file_load -underline 0}} - {{command} {Save} {-command ed_file_save -underline 0}} - {{separator} {} {}} - {{command} {Exit} {-command ed_stop_gui -underline 1}} - } - - construct_menu $Name File $Menu_string($Name) - - set Name $Parent.menuframe.edit - set Menu_string($Name) { - {{command} {Copy} {-command ed_edit_copy -underline 0}} - {{command} {Cut} {-command "ed_edit_cut" -underline 2}} - {{command} {Paste} {-command "ed_edit_paste" -underline 0}} - {{separator} {} {}} - {{command} {Search} {-command "ed_edit_searchf" -underline 0}} - {{command} {Turn Word Wrap On} {-command "wrap_on" -underline 0}} - {{separator} {} {}} - {{command} {Choose Font} {-command {catch {.ed_mainFrame.mainwin.textFrame.left.text configure -font "[choose_font "Arial 10"]"}} -underline 0}} - {{command} {Turn Highlighting Off} {-command "highlight_off_with_message" -underline 0}} - {{separator} {} {}} - {{command } {Test} {-command "ed_run_package" -underline 0}} - } -proc wrap_on {} { - .ed_mainFrame.mainwin.textFrame.left.text configure -wrap word - .ed_mainFrame.menuframe.edit.m2 entryconfigure 6 -label "Turn Word Wrap Off" - .ed_mainFrame.menuframe.edit.m2 entryconfigure 6 -command "wrap_off" -} -proc wrap_off {} { - .ed_mainFrame.mainwin.textFrame.left.text configure -wrap none - .ed_mainFrame.menuframe.edit.m2 entryconfigure 6 -label "Turn Word Wrap On" - .ed_mainFrame.menuframe.edit.m2 entryconfigure 6 -command "wrap_on" -} -proc highlight_on {} { -#only called on startup -global highlight -set highlight "true" - .ed_mainFrame.menuframe.edit.m2 entryconfigure 9 -label "Turn Highlighting Off" - .ed_mainFrame.menuframe.edit.m2 entryconfigure 9 -command "highlight_off_with_message" -} -proc highlight_off {} { -#only called on startup -global highlight -set highlight "false" - .ed_mainFrame.menuframe.edit.m2 entryconfigure 9 -label "Turn Highlighting On" - .ed_mainFrame.menuframe.edit.m2 entryconfigure 9 -command "highlight_on_with_message" -} -proc highlight_on_with_message {} { -global highlight -set highlight "true" - .ed_mainFrame.menuframe.edit.m2 entryconfigure 9 -label "Turn Highlighting Off" - .ed_mainFrame.menuframe.edit.m2 entryconfigure 9 -command "highlight_off_with_message" -tk_messageBox -title Highlight -message "Highlighting of keywords and program control will be enabled at next script editor load" -} -proc highlight_off_with_message {} { -global highlight -set highlight "false" - .ed_mainFrame.menuframe.edit.m2 entryconfigure 9 -label "Turn Highlighting On" - .ed_mainFrame.menuframe.edit.m2 entryconfigure 9 -command "highlight_on_with_message" -tk_messageBox -title Highlight -message "Highlighting of keywords and program control will be disabled at next script editor load" -} - - construct_menu $Name Edit $Menu_string($Name) - - set Name $Parent.menuframe.tpcc - set Menu_string($Name) { - {{command} {Benchmark} {-command "select_rdbms none" -underline 0}} - {{cascade} {TPC-C Schema} {{{command} {Build and Driver} {-command "configtpcc all" -underline 6}} {{command} {Load Driver Script} {-command "loadtpcc" -underline 6}}}} - {{cascade} {TPC-H Schema} {{{command} {Build and Driver} {-command "configtpch all" -underline 6}} {{command} {Load Driver Script} {-command "loadtpch" -underline 6}}}} - {{command} {Virtual User} {-command "vuser_options" -underline 1}} - {{command} {Autopilot} {-command "autopilot_options" -underline 0}} - {{command} {Transaction Counter} {-command "countopts" -underline 0}} - {{command} {Metrics} {-command "metricsopts" -underline 0}} - {{command} {Mode} {-command "select_mode" -underline 0}} - {{command} {Datagen} {-command "dgopts" -underline 0}} - {{tearoff} {no} {}} - } -construct_menu $Name Options\ $Menu_string($Name) - - set Name $Parent.menuframe.help - set Menu_string($Name) { - {{command} {About} {-command "about" -underline 0}} - {{command} {License} {-command "license" -underline 0}} - {{tearoff} {no} {}} - } - - construct_menu $Name Help $Menu_string($Name) - - - set Name $Parent.statusbar.l17 - ttk::label $Name -text "0.0" - pack $Name -anchor nw -side right -expand 0 -fill x - - set Name $Parent.statusbar.l16 - ttk::label $Name -text " Row.Col: " - pack $Name -anchor nw -side right -expand 0 -fill x - - set Name $Parent.statusbar.l15 - ttk::label $Name -text " Mode: $opmode" - pack $Name -anchor nw -side right -expand 0 -fill x - - set Name $Parent.statusbar.l14 - ttk::label $Name -text " File: $_ED(packagekeyname)" - pack $Name -anchor nw -side right -expand 0 -fill x - - set Name $Parent.buttons - ttk::frame $Name - pack $Name -anchor nw -side top -expand 0 -fill x -ipadx 0 -ipady 0 \ - -padx 0 -pady 0 - - construct_button $Parent.buttons.clear $new new.ppm "ed_edit_clear" \ - "Clear the screen" - - construct_button $Parent.buttons.load $open open.ppm "ed_file_load" \ - "Open existing file" - - construct_button $Parent.buttons.save $save save.ppm "ed_file_save" \ - "Save current file" - - set Name $Parent.buttons.l8 - ttk::label $Name -text " " - pack $Name -anchor nw -side left -expand 0 -fill x - - construct_button $Parent.buttons.copy $copy copy.ppm "ed_edit_copy"\ - "Copy selected text" - - construct_button $Parent.buttons.cut $cut cut.ppm "ed_edit_cut"\ - "Cut selected text" - - construct_button $Parent.buttons.paste $paste paste.ppm "ed_edit_paste" \ - "Paste selected text" - - construct_button $Parent.buttons.search $search search.ppm "ed_edit_searchf"\ - "Search in text" - - set Name $Parent.buttons.l15 - ttk::label $Name -text " " - pack $Name -anchor nw -side left -expand 0 -fill x - -construct_button $Parent.buttons.console $ctext console.gif "convert_to_oratcl" "Convert Trace to Oratcl" - -construct_button $Parent.buttons.test $test test.ppm "ed_run_package" \ - "Test Tcl code" - -construct_button $Parent.buttons.lvuser $lvuser arrow.ppm "remote_command load_virtual; load_virtual" "Load Virtual Users" - -construct_button $Parent.buttons.runworld $runworld world.ppm "remote_command run_virtual; run_virtual" "Run Virtual Users" - - set Name $Parent.buttons.l15a - ttk::label $Name -text " " - pack $Name -anchor nw -side left -expand 0 -fill x - -construct_button $Parent.buttons.boxes $boxes boxes.ppm "check_which_bm" "Create TPC Schema" - -construct_button $Parent.buttons.datagen $datagen datagen.ppm "run_datagen" "Generate TPC Data" - -construct_button $Parent.buttons.pencil $pencil pencil.ppm "transcount" "Transaction Counter" - -construct_button $Parent.buttons.dashboard $dashboard dashboard.ppm "metrics" "Metrics" - -set Name $Parent.buttons.l15b -ttk::label $Name -text " " -pack $Name -anchor nw -side left -expand 0 -fill x - -construct_button $Parent.buttons.autopilot $autopilot autopilot.ppm "start_autopilot" "Autopilot" -.ed_mainFrame.buttons.autopilot configure -state disabled - -construct_button $Parent.buttons.distribute $distribute distribute.ppm "distribute" "Master Distribution" -$Parent.buttons.distribute configure -state disabled - -set succ [image create photo -data $tick -gamma 1 -height 16 -width 16 -palette 5/5/4] -set fail [image create photo -data $cross -gamma 1 -height 16 -width 16 -palette 5/5/4] -set vus [image create photo -data $oneuser -gamma 1 -height 16 -width 16 -palette 5/5/4] -set run [image create photo -data $running -gamma 1 -height 16 -width 16 -palette 5/5/4] -set clo [image create photo -data $clock -gamma 1 -height 16 -width 16 -palette 5/5/4] - - set Name $Parent.panedwin - if { $ttk::currentTheme eq "clam" || $ttk::currentTheme eq "black" } { -switch $ttk::currentTheme { - clam { set pbckg $ttk::theme::clam::colors(-frame) } - black { set pbckg $ttk::theme::black::colors(-frame) } - } - panedwindow $Name -orient vertical -handlesize 8 -background $pbckg } else { - panedwindow $Name -orient vertical -showhandle true - } - pack $Name -expand yes -fill both - -ttk::style configure Heading -font TkDefaultFont -set Name $Parent.panedwin.subpanedwin - if { $ttk::currentTheme eq "clam" || $ttk::currentTheme eq "black" } { -switch $ttk::currentTheme { - clam { set pbckg $ttk::theme::clam::colors(-frame) } - black { set pbckg $ttk::theme::black::colors(-frame) } - } - panedwindow $Name -orient horizontal -handlesize 8 -background $pbckg } else { - panedwindow $Name -orient horizontal -showhandle true - } - pack $Name -expand yes -fill both - -set Name $Parent.treeframe -ttk::frame $Name -pack $Name -anchor sw -expand 1 -fill both -side bottom -$Parent.panedwin.subpanedwin add $Name -ttk::scrollbar $Parent.treeframe.vbar -orient vertical -command "$Parent.treeframe.treeview yview" - pack $Parent.treeframe.vbar -anchor center -expand 0 -fill y -ipadx 0 -ipady 0 \ - -padx 0 -pady 0 -side right -set Name $Parent.treeframe.treeview - if { $ttk::currentTheme eq "black" } { -ttk::style configure Treeview -background $defaultBackground -ttk::style configure Treeview -fieldbackground $defaultBackground -ttk::style map Treeview -background [ list selected #828282 ] - } -ttk::treeview $Name -yscrollcommand "$Parent.treeframe.vbar set" -$Name column #0 -stretch 1 -minwidth 1 -width 161 -$Name heading #0 -text "Benchmark" -$Name configure -padding {0 0 0 0} -pack $Name -side left -anchor w -expand 1 -fill both -$Name insert {} end -id "Oracle" -text "Oracle" -$Name item Oracle -tags {oraopt oraopt2} -$Name tag bind oraopt { if { ![ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] } { if { $rdbms != "Oracle" } { select_rdbms "Oracle" } } } -$Name tag bind oraopt2 { if { !([ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] || [ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled hover" ]) } { if { $rdbms eq "Oracle" } { -.ed_mainFrame.treeframe.treeview selection set Oracle -select_rdbms "Oracle" } } } -$Name insert {} end -id "MSSQLServer" -text "SQL Server" -$Name item MSSQLServer -tags {mssqlopt mssqlopt2} -$Name tag bind mssqlopt { if { ![ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] } { if { $rdbms != "MSSQLServer" } { select_rdbms "MSSQLServer" } } } -$Name tag bind mssqlopt2 { if { !([ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] || [ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled hover" ]) } { if { $rdbms eq "MSSQLServer" } { -.ed_mainFrame.treeframe.treeview selection set MSSQLServer -select_rdbms "MSSQLServer" } } } -$Name insert {} end -id "DB2" -text "DB2" -$Name item DB2 -tags {db2opt db2opt2} -$Name tag bind db2opt { if { ![ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] } { if { $rdbms != "DB2" } { select_rdbms "DB2" } } } -$Name tag bind db2opt2 { if { !([ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] || [ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled hover" ]) } { if { $rdbms eq "DB2" } { -.ed_mainFrame.treeframe.treeview selection set DB2 -select_rdbms "DB2" } } } -$Name insert {} end -id "MySQL" -text "MySQL" -$Name item MySQL -tags {mysqlopt mysqlopt2} -$Name tag bind mysqlopt { if { ![ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] } { if { $rdbms != "MySQL" } { select_rdbms "MySQL" } } } -$Name tag bind mysqlopt2 { if { !([ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] || [ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled hover" ]) } { if { $rdbms eq "MySQL" } { .ed_mainFrame.treeframe.treeview selection set MySQL -select_rdbms "MySQL" } } } -$Name insert {} end -id "PostgreSQL" -text "PostgreSQL" -$Name item PostgreSQL -tags {pgopt pgopt2} -$Name tag bind pgopt { if { ![ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] } { if { $rdbms != "PostgreSQL" } { select_rdbms "PostgreSQL" } } } -$Name tag bind pgopt2 { if { !([ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] || [ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled hover" ]) } { if { $rdbms eq "PostgreSQL" } { .ed_mainFrame.treeframe.treeview selection set PostgreSQL -select_rdbms "PostgreSQL" } } } -$Name insert {} end -id "Redis" -text "Redis" -$Name item Redis -tags {redopt redopt2} -$Name tag bind redopt { if { ![ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] } { if { $rdbms != "Redis" } { select_rdbms "Redis" } } } -$Name tag bind redopt2 { if { !([ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] || [ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled hover" ]) } { if { $rdbms eq "Redis" } { .ed_mainFrame.treeframe.treeview selection set Redis -select_rdbms "Redis" } } } -$Name insert {} end -id "Trafodion" -text "Trafodion" -$Name item Trafodion -tags {trafopt trafopt2} -$Name tag bind trafopt { if { ![ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] } { if { $rdbms != "Trafodion" } { select_rdbms "Trafodion" } } } -$Name tag bind trafopt2 { if { !([ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] || [ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled hover" ]) } { if { $rdbms eq "Trafodion" } { .ed_mainFrame.treeframe.treeview selection set Trafodion -select_rdbms "Trafodion" } } } -proc Press {w x y} { - set e [$w identify $x $y] - if {[string match "*detach" $e]} { - $w state pressed - } else { - upvar #0 [namespace current]::$w state - set state(drag) 1 - set state(drag_index) [$w index @$x,$y] - set state(drag_from_x) $x - set state(draw_from_y) $y - } -} -proc Release {w x y rootX rootY} { - $w state !pressed - set e [$w identify $x $y] - set index [$w index @$x,$y] - if {[string match "*detach" $e]} { - Detach $w $index - } else { - upvar #0 [namespace current]::$w state - if {[info exists state(drag)] && $state(drag)} { - set dropwin [winfo containing $rootX $rootY] - if {$dropwin eq {}} { - Detach $w $state(drag_index) - } - unset state - } - } -} -# Turn a tab into a toplevel (must be a tk::frame) -proc Detach {notebook index} { -global tabix tabiy - set tabindex [lindex [$notebook tabs] $index] - set tabname [ lindex [ split [ $notebook select ] "." ] end ] -if [ string match "*-state normal*" [ $notebook tab $index ] ] { set tabactive "true" } else { set tabactive "false" } -if { $tabname eq "tc" || $tabname eq "me" } { -if { $tabactive } { - set title [$notebook tab $index -text] - $notebook forget $index - wm manage $tabindex - wm title $tabindex $title - wm geometry $tabindex ${tabix}x${tabiy}+30+30 - wm minsize $tabindex $tabix $tabiy -if { $tabname eq "tc" } { - wm maxsize $tabindex $tabix $tabiy - } else { - wm resizable $tabindex true true - } - wm protocol $tabindex WM_DELETE_WINDOW \ - [namespace code [list Attach $notebook $tabindex $index]] - event generate $tabindex <> - } else { -#Only Transaction Counter tc and Metrics me can be Detached - } - } -} -# Attach a toplevel to the notebook -proc Attach {notebook tab {index end}} { -global windock winundock -set tabcount [ llength [ $notebook tabs ] ] -set tabname [ lindex [ split $tab "." ] end ] -#metrics window always goes one in from end -if { $tabname eq "me" } { set index [ expr $tabcount - 1 ] } -image create photo ::img::dock -data $windock -image create photo ::img::undock -data $winundock - set title [wm title $tab] - wm forget $tab - if {[catch { - if {[catch {$notebook insert $index $tab -text $title -compound right -image [list ::img::dock \ - {active pressed focus !disabled} ::img::dock \ - {active !disabled} ::img::undock] - } err]} { - $notebook add $tab -text $title - } - $notebook select $tab - } err]} { - wm manage $w - wm title $w $title - } -} -image create photo ::img::dock -data $windock -image create photo ::img::undock -data $winundock -set Name $Parent.notebook -ttk::notebook $Name - bind TNotebook {+Press %W %x %y} - bind TNotebook {+Release %W %x %y %X %Y} - $Name add [ tk::frame $Parent.mainwin ] -text "Script Editor" - $Name add [ tk::frame $Parent.tw ] -text "Virtual User Output" -state disabled - $Name add [ tk::frame $Parent.tc ] -text "Transaction Counter" -state disabled -compound right -image [list ::img::dock \ - {active pressed focus !disabled} ::img::dock \ - {active !disabled} ::img::undock] - $Name add [ tk::frame $Parent.me ] -text "Metrics" -state disabled -compound right -image [list ::img::dock \ - {active pressed focus !disabled} ::img::dock \ - {active !disabled} ::img::undock] - $Name add [ tk::frame $Parent.ap ] -text "Autopilot" -state disabled - ttk::notebook::enableTraversal $Name - $Parent.panedwin.subpanedwin add $Name -minsize 5i - $Parent.panedwin add $Parent.panedwin.subpanedwin -minsize 3i - - set Name $Parent.vuserframe - ttk::frame $Name - $Parent.panedwin add $Name -minsize 1i - set table [ tablist $Name ] - tkcon show - - set Name $Parent.buttons.statl15 - ttk::label $Name -text " " - pack $Name -anchor nw -side left -expand 0 -fill x - - set Name $Parent.buttons.statl15a - ttk::label $Name -text " " - pack $Name -anchor ne -side right -expand 0 -fill x - - set Name $Parent.buttons.statusframe -if { $ttk::currentTheme eq "black" } { - frame $Name -background white -borderwidth 2 -relief flat - } else { - frame $Name -background LightYellow -borderwidth 2 -relief raised - } - pack $Name -anchor e -fill both -expand 1 - - set Name $Parent.buttons.statusframe.currentstatus - set _ED(status_widget) $Name -if { $ttk::currentTheme eq "black" } { - ttk::label $Name -background white -foreground black \ - -justify left -textvariable _ED(status) -relief flat - } else { - ttk::label $Name -background LightYellow -foreground black \ - -justify left -textvariable _ED(status) -relief flat - } - pack $Name -anchor center - -foreach { db bn } { Oracle TPC-C Oracle TPC-H MSSQLServer TPC-C MSSQLServer TPC-H DB2 TPC-C DB2 TPC-H MySQL TPC-C MySQL TPC-H PostgreSQL TPC-C PostgreSQL TPC-H Redis TPC-C Trafodion TPC-C } { - populate_tree $db $bn - } - - wm geometry .ed_mainFrame ${mainx}x${mainy}+30+30 - if {$tcl_platform(platform) == "windows"} {set y 0} - wm minsize .ed_mainFrame $mainminx $mainminy - wm maxsize .ed_mainFrame $mainmaxx $mainmaxy -} - -proc populate_tree {rdbms bm} { -global boxes runworld option lvuser autopilot pencil dashboard mode datagen driveroptim driveroptlo vuseroptim -set Name .ed_mainFrame.treeframe.treeview -bind .ed_mainFrame.treeframe.treeview { ed_status_message -perm } -$Name insert $rdbms end -id $rdbms.$bm -text $bm -$Name insert $rdbms.$bm end -id $rdbms.$bm.build -text "Schema Build" -image [image create photo -data $boxes] -$Name item $rdbms.$bm.build -tags {buildhlp} -$Name tag bind buildhlp { ed_status_message -help "Build a TPC Schema" } -$Name insert $rdbms.$bm.build end -id $rdbms.$bm.build.schema -text "Options" -image [image create photo -data $option] -$Name item $rdbms.$bm.build.schema -tags {buildopt} -$Name tag bind buildopt { if { ![ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] } { if {$bm eq "TPC-C"} {configtpcc build } else {configtpch build } } } -$Name insert $rdbms.$bm.build end -id $rdbms.$bm.build.go -text "Build" -image [image create photo -data $boxes ] -$Name item $rdbms.$bm.build.go -tags builsch -$Name tag bind builsch { if { ![ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] } {check_which_bm } } -$Name insert $rdbms.$bm end -id $rdbms.$bm.driver -text "Driver Script" -image [image create photo -data $driveroptim ] -$Name item $rdbms.$bm.driver -tags {drvhlp} -$Name tag bind drvhlp { ed_status_message -help "Load a TPC Driver Script" } -$Name insert $rdbms.$bm.driver end -id $rdbms.$bm.driver.schema -text "Options" -image [image create photo -data $option] -$Name item $rdbms.$bm.driver.schema -tags drvopt -$Name tag bind drvopt { if { ![ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] } { if {$bm eq "TPC-C"} {configtpcc drive } else {configtpch drive} } } -$Name insert $rdbms.$bm.driver end -id $rdbms.$bm.driver.load -text "Load" -image [image create photo -data $driveroptlo] -$Name item $rdbms.$bm.driver.load -tags drvscr -$Name tag bind drvscr { if { ![ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] } { if {$bm eq "TPC-C"} {loadtpcc} else {loadtpch} } } -$Name insert $rdbms.$bm end -id $rdbms.$bm.vusers -text "Virtual User" -image [image create photo -data $vuseroptim ] -$Name item $rdbms.$bm.driver -tags {vuserhlp} -$Name tag bind vuserhlp { ed_status_message -help "Configure Virtual Users" } -$Name insert $rdbms.$bm.vusers end -id $rdbms.$bm.vusers.options -text "Options" -image [image create photo -data $option] -$Name item $rdbms.$bm.vusers.options -tags vuseopt -$Name tag bind vuseopt { if { ![ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] } {vuser_options } } -$Name insert $rdbms.$bm.vusers end -id $rdbms.$bm.vusers.load -text "Create" -image [image create photo -data $lvuser] -$Name item $rdbms.$bm.vusers.load -tags vuseload -$Name tag bind vuseload { if { ![ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] } { .ed_mainFrame.buttons.lvuser invoke } } -$Name insert $rdbms.$bm.vusers end -id $rdbms.$bm.vusers.run -text "Run" -image [image create photo -data $runworld] -$Name item $rdbms.$bm.vusers.run -tags vuserun -$Name tag bind vuserun { if { ![ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] } { .ed_mainFrame.buttons.runworld invoke } } -$Name insert $rdbms.$bm end -id $rdbms.$bm.autopilot -text "Autopilot" -image [image create photo -data $autopilot ] -$Name item $rdbms.$bm.autopilot -tags {autohlp} -$Name tag bind autohlp { ed_status_message -help "Configure Automated Tests" } -$Name insert $rdbms.$bm.autopilot end -id $rdbms.$bm.autopilot.options -text "Options" -image [image create photo -data $option] -$Name item $rdbms.$bm.autopilot.options -tags autoopt -$Name tag bind autoopt { if { ![ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] } {autopilot_options } } -$Name insert $rdbms.$bm.autopilot end -id $rdbms.$bm.autopilot.start -text "Autopilot" -image [image create photo -data $autopilot] -$Name item $rdbms.$bm.autopilot.start -tags autostart -$Name tag bind autostart { if { ![ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] } { start_autopilot } } -$Name insert $rdbms.$bm end -id $rdbms.$bm.txcounter -text "Transactions" -image [image create photo -data $pencil ] -$Name item $rdbms.$bm.txcounter -tags {txhlp} -$Name tag bind txhlp { ed_status_message -help "Configure Transaction Counter" } -$Name insert $rdbms.$bm.txcounter end -id $rdbms.$bm.txcounter.options -text "Options" -image [image create photo -data $option] -$Name item $rdbms.$bm.txcounter.options -tags txopt -$Name tag bind txopt { if { ![ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] } { countopts } } -$Name insert $rdbms.$bm.txcounter end -id $rdbms.$bm.txcounter.start -text "Counter" -image [image create photo -data $pencil] -$Name item $rdbms.$bm.txcounter.start -tags txstart -$Name tag bind txstart { if { ![ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] } { .ed_mainFrame.buttons.pencil invoke } } -$Name insert $rdbms.$bm end -id $rdbms.$bm.metrics -text "Metrics" -image [image create photo -data $dashboard ] -$Name item $rdbms.$bm.metrics -tags {methlp} -$Name tag bind methlp { ed_status_message -help "Configure Metrics" } -$Name insert $rdbms.$bm.metrics end -id $rdbms.$bm.metrics.options -text "Options" -image [image create photo -data $option] -$Name item $rdbms.$bm.metrics.options -tags metopt -$Name tag bind metopt { if { ![ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] } { metricsopts } } -$Name insert $rdbms.$bm.metrics end -id $rdbms.$bm.metrics.start -text "Display" -image [image create photo -data $dashboard ] -$Name item $rdbms.$bm.metrics.start -tags metstart -$Name tag bind metstart { if { ![ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] } { .ed_mainFrame.buttons.dashboard invoke } } -$Name insert $rdbms.$bm end -id $rdbms.$bm.mode -text "Mode" -image [image create photo -data $mode ] -$Name item $rdbms.$bm.mode -tags {modehlp} -$Name tag bind modehlp { ed_status_message -help "Configure Connections" } -$Name insert $rdbms.$bm.mode end -id $rdbms.$bm.mode.options -text "Options" -image [image create photo -data $option] -$Name item $rdbms.$bm.mode.options -tags modeopt -$Name tag bind modeopt { if { ![ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] } {select_mode } } -$Name insert $rdbms.$bm end -id $rdbms.$bm.datagen -text "Datagen" -image [image create photo -data $datagen] -$Name item $rdbms.$bm.datagen -tags {dghlp} -$Name tag bind dghlp { ed_status_message -help "Configure Data Generate" } -$Name insert $rdbms.$bm.datagen end -id $rdbms.$bm.datagen.options -text "Options" -image [image create photo -data $option] -$Name item $rdbms.$bm.datagen.options -tags dgopt -$Name tag bind dgopt { if { ![ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] } { dgopts } } -$Name insert $rdbms.$bm.datagen end -id $rdbms.$bm.datagen.start -text "Generate" -image [image create photo -data $datagen ] -$Name item $rdbms.$bm.datagen.start -tags dgstart -$Name tag bind dgstart { if { ![ string match [ .ed_mainFrame.treeframe.treeview state ] "disabled focus hover" ] } { .ed_mainFrame.buttons.datagen invoke } } -} - -proc ed_stop_gui {} { - ed_wait_if_blocked - exit -} - -proc construct_menu {Name label cmd_list} { - global _ED defaultBackground defaultForeground - - ttk::menubutton $Name -text $label -underline 0 -width [ string length $label ] - incr _ED(menuCount); - set newmenu $Name.m$_ED(menuCount) - - $Name configure -menu $newmenu - - catch "destroy $newmenu" - - eval "menu $newmenu" - - eval [list add_items_to_menu $newmenu $cmd_list] - -if { $ttk::currentTheme eq "black" } { - $newmenu configure -background $defaultBackground -foreground $defaultForeground -activebackground #828282 -activeforeground $defaultForeground - } else { - $newmenu configure -background $defaultBackground - } - -pack $Name -anchor nw -expand 0 -ipadx 4 -ipady 0 -padx 0 \ - -pady 0 -side left - - } - -proc add_items_to_menu {menubutton cmdList} { - global _ED defaultBackground defaultForeground - - foreach cmd $cmdList { - switch [lindex $cmd 0] { - "separator" { - set doit "$menubutton add separator [lindex $cmd 2]" - eval $doit - } - "tearoff" { - if {[string match [lindex $cmd 2] "no"]} { - $menubutton configure -tearoff no - } - } - "radio" { - set doit "$menubutton add radio -label {[lindex $cmd 1]} \ - -variable [lindex $cmd 2] -value on" - eval $doit - } - "command" { - set doit "$menubutton add [lindex $cmd 0] -background $defaultBackground -label {[lindex $cmd 1]} \ - [lindex $cmd 2]" - eval $doit - } - "cascade" { - incr _ED(menuCount); - set newmenu $menubutton.m$_ED(menuCount) - set doit "$menubutton add cascade -label {[lindex $cmd 1]} \ - -menu $newmenu" - eval $doit - menu $newmenu -if { $ttk::currentTheme eq "black" } { - $newmenu configure -background $defaultBackground -foreground $defaultForeground \ - -activebackground #828282 -activeforeground $defaultForeground - } - add_items_to_menu $newmenu [lindex $cmd 2] - } - } - } - } - -proc disable_tree { } { - global rdbms bm - set Name .ed_mainFrame.treeframe.treeview - set databases [$Name children {}] - foreach db $databases { - set benchmarks [$Name children $db] - foreach dbbn $benchmarks { - $Name detach $dbbn - } - } - $Name move $rdbms {} 0 - $Name move $rdbms.$bm $rdbms 0 - $Name see $rdbms.$bm - $Name focus $rdbms.$bm - $Name selection set $rdbms.$bm -} - -proc disable_enable_options_menu { disoren } { -global rdbms bm -set Name .ed_mainFrame.menuframe.tpcc.m3 -if { $disoren eq "disable" } { -for { set entry 0 } {$entry < 6 } {incr entry} { -#8 entries in menu leave last 3 always enabled -$Name entryconfigure $entry -state disabled - } -set Name .ed_mainFrame.buttons.boxes -$Name configure -state disabled -set Name .ed_mainFrame.treeframe.treeview -$Name state disabled - } else { -for { set entry 0 } {$entry < 6 } {incr entry} { -$Name entryconfigure $entry -state normal - } -if { [ info exists rdbms ] } { ; } else { set rdbms "Oracle" } -if { $rdbms eq "Redis" || $rdbms eq "Trafodion" } { set bm "TPC-C" } -if { [ info exists bm ] } { ; } else { set bm "TPC-C" } -if { $bm eq "TPC-C" } { -$Name entryconfigure 2 -state normal -$Name entryconfigure 3 -state disabled - } else { -$Name entryconfigure 3 -state normal -$Name entryconfigure 2 -state disabled - } -set Name .ed_mainFrame.buttons.boxes -$Name configure -state normal -set Name .ed_mainFrame.treeframe.treeview -$Name state !disabled - } -} - -proc disable_bm_menu {} { -global rdbms bm tcl_platform highlight -if { [ info exists rdbms ] } { ; } else { set rdbms "Oracle" } -if { $rdbms eq "Redis" || $rdbms eq "Trafodion" } { set bm "TPC-C" } -if { [ info exists bm ] } { ; } else { set bm "TPC-C" } -if { $bm eq "TPC-C" } { -.ed_mainFrame.menuframe.tpcc.m3 entryconfigure 2 -state normal -.ed_mainFrame.menuframe.tpcc.m3 entryconfigure 3 -state disabled - } else { -.ed_mainFrame.menuframe.tpcc.m3 entryconfigure 3 -state normal -.ed_mainFrame.menuframe.tpcc.m3 entryconfigure 2 -state disabled - } -if {$rdbms == "Oracle"} { -.ed_mainFrame.buttons.console configure -state normal - } else { -.ed_mainFrame.buttons.console configure -state disabled - } -disable_tree -if { $highlight eq "true" } { -highlight_on - } else { -highlight_off - } -} - -proc loadtpcc {} { -global _ED rdbms oradriver mysqldriver mssqlsdriver db2driver pg_driver redis_driver trafodion_driver allwarehouse my_allwarehouse mssqls_allwarehouse db2_allwarehouse pg_allwarehouse redis_allwarehouse trafodion_allwarehouse timeprofile mssqls_timeprofile my_timeprofile pg_timeprofile redis_timeprofile trafodion_timeprofile db2_timeprofile -set _ED(packagekeyname) "TPC-C" -ed_status_message -show "TPC-C Driver Script" -if { [ info exists rdbms ] } { ; } else { set rdbms "Oracle" } -if { ![ info exists oradriver ] } { set oradriver "standard" } -if { ![ info exists mysqldriver ] } { set mysqldriver "standard" } -if { ![ info exists mssqlsdriver ] } { set mssqlsdriver "standard" } -if { ![ info exists db2driver ] } { set db2driver "standard" } -if { ![ info exists pg_driver ] } { set pg_driver "standard" } -if { ![ info exists redis_driver ] } { set redis_driver "standard" } -if { ![ info exists trafodion_driver ] } { set trafodion_driver "standard" } -if { ![ info exists allwarehouse ] } { set allwarehouse "false" } -if { ![ info exists my_allwarehouse ] } { set my_allwarehouse "false" } -if { ![ info exists mssqls_allwarehouse ] } { set mssqls_allwarehouse "false" } -if { ![ info exists db2_allwarehouse ] } { set db2_allwarehouse "false" } -if { ![ info exists pg_allwarehouse ] } { set pg_allwarehouse "false" } -if { ![ info exists redis_allwarehouse ] } { set redis_allwarehouse "false" } -if { ![ info exists trafodion_allwarehouse ] } { set trafodion_allwarehouse "false" } -if { ![ info exists timeprofile ] } { set timeprofile "false" } -if { ![ info exists my_timeprofile ] } { set my_timeprofile "false" } -if { ![ info exists mssqls_timeprofile ] } { set mssqls_timeprofile "false" } -if { ![ info exists db2_timeprofile ] } { set db2_timeprofile "false" } -if { ![ info exists pg_timeprofile ] } { set pg_timeprofile "false" } -if { ![ info exists redis_timeprofile ] } { set redis_timeprofile "false" } -if { ![ info exists trafodion_timeprofile ] } { set trafodion_timeprofile "false" } -switch $rdbms { -Oracle { -if {$oradriver == "standard"} { -loadoratpcc - } else { -loadoraawrtpcc -if { $allwarehouse } { shared_tpcc_functions "allwarehouse" } -if { $timeprofile } { shared_tpcc_functions "timeprofile" } - } -} -MySQL { -if {$mysqldriver == "standard"} { -loadmytpcc - } else { -loadtimedmytpcc -if { $my_allwarehouse } { shared_tpcc_functions "allwarehouse" } -if { $my_timeprofile } { shared_tpcc_functions "timeprofile" } - } -} -MSSQLServer { -if {$mssqlsdriver == "standard"} { -loadmssqlstpcc - } else { -loadtimedmssqlstpcc -if { $mssqls_allwarehouse } { shared_tpcc_functions "allwarehouse" } -if { $mssqls_timeprofile } { shared_tpcc_functions "timeprofile" } - } -} -DB2 { -if {$db2driver == "standard"} { -loaddb2tpcc - } else { -loadtimeddb2tpcc -if { $db2_allwarehouse } { shared_tpcc_functions "allwarehouse" } -if { $db2_timeprofile } { shared_tpcc_functions "timeprofile" } - } -} -PostgreSQL { -if {$pg_driver == "standard"} { -loadpgtpcc - } else { -loadtimedpgtpcc -if { $pg_allwarehouse } { shared_tpcc_functions "allwarehouse" } -if { $pg_timeprofile } { shared_tpcc_functions "timeprofile" } - } -} -Redis { -if {$redis_driver == "standard"} { -loadredistpcc - } else { -loadtimedredistpcc -if { $redis_allwarehouse } { shared_tpcc_functions "allwarehouse" } -if { $redis_timeprofile } { shared_tpcc_functions "timeprofile" } - } -} -Trafodion { -if {$trafodion_driver == "standard"} { -loadtraftpcc - } else { -loadtimedtraftpcc -if { $trafodion_allwarehouse } { shared_tpcc_functions "allwarehouse" } -if { $trafodion_timeprofile } { shared_tpcc_functions "timeprofile" } - } -} -default { -if {$oradriver == "standard"} { -loadoratpcc - } else { -loadoraawrtpcc -if { $allwarehouse } { shared_tpcc_functions "allwarehouse" } -if { $timeprofile } { shared_tpcc_functions "timeprofile" } - } - } - } -applyctexthighlight .ed_mainFrame.mainwin.textFrame.left.text -} - -proc loadtpch {} { -global _ED rdbms cloud_query mysql_cloud_query pg_cloud_query -set _ED(packagekeyname) "TPC-H" -ed_status_message -show "TPC-H Driver Script" -if { [ info exists rdbms ] } { ; } else { set rdbms "Oracle" } -if { [ info exists cloud_query ] } { ; } else { set cloud_query "false" } -if { [ info exists mysql_cloud_query ] } { ; } else { set mysql_cloud_query "false" } -if { [ info exists pg_cloud_query ] } { ; } else { set pg_cloud_query "false" } -switch $rdbms { -Oracle { -if { $cloud_query } { -loadoracloud - } else { -loadoratpch - } -} -MySQL { -if { $mysql_cloud_query } { -loadmycloud - } else { -loadmytpch - } -} -DB2 { -loaddb2tpch -} -MSSQLServer { -loadmssqlstpch - } -PostgreSQL { -if { $pg_cloud_query } { -loadpgcloud - } else { -loadpgtpch - } -} -default { -loadoratpch - } - } -applyctexthighlight .ed_mainFrame.mainwin.textFrame.left.text -} - -proc construct_button {Name data file cmd helpmsg} { - -global tcl_version ctext - -set im [image create photo -data $data -gamma 1 -height 16 -width 16 -palette 5/5/4] - -ttk::button $Name -image $im -command "$cmd" - pack $Name -anchor nw -side left -expand 0 -fill x - bind $Name [list ed_status_message -help $helpmsg] - bind $Name {ed_status_message -perm} - } - -proc ed_file_load {} { - global _ED ed_loadsave - if { $autostart::autostartap == "true" } { - global apmode - set _ED(file) $autostart::autoloadscript - set apmode "enabled" - } else { - set _ED(file) [ed_loadsave load] - } - if {$_ED(file) == ""} {return} - if {![file readable $_ED(file)]} { - ed_error "File \[$_ED(file)\] is not readable." - return - } - ed_wait_if_blocked - set _ED(blockflag) 1 - ed_status_message -show "loading file: \"$_ED(file)\" ..." - update - if {[catch "open \"$_ED(file)\" r" fd]} { - ed_error "Error while opening $_ED(file): \[$fd\]" - ed_status_message -perm - set _ED(blockflag) 0 - return - } - set _ED(package) "[read $fd]" - close $fd - set _ED(temppackage) $_ED(package) - set _ED(packagekeyname) [file tail $_ED(file)] - if {$_ED(packagekeyname) == ""} {set _ED(packagekeyname) $_ED(file)} - if {$_ED(packagekeyname) == ""} {set _ED(packagekeyname) "UNKNOWN"} - - ed_edit - ed_status_message -perm - applyctexthighlight .ed_mainFrame.mainwin.textFrame.left.text - update - set _ED(blockflag) 0 -} - -proc ed_file_save {} { - global _ED - ed_wait_if_blocked - set _ED(blockflag) 1 - set _ED(package) "[.ed_mainFrame.mainwin.textFrame.left.text get 1.0 end]" - set _ED(blockflag) 0 - set $_ED(file) [ed_loadsave save] - if {$_ED(file) == ""} {return} - if {[file exists $_ED(file)]} { - if {![file writable $_ED(file)]} { - ed_error "File \[$_ED(file)\] is not writable." - return - } - } - ed_wait_if_blocked - set _ED(blockflag) 1 - ed_status_message -show "saving file: \"$_ED(file)\" ..." - update - if {[catch "open \"$_ED(file)\" w" fd]} { - ed_error "Error opening $_ED(file): \[$fd\]" - ed_status_message -perm - update - set _ED(blockflag) 0 - return - } - puts $fd "$_ED(package)" - close $fd - ed_status_message -perm - update - set _ED(blockflag) 0 -} - -proc ed_loadsave {loadflag} { - global ed_loadsave _ED - if {![info exists ed_loadsave(pwd)]} { - set ed_loadsave(pwd) [pwd] - set ed_loadsave(filter) "*.tcl" - set ed_loadsave(file) "" - } - set ed_loadsave(loadflag) $loadflag - set ed_loadsave(path) "" - set ed_loadsave(done) 0 - - ttk::toplevel .ed_loadsave - wm withdraw .ed_loadsave - if {[string match $loadflag "load"]} { - wm title .ed_loadsave "Open File" - } else { - wm title .ed_loadsave "Save File" - } - - wm geometry .ed_loadsave +[expr \ - ([winfo screenwidth .]/2) - 173]+[expr ([winfo screenheight .]/2) - 148] - - set Parent .ed_loadsave - - set Name $Parent.dir - ttk::frame $Name - pack $Name -anchor nw -side top - - set Name $Parent.dir.e3 - ttk::entry $Name -width 35 -textvariable ed_loadsave(pwd) - pack $Name -side right -anchor nw -padx 5 - bind $Name {ed_loadsavegetentries} - bind $Name { - if [%W selection present] { - %W delete sel.first sel.last - } else { - %W delete insert - } - } - - set Name $Parent.dir.l1 - ttk::label $Name -text "Directory: " - pack $Name -side right -anchor nw - - set Name $Parent.type - ttk::frame $Name - pack $Name -anchor nw -side top -fill x - - set Name $Parent.type.e7 - ttk::entry $Name -width 35 -textvariable ed_loadsave(filter) - pack $Name -side right -anchor nw -padx 5 - bind $Name {ed_loadsavegetentries} - bind $Name { - if [%W selection present] { - %W delete sel.first sel.last - } else { - %W delete insert - } - } - - set Name $Parent.type.l5 - ttk::label $Name -text "File Type: " - pack $Name -side right -anchor nw - - set Name $Parent.file - ttk::frame $Name - pack $Name -anchor nw -side top -fill x - - set Name $Parent.file.e11 - ttk::entry $Name -width 35 -textvariable ed_loadsave(file) - pack $Name -side right -anchor nw -padx 5 - .ed_loadsave.file.e11 delete 0 end - .ed_loadsave.file.e11 insert 0 $_ED(packagekeyname) - bind $Name { - if [%W selection present] { - %W delete sel.first sel.last - } else { - %W delete insert - } - } - bind $Name {if {[ed_loadsavevalentry]} {set ed_loadsave(done) 1}} - - set Name $Parent.file.l9 - ttk::label $Name -text "File: " - pack $Name -side right -anchor nw - - set Name $Parent.list - ttk::frame $Name -borderwidth 2 -height 50 \ - -relief raised -width 50 - pack $Name -side top -anchor nw -expand yes -fill both - - set Name $Parent.list.lb1 - listbox $Name -background white -yscrollcommand "$Parent.list.sb2 set" -selectmode browse - pack $Name -anchor center -expand 1 -fill both -ipadx 0 -ipady 0 \ - -padx 2 -pady 2 -side left - bind $Name {ed_loadsaveselbegin %W %y} - bind $Name {ed_loadsaveselbegin2 %W} - bind $Name {ed_loadsaveselbegin %W %y} - bind $Name {ed_loadsaveselbegin %W %y} - bind $Name {set _ED(packagekeyname) \ - $seld_file; ed_loadsaveselend %W %y} - bind $Name {break} - bind $Name {break} - bind $Name {ed_loadsaveselend %W %y} - bind $Name { - tkCancelRepeat - tkListboxBeginSelect %W [%W index active] - %W activate [%W index active] - } - bind $Name { - tkCancelRepeat - tkListboxBeginSelect %W [%W index active] - %W activate [%W index active] - } - - set Name $Parent.list.sb2 - ttk::scrollbar $Name -command "$Parent.list.lb1 yview" - pack $Name -anchor center -expand 0 -fill y -ipadx 0 -ipady 0 \ - -padx 2 -pady 2 -side left - - set Name $Parent.buttons - ttk::frame $Name - pack $Name -side top -anchor nw -fill x - - set Name $Parent.buttons.cancel - ttk::button $Name -text Cancel \ - -command {destroy .ed_loadsave} - pack $Name -side right -anchor nw -padx 3 -pady 3 - - set Name $Parent.buttons.ok - ttk::button $Name -text OK \ - -command {set _ED(packagekeyname) [.ed_loadsave.file.e11 get]; if \ - {[ed_loadsavevalentry]} {set ed_loadsave(done) 1}} - pack $Name -side right -anchor nw -padx 3 -pady 3 - - ed_loadsavegetentries - wm deiconify .ed_loadsave - vwait ed_loadsave(done) - destroy .ed_loadsave - if {[file isdirectory $ed_loadsave(path)]} {set ed_loadsave(path) ""} - return $ed_loadsave(path) -} - -proc ed_loadsaveselbegin {win ypos} { - $win select anchor [$win nearest $ypos] -} - -proc ed_loadsaveselbegin2 {win} { - - global seld_file - set seld_file [$win get [$win curselection]] - .ed_loadsave.file.e11 delete 0 end - .ed_loadsave.file.e11 insert 0 $seld_file - set _ED(packagekeyname) $seld_file -} - -proc ed_loadsaveselend {win ypos} { - global ed_loadsave - $win select set anchor [$win nearest $ypos] - set fil [.ed_loadsave.list.lb1 get [lindex [$win curselection] 0]] - if {-1 == [string last "/" $fil]} { - set ed_loadsave(file) $fil - set ed_loadsave(path) \ - [ concat $ed_loadsave(pwd)\/$ed_loadsave(file) ] - set ed_loadsave(done) 1 - cd [file dirname $ed_loadsave(path) ] - return "" - } - set ed_loadsave(pwd) [ed_loadsavemergepaths \ - $ed_loadsave(pwd) [string trimright $fil "/"]] - ed_loadsavegetentries - return "" -} - -proc ed_loadsavegetentries {} { - global ed_loadsave tcl_version - set e 0 - if {![file isdirectory $ed_loadsave(pwd)]} { - gui_error "\"$ed_loadsave(pwd)\" is not a valid directory" - .ed_loadsave configure -cursor {} - set e 1 - } - .ed_loadsave configure -cursor watch - update - -set sort_mode "-dictionary" -if {[info exists tcl_version] == 0 || $tcl_version < 8.0} { - set sort_mode "-ascii" -} - - if {$ed_loadsave(filter) == ""} {set ed_loadsave(filter) "*"} - set files [lsort $sort_mode "[glob -nocomplain $ed_loadsave(pwd)/.*] \ - [glob -nocomplain $ed_loadsave(pwd)/*]"] - .ed_loadsave.list.lb1 delete 0 end - if {$e} { - .ed_loadsave configure -cursor {} - update - return - } - set d "./ ../" - set fils "" - foreach f $files { - set ff [file tail $f] - if {$ff != "." && $ff != ".."} { - if {[file isdirectory $f]} { - lappend d "$ff/" - } else { - if {[string match $ed_loadsave(filter) $ff]} { - lappend fils "$ff" - } - } - } - } - set files "$d $fils" - foreach f $files { - .ed_loadsave.list.lb1 insert end $f - } - .ed_loadsave configure -cursor {} - update -} - -proc ed_loadsavevalentry {} { - global ed_loadsave _ED - if {"." != [file dirname $ed_loadsave(file)]} { - set path [ed_loadsavemergepaths \ - $ed_loadsave(pwd) $ed_loadsave(file)] - set ed_loadsave(pwd) [file dirname $path] - if {[file extension $path] != ""} { - set ed_loadsave(filter) "*[file extension $path]" - } else { - set ed_loadsave(filter) "*" - } - set ed_loadsave(file) [file tail $path] - ed_loadsavegetentries - return 0 - } - set fil [ed_loadsavemergepaths $ed_loadsave(pwd) $ed_loadsave(file)] - if {[string match $ed_loadsave(loadflag) "load"]} { - if {(![file exists $fil]) || (![file readable $fil])} { - gui_error "\"$fil\" cannot be loaded." - set ed_loadsave(path) "" - return 0 - } else { - set ed_loadsave(path) $fil - set _ED(file) $fil - set ed_loadsave(done) 1 - return 1 - } - } else { - set d [file dirname $fil] - if {![file writable $d]} { - gui_error "\"$d\" directory cannot be written to." - set ed_loadsave(path) "" - set _ED(file) "" - return 0 - } - if {[file exists $fil] && (![file writable $fil])} { - gui_error "\"$file\" cannot be written to." - set ed_loadsave(path) "" - set _ED(file) "" - return 0 - } - set ed_loadsave(path) $fil - set ed_loadsave(done) 1 - set _ED(file) $fil - return 1 - } -} - -proc ed_loadsavemergepaths {patha pathb} { - set pa [file split $patha] - set pb [file split $pathb] - if {[string first ":" [lindex $pb 0]] != -1} {return [eval file join $pb]} - if {[lindex $pb 0] == "/"} {return [eval file join $pb]} - set i [expr [llength $pa] - 1] - foreach item $pb { - if {$item == ".."} { - incr i -1 - set pa [lrange $pa 0 $i] - } elseif {$item == "."} { - # -- do nothing - } else { - lappend pa $item - } - } - return [eval file join $pa] -} - -proc gui_error {message} { - tk_messageBox -icon error -message $message -} - -if {[info procs bgerror] == ""} { - proc bgerror {{message ""}} { - global errorInfo - if {[string match {*threadscreated*} $errorInfo]} { - #puts stderr "Background Error ignored - Threads Killed" - } else { - puts stderr "Unmatched Background Error - $errorInfo" - } - } -} - -proc ed_edit_searchf {} { - global _ED - catch "destroy .ed_edit_searchf" - ttk::toplevel .ed_edit_searchf - wm withdraw .ed_edit_searchf - wm title .ed_edit_searchf {Search} - - set Parent .ed_edit_searchf - - set Name $Parent.f1 - ttk::frame $Name - pack $Name -anchor nw -fill x -side top -padx 5 - - set Name $Parent.f1.l1 - ttk::label $Name -text "Search for: " - grid $Name -column 0 -row 0 -sticky e - - set Name $Parent.f1.e1 - ttk::entry $Name -width 30 - grid $Name -column 1 -row 0 - - bind .ed_edit_searchf.f1.e1 { - if [%W selection present] { - %W delete sel.first sel.last - } else { - %W delete insert - } - } - bind .ed_edit_searchf.f1.e1 {tk_focusNext %W} - $Name delete 0 end - - set Name $Parent.f1.l2 - ttk::label $Name -text "Replace with: " - grid $Name -column 0 -row 1 -sticky e - - set Name $Parent.f1.e2 - ttk::entry $Name -width 30 - grid $Name -column 1 -row 1 - global Procs - set Procs($Name) { {bind .ed_edit_searchf.f1.e2 } \ - {bind .ed_edit_searchf.f1.e2 } \ - {bind .ed_edit_searchf.f1.e2 } \ - {bind .ed_ediy_searchf.f1.e2 }} - bind .ed_edit_searchf.f1.e2 {tkEntryBackspace %W} - bind .ed_edit_searchf.f1.e2 { - if [%W selection present] { - %W delete sel.first sel.last - } else { - %W delete insert - } - } - bind .ed_edit_searchf.f1.e2 {tk_focusNext %W} - $Name delete 0 end - - set Name $Parent.mainwin - ttk::frame $Name - pack $Name -anchor nw -side top -fill x -padx 5 -pady 5 - - set Name $Parent.mainwin.b3 - ttk::button $Name -command {destroy .ed_edit_searchf; if {[.ed_mainFrame.mainwin.textFrame.left.text tag ranges sel] != ""} {.ed_mainFrame.mainwin.textFrame.left.text tag remove sel 1.0 end}} -text Cancel - pack $Name -anchor nw -side right -padx 3 -pady 3 - -set Name $Parent.mainwin.b2 - ttk::button $Name -command { - if {[.ed_mainFrame.mainwin.textFrame.left.text get sel.first sel.last] != ""} { - set _ED(rplc_term) [.ed_edit_searchf.f1.e2 get] - .ed_mainFrame.mainwin.textFrame.left.text insert $_ED(editcursor) $_ED(rplc_term) - .ed_mainFrame.mainwin.textFrame.left.text delete sel.first sel.last - raise .ed_edit_searchf - } - } -text {Replace} - pack $Name -anchor nw -side right -padx 3 -pady 3 - - set Name $Parent.mainwin.b1 - ttk::button $Name -command { - set _ED(srch_new) [.ed_edit_searchf.f1.e1 get] - if {[.ed_mainFrame.mainwin.textFrame.left.text tag ranges sel] != ""} {.ed_mainFrame.mainwin.textFrame.left.text tag remove sel 1.0 end} - if {$_ED(srch_new) != $_ED(srch_old)} {set _ED(editcursor) 1.0} - ed_edit_search .ed_mainFrame.mainwin.textFrame.left.text $_ED(srch_new) - set _ED(srch_old) [.ed_edit_searchf.f1.e1 get] - focus .ed_mainFrame.mainwin.textFrame.left.text - raise .ed_edit_searchf - } -text {Search} - pack $Name -anchor nw -side right -padx 3 -pady 3 - - set x [expr [winfo rootx .ed_mainFrame] + 300] - set y [expr [winfo rooty .ed_mainFrame] + [winfo height .ed_mainFrame] - 300] - wm geometry .ed_edit_searchf +$x+$y - wm deiconify .ed_edit_searchf - raise .ed_edit_searchf - update - wm minsize .ed_edit_searchf [winfo width .ed_edit_searchf] \ - [winfo height .ed_edit_searchf] - wm maxsize .ed_edit_searchf [winfo width .ed_edit_searchf] \ - [winfo height .ed_edit_searchf] - -} - -proc ed_edit_search {textwin srch_string} { - global _ED - - if {$srch_string == ""} {set _ED(editcursor) 1.0; return} - set length 0; - - set fail [catch {\ - $textwin search -regexp -count length $srch_string $_ED(editcursor) end} \ - _ED(editcursor) ] - - if { ($length != 0) && (!$fail) } { - $textwin tag add sel $_ED(editcursor) "$_ED(editcursor) + $length char" - set _ED(editcursor) [$textwin index "$_ED(editcursor) + $length char"] - $textwin see $_ED(editcursor) - } else {set _ED(editcursor) 1.0} - - if {$_ED(editcursor) == 1.0} {ed_error "No match for string"; return} - if {$_ED(editcursor) == $_ED(editcurold)} {ed_error "End of search"} - set _ED(editcurold) $_ED(editcursor) -} - -proc ed_edit_clear {} { - global _ED - ed_wait_if_blocked - set _ED(blockflag) 1 - set _ED(temppackage) "" - set _ED(blockflag) 0 - if {[info commands .ed_mainFrame.mainwin.f1] != ""} { - .ed_mainFrame.mainwin.textFrame.left.text delete 1.0 end - set _ED(packagekeyname) [.ed_mainFrame.mainwin.f1.e5 get] - } - - set _ED(package) "" - set _ED(packagekeyname) "" - ed_edit -} - -proc ed_edit_commit {} { - global _ED - ed_wait_if_blocked - set _ED(blockflag) 1 - set _ED(package) "[.ed_mainFrame.mainwin.textFrame.left.text get 1.0 end]" - set _ED(blockflag) 0 - update -} - -proc ed_edit_cut {} { - - tk_textCut .ed_mainFrame.mainwin.textFrame.left.text - -} - -proc ed_edit_copy {} { - tk_textCopy .ed_mainFrame.mainwin.textFrame.left.text -} - - -proc ed_edit_paste {} { - tk_textPaste .ed_mainFrame.mainwin.textFrame.left.text -} - -proc tlines {text} { -return [expr [lindex [split [$text index end] .] 0] -1] -} - -proc applyctexthighlight {w} { -global highlight -if { $highlight eq "true" } { -#force cursor change for windows -.ed_mainFrame conf -cursor watch -tk busy .ed_mainFrame -$w highlight 1.0 [ tlines $w ].0 -tk busy forget .ed_mainFrame -.ed_mainFrame conf -cursor {} -ed_status_message -temp "Highlighting Complete" -update - } else { -#Don't highlight - ; - } - } - -proc setctexthighlight {w} { - set colour(vars) green - set colour(cmds) blue - set colour(functions) magenta - set colour(brackets) gray50 - set colour(comments) black - set colour(strings) red - ctext::addHighlightClassWithOnlyCharStart $w vars $colour(vars) "\$" - ctext::addHighlightClass $w cmds $colour(cmds) [ list mysqlconnect oralogon tell socket subst open eof oraplexec pwd mysqlquery oraopen glob list mysqlnext pid exec oraexec auto_load_index time unknown eval lassign lrange fblocked lsearch oracols auto_import gets mysqlmap case lappend proc throw mysqlbaseinfo mysqlresult break mysqlseek variable llength orabind auto_execok return pkg_mkIndex linsert mysqlsel error oracommit catch mysqlping clock info split orainfo redis array if fconfigure coroutine concat join lreplace mysqlreceive source fcopy global orastmlist switch auto_qualify update mysqlcol tclPkgUnknown close orabreak cd for auto_load file append lreverse oramsg format lmap mysqlchangeuser mysqlendquery unload read package set namespace binary scan apply mysqlstate oralob oraldalist oralogoff trace oraconfig seek oradesc zlib while chan flush after mysqlexec mysqluse vwait orafetch dict uplevel continue try mysqlinsertid oraclose foreach lset rename oralong oraautocom fileevent yieldto regexp mysqlclose orabindexec lrepeat tclPkgSetup upvar tailcall mysqlescape encoding expr unset load regsub mysqlinfo orasql history interp exit oraroll puts incr lindex lsort oraparse tclLog string yield tsv::get tsv::set pg_backend_pid pg_blocking pg_cancelrequest pg_conndefaults pg_connect pg_disconnect pg_escape_bytea pg_escape_string pg_exec pg_exec_params pg_exec_prepared pg_execute pg_getresult pg_isbusy pg_listen pg_lo_close pg_lo_creat pg_lo_export pg_lo_import pg_lo_lseek pg_lo_open pg_lo_read pg_lo_tell pg_lo_unlink pg_lo_write pg_notice_handler pg_on_connection_loss pg_parameter_status pg_quote pg_result pg_result_callback pg_select pg_sendquery pg_sendquery_params pg_sendquery_prepared pg_server_version pg_transaction_status pg_unescape_bytea database ] - - ctext::addHighlightClass $w functions $colour(functions) [ list abs acos asin atan atan2 bool ceil cos cosh double entier exp floor fmod hypot int isqrt log log10 max min pow rand round sin sinh sqrt srand tan tanh wide ] - ctext::addHighlightClassForSpecialChars $w brackets $colour(brackets) {\{\}\[\]} - ctext::addHighlightClassForRegexp $w comments $colour(comments) {\#[^\n\r]*} - ctext::addHighlightClassForRegexp $w strings $colour(strings) {"(\\"|[^"])*"} - } - -proc ed_edit {} { - global _ED defaultBackground defaultForeground - global Menu_string - global highlight - - catch "destroy .ed_mainFrame.mainwin.buttons" - catch "destroy .ed_mainFrame.mainwin.f1" - catch "destroy .ed_mainFrame.mainwin.textFrame" - - set Parent .ed_mainFrame.mainwin - - set Name $Parent.textFrame - ttk::frame $Name - pack $Name -anchor sw -expand 1 -fill both -side bottom - - set Name $Parent.textFrame.right - ttk::frame $Name -height 10 -width 15 - pack $Name -anchor sw -expand 0 -fill x -ipadx 0 -ipady 0 -padx 0 \ - -pady 0 -side bottom - - set Name $Parent.textFrame.right.vertScrollbar - ttk::scrollbar $Name -command "$Parent.textFrame.left.text xview" \ - -orient horizontal - pack $Name -anchor center -expand 1 -fill x -ipadx 0 -ipady 0 -padx "0 16" \ - -pady 0 -side left - - set Name $Parent.textFrame.left - ttk::frame $Name - pack $Name -anchor center -expand 1 -fill both -ipadx 0 -ipady 0 \ - -padx 0 -pady 0 -side top - - set Name $Parent.textFrame.left.horizScrollbar - ttk::scrollbar $Name -command "$Parent.textFrame.left.text yview" - pack $Name -anchor center -expand 0 -fill y -ipadx 0 -ipady 0 \ - -padx 0 -pady 0 -side right - - set Name $Parent.textFrame.left.text -if { $ttk::currentTheme eq "black" } { - set bwidth 0 - set hbgrd LightGray - } else { - set bwidth 2 - set hbgrd $defaultBackground - } -if { $highlight eq "true" } { - ctext $Name -background white -borderwidth $bwidth -foreground black \ - -highlight 1 \ - -highlightbackground LightGray -insertbackground black \ - -selectbackground $hbgrd -selectforeground black \ - -wrap none \ - -font basic \ - -xscrollcommand "$Parent.textFrame.right.vertScrollbar set" \ - -yscrollcommand "$Parent.textFrame.left.horizScrollbar set" \ - -linemap 1 \ - -linemap_markable 0 - setctexthighlight $Name - easyCtextCommenting $Name - } else { - ctext $Name -background white -borderwidth $bwidth -foreground black \ - -highlight 0 \ - -highlightbackground LightGray -insertbackground black \ - -selectbackground $hbgrd -selectforeground black \ - -wrap none \ - -font basic \ - -xscrollcommand "$Parent.textFrame.right.vertScrollbar set" \ - -yscrollcommand "$Parent.textFrame.left.horizScrollbar set" \ - -linemap 0 \ - -linemap_markable 0 - } - $Name fastinsert end { } - pack $Name -anchor center -expand 1 -fill both -ipadx 0 -ipady 0 \ - -padx 0 -pady 0 -side top - bind $Parent.textFrame.left.text \ -{.ed_mainFrame.statusbar.l17 configure -text \ -[.ed_mainFrame.mainwin.textFrame.left.text index insert]} - bind $Parent.textFrame.left.text \ -{.ed_mainFrame.statusbar.l17 configure -text \ -[.ed_mainFrame.mainwin.textFrame.left.text index insert]} - - $Name delete 1.0 end - $Name insert end $_ED(temppackage) - ed_edit_commit - update -} - -proc ed_stop_button {} { -global _ED stop tcl_version -set Name .ed_mainFrame.buttons.test - -set im [image create photo -data $stop -gamma 1 -height 16 -width 16 -palette 5/5/4] - -$Name config -image $im -command "ed_kill_apps" -bind .ed_mainFrame.buttons.test {ed_status_message -help \ - "Stop running code"} -} - -proc ed_stop_vuser {} { -global _ED stop tcl_version -set Name .ed_mainFrame.buttons.lvuser - set im [image create photo -data $stop -gamma 1 -height 16 -width 16 -palette 5/5/4] -$Name config -image $im -command "remote_command ed_kill_vusers; ed_kill_vusers" -bind .ed_mainFrame.buttons.lvuser {ed_status_message -help \ - "Destroy Virtual Users"} -} - -proc ed_stop_transcount {} { -global _ED stop tcl_version -set Name .ed_mainFrame.buttons.pencil - set im [image create photo -data $stop -gamma 1 -height 16 -width 16 -palette 5/5/4] -$Name config -image $im -command "ed_kill_transcount" -bind .ed_mainFrame.buttons.pencil {ed_status_message -help \ - "Stop Transaction Counter"} -} - -proc ed_transcount_button {} { -global _ED pencil tcl_version -set Name .ed_mainFrame.buttons.pencil -set im [image create photo -data $pencil -gamma 1 -height 16 -width 16 -palette 5/5/4] -$Name config -image $im -command "transcount" -bind .ed_mainFrame.buttons.pencil {ed_status_message -help \ - "Transaction Counter"} -} - -proc ed_metrics_button {} { -global _ED dashboard tcl_version -set Name .ed_mainFrame.buttons.dashboard -set im [image create photo -data $dashboard -gamma 1 -height 16 -width 16 -palette 5/5/4] -$Name config -image $im -command "metrics" -bind .ed_mainFrame.buttons.dashboard {ed_status_message -help \ - "Metrics"} -} - -proc ed_test_button {} { -global _ED test tcl_version -set Name .ed_mainFrame.buttons.test - - set im [image create photo -data $test -gamma 1 -height 16 -width 16 -palette 5/5/4] - -$Name config -image $im -command "ed_run_package" -bind .ed_mainFrame.buttons.test {ed_status_message -help \ - "Test current code"} -} - -proc ed_lvuser_button {} { -global _ED lvuser tcl_version -set Name .ed_mainFrame.buttons.lvuser -set im [image create photo -data $lvuser -gamma 1 -height 16 -width 16 -palette 5/5/4] -$Name config -image $im -command "remote_command load_virtual; load_virtual" -bind .ed_mainFrame.buttons.lvuser {ed_status_message -help \ - "Create Virtual Users"} -} - -proc ed_stop_autopilot {} { -global _ED stop tcl_version -set Name .ed_mainFrame.buttons.autopilot - set im [image create photo -data $stop -gamma 1 -height 16 -width 16 -palette 5/5/4] -$Name config -image $im -command "ed_kill_autopilot" -bind .ed_mainFrame.buttons.autopilot {ed_status_message -help \ - "Stop Autopilot"} -} - -proc ed_autopilot_button {} { -global _ED autopilot tcl_version -set Name .ed_mainFrame.buttons.autopilot -set im [image create photo -data $autopilot -gamma 1 -height 16 -width 16 -palette 5/5/4] -$Name config -image $im -command "start_autopilot" -bind .ed_mainFrame.buttons.autopilot {ed_status_message -help \ - "Start Autopilot"} -} - -proc ed_stop_metrics {} { -global _ED stop tcl_version -set Name .ed_mainFrame.buttons.dashboard - set im [image create photo -data $stop -gamma 1 -height 16 -width 16 -palette 5/5/4] -$Name config -image $im -command "ed_kill_metrics" -bind .ed_mainFrame.buttons.dashboard {ed_status_message -help \ - "Stop Metrics"} -} - -proc ed_run_package {} { -global _ED maxvuser suppo ntimes -set maxvuser 1 -set suppo 1 -set ntimes 1 -.ed_mainFrame.buttons.test configure -state disabled - if {"$_ED(package)" == ""} { - ed_status_message -alert "No code currently in run buffer." - update - set maxvuser $tmp_maxvuser - set suppo $tmp_suppo - set ntimes $tmp_ntimes - .ed_mainFrame.buttons.test configure -state normal - return - } - ed_kill_apps - ed_edit_commit -if { [catch {load_virtual} message]} { -puts "Failed to create virtaul user: $message" - } else { -if { [catch {run_virtual} message]} { -puts "Failed to run TCL Code Test: $message" - } - } -return -} - -proc ed_kill_apps {args} { - global _ED ed_mainf - if {$_ED(runslave) == ""} {return} - .ed_mainFrame configure -cursor watch - ed_status_message -show "... closing down active GUI applications ..." - update - ed_wait_if_blocked - set _ED(blockflag) 1 - catch "interp delete $_ED(runslave)" - set _ED(blockflag) 0 - set _ED(runslave) "" - .ed_mainFrame configure -cursor {} - ed_status_message -perm - ed_test_button - update -} - -proc vuser_options {} { - global _ED - global maxvuser - global delayms - global conpause - global ntimes - global suppo - global optlog - global lvuser - global unique_log_name - global no_log_buffer - global threadscreated - -if { [ info exists maxvuser ] } { ; } else { set maxvuser 1 } -if { [ info exists delayms ] } { ; } else { set delayms 500 } -if { [ info exists conpause ] } { ; } else { set conpause 500 } -if { [ info exists ntimes ] } { ; } else { set ntimes 1 } -if { [ info exists suppo ] } { ; } else { set suppo 0 } -if { [ info exists optlog ] } { ; } else { set optlog 0 } -if { [ info exists unique_log_name ] } { ; } else { set unique_log_name 0 } -if { [ info exists no_log_buffer ] } { ; } else { set no_log_buffer 0 } -#If window already exists then destroy - catch "destroy .vuserop" -if { [ info exists threadscreated ] } { -tk_messageBox -icon error -message "Virtual Users already created, destroy Virtual Users before changing Virtual User options" -return - } - ttk::toplevel .vuserop - wm withdraw .vuserop - wm title .vuserop {Virtual User Options} - - set Parent .vuserop - - set Name $Parent.f1 - ttk::frame $Name - pack $Name -anchor nw -fill x -side top -padx 5 - -set Prompt $Parent.f1.h1 -ttk::label $Prompt -image [image create photo -data $lvuser] -grid $Prompt -column 0 -row 0 -sticky e -set Prompt $Parent.f1.h2 -ttk::label $Prompt -text "Virtual User Options" -grid $Prompt -column 1 -row 0 -sticky w - - set Name $Parent.f1.e1 - set Prompt $Parent.f1.p1 - ttk::label $Prompt -text "Virtual Users :" - ttk::entry $Name -width 30 -textvariable maxvuser - grid $Prompt -column 0 -row 1 -sticky e - grid $Name -column 1 -row 1 - - set Name $Parent.f1.e2 - set Prompt $Parent.f1.p2 - ttk::label $Prompt -text "User Delay(ms) :" - ttk::entry $Name -width 30 -textvariable conpause - grid $Prompt -column 0 -row 2 -sticky e - grid $Name -column 1 -row 2 - - set Name $Parent.f1.e3 - set Prompt $Parent.f1.p3 - ttk::label $Prompt -text "Repeat Delay(ms) :" - ttk::entry $Name -width 30 -textvariable delayms - grid $Prompt -column 0 -row 3 -sticky e - grid $Name -column 1 -row 3 - - set Name $Parent.f1.e4 - set Prompt $Parent.f1.p4 - ttk::label $Prompt -text "Iterations :" - ttk::entry $Name -width 30 -textvariable ntimes - grid $Prompt -column 0 -row 4 -sticky e - grid $Name -column 1 -row 4 - - set Name $Parent.f1.e5 -ttk::checkbutton $Name -text "Show Output" -variable suppo -onvalue 1 -offvalue 0 - grid $Name -column 1 -row 5 -sticky w - -bind .vuserop.f1.e5