# ------------------------------------------------------------ # Copyright (c) 2003-2020 # Q.W.Page Associates Inc. # www.qwpage.com # All rights reserved. # ------------------------------------------------------------ /* { 2.34.1 - turned qw_boot.tcl into package qw_boot.qw_lib */ } ::namespace eval ::qw::boot {} ::if {$::qw::control(sargv_refactor)} { ::proc ::qw::boot::qw_sargv_build_handle_file_option {} { # ------------------------------------------------------------ # Original handling of -file before -database_path # ------------------------------------------------------------ # 2.27.1 ::set Index [::lsearch -exact $::argv "-file"]; ::if {$Index>=0} { ::set ::argv [::lreplace $::argv $Index $Index -database_path]; ::return; } ::set Index [::lsearch -exact $::argv "-database_path"]; ::if {$Index>=0} { ::return; } # ::set FirstArg [::lindex $::qw_argv 0]; ::set FirstArg [::lindex $::argv 0]; ::switch -- [::string index $FirstArg 0] { "" { } "." - "-" { } default { ::set ::argv [::concat -database_path $::argv]; } } } ::proc ::qw::boot::qw_sargv_build {} { # ------------------------------------------------------------ # ::qw::sargv_build - creates ::qw_sargv # ------------------------------------------------------------ /* { Argument processing ------------------- A few words of explanation. The commandline args are in ::argv and we will not alter it's contents. Instead we copy it to ::qw_argv and convert it's contents to lower case. Then we manipulate ::qw_argv a bit such as fixing the -file problem, and converting backslashes to slashes. Then we process ::qw_argv converting it to a sargs contained in ::qw_sargv. Each hyphen-option in ::qw_argv becomes a dot-field in ::qw_sargv. For hyphen options such as -server that have no value, i.e. followed by another hyphen-prefixed word, they are converted into a dot field with value 1 which can then be tested using ::sargs::boolean_get. This proc sets up ::qw_sargv but the processing of actual command line options is carried out by ::qw::boot::process_commandline_options. */ } ::qw::boot::qw_sargv_build_handle_file_option; ::set ::qw_argv [::string tolower $::argv]; ::set ::qw_argv [::string map [::list "\\" "/"] $::qw_argv]; ::set ::qw_sargv $::qw_argv; ::if {[::sargs::is_primitive $::qw_sargv]} { ::set ::qw_sargv [::sargs::hargs2sargs .hargs $::qw_argv]; } ::if {[::sargs::is_primitive $::qw_sargv]} { ::if {$::qw_sargv ne ""} { ::qw::throw "Can't process mal-formed command line arguments \"$::argv\"."; } } ::if {[::sargs::exists $::qw_sargv .file]} { # ------------------------------------------------------------ # Replace .file with .database_path # ------------------------------------------------------------ /* { 2.38.5 - replaced $qw_sargv with $::qw_sargv. Prevously var not found. */ } ::if {![::sargs::exists $::qw_sargv .database_path]} { ::sargs::var::set ::qw_sargv .database_path [::sargs::get $::qw_sargv .file]; ::sargs::var::unset ::qw_sargv .file; } /* { 2.38.4 replaced with the code above ::if {![::sargs::exists $sargs .database_path]} { # 2.38.4 ::sargs::var::set ::qw_sargv .database_path [::sargs::get $::qw_sargs .file]; ::sargs::var::set ::qw_sargv .database_path [::sargs::get $::qw_sargs .file]; ::sargs::var::unset sargs .file; } */ } } /* { ::set Pos [::lsearch $::qw_argv "-hub_list_entry"]; ::if {$Pos>=0} { /* { Help about can't process the -hub_list_entry which can be somewhat complex sargs, typically surrounded by braces etc, so we just eliminate it here. Otherwise we get "missing close-bracket". This only happens in the command line where a stub launches a hub. */ } # ::set ::qw_help_about_commandline [::lreplace $::qw_argv $Pos [::expr {$Pos+1}]]; } else { ::set ::qw_help_about_commandline [::string map [::list "{" "" "}" ""] $::qw_argv]; } */ } ::return; } } ::if {!$::qw::control(sargv_refactor)} { ::proc ::qw::boot::process_argv {} { # ------------------------------------------------------------ # ::qw::process_argv - creates ::qw_sargv # ------------------------------------------------------------ /* { Argument processing ------------------- A few words of explanation. The commandline args are in ::argv and we will not alter it's contents. Instead we copy it to ::qw_argv and convert it's contents to lower case. Then we manipulate ::qw_argv a bit such as fixing the -file problem, and converting backslashes to slashes. Then we process ::qw_argv converting it to a sargs contained in ::qw_sargv. Each hyphen-option in ::qw_argv becomes a dot-field in ::qw_sargv. For hyphen options such as -server that have no value, i.e. followed by another hyphen-prefixed word, they are converted into a dot field with value 1 which can then be tested using ::sargs::boolean_get. This proc sets up ::qw_sargv but the processing of actual command line options is carried out by ::qw::boot::process_commandline_options. */ } ::set rwb1_debug 0; ::set DatabasePath ""; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::process_argv,1000.0,::argv==$::argv";} ::if {![::sargs::is_primitive $::argv]} { # 2.38.1 - couldn't process du commandline arguments ::set ::qw_argv [::string tolower $::argv]; ::set ::qw_sargv $::qw_argv; } ::set Pos [::lsearch -exact $::argv "-database_path"]; ::if {$Pos>=0} { # ------------------------------------------------------------ # Replace -file with -database_path # ------------------------------------------------------------ /* { 2.34.2 Note that we did not use database_path as that is used elsewhere and we want to maintain maximum grep-ability. Somebody is treating -file in a special way and we have known this for a long time, but this is causing problems when stubs are running hubs and so on. This also means we have to hunt down all occurences of ".file". */ } ::set DatabasePath [::lindex $::argv [::expr {$Pos+1}]]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::process_argv,1000.1.0,::argv==$::argv";} } ::if {$DatabasePath eq ""} { ::set Pos [::lsearch -exact $::argv "-file"]; ::if {$Pos>=0} { # ------------------------------------------------------------ # Replace -file with -database_path # ------------------------------------------------------------ /* { 2.34.2 Note that we did not use database_path as that is used elsewhere and we want to maintain maximum grep-ability. Somebody is reating -file specially and we have know this for a long time, but this is causing problems when stubs are running hubs and so on. This also means we have to hunt down all occurences of ".file". */ } ::set ::argv [::lreplace $::argv $Pos $Pos "-database_path"]; ::set DatabasePath [::lindex $::argv [::expr {$Pos+1}]]; } } ::set ::qw_argv [::string tolower $::argv]; ::set ::qw_argv [::string map [::list "\\" "/"] $::qw_argv]; ::if {$DatabasePath eq ""} { # ------------------------------------------------------------ # Original handling of -file before -database_path # ------------------------------------------------------------ # 2.27.1 ::set Index [::lsearch -exact $::qw_argv "-file"]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::process_argv,1000.1,Index==$Index";} ::if {$Index<0} { ::set Index [::lsearch -exact $::qw_argv ".file"]; } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::process_argv,1000.2,Index==$Index";} ::if {$Index<0} { /* { 2.34.5 If first arg starts with dot we also do not attempt to add -database_path or -file. 2.15.4 The -file flag started to disappear when we went to tcl 8.5. However this only happened if it is the first arg. So if -file is not found and the first arg has no hyphen, we will assume it is a file name. 2.26.0 Used to just do this for version 8.5 but with intrduction of vlerq have to do it for tcl 8.4 as well. 2.27.0 We used to replace the -file much later but discovered asap is better because for example, /help/about uses ::qw_argv and was missing -file when we had replaced it too late, i.e. after processing -about. */ } ::if {[::llength $::qw_argv]>0} { ::set FirstArg [::lindex $::qw_argv 0]; ::switch -- [::string index $FirstArg 0] { "." - "-" { } default { ::set ::qw_argv [::concat -database_path $::qw_argv]; ::set Index 0; } } /* { 2.34.5 - replace by code above ::if {[::string index $FirstArg 0] ne "-"&&} { ::set ::qw_argv [::concat -database_path $::qw_argv]; ::set Index 0; } */ } } } } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::process_argv,1000.3,::qw_argv==$::qw_argv";} ::qw::try { # ------------------------------------------------------------ # Convert hyphen args into sargs # ------------------------------------------------------------ ::set ::qw_sargv [::sargs::hargs2sargs .hargs $::qw_argv]; } catch Exception { ::qw::throw \ .text "Syntax error in command line arguments \"$::argv\"." \ ; } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::process_argv,1000.3,::qw_sargv==$::qw_sargv";} /* { This kludge is for help about. */ } ::set ::qw_help_about_commandline [::string map [::list "{" "" "}" ""] $::qw_argv]; } } ::proc ::qw::boot::process_commandline_options {} { /* { It was getting out of control so we tried to isolate most command line arguments into this one place. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,process_commandline_options,1000.2";} ::set Index [::lsearch -exact $::qw_argv "-help_css_file"]; ::if {$Index>=0} { ::set CssFile [::lindex $::qw_argv [::incr Index]]; ::set Handle [::open $CssFile r]; ::set ::qw::control(help_css_file) [::read $Handle]; ::close $Handle; ::set CssFile ""; } #nv2.33.2 #nv2.33.1(.5) (new feature) - command line argument -http_port and -https_port ::if {$rwb1_debug} {::puts "rwb1_debug,process_commandline_options,1000.1";} # ------------------------------------------------------------ # process_list_file # ------------------------------------------------------------ /* { Hubs and nodes are be given the process_list_file. The process file is only known to the stub, which then passes the path to hubs and hubs pass it to nodes. If the process_list file is not specified, then we get it from the program_folder's parent folder. This allows us to run a hub without a stub. */ } /* { ::set ::qw::control(process_list_file) [::sargs::get $::qw_sargv .process_list_file]; ::if {$::qw::control(process_list_file) eq ""} { ::set ::qw::control(process_list_file) [::file join [::file dirname $::qw_program_folder] "nv2_process_list.txt"]; } */ } # ------------------------------------------------------------ # ports # ------------------------------------------------------------ /* { # 2.36.0 - the ports are loaded from the command line directly # so don't need nything here ::set Value [::sargs::integer_get $::qw_sargv .http_port]; ::if {$Value!=0} { ::set ::qw::control(http_port) $Value; } ::set Value [::sargs::integer_get $::qw_sargv .https_port]; ::if {$Value!=0} { ::set ::qw::control(https_port) $Value; } */ } #nv2.27.4 (new feature) - command line argument -multiport ::set Index [::lsearch -exact $::qw_argv "-multi_port"]; ::if {$Index>=0} { ::set ::qw::control(server_multi_port) 1; } # ------------------------------------------------------------ # sub-product # ------------------------------------------------------------ ::set Index [::lsearch -exact $::qw_argv "-nph"]; ::if {$Index>=0} { ::set ::qw::control(nvnph_compile) 1; ::set ::qw_sub_product "nph"; } ::set Index [::lsearch -exact $::qw_argv "-crm"]; ::if {$Index>=0} { ::set ::qw::control(crm_include) 1; ::set ::qw_sub_product "crm"; } #2.34.2 ::set Index [::lsearch -exact $::qw_argv "-npm"]; ::if {$Index>=0} { #::set ::qw::control(nvnpm_compile) 1; ;#_pgq,debug ::set ::qw_sub_product "npm"; } ::set Index [::lsearch -exact $::qw_argv "-mdb"]; ::if {$Index>=0} { # 2.36.2 ::set ::qw_sub_product "mdb"; } ::set Index [::lsearch -exact $::qw_argv "-code_demo"]; ::if {$Index>=0} { # 2.37.2 ::set ::qw::control(code_demo) 1; } ::set Index [::lsearch -exact $::qw_argv "-schema_explorers"]; ::if {$Index>=0} { # 2.37.2 ::set ::qw::control(schema_explorers) 1; } ::if {$rwb1_debug} {::puts "rwb1_debug,process_commandline_options,1000.2";} # ------------------------------------------------------------ # mouse # ------------------------------------------------------------ #nv2.14.3 ::set Index [::lsearch -exact $::qw_argv "-mouse_motion_select_requires_control_key"]; ::if {$Index>=0} { ::set ::qw::control(mouse_motion_select_requires_control_key) 1; } #nv2.15.0 ::set Index [::lsearch -exact $::qw_argv "-mouse_motion_select_no_control_key"]; ::if {$Index>=0} { ::set ::qw::control(mouse_motion_select_requires_control_key) 0; } #2.27.0 ::set ::qw_manual_file [::file join $::qw_program_folder nv2.dat manual.chm]; /* { ::if {$::qw_sub_product ne ""} { ::set ::qw_manual_file [::file join $::qw_data manual_$::qw_sub_product.chm]; } */ } # ------------------------------------------------------------ # template # ------------------------------------------------------------ #nv2.20.2 ::set Index [::lsearch -exact $::qw_argv "-template_print_speedup"]; ::if {$Index>=0} { ::set ::qw::control(template_print_speedup) 1; } #nv2.17.0 #::set Index [::lsearch -exact $::qw_argv "-arrow_maximize"]; #nv2.24.1 (bug fix) - remove command line arg -old_style_maximize_button /* { ::set Index [::lsearch -exact $::qw_argv "-old_style_maximize_button"]; ::if {$Index>=0} { ::set ::qw::control(arrow_buttons) 0; } */} ::if {$rwb1_debug} {::puts "rwb1_debug,process_commandline_options,1000.3";} #nv2.11.4 /* { This has been here since 2.11.4 bu we don't summarize (summary postings) any more. ::set Index [::lsearch -exact $::qw_argv "-no_summarize"]; ::if {$Index>=0} { ::set ::qw::control(no_summarize_import) 1; } */ } /* { ::set Index [::lsearch -exact $::qw_argv "-verbose"]; ::if {$Index>=0} { ::verbose_set [::lindex $::qw_argv [::incr Index]]; } */ } ::set Index [::lsearch -exact $::qw_argv "-about"]; ::if {$Index>=0} { /* { This allows the about script to be run from the install so customer support can get a handle on the computer configuration. This is also checked before we attempt to run a script and before we call computer_check. The point is that we may want the about information because the computer check fails. Note we are calling about.qw_script without a database object so about.qw_script has to check for this. 2.28.0 - Added call to registration check because the serial and company name were not appearing. */ } ::qw::boot::registration_check; #2.34.5 - added ::qw::control(commandline_script_path) ::set ScriptPath [::file join $::qw_program_path doc qw_help_about.qw_script]; ::sargs::var::set ::qw_sargv .script.path $ScriptPath; ::set ::qw::control(commandline_script_path) $ScriptPath; # 2.32.3 ::qw::script::source $::qw_sargv .odb.object {} .script.invoker commandline; /* { # 2.32.2 ::switch -- $::tcl_platform(platform) { windows { ::qw::script::source \ .odb.object {} \ .script.path [::file join $::qw_library doc qw_chtml_compile.qw_script] \ .path [::file join $::qw_library doc qw_about_windows.qw_help] \ ; } unix { ::qw::script::source \ .odb.object {} \ .script.path [::file join $::qw_library doc qw_chtml_compile.qw_script] \ .path [::file join $::qw_library doc qw_about_linux.qw_help] \ ; } } */ } # 2.34.5 # 2.34.5 - qw_help_about.qw_script will shut down when called with script invoker commandline #::qw::shutdown; ::return; ::qw::throw .text "314120160329135129 - unwind stack." .priority ignore; } ::if {$rwb1_debug} {::puts "rwb1_debug,process_commandline_options,1000.4";} #2.37.0 ::set ProcessRestartDelay [::sargs::integer_get $::qw_sargv .process_restart_delay]; ::if {$ProcessRestartDelay!=0} { /* { We are started with a time delay. Why? When a process such as a server encounters a bug we may to keep it going by shutting and restarting with a delay to allow the shutdown to complete. See ::qw::process_restart in qw_exception.qw_lib. */ } ::after $ProcessRestartDelay; } # ------------------------------------------------------------ # ifs_maximum_page_size_estimate # ------------------------------------------------------------ ::set IfsPageSize [::sargs::real_get $::qw_sargv .ifs_page_size]; ::if {$IfsPageSize!=0.0} { ::set ::qw::control(ifs_maximum_page_size_estimate) $IfsPageSize; } ::set IfsPageSizeScale [::sargs::real_get $::qw_sargv .ifs_page_size_scale]; ::if {$IfsPageSizeScale!=0.0} { ::set ::qw::control(ifs_maximum_page_size_estimate) $IfsPageSizeScale*$::qw::control(ifs_maximum_page_size_estimate); } # ------------------------------------------------------------ # memory scales # ------------------------------------------------------------ ::set Scale [::sargs::real_get $::qw_sargv .memory_field_scale]; ::if {$Scale!=0.0} { ::set Limits [[::qw::system] cpp_limits_get]; ::foreach Field { .object_cache_field_limit } { ::set Value [::sargs::get $Limits $Field]; ::set Value [::expr {int($Value*$Scale)}]; ::sargs::var::set Limits $Field $Value; } [::qw::system] cpp_limits_set $Limits; } ::set Scale [::sargs::real_get $::qw_sargv .memory_record_scale]; ::if {$Scale!=0.0} { ::set Limits [[::qw::system] cpp_limits_get]; ::foreach Field { .object_cache_field_limit .page_cache_byte_limit .sector_cache_sector_limit } { ::set Value [::sargs::get $Limits $Field]; ::set Value [::expr {int($Value*$Scale)}]; ::sargs::var::set Limits $Field $Value; } [::qw::system] cpp_limits_set $Limits; } ::set Scale [::sargs::real_get $::qw_sargv .memory_sector_scale]; ::if {$Scale!=0.0} { ::set Limits [[::qw::system] cpp_limits_get]; ::foreach Field { .sector_cache_sector_limit } { ::set Value [::sargs::get $Limits $Field]; ::set Value [::expr {int($Value*$Scale)}]; ::sargs::var::set Limits $Field $Value; } [::qw::system] cpp_limits_set $Limits; } ::set Scale [::sargs::real_get $::qw_sargv .memory_scale]; ::if {$Scale!=0.0} { ::set Limits [[::qw::system] cpp_limits_get]; ::foreach Field { .object_cache_field_limit .page_cache_record_limit .page_cache_byte_limit .sector_cache_sector_limit } { ::set Value [::sargs::get $Limits $Field]; ::set Value [::expr {int($Value*$Scale)}]; ::sargs::var::set Limits $Field $Value; } [::qw::system] cpp_limits_set $Limits; } ::if {$rwb1_debug} {::puts "rwb1_debug,process_commandline_options,1000.5";} ::if {[::sargs::boolean_get $::qw_sargv .memory_refresh]} { /* { #2.34.0 memory_refresh was added in 2.34.0 in order to avoid the slow windows reloading of kicked out virtual memory. It causes all nv2 memory in the memory manager to be accessed from time to time. However, this could possibly cause unexpected side-effects so this command line option, i.e. memory_refresh, was added so that it defaults to disabled and must be turned on explcitly. */ } # ------------------------------------------------------------ # start up the background memory refresher # ------------------------------------------------------------ ::switch -glob -- [::string tolower [::info hostname]] { benn* { /* { Start up the virtual memory refresher "right away" for testing purposes. */ } ::after [::expr {1*1000}] [::list ::qw::memoryutil::memory_refresh]; } default { /* { Not likely to need the virtual memory refresher for short duration programs so start it up after an hour. */ } ::after [::expr {1*3600*1000}] [::list ::qw::memoryutil::memory_refresh]; } } } # ------------------------------------------------------------ # Process latency test command line arguments. # ------------------------------------------------------------ ::if {$rwb1_debug} {::puts "rwb1_debug,process_commandline_options,1000.6";} ::if {[::sargs::exists $::qw_sargv .upload_latency]} { #2.32.0 ::set ::qw::control(latency_socket_upload) [::sargs::integer_get $::qw_sargv .upload_latency]; ::set ::qw::control(latency_plug_upload) [::sargs::integer_get $::qw_sargv .upload_latency]; } ::if {[::sargs::exists $::qw_sargv .download_latency]} { #2.32.0 ::set ::qw::control(latency_socket_download) [::sargs::integer_get $::qw_sargv .download_latency]; ::set ::qw::control(latency_plug_download) [::sargs::integer_get $::qw_sargv .download_latency]; } ::if {$rwb1_debug} {::puts "rwb1_debug,process_commandline_options,1000.7";} # ------------------------------------------------------------ # Move .script to .script.path. # ------------------------------------------------------------ ::set ScriptPath [::sargs::get $::qw_sargv .script.path]; ::if {$rwb1_debug} {::puts "rwb1_debug,process_commandline_options,1000.7.0.0,ScriptPath==$ScriptPath";} ::if {$ScriptPath eq ""} { # 2.34.2 ::set ScriptPath [::sargs::get $::qw_sargv .script]; ::if {$ScriptPath ne ""} { ::sargs::var::unset ::qw_sargv .script; ::sargs::var::set ::qw_sargv .script.path $ScriptPath; } } ::if {$rwb1_debug} {::puts "rwb1_debug,process_commandline_options,1000.7.1,ScriptPath==$ScriptPath";} ::if {$rwb1_debug} {::puts "rwb1_debug,process_commandline_options,1000.7.2,::qw_sargv==$::qw_sargv";} } ::proc ::qw::boot::computer_check {sargs} { /* { ::if {$::tcl_platform(os) eq "Windows NT"} { #2.27.2 replaced network info stuff with twapi # [::qw::system] cpp_network_info_setup; # ::qw::network::network_info_setup; # [::qw::system] cpp_network_info_set [::qw::get_network_info]; # [::qw::system] cpp_nic_list_set [::qw::nic_list_get]; } */ } ::switch -- $::tcl_platform(platform) { "windows" { ::if {$::tcl_platform(os) ne "Windows NT"} { ::qw::throw \ .text "NewViews does not run on $::tcl_platform(os) version \"$::tcl_platform(osVersion)\"." \ .help_id 314120050404080616 \ ; } } "unix" { } default { ::qw::throw \ .text "NewViews does not run on $::tcl_platform(os) version \"$::tcl_platform(osVersion)\"." \ .help_id 314120050404080616 \ ; } } ::set Memory [::expr {(double([::qw::memoryutil::memory_physical])/(1024.0*1024.0))}]; ::if {$Memory<500} { ::qw::throw \ .text "This computer has insufficient physical memory (${Memory}MB) to run NewViews." \ .help_id 314120050404080618 \ ; } } ::proc ::qw::boot::registration_setup {sargs} { /* { This is called to set up registration information whether or not newviews is registered. It does not throw exceptions under any circumstances. This is done so that services and scripts can run without putting up messages such as NewViews is not registered, etc. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,registration_setup,1000.0";} # 2.34.6 ::set Registration ""; ::set Path [::file join $::qw_data program.qw_reg]; ::if {$rwb1_debug} {::puts "rwb1_debug,registration_setup,1000.1";} ::set Registration [::qw::fileutil::file_read .path $Path .nocomplain 1]; /* { # 2.34.6 ::if {[::file exists $Path]} { ::qw::try { ::if {$rwb1_debug} {::puts "rwb1_debug,registration_setup,1000.2";} ::set Handle [::open $Path r]; ::set Registration [::read $Handle]; ::qw::finally [::list close $Handle]; ::if {$rwb1_debug} {::puts "rwb1_debug,registration_setup,1000.3";} } catch Dummy { } } */ } ::if {$Registration ne ""} { ::if {$rwb1_debug} {::puts "rwb1_debug,registration_setup,1000.4,cpp_encryption_checksum_check==[[::qw::system] cpp_encryption_checksum_check $Registration]";} ::if {[[::qw::system] cpp_encryption_checksum_check $Registration]} { ::if {$rwb1_debug} {::puts "rwb1_debug,registration_setup,1000.5";} [::qw::system] cpp_registration_set $Registration; ::if {$rwb1_debug} {::puts "rwb1_debug,registration_setup,1000.6";} ::set Serial [::sargs::get [[::qw::system] cpp_registration_get] .serial]; ::if {$rwb1_debug} {::puts "rwb1_debug,registration_setup,1000.7";} ::if {[::string first "internal" [::string tolower $Serial]]>=0} { ::if {$rwb1_debug} {::puts "rwb1_debug,registration_setup,1000.8";} ::set ::qw::control(serial_is_internal) 1; #rwb_release; ::if {$rwb1_debug} {::puts "rwb1_debug,registration_setup,1000.9";} } } } ::qw::try { ::if {$rwb1_debug} {::puts "rwb1_debug,registration_setup,1000.10,::qw::system==\"[::qw::system]\"";} /* { #2.32.2 Had obvious problem in the next line. Don't know how we got away with it in the past. Discovered when going to linux. BTW: Not sure why we call cpp_nic_address_list_get anyway. [[::qw::system] cpp_nic_address_list_get]; */ } [::qw::system] cpp_nic_address_list_get; ::if {$rwb1_debug} {::puts "rwb1_debug,registration_setup,1000.11";} } catch Dummy { } ::if {$rwb1_debug} {::puts "rwb1_debug,registration_setup,1000.12";} } ::proc ::qw::boot::registration_check {sargs} { /* { We are not installing, registering, or running a script. It is now time to check the registration. Whether we are a workstation or server is irrelevant because there is only one registration per computer. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.0";} ::if {!$::qw::control(registration_policy_is_enabled)} { ::return; } ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.1";} ::if {$::qw::control(skip_gnu_registration_check)} { ::return; } ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.2";} ::if {[::string first "launch_help" [::sargs::get $::qw_sargv .script]]>=0} { /* { 2.32.2 With browser_help we no longer launch the manual or accounting_primer from the startmenu using a .chm file. We now do it by running the launch_help script. But in that case we really don't want the "NewViews is not registered." prompt to come up and confuse the user. */ } ::return; } ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.3";} ::if {[::sargs::get $::qw_sargv .script] ne ""} { /* { 2.31.2 Don't want registration check coming up when just running a script. For example when running a service_hub or the mothership. rwb__debug - what about a node? */ } ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.4";} ::qw::boot::registration_setup; ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.5";} ::return; } ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.6";} ::set Registration ""; ::set Path [::file join $::qw_data program.qw_reg]; ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.7";} ::if {![::file exists $Path]} { ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.8";} ::set Text "NewViews is not registered.\n\n"; ::append Text "NewViews will be running in evaluation mode.\n"; ::append Text "Without a serial number, access will eventually become read-only.\n"; ::append Text "Click for more.\n" ::qw::dialog::notify [::subst { .title "NewViews is not registered." .text {$Text} .help { .help_id 314120050220152701 } /button { /cancel { .text "Enter NewViews" } } }]; ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.9";} ::return; } ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.10";} ::qw::try { ::set Handle [::open $Path r]; ::set Registration [::read $Handle]; ::close $Handle; } catch Exception { ::qw::try { ::close $Handle; } catch Dummy {} ::return; } ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.11,Registration==\n$Registration";} ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.11.0,cpp_encryption_checksum_check==[[::qw::system] cpp_encryption_checksum_check $Registration]";} ::if {![[::qw::system] cpp_encryption_checksum_check $Registration]} { ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.12,cpp_encryption_checksum_check==[[::qw::system] cpp_encryption_checksum_check $Registration]";} ::qw::throw [::sargs \ .text "Detected uncontrolled changes in \"$Path\"." \ .help_id 314120050217091431 \ ]; } ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.13";} ::if {[[::qw::system] cpp_nic_address_list_get] ne ""} { /* { The nic list (and probably the nic) cannot be retrieved on XP64 so until we resolve this issue we must let the user proceed. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.14";} ::if {[::lsearch [[::qw::system] cpp_nic_address_list_get] [::sargs::get $Registration .nic]]<0} { [::qw::system] cpp_registration_condition_set nic_does_not_match_computer; ::set Text "This NewViews installation has been registered for a different computer.\n\n"; ::append Text "NewViews will run but database access will be read-only.\n"; ::append Text "The installation can be returned to full functionality by registering.\n" ::append Text "Click for more.\n" ::qw::dialog::notify [::subst { .title "This NewViews installation has been registered for a different computer." .text {$Text} .help { .help_id 314120050217163526 } /button { /cancel { .text "Enter NewViews" } } }]; ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.15";} ::return; } } /* { ::if {[::sargs::get $Registration .nic] ne [[::qw::system] cpp_nic_get]} { [::qw::system] cpp_registration_condition_set nic_does_not_match_computer; ::set Text "This NewViews installation has been registered for a different computer.\n\n"; ::append Text "NewViews will run but database access will be read-only.\n"; ::append Text "The installation can be returned to full functionality by registering.\n" ::append Text "Click for more.\n" ::qw::dialog::notify [::subst { .title "This NewViews installation has been registered for a different computer." .text {$Text} .help { .help_id 314120050217163526 } /button { /cancel { .text "Enter NewViews" } } }]; ::return; } */ } ::while {1} { # simulated if then else statement ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.16";} ::set RegistrationDate [::sargs::get $Registration .date]; ::set RegistrationSerial [::sargs::get $Registration .serial]; ::if {[::qw::date::difference $RegistrationDate $::qw_build seconds]>=0} { /* { If the program registration date is greater than the release date then we really do not care about anything else. This covers the case where a newly registered customer downloaded the most recent version of NewViews whose build should always precede the registration date. The build does not contain a customer support record for the customer because he registered after the build was produced. Subsequent release should contain the customer's customer support record and be processed by code below. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.16.0";} ::break; } ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.17,Registration==\n[::sargs::format $Registration]";} /* { .warning1 {**************************** WARNING ***************************} .warning2 {Uncontrolled changes to this file will render NewViews unusable.} .warning3 {**************************** WARNING ***************************} .serial INTERNAL-BENN-5 .nic F4-6D-04-61-A5-CE .date 20111202 .checksum 5AF32499C6E218B32653EA605F5E8ADD .customer_number INTERNAL-BENN .maximum_connection_count 5 .nv2_upgrades_expiry_date 20191231 .nv3_release 2.32.3_alpha.20180504 .latest_release 2.34.2_alpha.20200320 */ } # 2.34.5 ::set CustomerSupportRegistrationRecord [[::qw::system] cpp_customer_support_registration_record_get $Registration]; ::set CustomerSupportRegistrationRecord [::qw::registrations::record_get $Registration]; ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.17.0,CustomerSupportRegistrationRecord==\n[sargs::format $CustomerSupportRegistrationRecord]";} ::if {$CustomerSupportRegistrationRecord eq ""} { /* { We have no customer support registration record. The customer has registered but is not in the exe for this release. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.18,RegistrationDate==$RegistrationDate,::qw_build==$::qw_build";} ::if {[::qw::date::difference $RegistrationDate $::qw_build day]<0} { /* { The program registration date is less than the release date. The customer registered before the release was produced and therefore the customer serial should be in the exe. So how could this happen? I have only one logical explanation, other than a bug in the program. Customer support must have incorrectly entered the customer serial number. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.19";} ::qw::throw [::sargs \ .text "Could not authorize the version of NewViews you attempted to run." \ .help_id 314120051216133748 \ .registration_serial $RegistrationSerial \ .registration_date $RegistrationDate \ ]; } /* { The program registration date is greater than or equal to the release date. This is as it should be. The customer registered after the release was produced. He has a valid serial number but could not be entered into the exe. We let him go. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.20";} ::break; } ::set MaintenanceExpiryDate [::sargs::get $CustomerSupportRegistrationRecord .nv2_upgrades_expiry_date]; ::if {[::qw::date::difference $MaintenanceExpiryDate $::qw_build seconds]>=0} { /* { The customer has a valid maintenance contract, its expiry date being after the build date. Everything is fine. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.21";} ::break; } /* { [::qw::system] cpp_registration_set $Registration; # ::set SystemDate [::qw::date::from_number clock_second [::clock seconds]]; ::set RegistrationDate [::sargs::get $Registration .date]; ::set DateLimit [::qw::date::add $RegistrationDate year 1]; ::if {[::qw::date::difference $::qw_build $DateLimit seconds]<=0} { /* { The user is not on the maintenance plan but the build is within a year of the registration date. Let him go. */ } ::break; } */ } /* { The customer has registered but the maintenance contract, if any, is not valid to update from this release. */ } ::set CustomerSupportRegistrationDate [::sargs::get $CustomerSupportRegistrationRecord .registration_date]; ::if {$CustomerSupportRegistrationDate eq $MaintenanceExpiryDate} { /* { We make the assumption that if the customer support registration record registration date and maintenance expiry date are equal, then the customer does not have a maintenance contract. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.22";} ::qw::throw [::subst -nocommands { .text "Attempted to run an unauthorized version of NewViews." \ .help_page { .id 314120051215164518 \ .tags {error} .body { [p { You attempted to run an unauthorized version of NewViews. You do not subscribe to the maintenance plan and therefore you are not authorized to use this version of NewViews. When you exit the error message, NewViews will be terminated. }] [p { This situation can only occur if you have downloaded and installed a version of NewViews from the Q.W.Page web site that you are not authorized to use. We attempt to avoid this situation by prohibiting the installation of an unauthorized version. However, there are work-arounds. We can only assume that you have attempted to work around by installing into either a new folder or into an authorized installation and then have copied files into the current installation folder. We recommend that you retract to, or re-install an older authorized version of NewViews, or contact Q.W.Page customer support to rectify the situation. }] [p { We strongly recommend that you subscribe to the maintenance plan and keep your subscription active. This will entitle you to use the latest versions of NewViews as they become available. }] [p { The maintenance plan works both ways. It generates revenue for Q.W.Page of course, but it also tends to reduce costs for NewViews users. An up-to-date customer base greatly simplifies Q.W.Page's ability to support and enhance NewViews, and to detect and correct bugs that could potentially compromise integrity. Supporting a large number of different NewViews versions would eventually become unmanageable from product development and customer support points of view, as well as for users. Allowing this situation would result in what is called [qw_term "version madness"]. Version madness reduces the ability of users to communicate with each other effectively, and causes more confusion and expense for all. }] } } }]; } ::set FormattedMaintenanceExpiryDate [::qw::date::format $MaintenanceExpiryDate "%b %d, %Y"]; ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.23";} ::qw::throw [::subst -nocommands { .text "Attempted to run an unauthorized version of NewViews." \ .help_page { .id 314120050427151024 \ .tags {error} .body { [p { You attempted to run an unauthorized version of NewViews. Your maintenance plan expired on [qw_field_value {$FormattedMaintenanceExpiryDate}] and therefore you are not authorized to use this version of NewViews. When you exit the error message, NewViews will be terminated. }] [p { This situation can only occur if you have downloaded and installed a version of NewViews from the Q.W.Page web site that you are not authorized to use. We attempt to avoid this situation by prohibiting the installation of an unauthorized version. However, there are work-arounds. We can only assume that you have attempted to work around by installing into either a new folder or into an authorized installation and then have copied files into the current installation folder. We recommend that you retract to, or re-install an older authorized version of NewViews, or contact Q.W.Page customer support to rectify the situation. }] [p { There are no restrictions on the use of any registered NewViews installation. However, you can only update to new versions of Newviews if you subscribe to the maintenance plan. }] [p { We strongly recommend that you subscribe to the maintenance plan and keep your subscription active. This will entitle you to use the latest versions of NewViews as they become available. }] [p { The maintenance plan works both ways. It generates revenue for Q.W.Page of course, but it also tends to reduce costs for NewViews users. An up-to-date customer base greatly simplifies Q.W.Page's ability to support and enhance NewViews, and to detect and correct bugs that could potentially compromise integrity. Supporting a large number of different NewViews versions would eventually become unmanageable from product development and customer support points of view, as well as for users. Allowing this situation would result in what is called [qw_term "version madness"]. Version madness reduces the ability of users to communicate with each other effectively, and causes more confusion and expense for all. }] } } }]; }; ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.24";} [::qw::system] cpp_registration_set $Registration; ::set Serial [::sargs::get [[::qw::system] cpp_registration_get] .serial]; ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.25";} ::if {[::string first "internal" [::string tolower $Serial]]>=0} { ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.26";} ::set ::qw::control(serial_is_internal) 1; #rwb_release; } ::if {($::qw::control(app_name) ne "app_name_workstation") && ($::qw::control(app_name) ne "app_name_server")} { /* { 2.36.1 We only want to check the age of NewViews when running a workstation or hyphen-server. This could cause reboot problems, for example, when rebooting a service or mothership. We should consider eliminating it altogether. */ } ::return; } ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.27";} ::set SystemDate [::qw::date::from_number clock_second [::clock seconds]]; ::set DateLimit [::qw::date::add $::qw_build year 1]; ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.28";} ::if {[::qw::date::difference $SystemDate $DateLimit seconds]>0} { ::if {$::qw::control(tk_is_enabled)} { ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.29";} ::set Title "Your version of NewViews is out of date." ::qw::dialog3::notify [::subst -nocommands { .title {$Title} .id 314120050428110628 .html { .height 1.5i .width 4.5i .body { [h2 "Your version of NewViews is out of date."] [p { This is just a warning. NewViews will run but we recommend that you update to the current version to avoid any issues and maintain access to technical support services. Click [qw_button Help] for more. }] } } .help_page { .id 314120190923082012 .title {$Title} .body { [p { NewViews will run but we recommend that you update to the current version to avoid any issues and maintain access to technical support services. }] [h3 "Notes on Renewing"] [p { Please keep your Annual Upgrade Plan up-to-date to receive all updates for NewViews 2 or NewViews for Non-Profit Housing. To order or renew an [qw_term "Annual Upgrade"] plan, click here . }] [p { Once in the store, make sure you choose the category corresponding to your edition of NewViews (i.e. NewViews 2 or NewViews for Non-Profit Housing). }] [/* { [p { If you are using NewViews 2, add the following product to your shopping cart: NewViews 2 Annual Upgrade Plan }] [p { If you are using NewViews for Non-Profit Housing, add the following product to your shopping cart: NewViews for Non-Profit Housing Annual Upgrade Plan }] */ }] [p { Please note that you must order/renew an Annual Upgrade Plan for each workstation running NewViews. }] [p { Upon checkout, you will receive a receipt by email that confirms your order and provides you with a download link. If you are running NewViews in a multiuser environment, the update only needs to be installed on the NewViews server; remote workstations will be updated when they log in. }] [p { If an Annual Upgrade Plan for a NewViews server or workstation expires before you renew, you may be required to re-register that server/workstation in order to install an update. Re-registration only takes a few minutes and can be done by contacting Q.W. Page Technical Support. }] [p { For complete instructions on installing a NewViews update, please consult the User Guide. }] } } .control_button { .dismiss { .text "Enter NewViews" .tooltip { .text "(Esc) - Enter NewViews" } .value "" } } }]; } else { ::qw::warning 314120190924102504 "Your version of NewViews is out of date."; } } ::return; /* { ::if {[::qw::date::difference $SystemDate $DateLimit seconds]>0} { ::set Text "NewViews is getting old."; ::append Text "\n\nNewViews will run but we recommend that you update."; ::append Text "\nClick for more." ::qw::dialog::notify [::subst { .title "NewViews is getting old." .text {$Text} .help { .help_id 314120050428110628 } /button { /cancel { .text "Enter NewViews" } } }]; } ::if {$rwb1_debug} {::puts "rwb1_debug,registration_check.1000.30";} ::return; */ } /* { Code below this point is left in for now but it will probably never be used again. */ } [::qw::system] cpp_registration_set $Registration; ::set SystemDate [::qw::date::from_number clock_second [::clock seconds]]; ::set RegistrationDate [::sargs::get $Registration .date]; ::set DateLimit [::qw::date::add $RegistrationDate year 1]; ::if {[::qw::date::difference $SystemDate $DateLimit seconds]>0} { [::qw::system] cpp_registration_condition_set registration_expired; ::set Text "The annual NewViews registration has expired.\n\n"; ::append Text "NewViews will run but database access will be read-only.\n"; ::append Text "The installation can be returned to full functionality by registering.\n" ::append Text "Click for more.\n" ::qw::dialog::notify [::subst { .title "NewViews annual registration has expired." .text {$Text} .help { .help_id 314120050217175503 } /button { /cancel { .text "Enter NewViews" } } }]; ::return; } ::set GraceDateLimit [::qw::date::add $RegistrationDate month 11]; ::if {[::qw::date::difference $SystemDate $GraceDateLimit seconds]>0} { ::set Text "The annual NewViews registration will expire on [::qw::date::format $DateLimit {%d %b %Y}].\n\n"; ::append Text "Please renew the registration to avoid expiry.\n" ::append Text "Click for more.\n" ::qw::dialog::notify [::subst { .title "NewViews annual registration will expire soon." .text {$Text} .help { .help_id 314120050217181419 } /button { /cancel { .text "Enter NewViews" } } }]; } } ::proc ::qw::boot::script_run_on_demand {} { /* { We check to see if there is a script to run. If there is, then we run it and if it returns, we unwind the stack. The script itself will take control, possibly with vwait and possibly issuing ::qw::shutdown. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::script_run_on_demand,1000.0,qw_sargv==$::qw_sargv";} ::if {![::sargs::exists $::qw_sargv .script]} { /* { Can't be running a script because no .script argument. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::script_run_on_demand,1000.0.0";} ::return 0; } /* { # this is handled by ::qw::boot::process_argv so no need here. ::if {[::sargs::exists $::qw_sargv .script.path]} { /* { If there is a .script.path argument then we are probably being called by a another script which is also launching newviews. However, it could have been manually typed into a command line. If there is a .script argument but not a .script.path argument then it was probably run manually typed into command line. In that case we move the .script value to .script.path. If the .script argument had never existed and we had started with .script.path, then this would not be an issue. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::script_run_on_demand,1000.1";} } else { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::script_run_on_demand,1000.2";} ::set ScriptPath [::sargs::get $::qw_sargv .script]; ::sargs::var::unset ::qw_sargv .script; ::sargs::var::set ::qw_sargv .script.path $ScriptPath; } */ } ::set ScriptPath [::sargs::get $::qw_sargv .script.path]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::script_run_on_demand,1000.3";} ::if {$ScriptPath eq "1"||$ScriptPath eq ""} { /* { hargs2sargs can set a value to 1 if it's value was omitted. */ } ::qw::throw "Empty script path specified in command line."; } # ----------------------------------------------------------- # Set up ::qw::script::auto_shortcut # ----------------------------------------------------------- # 2.34.5 - moved shortcuts here from qw_script.qw_lib # reason - make shortcuts compatible with ::qw::control(commandline_script_path); /* { We allow shortcuts in general whereby each shortcut maps to the vfs file. rwb_absolute allows running from the host directory system instead of the vfs so we don't have to recompile with each change. This only occurs on benn7 and aspire and only when not a release. */ } ::set Folder $::qw_program_path; ::if {$::qw::control(rwb_absolute)} { ::set Folder [::file join c:/ rwb]; } ::switch -glob -- $ScriptPath { "stub" { ::if {$::qw::control(use_stub_july_stub_script)} { # this is the old stub that was working with c04 and c05 ::set ScriptPath [::file join $Folder system service qw_service_stub_july.qw_script]; } else { # this is the new stub with separate stub checker ::set ScriptPath [::file join $Folder system service qw_service_stub.qw_script]; } } "hub" { ::set ScriptPath [::file join $Folder system service qw_service_hub.qw_script]; } "node" { ::set ScriptPath [::file join $Folder system service qw_service_node.qw_script]; } "about" { ::set ScriptPath [::file join $Folder doc qw_help_about.qw_script]; } "wsi" { ::set ScriptPath [::file join $Folder system service windows_service_installer.qw_script]; } "*database_utilities.qw_script" - "du" { # 2.35.0 /* { Moved database_utilities from system to system/database_utilities in 2.34.9. Left a placeholder script in system to redirect the call but gave it the wrong path. Decided to delete the placeholder and redirect here in one place. */ } ::set ScriptPath [::file join $Folder database_utilities database_utilities.qw_script]; } "mdb" { ::set ScriptPath [::file join $Folder message_database qw_message_database.qw_script]; } "mdb_query" { /* { This goes to host file system so only works on development computers. But don't need to recompile for each query. */ } ::switch -- $::tcl_platform(platform) { "windows" { ::switch -glob -- [::info hostname] { "benn*" { ::set ScriptPath [::file join c:/ rwb message_database qw_message_database_query_ui.qw_script]; } default { ::qw::throw "Script \"mdb_query\" is not set up to run \"qw_message_database_query_ui.qw_script\" on this computer."; } } } "unix" { ::switch -- [::info hostname] { "benn-2025" { ::set ScriptPath [::file join /home benn qw rwb message_database qw_message_database_query_ui.qw_script]; } default { ::qw::throw "Script \"mdb_query\" is not set up to run \"qw_message_database_query_ui.qw_script\" on this computer."; } } } } } "dt" { ::switch -- $::tcl_platform(platform) { "unix" { ::switch -- [::info hostname] { "benn-2025" { ::set ScriptPath [::file join /home benn qw rwb_global database_tools.qw_script]; } default { ::qw::throw "Script \"dt\" is not set up to run \"database_tools.qw_script\" on this computer."; ::set ScriptPath [::file join $::qw_program_folder database_tools.qw_script]; } } } "windows" { ::set ScriptPath [::file join c:/ rwb_global database_tools.qw_script]; } } } } ::qw::try { # 2.28.0 /* { # 2.28.0 We will build a list of potential script paths. If the given path is relative then we try it relative to the vfs and then the pwd. If no extension we also try it without and then with the extension. The first one that exists then goes through additional check that can throw exceptions. # 2 28.0 ::set Path [::string tolower [::file join [cd] $Path]]; */ } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::script_run_on_demand,1000.4";} ::set PathList [::list]; ::switch -- [::file pathtype $ScriptPath] { relative { /* { 2.27.0 We make path relative to .exe using $::qw_program_path, i.e. [::info nameofexecutable]. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::script_run_on_demand,1000.5";} ::lappend PathList [::file join $::qw_program_path $ScriptPath]; ::if {[::file extension $ScriptPath] eq ""} { ::lappend PathList [::file join $::qw_program_path $ScriptPath.qw_script]; } /* { 2.28.0 With lower priority we make path relative to pwd. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::script_run_on_demand,1000.6.0";} ::lappend PathList [::string tolower [::file join [::pwd] $ScriptPath]]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::script_run_on_demand,1000.6.1";} ::if {[::file extension $ScriptPath] eq ""} { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::script_run_on_demand,1000.6.2";} # 2.29.0 - there was an error in the syntax of the following line ::lappend PathList [::string tolower [::file join [::pwd] $ScriptPath.qw_script]]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::script_run_on_demand,1000.6.3";} } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::script_run_on_demand,1000.7";} #2.28.0 ::set ScriptPath [::string tolower [::file join [::info nameofexecutable] $ScriptPath]]; } absolute { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::script_run_on_demand,1000.8";} ::lappend PathList $ScriptPath; ::if {[::file extension $ScriptPath] eq ""} { ::lappend PathList $ScriptPath.qw_script; } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::script_run_on_demand,1000.9";} } volumerelative { } default { } } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::script_run_on_demand,1000.10";} ::foreach Path $PathList { ::if {[::file exists $Path]} { /* { If the specified file does not exist but the file path has no extension, then append .qw_script and try again. */ } ::set ScriptPath $Path; ::break; } } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::script_run_on_demand,1000.11";} /* { ::if {![::file exists $ScriptPath]} { ::qw::throw "Could not find \"$ScriptPath\"."; } ::if {[::file isdirectory $ScriptPath]} { ::qw::throw "\"$ScriptPath\" is a folder."; } /* { The following check caused problems on some computers so it was removed. ::if {[::file executable $ScriptPath]} { ::qw::throw "\"$ScriptPath\" is an executable file."; } */ } ::if {![::file readable $ScriptPath]} { ::qw::throw "\"$ScriptPath\" is not readable by the current user."; } ::if {$::tcl_platform(platform)=="windows"} { ::array set Attributes [::file attributes $ScriptPath]; ::if {$Attributes(-system)} { ::qw::throw "\"$ScriptPath\" is a system file."; } } ::if {![::file isfile $ScriptPath]} { ::qw::throw "\"$ScriptPath\" is not a file."; } */ } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::script_run_on_demand,1000.14";} } catch Exception { ::qw::throw [::qw::exception::nest .super "Could not run script \"$ScriptPath\"." .sub $Exception]; } ::qw::try { #2.34.5 - added ::qw::control(commandline_script_path) # ::set ScriptPath [::file join $::qw_program_path doc qw_help_about.qw_script]; ::set ::qw::control(commandline_script_path) $ScriptPath; # 2.32.3 ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::script_run_on_demand,1000.15,ScriptPath==$ScriptPath";} ::qw::script::source $::qw_sargv .script.path $ScriptPath .script.invoker commandline; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::script_run_on_demand,1000.16";} ::return 1; } catch Exception { ::qw::throw [::qw::exception::nest .super "Error in script \"$ScriptPath\"." .sub $Exception]; } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::script_run_on_demand,1000.99";} ::return 0; } ::proc ::qw::boot::database_path_from_commandline {} { /* { 2.29.0 Extracts -file or -database_psath from the command line args and returns it. Handles the case where the database_path is relative, i.e. not absolute. Cut this out to separate proc because it is needed in several places. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::database_path_from_commandline,1000.0";} ::set Index [::lsearch -exact $::qw_argv "-database_path"]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::database_path_from_commandline,1000.1";} ::if {$Index<0} { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::database_path_from_commandline,1000.2";} ::return ""; } # ::set ArgV [::string map [::list "{{" "{" "}}" "}"] $::qw_argv]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::database_path_from_commandline,1000.3.0,::argv==$::argv";} ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::database_path_from_commandline,1000.3.1,::qw_argv==$::qw_argv";} # ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::database_path_from_commandline,1000.3.2,ArgV==$ArgV";} ::set DatabasePath [::lindex $::qw_argv [::incr Index]]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::database_path_from_commandline,1000.3.3,DatabasePath==$DatabasePath";} ::set DatabasePath [::string map [::list "\\" "\\\\"] $DatabasePath]; ::set DatabasePath [::string map [::list "{" "" "}" ""] $DatabasePath]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::database_path_from_commandline,1000.3.4,DatabasePath==$DatabasePath";} ::if {$DatabasePath eq ""} { ::qw::throw "Encountered an empty path to the workstation or server file."; } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::database_path_from_commandline,1000.4";} ::if {[::file pathtype $DatabasePath] eq "relative"} { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::database_path_from_commandline,1000.5.0,DatabasePath==$DatabasePath";} ::set DatabasePath [::file join $::qw_program_folder $DatabasePath]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::database_path_from_commandline,1000.5.1,DatabasePath==$DatabasePath";} } ::set DatabasePath [::file normalize $DatabasePath]; ::set DatabasePath [::string tolower $DatabasePath]; ::if {[::file extension $DatabasePath] eq ""} { ::append DatabasePath ".nv2"; } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::boot::database_path_from_commandline,1000.6,DatabasePath==$DatabasePath";} ::return $DatabasePath; }