::array set ::qw::odb::definitions {}; ::array set ::qw::odb::classes_installed {}; ::array set ::qw::odb::load_definitions_on_demand_array {}; # key==class_path,value=definition_file_path ::if {$::qw::control(active_index_procs)} { ::array set ::qw::odb::active_index_odb_key_array {}; ::array set ::qw::odb::active_index_odb_is_hit_array {}; ::array set ::qw::odb::active_index_odb_is_interactive_array {}; ::array set ::qw::odb::active_index_odb_is_closure_array {}; } ::set ::qw::odb::class_to_file_map_is_loaded 0; # ------------------------------------------------------------ # ::qw::odb::definitions # ------------------------------------------------------------ ::set ::qw::odb::background_definition_path_list [::list]; # list to be loaded in background ::array set ::qw::odb::loaded_definition_path_array {}; # path to each definition_file that has been loaded, /* { This library contains methods responsible for loading definition.qw_tcl files. ::qw::odb::background_definition_path_list contains the list of definition.qw_tcl files that are to be loaded in background. The load_definition_background task loads one definition file at a time. The files can also be loaded on demand, as needed, when constructing odb classes. All file paths are relative when stored in lists or arrays. They are only absolute when actually loading from the vfs. */ } ::proc ::qw::odb::load_definition_background {} { # -------------------------------------------------------- # Background task to load one definition file at a time # -------------------------------------------------------- ::set rwb1_debug 0; ::if {!$::qw::control(load_definitions_on_demand)} { /* { If we're not loading on demand then we are preloading and we never start this background task. */ } ::qw::bug 314120200304144342 "[::qw::procname] - unexpected call."; } ::if {[::llength $::qw::odb::background_definition_path_list]==0} { ::qw::bug 314120200523205724 "[::qw::procname] - empty background_definition_path_list."; } ::set QwTclFilePath [::lindex $::qw::odb::background_definition_path_list 0]; ::if {$QwTclFilePath eq ""} { ::qw::bug 314120200523205725 "[::qw::procname] - empty background_definition_path."; } ::set ::qw::odb::background_definition_path_list [::lrange $::qw::odb::background_definition_path_list 1 end]; ::if {![::info exists ::qw::odb::loaded_definition_path_array($QwTclFilePath)]} { # ------------------------------------------------------------ # Only load file if not already loaded. # ------------------------------------------------------------ ::if {$rwb1_debug} {::puts "rwb1_debug,load_definition_background,1000.0,seconds==[::clock seconds],file==$QwTclFilePath";} ::qw::odb::load_qw_tcl_file .relative_path $QwTclFilePath; ::if {$rwb1_debug} { ::set Count 0; ::puts "rwb1_debug,load_definition_background,1000.1,::qw::odb::background_definition_path_list=="; ::foreach Path $::qw::odb::background_definition_path_list { ::puts "PathList\[$Count\]==\"$Path\"."; ::incr Count; } } } ::if {[::llength $::qw::odb::background_definition_path_list]!=0} { # ------------------------------------------------------------ # Schedule next load until unloaded list is empty. # ------------------------------------------------------------ /* { 2.38.2 - changed 1 sec to 5 secs. pgq complained that pauses drove him nuts wen booting. */ } ::after 5000 [::subst -nocommands { ::if {[::qw::command_exists ::qw::odb::load_definition_background]} { ::qw::odb::load_definition_background; } }]; } else { ::if {$rwb1_debug} {::puts "rwb1_debug,load_definition_background,1000.99,seconds==[::clock seconds],nothing more to schedule.";} } } ::proc ::qw::odb::get_class_definition {sargs} { /* { 2.28.3 We want faster boot times so now we load the definitions on demand. This proc returns the definition for one class. It is called from odb.cpp tcl_class(). It should only be called once for each class. The first time it is called, it loads the load_definitions_on_demand_array. */ } ::set rwb1_debug 0; ::if {!$::qw::control(load_definitions_on_demand)} { ::qw::bug 314120151208103902 "[::qw::procname] - unexpected call."; } ::if {!$::qw::odb::class_to_file_map_is_loaded} { # -------------------------------------------------------- # Load the class to file map - class_to_file_map.tcl # -------------------------------------------------------- /* { The first time we get a class we load the array, which maps class paths to the file containing their definition. I don't use ::array size because that method actually counts the items (is inefficient). Number of list elements 3224, i.e 1612 classes defined. Time to load on benn7 machine 20ms. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::get_class_definition,1000.0,sargs==$sargs";} ::qw::profile::begin "class_to_file_map_build"; ::set Milli0 [::clock clicks -milliseconds]; ::set NameValueList [::qw::fileutil::file_read .path [::file join $::qw_library system class_to_file_map.tcl] .translation binary]; ::array set ::qw::odb::class_to_file_map $NameValueList; ::set ::qw::odb::class_to_file_map_is_loaded 1; ::qw::profile::end "class_to_file_map_build"; ::switch -- $::qw::control(app_name) { app_name_service_hub { ::lappend ::qw::odb::background_definition_path_list "object/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/server/application_definition.qw_tcl"; } app_name_workstation { ::lappend ::qw::odb::background_definition_path_list "object/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/window_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/workstation/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/workstation/window_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/system/gui/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/system/gui/window_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/system/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/system/window_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/window_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/payroll/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/payroll/window_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/payroll/canada/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/payroll/canada/window_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/payroll/usa/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/payroll/usa/window_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/de/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/de/window_definition.qw_tcl"; } app_name_database_utilities - app_name_server { ::lappend ::qw::odb::background_definition_path_list "object/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/window_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/system/gui/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/system/gui/window_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/system/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/system/window_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/server/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/server/workstation_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/window_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/payroll/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/payroll/window_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/payroll/canada/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/payroll/canada/window_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/payroll/usa/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/payroll/usa/window_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/de/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/de/window_definition.qw_tcl"; } app_name_service_node { ::lappend ::qw::odb::background_definition_path_list "object/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/workstation/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/system/gui/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/system/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/payroll/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/payroll/canada/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/payroll/usa/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/de/application_definition.qw_tcl"; } app_name_default { ::lappend ::qw::odb::background_definition_path_list "object/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/workstation/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/system/gui/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/system/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/payroll/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/payroll/canada/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/payroll/usa/application_definition.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/de/application_definition.qw_tcl"; } } # -------------------------------------------------------- # Start the background definition load process. # -------------------------------------------------------- /* { 2.38.2 - changed 1 sec to 5 secs. pgq complained that pauses drove him nuts wen booting. */ } ::after 5000 [::subst -nocommands { ::if {[::qw::command_exists ::qw::odb::load_definition_background]} { ::qw::odb::load_definition_background; } }]; /* { Various non-definition and non-install *.qw_tcl files. ::lappend ::qw::odb::background_definition_path_list "object/newviews/importer.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/payroll/payrun.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/payroll/canada/payrun.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "object/newviews/payroll/usa/payrun.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "/system/print/print.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "/system/print/com.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "/object/system/gui/gui.qw_tcl"; ::lappend ::qw::odb::background_definition_path_list "/object/system/gui/tree_new_observers.qw_tcl"; */ } } # -------------------------------------------------------- # Return the definition we were called for in the first place. # -------------------------------------------------------- ::set ClassPath [::sargs::get $sargs .class_path]; ::if {$ClassPath eq ""} { ::qw::bug 314120151207174636 "[::qw::procname] - no .class_path argument"; } ::if {[::info exists ::qw::odb::definitions($ClassPath)]} { /* { The class definition must have been in a vfs .qw_tcl file that has already been loaded. */ } ::return $::qw::odb::definitions($ClassPath); } ::if {![::info exists ::qw::odb::class_to_file_map($ClassPath)]} { /* { Some classes are not defined and are treated as having an empty definition. When not defined we just return empty. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::odb::get_class_definition,no definition for ClassPath \"$ClassPath\".";} ::return ""; } # ::set DefinitionFilePath [::file join $::qw_program_path $::qw::odb::class_to_file_map($ClassPath)]; ::qw::odb::load_qw_tcl_file .relative_path $::qw::odb::class_to_file_map($ClassPath); ::if {![::info exists ::qw::odb::definitions($ClassPath)]} { ::qw::bug 314120200306162005 "Can't find definition for class path $ClassPath."; } ::return $::qw::odb::definitions($ClassPath); /* { # -------------------------------------------------------- # Load a *.qw_tcl definition file. # -------------------------------------------------------- ::if {$::qw::control(qw_tcl_is_encrypted)} { ::set Path $::qw::odb::class_to_file_map($ClassPath); ::set CipherPath [::file join $::qw_library $Path]; ::set Key "qw_tcl_key_16180339"; ::set CipherText [::qw::fileutil::file_read .path $CipherPath .translation binary]; ::qw::profile::finally class_definition_load_one$ClassPath ::if {$::qw::control(click_profile)} { ::set Clicks [::clock clicks -milliseconds]; } ::set CipherText [::base64::decode $CipherText]; ::set PlainText [::qw::aes::encrypt .key $Key .cipher_text $CipherText]; ::set ClassDefinitionList $PlainText; ::qw::profile::end class_definition_load_one$ClassPath; ::qw::odb::class_definition_list_load .class_definition_list $ClassDefinitionList; ::return $::qw::odb::definitions($ClassPath); } ::set Path [::file join $::qw_program_path $::qw::odb::class_to_file_map($ClassPath)]; ::qw::profile::finally class_definition_load_one$ClassPath ::set ClassDefinitionList [::qw::fileutil::file_read .path $Path .translation binary]; ::qw::odb::class_definition_list_load .class_definition_list $ClassDefinitionList; ::qw::profile::end class_definition_load_one$ClassPath; ::return $::qw::odb::definitions($ClassPath); */ } } ::proc ::qw::odb::class_definition_list_load {sargs} { /* { Loads up ::qw::odb::definitions array with the definition of each class encountered in the class_path_list which should be a list of class_path/defintion pairs. This proc is passed a list of definitions which is generally the contents of one definition.qw_tcl file. */ } ::if {[::qw::command_exists ::qw::loading_banner::update]} { ::qw::loading_banner::update; } ::set ClassDefinitionList [::sargs::get $sargs .class_definition_list]; ::if {[::llength $ClassDefinitionList]%2!=0} { ::qw::throw "Syntax error, commonly caused by mismatched braces."; } ::foreach {ClassPath ClassDefinition} $ClassDefinitionList { ::if {$ClassPath eq "/*"} { /* { Ignore any comments placed between definitions. */ } ::continue; } ::if {$ClassPath eq "#include"} { /* { Brings in the specified file inline like any include mechanism would. */ } ::set Path $ClassDefinition; ::if {![::file exists $Path]} { ::qw::throw \ .text "Definition #include failed - could not find file \"$Path\"." \ ; } ::set IncludeDefinitions [::qw::fileutil::file_read .path $Path .translation binary]; [::qw::procname] .class_definition_list $IncludeDefinitions; ::continue; } ::if {![::sargs::is_field_path $ClassPath]} { /* { 2.30.0 Checking even number of items is not sufficient. After comments eliminated, have to check each path is in fact valid. Encountered comments starting with # that had even number of elements and this led to subtle problems that were hard to find. */ } ::if {[::string length $ClassPath]>64} { ::set ClassPath "[::string range $ClassPath 0 63]..."; } ::qw::throw "Syntax error, bad path:\"$ClassPath\"."; } ::if {[::info exists ::qw::odb::definitions($ClassPath)]} { ::qw::throw "Duplicate definition of \"$ClassPath\"."; } ::set ::qw::odb::definitions($ClassPath) $ClassDefinition; } } ::proc ::qw::odb::load_qw_tcl_file {sargs} { /* { Loads a *.qw_tcl file. If a window/application definition then loads up ::qw::odb::definitions. Otherwise assumes it is a script and sources it. We are give the absolute path in .path. */ } ::set RelativePath [::sargs::get $sargs .relative_path]; ::qw::try { ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,load_qw_tcl_file,1000.0,relative_path==$RelativePath";} ::qw::profile::finally class_definition_load_$RelativePath; ::if {[::info exists ::qw::odb::loaded_definition_path_array($RelativePath)]} { /* { We could have been loaded (or sourced) in foreground and then background tries to load it again. Problem: What about "scripts" like payrun.qw_tcl. Answer: We do not preload them. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,load_qw_tcl_file,1000.0.0";} ::return; } ::set ::qw::odb::loaded_definition_path_array($RelativePath) 1; ::if {![::file exists [::file join $::qw_library $RelativePath]]} { /* { An example was definition file that had no window classes, i.e. /object/definition.qw_tcl. So there was no window_deifnition.qw_tcl file. */ } ::return; } # ------------------------------------------------------------ # Read the file, decrypting if necessary. # ------------------------------------------------------------ ::switch -- [::file tail $RelativePath] { "application_definition.qw_tcl" - "window_definition.qw_tcl" { # ------------------------------------------------------------ # Load definition.qw_tcl into ::qw::odb::definitions array. # ------------------------------------------------------------ ::qw::profile::begin "qw_tcl_read-$RelativePath"; ::set Data [::qw::fileutil::file_read \ .path [::file join $::qw_library $RelativePath] \ .translation binary \ ]; ::qw::profile::end "qw_tcl_read-$RelativePath"; ::if {$::qw::control(qw_tcl_is_base64)} { ::qw::profile::begin "qw_tcl_base64-$RelativePath"; ::set Data [::qw::base64::decode .data $Data]; ::qw::profile::end "qw_tcl_base64-$RelativePath"; } ::if {$::qw::control(qw_tcl_is_encrypted)} { ::qw::profile::begin "qw_tcl_decrypt-$RelativePath"; ::set Data [::qw::aes::decrypt .key "qw_tcl_key_16180339" .cipher_text $Data]; ::qw::profile::end "qw_tcl_decrypt-$RelativePath"; } ::if {$rwb1_debug} {::puts "rwb1_debug,load_qw_tcl_file,1000.1.0";} ::set ClassDefinitionList $Data; ::if {$rwb1_debug} {::puts "rwb1_debug,load_qw_tcl_file,1000.1.1";} ::if {[::llength $ClassDefinitionList]%2!=0} { ::if {$rwb1_debug} {::puts "rwb1_debug,load_qw_tcl_file,1000.1.2";} ::if {$rwb1_debug} {::puts "rwb1_debug,load_qw_tcl_file,1000.6";} ::qw::throw "Syntax error, commonly caused by mismatched braces."; } ::if {$rwb1_debug} {::puts "rwb1_debug,load_qw_tcl_file,1000.1.3";} ::foreach {ClassPath ClassDefinition} $ClassDefinitionList { ::if {$ClassPath eq "/*"} { /* { Ignore any comments placed between definitions. */ } ::continue; } ::if {$ClassPath eq "#include"} { /* { Brings in the specified file inline like any include mechanism would. */ } ::set Path $ClassDefinition; ::if {![::file exists $Path]} { ::qw::throw \ .text "Definition #include failed - could not find file \"$Path\"." \ ; } ::set IncludeDefinitions [::qw::fileutil::file_read .path $Path .translation binary]; [::qw::procname] .class_definition_list $IncludeDefinitions; ::continue; } ::if {![::sargs::is_field_path $ClassPath]} { /* { 2.30.0 Checking even number of items is not sufficient. After comments eliminated, have to check each path is in fact valid. Encountered comments starting with # that had even number of elements and this led to subtle problems that were hard to find. */ } ::if {[::string length $ClassPath]>64} { ::set ClassPath "[::string range $ClassPath 0 63]..."; } ::qw::throw "Syntax error, bad path:\"$ClassPath\"."; } ::if {[::info exists ::qw::odb::definitions($ClassPath)]} { ::qw::throw "Duplicate definition of \"$ClassPath\"."; } ::if {$rwb1_debug} {::puts "rwb1_debug,load_qw_tcl_file,1000.7";} ::set ::qw::odb::definitions($ClassPath) $ClassDefinition; ::if {$rwb1_debug} {::puts "rwb1_debug,load_qw_tcl_file,1000.8";} } } default { # ------------------------------------------------------------ # If it's not a definition file than just source it. # ------------------------------------------------------------ ::qw::profile::begin "read_qw_tcl_file$RelativePath"; ::if {$::qw::control(qw_tcl_is_encrypted)} { ::set Data [::qw::fileutil::file_read \ .path [::file join $::qw_library $RelativePath] \ .translation binary \ ]; # ::set CipherText [::qw::base64::decode .data $CipherText]; #base64 ::set Data [::qw::base64::decode .data $Data]; ::set Data [::qw::aes::decrypt .key "qw_tcl_key_16180339" .cipher_text $Data]; ::qw::profile::end "read_qw_tcl_file$RelativePath"; } ::eval $Data; } } ::if {$rwb1_debug} {::puts "rwb1_debug,load_qw_tcl_file,1000.14";} } catch Exception { ::qw::throw [::qw::exception::nest .sub $Exception .super "Could not load file \"$RelativePath\"."]; } } ::proc ::qw::odb::load_all_class_definitions {} { ::set rwb1_debug 0; /* { ::if {$::qw::control(load_definitions_on_demand)} { ::qw::bug 314120299413084857 "[::qw::procname] - unexpected call."; } */ } ::qw::profile::finally "load_all_class_definitions"; ::set PathList [::list]; ::if {!$::qw::control(skip_linux_problems)} { ::package require printer; } #2.34.2 ::package require qw::object::system::gui; #2.34.2 ::lappend PathList [::file join object system gui gui.qw_tcl]; ::if {!$::qw::control(load_definitions_on_demand)} { ::lappend PathList [::file join system print com.qw_tcl]; ::lappend PathList [::file join object system gui tree_new_observers.qw_tcl]; ::lappend PathList [::file join object newviews payroll payrun.qw_tcl]; ::lappend PathList [::file join object newviews payroll canada payrun.qw_tcl]; ::lappend PathList [::file join object newviews payroll usa payrun.qw_tcl]; ::lappend PathList [::file join object definition.qw_tcl]; ::lappend PathList [::file join object workstation definition.qw_tcl]; ::lappend PathList [::file join object server definition.qw_tcl]; ::lappend PathList [::file join object system gui definition.qw_tcl]; ::lappend PathList [::file join object system definition.qw_tcl]; ::lappend PathList [::file join object newviews definition.qw_tcl]; ::lappend PathList [::file join object newviews payroll definition.qw_tcl]; ::lappend PathList [::file join object newviews payroll canada definition.qw_tcl]; ::lappend PathList [::file join object newviews payroll usa definition.qw_tcl]; #dataease ::lappend PathList [::file join object de definition.qw_tcl]; #20031019_airtech ::if {$::qw::control(airtech)} { ::lappend PathList [::file join object newviews airtech definition.qw_tcl]; } } ::foreach Path $PathList { ::qw::try { ::qw::profile::begin "class_definition_load_$Path"; ::switch [::file rootname [::file tail $Path]] { "definition" { ::set ClassDefinitionList [::qw::fileutil::file_read .path [::file join $::qw_library $Path] .translation binary]; ::qw::odb::class_definition_list_load .class_definition_list $ClassDefinitionList; } default { ::source [::file join $::qw_library $Path]; } } ::qw::profile::end "class_definition_load_$Path"; } catch Exception { ::qw::throw [::qw::exception::nest .sub $Exception .super "Could not load file \"$Path\"."]; } } } ::qw::odb::load_all_class_definitions;